Retro1.org codex

          IDENT  SFM,SFM 
          PERIPH
          BASE   MIXED
          SST
 STI$     EQU    1           SET UNCONDITIONAL RETURN FROM *COMPSTI*
*COMMENT  SFM - SYSTEM FILE MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  SFM - SYSTEM FILE MANAGER.
          SPACE  4
***       SFM - SYSTEM FILE MANAGER.
*         G. R. MANSFIELD.  70/10/02.
*         R. A. JAPS.        75/01/02.
*         S. L. KSANDER.     75/05/26.
*         P. D. HAAS.        79/05/23.
          SPACE  4
***              SFM PERFORMS VARIOUS FILE MANAGING TASKS FOR A JOB.
          SPACE  4
***       CALL.
*
*
*T        18/ *SFM*,1/,1/1,4/,12/ CODE,6/,18/ FET
*         CODE   FUNCTION CODE
*         FET    ADDRESS OF FET
*
*T FET    42/ LFN , 17/  , 1/0
*T,FET+1  12/ ET , 3/  , 1/E, 26/   , 18/ FIRST
*T,FET+2  42/  , 18/  IN
*T,FET+3  42/  , 18/  OUT
*T,FET+4  42/  , 18/ LIMIT
*T,FET+5  60/
*T,FET+6  60/
*T,FET+7  12/ EQ, 24/ , 12/ TY, 6/ , 6/ WI
*
*         LFN = LOCAL FILE NAME.
*         ET  = EQUIPMENT TYPE.
*         E   = RETURN ERROR CODE.
*         EQ  = EST ORDINAL.
*         TY  = DAYFILE TYPE. (SEE COMSIOQ FOR DEFINED CODES).
*                1 = SYSTEM DAYFILE
*                2 = ACCOUNT DAYFILE
*                3 = ERRLOG DAYFILE
*                4 = MAINTENANCE LOG DAYFILE
*         WI  = WORD INDEX IN SECTOR (SETDI).
*
*         RETURN.
*
*T FET    42/  *FILE NAME*,8/  EC,9/,1/1
*         EC     ERROR CODE
          SPACE  4
***       DAYFILE MESSAGES.
*
*
*         * SFM ARGUMENT ERROR.*
*                ARGUMENT TO SFM WAS OUT OF RANGE.
*
*         * SFM BML MESSAGE LENGTH ERROR.*
*                BML MESSAGE LENGTH IS = 0, OR .GT. 6.
*
*         * SFM INCORRECT REQUEST.*
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
*                1. SFM NOT CALLED WITH AUTO RECALL.
*                2. FUNCTION CODE OUT OF RANGE.
*                3. USER DOES NOT HAVE SYSTEM ORIGIN PRIVILEGES.
*                4. CALLING PROGRAM IS NOT SSJ=.
*
*         * SFM INCORRECT DAYFILE CODE.*
*                DAYFILE CODE PASSED IN THE FET WAS NOT WITHIN RANGE.
*
*         * SFM INCORRECT EQUIPMENT.*
*                EQUIPMENT NOT WITHIN EST OR NOT MASS STORAGE.
*
*         * SFM FILE NOT FOUND.*
*                REQUESTED FILE WAS NOT FOUND.
*
*         * SFM DUPLICATE FILE FOUND.*
*                THE REQUESTED FILE IS ALREADY ATTACHED TO THE
*                CONTROL POINT.
*
*         * SFM FILE NOT ON MASS STORAGE.*
*                SELF EXPLANATORY.
*
*         * SFM I/O SEQUENCE ERROR.*
*                ACTION HAS BEEN REQUESTED ON A BUSY FILE.
*
*         * SFM FILE EMPTY.*
*                SELF EXPLANATORY.
*
*         * SFM FILE NAME ERROR.*
*                FILE NAME, LFN, PASSED THROUGH FET IS NOT A
*                VALID FILE NAME.
*
*         * SFM FNT FULL.*
*                A FAST ATTACH FILE COULD NOT BE CREATED BECAUSE
*                THE FNT WAS FULL.
*
*         * SFM INCORRECT FILE TYPE.*
*                FILE MUST BE LOCAL FOR SYSTEM FILE AND DIRECT
*                ACCESS FOR FAST ATTACH FILE.
*
*         * SFM DIRECT ACCESS FILE ERROR.*
*                ERROR WAS ENCOUNTERED ON SYSTEM SECTOR OF A DIRECT
*                ACCESS FILE.
*
*         *  XXXXXXX TERMINATED.*
*                THE DAYFILE XXXXXXX, HAS BEEN TERMINATED.
*                (ISSUED TO SYSTEM AND CONTROL POINT DAYFILES).
*
*         * DAYFILE TERMINATED.*
*                SELF EXPLANATORY. (ISSUED TO TERMINATED DAYFILE).
*
*         * SFM UNABLE TO INTERLOCK DEVICE.*
*                REQUEST WAS NOT PERFORMED BECAUSE DEVICE COULD
*                NOT BE INTERLOCKED.
*
*         * SFM TRACK INTERLOCK ERROR.*
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS.
*                1. TRACK WAS INTERLOCKED WHEN IT SHOULD NOT
*                   HAVE BEEN.
*                2. TRACK WAS NOT INTERLOCKED WHEN IT SHOULD
*                   HAVE BEEN.
*
*         * SFM SYSTEM SECTOR ERROR.*
*                AN ERROR HAS BEEN ENCOUNTERED WHILE ATTEMPTING
*                TO READ A SYSTEM SECTOR.
*
*         * SFM GLOBAL FAST ATTACH LIMIT.*
*                THIS MESSAGE IS ISSUED WHEN A REQUEST IS
*                MADE TO ENTER A GLOBAL FAST ATTACH FILE
*                AND NO SPACE IS AVAILABLE IN THE *FAT*.
*
*         * SFM ABORTED.*
*                ERROR FLAG WAS SET AT SFM,S CONTROL POINT.
*
*         * SFM UNRECOVERABLE LINK DEVICE ERROR.*
*                READ OR WRITE ERROR WHEN ATTEMPTING TO UPDATE
*                *FAT* ENTRIES ON LINK DEVICE.
*
*         * SFM FAST ATTACH SYSTEM SECTOR ERROR.*
*                AN UNRECOVERABLE ERROR WAS DETECTED WHEN TRYING TO
*                READ THE SYSTEM SECTOR OF THE FILE BEING ENTERED
*                INTO FAST ATTACH STATUS.  THE FILE WAS ENTERED,
*                HOWEVER, THE SYSTEM SECTOR POINTERS WERE NOT SET.
*                THIS FILE MAY NOT BE DUMPED PROPERLY BY *PFDUMP*
*                WHEN THIS OCCURS.
*
*         * SFM LINK FAST ATTACH FILE NOT FOUND.*
*                AN ATTEMPT TO LINK TO AN EXISTING FAST ATTACH FILE
*                WAS UNSUCCESSFUL BECAUSE THE FILE WAS NOT FOUND
*                IN THE *FAT*.
*
*         * SFM FAMILY STILL ACTIVE.*
*                AN ATTEMPT HAS BEEN MADE TO REMOVE A FAST ATTACH FILE
*                FROM A FAMILY WHILE ACTIVITY STILL EXISTS WITHIN
*                THAT FAMILY.
*
*         THE FOLLOWING ERROR MESSAGES ARE ISSUED IF THE *EP* BIT
*         IS NOT SET. OTHERWISE, THE SPECIFIED ERROR CODE IS
*         RETURNED TO FET+0.  ERRORS FOR THOSE FUNCTIONS WHICH
*         HAVE ONLY A ONE-WORD PARAMETER BLOCK WILL ALWAYS BE
*         PROCESSED AS IF *EP* HAD BEEN SET.  (THESE ERRORS
*         ARE DOCUMENTED BELOW IN PARENTHESES.)
*
*         * SFM DAYFILE BUSY.*
*                EC = 1. THE DAYFILE IS CURRENTLY BUSY.
*
*         * SFM MASS STORAGE NOT AVAILABLE.*
*                EC = 2. MASS STORAGE IS NOT AVAILABLE ON THE
*                SPECIFIED DEVICE.
*
*         * SFM FILE NOT FOUND.*
*                EC = 3. THE FILE FOR WHICH ACTION HAS BEEN
*                REQUESTED CAN NOT BE FOUND.
*
*         * SFM UNCORRECTABLE RMS ERROR.*
*                EC = 4. AN UNCORRECTABLE RMS ERROR HAS BEEN DETECTED
*                DURING AN I/O OPERATION.
*
*         + *CPD* NOT ACTIVE.+
*                EC = 5. *SFM* WAS CALLED TO SET THE *CPD* DROP
*                FLAG WHEN *CPD* WAS NOT ACTIVE.
*
*         * SFM - LID TABLE TOO LONG FOR BUFFER.*
*                EC = 6.  AN ATTEMPT WAS MADE TO GET A COPY OF THE
*                LID TABLE BUT THE LIDT WAS LARGER THAN THE CALLER-S
*                BUFFER.
*
*         (LID UNKNOWN OR NOT LEGAL.)
*                EC=7. THE SPECIFIED LID WAS NOT FOUND IN THE
*                LID TABLE, OR IS NOT EXACTLY 3 CHARACTERS LONG.
*
*         ( INCORRECT LID ATTRIBUTES.)
*                EC=10.   THE SPECIFIED ATTRIBUTES ARE NOT CORRECT FOR
*                THE SPECIFIED LID.
*
*         ( CURRENT ATTRIBUTES NOT IN LID TABLE.)
*                EC = 11.  THE CURRENT ATTRIBUTES SPECIFIED DO NOT
*                MATCH THOSE CURRENTLY IN THE LID TABLE FOR THE
*                SPECIFIED LID.
*
*         ( LID TABLE OVERFLOW.)
*                EC = 12.  THE SPECIFIED NEW LID CANNOT BE ADDED TO THE
*                LID TABLE, SINCE THE LID TABLE IS ALREADY FULL.
*
*         ( TOO MANY HOST LIDS.)
*                EC = 13.  THE SPECIFIED NEW HOST LID CANNOT BE ADDED
*                TO THE LID TABLE, SINCE THE TABLE ALREADY CONTAINS
*                THE MAXIMUM NUMBER OF HOST LIDS.
*
*         ( INCORRECT SUBFUNCTION CODE.)
*                EC = 14.  THE SPECIFIED SUBFUNCTION IS NOT DEFINED FOR
*                THIS FUNCTION.
*
*         ( INCORRECT NETWORK STATUS PARAMETER.)
*                EC = 15.  THE SPECIFIED NETWORK STATUS IS NOT VALID.
*
*         ( CHECK PARAMETER BLOCK ENTRIES FOR ERROR.)
*                EC = 16.  AT LEAST ONE PARAMETER BLOCK ENTRY COULD NOT
*                BE PROCESSED DUE TO AN ERROR DETECTED.  THE CALLER MAY
*                NEED TO CHECK EACH PARAMETER ENTRY (BYTE 4) TO DETER-
*                MINE WHICH ONES WERE NOT PROCESSED, AND WHY.
          SPACE  4
***       ACCOUNT FILE MESSAGES.
*
*
*         *SDCA, XXXXXX.XXXSECS.*
*                CPU MONITOR PROGRAM MODE TIME.
*
*         *SDCM, XXXXXX.XXXKUNS.*
*                NUMBER OF STORAGE MOVES.
*
*         *SDMR, XXXXXX.XXXKUNS.*
*                CONTROL POINTS MOVED.
*
*         *SDMS, XXXXXX.XXXKUNS.*
*                SECTORS ROLLED.
*
*         *SDNF, XXXXXX.XXXKUNS.*
*                NUMBER OF FL INCREASES TO NFL.
*
*         *SDSF, XXXXXX.XXXKUNS.*
*                NUMBER OF TIMES RECALL STACK IS FULL.
*
*         *SDTS, XXXXXX.XXXKUNS.*
*                JOBS ROLLED DUE TO TIME SLICE.
*
*         *SDTO, XXXXXX.XXXKUNS.*
*                JOBS ROLLED DUE TO SLICE LIMIT OR TIME SLICE
*                WITH OUTPUT PENDING.
*
*         *SDPX, XXXXXX.XXXKUNS.*
*                PP EXCHANGE PRIORITY REQUESTS.
*
*         *ABST, X...X.*
*                SYSTEM TITLE.
*
*         *ABSV, X...X.*
*                SYSTEM VERSION.
*
*         *ABSY,  YY/MM/DD.*
*                BEGINNING OF A NEW ACCOUNT DAYFILE DUE TO
*                INITIALIZATION OR TERMINATION ON DATE
*                YY/MM/DD.
*
*         *AESY,  YY/MM/DD.*
*                END OF AN ACCOUNT DAYFILE ON DATE YY/MM/DD.
          SPACE  4,10
***       ERROR LOG MESSAGES.
*
*
*         *CHXX,YYYYYYYYY.* = EQUIPMENT ON CHANNEL XX IS RUNNING WITH
*         FIRMWARE REVISION YYYYYYYYY.
*
*         *ETXXX, UYY,PS=ZZZZZZ.* = THE PACK ON PHYSICAL UNIT YY OF EST
*         ORDINAL XXX OF TYPE ET HAS A SERIAL NUMBER OF ZZZZZZ.
          SPACE  4
          SPACE  4
**        ROUTINES CALLED.
*
*
*         0BF - BEGIN FILE.
*         0DF - DROP FILE.
*         0TD - TERMINATE DAYFILE.
*         0CI - IDENTIFY FIRMWARE.
*         0PI - LIST PACK SERIAL NUMBER.
          SPACE  4
*CALL     COMPMAC
*CALL     COMSCPS
*CALL     COMSSSD
*CALL     COMSDFS
*CALL     COMSEJT
*CALL     COMSHIO
*CALL     COMSIOQ
*CALL     COMSLFD
*CALL     COMSMSC
*CALL     COMSMSP
*CALL     COMSMST
          QUAL   COMSMTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSPFM
*CALL     COMSPIM
*CALL     COMSSCD
*CALL     COMSSSE
*CALL     COMSSSJ
          QUAL   TFM
*CALL     COMSTFM
          QUAL   *
*CALL     COMSMMF
*CALL     COMSWEI
*CALL     COMSZOL
          LIST   X
*CALL     COMSSFM
          LIST   *
          SPACE  4,10
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 FS       EQU    20 - 24     FST ENTRY (5 LOCATIONS)
 FT       EQU    20 - 21     FIRST
 IN       EQU    22 - 23     IN
 P0       EQU    25          OVERLAY PROCESSOR ADDRESS
 HI       EQU    25          *FAT* INDEX OF AVAILABLE HOLE
 QA       EQU    26          FNT ORDINAL
 FC       EQU    27          *FAT* TABLE COUNT
 TY       EQU    30          DAYFILE TYPE
 DA       EQU    30 - 31     LINK DEVICE PARAMETERS
 ID       EQU    32          MACHINE ID
 CN       EQU    33 - 37     CM WORD BUFFER
 FN       EQU    40 - 44     FILE NAME (5 LOCATIONS)
 OT       EQU    40 - 41     OUT
 LM       EQU    42 - 43     LIMIT
 LS       EQU    45          LAST FET STATUS
 JC       EQU    46          JOB COUNT (MAXIMUM)
 MI       EQU    46          MACHINE INDEX
 BA       EQU    47          *FAT* ITEM BASE ADDRESS
 FA       EQU    57          ADDRESS OF FNT ENTRY
 TE       EQU    60          NUMBER OF TABLE ENTRIES (FNT)
 LO       EQU    61          LAST MASS STORAGE ORDINAL + 1
 ES       EQU    62 - 66     CM WORD BUFFER (EST ENTRY)
 FI       EQU    67          *FAT* INDEX OF ENTRY / HOLE
          SPACE  4,10
**        ASSEMBLY CONSTANTS.
 
 
 ILKN     EQU    200000      INTERLOCK DAYFILE MESSAGE OPTION
****
          TITLE  MACRO DEFINITIONS.
 ABORT    SPACE  4,10
**        ABORT - ABORT CONTROL POINT.
*
*         ABORT  ADDR
*
*         ENTRY  *ADDR* = MESSAGE ADDRESS.
*
*         EXIT   TO *ABT*.
 
 
          PURGMAC  ABORT
 
 ABORT    MACRO  A
          MACREF ABORT
          LDC    A
          LJM    ABT
          ENDM
 ENTRY    SPACE  4,10
**        ENTRY - DEFINE OVERLAY ENTRY NAME.
*
*         ENTRY  NAME
*
*         ENTRY  *NAME* = NAME OF PROCESSOR ADDRESS.
 
 
          PURGMAC  ENTRY
 
          MACRO  ENTRY,N
          MACREF ENTRY
          QUAL
 N        EQU    *+1R".M"*10000B
          QUAL   ".O"
 N        BSS    0
          ENDM
 ERROR    SPACE  4,10
**        ERROR - RETURN ERROR CODE TO FET.
*
*         ERROR  EC
*
*         ENTRY  *EC* = ERROR CODE.
*
*         EXIT   TO *ERR*.
 
 
          PURGMAC  ERROR
 
 ERROR    MACRO  E
          MACREF ERROR
          LDN    E
          LJM    ERR
          ENDM
 FCN      SPACE  4,50
**        FCN - DEFINE FUNCTION PROCESSOR.
*
* TN      FCN    F,N,L,P,S,M,E,A
*
*         TN     TABLE NAME (FIRST CALL ONLY).
*         F      FUNCTION CODE.
*         N      NAME OF FUNCTION PROCESSOR.
*         L      REQUIRED FET LENGTH - 1.
*         P      CALLER MUST HAVE SYSTEM ORIGIN PRIVILEGES.
*         S      CALLER MUST BE SPECIAL SYSTEM JOB (SSJ).
*         M      MAINTENANCE ACCESS ALLOWED
*         E      EITHER SSJ= OR SYSTEM ORIGIN PRIVILEGES REQUIRED.
*         A      ALLOW ACCESS IF CALLER HAS PRIVILEGED ANALYST
*                VALIDATION AND IF *PRIVILEGED ANALYST MODE* ENABLED.
*
*         TABLE GENERATED.
*
*T,TN     12/O,12/N,1/S,1/P,1/M,1/E,1/A,1/0,6/L
*
*         O      OVERLAY NAME (LAST CHARACTER)
*         N      PROCESSOR ADDRESS
*         S      SSJ= REQUIRED
*         P      SYSTEM ORIGIN PRIVILEDGES REQUIRED
*         M      MAINTENANCE ACCESS ALLOWED
*         E      EITHER SSJ= OR SYSTEM ORIGIN PRIVILEGES REQUIRED.
*         A      ALLOW ACCESS IF CALLER HAS PRIVILEGED ANALYST
*                VALIDATION AND IF *PRIVILEGED ANALYST MODE* ENABLED.
*         L      REQUIRED FET LENGTH - 1
 
 
          MACRO  FCN,TN,F,N,L,P,S,M,E,A
          MACREF FCN
 .1       IFC    NE,$TN$$
 TN       BSS    0
 .T       SET    TN
 .1       ELSE
          ORG    .T+3*F
 .2       IFC    NE,$N$$
          LOC    F
          CON    N/10000B,N-N/10000B*10000B
 .3       IFC    EQ,$S$SSJ$
          VFD    1/1
 .3       ELSE
          VFD    1/0
 .3       ENDIF
 .4       IFC    NE,$P$$
          VFD    1/1
 .4       ELSE
          VFD    1/0
 .4       ENDIF
 .5       IFC    NE,$M$$
          VFD    1/1
 .5       ELSE
          VFD    1/0
 .5       ENDIF
 .6       IFC    NE,$E$$
          VFD    1/1
 .6       ELSE
          VFD    1/0
 .6       ENDIF
 .7       IFC    NE,$A$$
          VFD    1/1
 .7       ELSE
          VFD    1/0
 .7       ENDIF
          VFD    1/0
          VFD    6/L
 .2       ENDIF
          BSS    0
 .1       ENDIF
          ENDM
          SPACE  4,2
 .N       SET                0
 OVLB     MICRO  1,, 3S      BASE OVERLAY NAME
 OVERLAY  SPACE  4,20
**        OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*         OVERLAY (TEXT),LOAD,NQ
*
*         ENTRY  *TEXT* = TEXT FOR SUBTITLE.
*                *LOAD* = IF SPECIFIED, DEFINE ORIGIN ADDRESS.
*                *NQ* = IF SPECIFIED, OVERLAY NOT QUALIFIED.
 
          PURGMAC OVERLAY
 
 OVERLAY  MACRO  TEXT,LOAD,NQ
          QUAL
          NOREF  .N
          MACREF OVERLAY
 .N       SET    .N+1
 .M       MICRO  .N,1, ZYXWVUTSRQPONMLKJIHGFEDCBA
 .O       MICRO  1,3 "OVLB"".M"
          IFC    EQ,*NQ**,1
          QUAL   ".O"
          TTL    SFM/".O" - TEXT
          IDENT  ".O",OVL    TEXT
          TITLE
*COMMENT  SFM - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          IFC    NE,*LOAD**
          ORG    LOAD
          ELSE   1
          ORG    OVLA
 OVL      LJM    *
          UJN    OVL
          ENDM
 PERR     SPACE  4,10
**        PERR - PUT ERROR CODE IN PARAMETER BLOCK ENTRY.
*
*         PERR   EC
*
*         ENTRY  *EC* = ERROR CODE.
*
*         EXIT   *EC* PLACED IN BYTE 4 OF PARAMETER BLOCK ENTRY
*                AND WORD REWRITTEN TO USER-S FL.
*
*         CALLS  /3SW/PER.
 
 
          PURGMAC  PERR
 
 PERR     MACRO  E
          MACREF PERR
          LDN    E
          RJM    PER
          ENDM
 SUBSYST  SPACE  4,10
**        SUBSYST - GENERATE SUBSYSTEM TABLE.
*
*         SUBSYST  NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT
*
*         ENTRY  *ID* = SUBSYSTEM ID.
*
*         GENERATE TABLE OF *SSSL* BYTES AND MASKS.
*
*T        12/ BYTE, 12/ MASK
 
 
          PURGMAC  SUBSYST
 
 SUBSYST  MACRO  NM,ID,PT,PP,AU,DF,DC,CP,PR,AB
 .SUB     RMT
 .1       SET    MXSI-ID
 .21      SET    .1/12D
 .3       SET    4-.21       *SSSL* BYTE
 .4       DECMIC .1-12D*.21
 .5       SET    1S".4"      *SSSL* MASK
          INDEX  (MXSI*2-ID*2),(.3,.5)
 .SUB     RMT
 SUBSYST  ENDM
          TITLE  MAIN PROGRAM.
 SFM      SPACE  4
**        SFM - MAIN PROGRAM.
 
 
          ORG    PPFW
 SFM      RJM    PRS         PRESET PROGRAM
 SFM1     LDC    0
 SFMA     EQU    *-1
          ZJN    SFM2        IF NO OVERLAY LOAD
          LMC    2L"OVLB"    LOAD OVERLAY
          RJM    EXR
 SFM2     LJM    *           PROCESS REQUEST
 SFMB     EQU    *-1
 
 SFMX     RJM    CFB         SET FILE NOT BUSY
          RJM    GFE         READ FILE NAME
          CRD    FN
          AOD    LS          SET FET NOT BUSY
          STD    FN+4
          LDD    FN+3
          SCN    77
          LMC    0
 SFMC     EQU    *-1         (ERROR CODE)
          STD    FN+3
          RJM    GFE         STORE FET STATUS
          CWD    FN
 SFMD     LDN    0
          ZJN    SFM3        IF NO SYSTEM SECTOR ERROR
          LDC    ERFS        * FAST ATTACH SYSTEM SECTOR ERROR.*
          RJM    DFM
 SFM3     LDM    SFMF
          ZJN    DPP         IF OPERATION COMPLETE
          STD    T1
          LDD    T5
          STM    CKPA+3      SET EQUIPMENT IN REQUEST
          LDD    CP          SET CONTROL POINT
          SHN    -7
          RAM    1,T1
          LDD    IA          STORE INPUT REGISTER
          CWM    0,ON
 SFMF     EQU    *-1
          EXECUTE  CPD,=
          EXECUTE  1CK,=
          UJN    SFM4        EXIT TO PP RESIDENT
 
 DPP      MONITOR DPPM       DROP PP
 SFM4     LJM    PPR         EXIT TO PP RESIDENT
 
 CKPA     VFD    18/3R1CK,6/40,12/4,24/0
 ERFS     DATA   C* SFM FAST ATTACH SYSTEM SECTOR ERROR.*
 
 FETL     CON    0           FET LENGTH REQUIRED FOR FUNCTION
          TITLE  RESIDENT SUBROUTINES.
 ABT      SPACE  4
**        ABT - ABORT JOB.
*
*         ENTRY  (A) = FWA OF MESSAGE.
*
*         EXIT   TO *ERR1*.
*                (DA) = ADDRESS OF MESSAGE.
*
*         CALLS  CFI.
 
 
 ABT      BSS    0           ENTRY
          STD    DA
          LDC    0
*         LDC    1           (*DATI* INTERLOCK SET)
*         LDC    2           (*DATI* AND *FATI* INTERLOCK SET)
 ABTB     EQU    *-1
          ZJN    ABT0        IF NO FLAG REGISTER INTERLOCKS SET
          LDN    DATI        CLEAR *DATI* INTERLOCK
          RJM    /3SY/CFI
          ZJN    ABT0        IF *FATI* INTERLOCK NOT SET
          LDN    FATI        CLEAR *FATI* INTERLOCK
          RJM    /3SY/CFI
 ABT0     LDC    ABP
          UJN    ERR1        LOAD ERROR PROCESSING OVERLAY
 ERR      SPACE  4,10
**        ERR - ERROR EXIT PROCESSOR.
*
*         ENTRY  (A) = ERROR CODE.
*
*         EXIT   TO *SFM0*.
*
*         USES   DA.
 
 
 ERR      BSS    0           ENTRY
          STD    DA
          LDC    ERP
 ERR1     STM    SFMB        SET PROCESSOR ADDRESS
          SHN    -14
          STM    SFMA
          LJM    SFM1        LOAD ERROR PROCESSING OVERLAY
 ERS      SPACE  4,10
**        ERS - ENTER PP RECALL STACK.
*
*         ENTRY  (A) = RECALL STACK REASON CODE.
*
*         EXIT   TO *PPR*.
*
*         USES   CM - CM+5.
*
*         MACROS MONITOR.
 
 
 ERS      BSS    0           ENTRY
          STD    CM          SAVE RECALL STACK REASON CODE
          LDN    ZERL
          CRD    CM+1
          LDD    MA          RECALL *SFM*
          CWD    IR
          ADN    1
          CWD    CM
          MONITOR  RECM
          LJM    PPR         EXIT TO PP RESIDENT
 CFB      SPACE  4,10
**        CFB - CLEAR FILE BUSY.
*
*         ENTRY  (FA) = FNT ADDRESS OF BUSY FILE.
*                (FS - FS+4) = FST INFORMATION.
*
*         EXIT   (A) = (FA) = 0.
*
*         MACROS NFA.
 
 
 CFB      SUBR               ENTRY/EXIT
          LDD    FA
          ZJN    CFBX        IF NO FILE ASSIGNED
          AOD    FS+4
          NFA    FA,R        CLEAR FILE BUSY
          ADN    FSTL
          CWD    FS
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          UJN    CFBX        RETURN
 DRF     SPACE   4,15
**        DRF - DROP FILE.
*
*         ENTRY  (FA) = INDEX OF FNT ENTRY.
*
*         EXIT   (A) = (FA) = 0.
*
*         ERROR  TO *EER* IF MASS STORAGE DEVICE INACCESSIBLE.
*
*         CALLS  *0DF*.
 
 
 DRF      SUBR               ENTRY/EXIT
          LDN    1           SET *UNLOAD* FILE FLAG FOR *0DF*
          STM    OVL0-1
          EXECUTE 0DF,OVL0
          ZJN    DRFX        IF FILE RELEASED
*         UJN    EER         EVALUATE MASS STORAGE ERROR RETURN
 EER      SPACE  4,15
**        EER - EVALUATE MASS STORAGE ERROR RETURN.
*
*         ENTRY  (T5) = EST ORDINAL.
*
*         EXIT   JOB IS ROLLED OUT TO WAIT FOR A DEVICE TO BECOME
*                ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
*                RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
*
*         USES   IR+4.
*
*         CALLS  CFB, RTI, *1RJ*.
*
*         MACROS ENDMS, ERROR, EXECUTE, PAUSE.
 
 
 EER      ENDMS
          RJM    RTI         RELEASE TRACK INTERLOCK
          LDM    RDCT
          SHN    21-12
          PJN    EER2        IF RECOVERABLE ERROR
 EER1     ERROR  /ERR/RMS
 
 EER2     LDM    MSD         CHECK CALLER
          SHN    21-13
          PJN    EER1        IF SUBSYSTEM
          PAUSE
          LDD    CM+1
          NJP    SFMX        IF ERROR FLAG SET
          RJM    CFB
          LDD    T5          SET EST ORDINAL
          STD    IR+4
          EXECUTE  1RJ       RECALL JOB
 EFN      SPACE  4
**        EFN - ENTER FILE NAME.
*
*         ENTRY  (FN - FN+4) = FILE NAME.
*
*         EXIT   (FA) = INDEX OF FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*
*         CALLS  VFN, *0BF*.
*
*         MACROS ABORT, EXECUTE.
 
 
 EFN      SUBR               ENTRY/EXIT
          RJM    VFN         VERIFY FILE NAME
          NJN    EFN1        IF NO ERROR
          ABORT  /MESS/ERFN  * SFM FILE NAME ERROR.*
 
 EFN1     LDN    0           SELECT NO RETURN WITHOUT FILE CREATED
          STM    OVL0-1
          LDN    NEEQ        ASSIGN NULL EQUIPMENT
          STD    FS
          EXECUTE 0BF,OVL0
          UJN    EFNX        RETURN WITH NEW FILE CREATED
 
*         PROCESS ADVANCE EXIT FROM *0BF* IF FILE ALREADY EXISTS.
 
          LDN    0           CLEAR FNT ENTRY ADDRESS
          STD    FA
          ABORT  /MESS/ERDF  * SFM DUPLICATE FILE FOUND.*
 FDB      SPACE  4,10
**        FDB - FLUSH DAYFILE BUFFER.
*
*         ENTRY  (A) = ADDRESS OF TERMINATING MESSAGE.
*                (TY) = DAYFILE TYPE.
*
*         EXIT   DAYFILE BUFFER FLUSHED.
*
*         CALLS  DFM, *0TD*.
*
*         MACROS EXECUTE.
 
 
 FDB      SUBR               ENTRY/EXIT
          LMC    ILKN        ADD INTERLOCK REQUEST
          RJM    DFM         ISSUE DAYFILE MESSAGE
          LDD    TY
          STM    OVL0-1      SET *0TD* PARAMETER
          EXECUTE 0TD,OVL0   FLUSH BUFFER
          UJN    FDBX        RETURN
 GFE      SPACE  4,5
**        GFE - GET FET ADDRESS.
*
*         EXIT   (A) = FET ADDRESS.
 
 
 GFE      SUBR               ENTRY/EXIT
          LDD    IR+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          UJN    GFEX        RETURN
 LLT      SPACE  4,10
**        LLT - LOCATE LABEL TRACK.
*
*         ENTRY  (T5) = EST ORDINAL.
*
*         EXIT   (A) = (T6) = LABEL TRACK.
*                (CM - CM+4) = EST ENTRY.
*                (T0 - T4) = *ALGL* WORD OF MST.
*
*         USES   T6, CM - CM+4, T0 - T4.
 
 
 LLT      SUBR               ENTRY/EXIT
          SFA    EST,T5      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM+4        READ *ALGL* WORD FROM THE MST
          SHN    3
          ADN    ALGL
          CRD    T0
          LDD    T0+1        SET LABEL TRACK
          STD    T6
          UJN    LLTX        RETURN
 SDA      SPACE  4,8
**        SDA - SET DAYFILE POINTER ADDRESS.
*
*         ENTRY  (TY) = DAYFILE TYPE.
*                     = 0 IF USER DAYFILE.
*
*         EXIT   (A) = ADDRESS OF DAYFILE POINTER FST.
*
*         MACROS NFA.
 
 
 SDA1     NFA    DAPN+2      SET ADDRESS OF JOB DAYFILE FST
 
 SDA      SUBR               ENTRY/EXIT
          LDD    TY
          ZJN    SDA1        IF USER DAYFILE
          STD    T0
          SHN    1
          ADD    T0
 SDAA     ADC    **          (FWA-1 OF DAYFILE POINTERS)
          UJN    SDAX        RETURN
 SDT      SPACE  4,10
**        SDT - SET DAYFILE TYPE.
*
*         EXIT   (TY) = DAYFILE TYPE.
*                (CN - CN+4) = WORD 7 OF FET.
*
*         CALLS  GFE.
 
 
 SDT      SUBR               ENTRY/EXIT
          RJM    GFE         READ FET+7
          ADN    7
          CRD    CN
          LDD    CN+3        SET DAYFILE TYPE
          LPN    77
          STD    TY
          ZJN    SDT1        IF INCORRECT TYPE
          SBN    EXDF+1
          MJN    SDTX        IF VALID DAYFILE TYPE
 SDT1     ABORT  /MESS/ERDC  * SFM INCORRECT DEVICE CODE.*
 RMS      SPACE  4,10
**        RMS - READ MASS STORAGE.
*
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T5 - T7) = MASS STORAGE PARAMETERS.
*
*         EXIT   (A) .GE. 0.
*
*         ERROR  TO *EER*.
*
*         CALLS  RDS.
 
 
 RMS      SUBR               ENTRY/EXIT
          RJM    RDS
          PJN    RMSX        IF SUCCESSFUL READ
          LJM    EER         EVALUATE ERROR RETURN
 RTI      SPACE  4,10
**        RTI - RELEASE TRACK INTERLOCK.
*
*         ENTRY  (RTIA) = TRACK NUMBER IF TRACK INTERLOCKED.
*
*         EXIT   (A) = (RTIA) = 0.
*
*         CALLS  CTI.
 
 
 RTI      SUBR               ENTRY/EXIT
          LDC    0
 RTIA     EQU    *-1
          ZJN    RTIX        IF NO TRACK INTERLOCK
          RJM    CTI
*         LDN    0           CLEAR INTERLOCK STATUS
          STM    RTIA
          UJN    RTIX        RETURN
 WMS      SPACE  4,10
**        WMS - WRITE MASS STORAGE.
*
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T5 - T7) = MASS STORAGE PARAMETERS.
*
*         EXIT   (A) .GE. 0.
*
*         ERROR  TO *EER*.
*
*         CALLS  WDS.
 
 
 WMS      SUBR               ENTRY/EXIT
          RJM    WDS
          PJN    WMSX        IF SUCCESSFUL WRITE
          LJM    EER         EVALUATE ERROR RETURN
 WTI      SPACE  4,15
**        WTI - WAIT FOR TRACK INTERLOCK.
*
*         ENTRY  (T5) = EQUIPMENT.
*                (T6) = TRACK.
*
*         EXIT   (A) = 0, IF INTERLOCK SET.
*                    = 1, IF *ORET* ERROR FLAG SET IN CPA.
*
*         USES   CM - CM+4.
*
*         CALLS  STI.
*
*         MACROS DELAY, PAUSE.
 
 
 WTI3     LDN    1           RETURN WITH ERROR
 
 WTI      SUBR               ENTRY/EXIT
 WTI1     RJM    STI         SET TRACK INTERLOCK
          ZJN    WTIX        IF INTERLOCK SET
 
*         DELAY 100 MILLISECONDS AND RETRY.
 
          LDC    1400
          STD    T0
 WTI2     DELAY
          PAUSE
          LDD    CM+1
          LMN    ORET
          ZJN    WTI3        IF *ORET* ERROR FLAG SET
          SOD    T0
          PJN    WTI2        IF MORE DELAY REQUIRED
          UJN    WTI1        LOOP TO RETRY INTERLOCK
          SPACE  4
*         COMMON DECKS.
 
 
*CALL     COMPCTI
*CALL     COMPDTS
 EJT$     EQU    0           DEFINE *COMPGFP* ACCESS TO EJT
 FNT$     EQU    0           DEFINE *COMPGFP* ACCESS TO FNT
 IFP$     EQU    0           GENERATE *IFP* REMOTE CODE
 JCB$     EQU    0           DEFINE *COMPGFP* ACCESS TO JCB
*CALL     COMPGFP
*CALL     COMPRLA
*CALL     COMPSAF
*CALL     COMPSEI
*CALL     COMPSFB
*CALL     COMPSTI
*CALL     COMPVFN
          QUAL   MIO
 QUAL$    EQU    1
 RDS      EQU    RMS
 WDS      EQU    WMS
*CALL     COMPRSS
*CALL     COMPWEI
*CALL     COMPWSS
          QUAL   *
 RSS      EQU    /MIO/RSS
 WEI      EQU    /MIO/WEI
 WSS      EQU    /MIO/WSS
 CFS      SPACE  4,10
**        CFS - CHECK FILE STATUS.
*
*         ENTRY  (FA) = INDEX OF FNT ENTRY.
*
*         EXIT   (FS - FS+4) = FST ENTRY.
*                (ES - ES+4) = FILE EQUIPMENT EST ENTRY.
*                (CM - CM+4) = FNT ENTRY.
*                (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*
*         CALLS  SFB.
*
*         MACROS ABORT, SFA.
 
 
 CFS      SUBR               ENTRY/EXIT
          RJM    SFB         SET FILE BUSY
          ZJN    CFS1        IF NO REJECT
          LDN    0
          STD    FA
          ABORT  /MESS/ERIO  * SFM I/O SEQUENCE ERROR.*
 
 CFS1     LDD    FS          READ EST ENTRY
          STD    T5
          SFA    EST
          ADK    EQDE
          CRD    ES
          LDD    ES          CHECK EQUIPMENT
          SHN    6
          MJN    CFS2        IF MASS STORAGE
          ABORT  /MESS/ERMS  * SFM FILE NOT ON MASS STORAGE.*
 
 CFS2     LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDD    FS+2
          NJN    CFSX        RETURN IF FILE USED
          ABORT  /MESS/ERFE  * SFM FILE EMPTY.*
          SPACE  4
 TDYN     SPACE  4,10
**        TDYN - TABLE OF DAYFILE NAMES.
 
 
 TDYN     BSS    0
          LOC    SDAY
          CON    NDYF        SYSTEM DAYFILE
          CON    NACF        ACCOUNT DAYFILE
          CON    NERL        ERRLOG DAYFILE
          CON    NBML        MAINTENANCE LOG
          LOC    *O
          SPACE  4
 NDYF     VFD    42/0LDAYFILE,6/1,6/LIFT,6/0
 NACF     VFD    42/0LACCOUNT,6/1,6/LIFT,6/0
 NERL     VFD    42/0LERRLOG,6/1,6/LIFT,6/0
 NBML     VFD    42/0LMAINLOG,6/1,6/LIFT,6/0
          USE    OVERLAY
 OVLA     EQU    *+5         OVERLAY BASE ADDRESS
 ADF      TITLE  FUNCTION PROCESSORS.
 ADF      SPACE  4
***       FUNCTION *AMDF* - ACCESS MASTER DAYFILE.
*
*         READ CM PART OF DAYFILE STARTING AT FIRST, AND MAKE LOCKED
*         LIBRARY FILE AT CONTROL POINT.
*
*         ENTRY CONDITIONS.
*
*         MESSAGE TO ISSUE IN BUFFER STARTING AT FIRST.
*         (MAXIMUM LENGTH OF 30 CHARACTERS.)  THE MESSAGE IS
*         ISSUED BEFORE THE CM BUFFER IS COPIED AND THE FILE
*         LENGTH CALCULATED.  THE MESSAGE WILL BE THE LAST ONE
*         IN THE DAYFILE FOR THIS ACCESS TO THE DAYFILE.
*
*         EXIT CONDITIONS.
*
*T FET+5  42/  0 , 18/ RL
*T,FET+6  42/  0 , 18/ CL
*
*         RL = DAYFILE LENGTH AT LAST DEADSTART.
*         CL = CURRENT DAYFILE LENGTH IN PRUS.
 
 
 ADF      BSS    0           ENTRY
          LDN    SDAY        SELECT MASTER DAYFILE
 ADF1     STD    TY          SAVE DAYFILE TYPE
          RJM    CBL         CHECK DAYFILE BUFFER LENGTH
 
*         CHECK FILE STATUS.
 
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    ADF3        IF NOT FOUND
          RJM    SFB         SET FILE BUSY
          ZJN    ADF2        IF NO REJECT
          LDN    0
          STD    FA
          ABORT  /MESS/ERIO  * SFM I/O SEQUENCE ERROR.*
 
 ADF2     RJM    DRF         DROP FILE
 ADF3     RJM    EFN         ENTER FILE NAME
          RJM    SDA         SET DAYFILE FST ADDRESS
          CRD    FS          READ DAYFILE FST
          SBN    1           READ DAYFILE BUFFER POINTERS
          CRD    CM
          AOD    CM+2        VALIDATE BUFFER POINTERS
          RJM    VBP
          MJN    ADF4        IF DATA FITS IN BUFFER AND IN FL
          NFA    FA,R        READ CORRECT FST FOR *ABT*
          ADN    FSTL
          CRD    FS
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
*         INTERLOCK DAYFILE.
 
 ADF4     LDD    FS          SET EQUIPMENT
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDD    TY
          NJN    ADF5        IF NOT USER DAYFILE DUMP
          LJM    ADF8        PROCESS USER DAYFILE DUMP
 
 ADF5     LDD    TH          FLAG TRACK INTERLOCK SET
          RAM    ADFE
          RJM    STI         SET TRACK INTERLOCK
          ZJN    ADF6        IF TRACK INTERLOCKED
          NFA    FA,R        READ CORRECT FST FOR *ABT*
          ADN    FSTL
          CRD    FS
          ERROR  /ERR/DFB    EC=1, DAYFILE BUSY
 
 ADF6     LDD    T6          SET TRACK INTERLOCKED STATUS
          STM    RTIA
          LDD    CP          FETCH EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      READ SEQUENCE NUMBER FROM EJT
          CRM    BFMS,ON
          ADN    SCLE-JSNE-1 GET JOB SERVICE CLASS
          CRD    CM
          LDC    2R
          STM    BFMS+2
          STM    BFMS+3
          LDD    CM          SET SERVICE CLASS IN MESSAGE
          SHN    -6
          STM    BFMS+4
          LDD    CN+3        READ DAYFILE MESSAGE
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CM+1
 ADFC     ADN    0
*         ADN    1           (MAINTENANCE LOG PROCESSING)
          CRM    BFMS+5,TR
*         CRM    BFMS,TR     (MAINTENANCE LOG PROCESSING)
 ADFD     EQU    *-1
          LDN    0           ENSURE MESSAGE HAS TERMINATOR
          STM    BFMS+5+3*5
          LDD    CM+1        BYTE COUNT OF MAINTENANCE LOG MESSAGE
 ADFF     UJN    ADF7.4      CONTINUE
*         NJN    ADF7.3      (MAINTENANCE LOG PROCESSING)
 ADF7     RJM    RTI         RELEASE TRACK INTERLOCK
          NFA    FA,R        RESTORE FST FOR ABORT PROCESSING
          ADN    FSTL
          CRD    FS
          ABORT  /MESS/ERWC  * SFM BML MESSAGE LENGTH ERROR.*
 
 ADF7.3   SBN    7
          PJN    ADF7        IF WORD COUNT TOO LARGE
          ADN    7
 ADF7.4   SHN    2
          RAD    CM+1
          LDM    ADFG-1,TY   ISSUE MESSAGE AND INTERLOCK DAYFILE
          SHN    14
          ADC    ILKN+BFMS
          RJM    DFM
 
*         TRANSFER CM DAYFILE BUFFER TO CONTROL POINT.
 
          LDD    TY          CHECK DAYFILE TYPE
          LMN    BMLF
          NJN    ADF8        IF NOT MAINTENANCE LOG
          LDN    BMLL        READ MAINTENANCE LOG CONTROL WORD
          CRD    CM
          LDD    CN+3        STORE CONTROL WORD IN BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWD    CM
          AOD    CN+4        ADVANCE IN POINTER
          SHN    -14
          RAD    CN+3
 ADF8     RJM    CDF         DUMP CM DAYFILE TO CONTROL POINT
 
*         UPDATE FET INFORMATION.
 
          LDD    T6
          STD    T2
          STD    T3
          ZJN    ADF9        IF NO FIRST TRACK
          RJM    SEI
          LCN    FSMS        DISCOUNT SYSTEM SECTOR
          RAD    T3
          PJN    ADF9        IF NO BORROW
          SOD    T2          PROPAGATE BORROW
          AOD    T3
 ADF9     LDN    ZERL
          CRD    CM
          LDD    T3
          STD    CM+4        LOWER HALF OF FILE LENGTH
          LDD    T2
          STD    CM+3        UPPER HALF OF FILE LENGTH
          LDN    0
          STD    CN
          STD    CN+1
          STD    CN+2
          RJM    GFE         STORE IN
          ADN    2
          CWD    CN
          ADN    6-2         STORE SECTOR COUNT
          CWD    CM
 
*         GET LENGTH OF DAYFILE AT LAST DEADSTART.
 
          LDD    TY
          NJN    ADF10       IF NOT USER DAYFILE DUMP
          LJM    ADF12
 
 ADF10    RJM    SDA         READ BUFFER STATUS WORD
          CRD    CM
          LDN    2           CLEAR BUFFER INTERLOCK
          RAD    CM+4
          RJM    SDA         STORE BUFFER STATUS WORD
          CWD    CM
          SETMS  IO
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDM    TDYN-1,TY   READ SYSTEM SECTOR
          RJM    RSS
          ZJN    ADF11       IF NO ERROR
          RJM    RTI         RELEASE TRACK INTERLOCK
          NFA    FA,R        READ CORRECT FST FOR *ABT*
          ADN    FSTL
          CRD    FS
          ABORT  /MESS/ERSE  * SFM SYSTEM SECTOR ERROR.*
 
 ADF11    ENDMS
          LDN    ZERL        SET LENGTH IN FET+5
          CRD    CM
          LDM    FLSS
          STD    CM+3
          LDM    FLSS+1
          STD    CM+4
          RJM    GFE
          ADN    5
          CWD    CM
 
*         ATTACH DAYFILE TO CONTROL POINT.
 
 ADF12    LDC    4           SET FILE STATUS
*         LDC    1004        (IF TRACK INTERLOCK SET)
 ADFE     EQU    *-1
          STD    FS+4
          LDD    FS+2
          ZJN    ADF13       IF FILE NOT USED
          LDD    FS+1        REWIND FILE
          STD    FS+2
          LDN    FSMS        SET FIRST DATA SECTOR
          STD    FS+3
 ADF13    NFA    FA,R        READ FNT ENTRY
          CRD    CM
          LDD    CM+3        SET EXTEND-ONLY AND WRITE LOCKOUT
          SCN    77
          LMN    21
          STD    CM+3
          LDC    LIFT*100    SET FILE TYPE TO *LIBRARY*
          STD    CM+4
          NFA    FA,R        STORE FNT ENTRY
          CWD    CM
          LDN    22          LAST STATUS = EOR
          STD    LS
          LJM    SFMX        EXIT
 
 ADFG     BSS    0           TABLE OF DAYFILE MESSAGE OPTIONS
          LOC    SDAY
          CON    JNMN/10000
          CON    AJNN/10000
          CON    EJNN/10000
          CON    BMLN/10000
          LOC    *O
 AAC      SPACE  4
***       FUNCTION *AAFF* - ACCESS ACCOUNT FILE.
*
*         READ CM PART OF DAYFILE STARTING AT FIRST, AND MAKE LOCKED
*         LIBRARY TYPE FILE AT CONTROL POINT.
 
 
 AAC      BSS    0           ENTRY
          LDN    ACCF        SELECT ACCOUNT FILE
          UJN    AER1
 AER      SPACE  4
***       FUNCTION *AELF* - ACCESS ERROR LOG.
*
*         READ CM PART OF DAYFILE STARTING AT FIRST, AND MAKE LOCKED
*         LIBRARY TYPE FILE AT CONTROL POINT.
 
 
 AER      LDN    ERLF        SELECT ERROR LOG
 AER1     LJM    ADF1        ACCESS DAYFILE
 AMF      SPACE  4,10
***       FUNCTION *AMLF* - ACCESS MAINTENANCE LOG.
*
*         READ CM PART OF DAYFILE STARTING AT FIRST, AND MAKE LOCKED
*         LIBRARY TYPE FILE AT CONTROL POINT.
 
 
 AMF      LCN    5           ADJUST ADDRESS FOR ACCESS MESSAGE
          RAM    ADFD
          AOM    ADFC
          LDC    NJNI+ADF7.3-ADFF
          STM    ADFF
          LDN    BMLF        SELECT MAINTENANCE LOG
          UJN    AER1        ACCESS DAYFILE
 
          ERRNG  37-ADF7.3+ADFF  JUMP OUT OF RANGE
 AUD      SPACE  4
***       FUNCTION *AUDF* - ACCESS USER DAYFILE.
*
*         READ CM PART OF DAYFILE STARTING AT FIRST, AND MAKE LOCKED
*         LIBRARY TYPE FILE AT CONTROL POINT.
 
 
 AUD      LDN    0           SELECT USER DAYFILE
          UJN    AER1
 RDT      SPACE  4
***       FUNCTION *RDTF* - RETURN DEVICE TYPE.
*
*         FET+1, BYTE 0 = EST ORDINAL.
*         RETURN DEVICE TYPE IN FET+1, BYTE 0.
 
 
 RDT      RJM    GFE         GET FET ADDRESS
          ADN    1
          CRD    CM
          LDN    ESTP        READ EST POINTER
          CRD    FS
          LDD    CM          LOAD EST ORDINAL
          SBD    FS+2
          MJN    RDT1        IF IN TABLE
          ABORT  /MESS/EREQ  * SFM INCORRECT EQUIPMENT.*
 
 RDT1     SFA    EST,CM
          ADK    EQDE
          CRD    FS          READ EST ENTRY
          LDD    FS
          LPC    4000
          LMD    FS+3
          STD    CM
          RJM    GFE         RETURN DEVICE TYPE TO FET
          ADN    1
          CWD    CM
          LJM    SFMX        EXIT
 PAD      SPACE  4,5
***       FUNCTION *PADF* - PROTECT ACTIVE DAYFILE.
*
*         AN ACTIVE DAYFILE OF TYPE, TY, WILL BE PROTECTED BY
*         PLACING THE FIRST TRACK FROM THE DAYFILE POINTER INTO THE
*         APPROPRIATE TRACK BYTE IN THE SECTOR OF LOCAL AREAS.
*         THE TRACK INTERLOCK IS ASSUMED TO BE INTERLOCKED.
*         THE TRACK INTERLOCK WILL BE CLEARED.
 
 
 PDF      RJM    SDT         SET DAYFILE TYPE
          RJM    SDA         SET DAYFILE POINTER ADDRESS
          CRD    CM
          LDD    CM          SET EQUIPMENT
          STD    T5
          LDD    CM+1        SET FIRST TRACK
          STD    T6
          RJM    DTS         DETERMINE TRACK STATUS
          MJN    PDF1        IF TRACK INTERLOCKED
          ABORT  /MESS/ERTE  * SFM TRACK INTERLOCK ERROR.*
 
 PDF1     LDD    T6          CLEAR TRACK INTERLOCK
          RJM    CTI
          LDN    SPFS        SET PRESERVED FILE BIT
          STD    CM+3
          LDD    T5          SET EQUIPMENT
          STD    CM+1
          LDD    T6          SET FIRST TRACK
          STD    CM+2
          MONITOR STBM
 PDF2     LDC    CKPA        SET CHECKPOINT REQUEST
          STM    SFMF
          LJM    SFMX        RETURN
 CDB      SPACE  4,6
***       FUNCTION *CDBF* - CLEAR DAYFILE BYTE.
*
*         THE TRACK INTERLOCK AND THE FIRST TRACK BYTE FOR THE
*         SPECIFIED DAYFILE ON THE SPECIFIED DEVICE WILL BE CLEARED.
 
 
 CDB      RJM    SDT         SET DAYFILE TYPE
          LDD    CN          SET EQUIPMENT
          STD    T5
          STM    CDBA
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CN
          LDD    CN          CHECK IF MASS STORAGE
          SHN    21-13
          MJN    CDB2        IF MASS STORAGE EQUIPMENT
 CDB1     ABORT  /MESS/EREQ  * SFM INCORRECT EQUIPMENT.*
 
 CDB2     RJM    RLA         READ SECTOR OF LOCAL AREAS
          ZJN    CDB1        IF NO ENTRY FOR THIS MACHINE
          PJN    CDB3        IF NO MASS STORAGE ERROR
          ERROR  /ERR/RMS    EC=3, SFM UNCORECTABLE RMS ERROR
 
 CDB3     ADD    TY          SET TRACK BYTE ADDRESS
          SBN    SDAY
          STD    T1
          LDI    T1          SET FIRST TRACK OF INACTIVE DAYFILE
          STD    T6
          RJM    DTS         DETERMINE TRACK STATUS
          MJN    CDB4        IF TRACK INTERLOCK SET
          ABORT  /MESS/ERTE  * SFM TRACK INTERLOCK ERROR.*
 
 CDB4     LDD    TY          SET CHECKPOINT PARAMETER
          STM    CKPA+4
          RJM    CIB         CLEAR FST INTERLOCK BIT
          LDD    T6          CLEAR TRACK INTERLOCK
          RJM    CTI
          LDD    MA          LOCATE THE *ZZZZLBT* FILE
          CWM    ATDD,ON
          SBN    1
          CRD    FN
          RJM    SAF
          ZJN    CDB5        IF FILE NOT FOUND
          RJM    DRF         RETURN THE *ZZZZLBT* FILE
          LDC    *           RESET THE EST ORDINAL
 CDBA     EQU    *-1
          STD    T5
          LJM    PDF2        SET CHECKPOINT REQUEST
 
 CDB5     ABORT  /MESS/ERFF  * SFM FILE NOT FOUND.*
 ATD      SPACE  4,15
 ATD      TITLE  ATTACH INACTIVE DAYFILE.
***       FUNCTION *ATDF* - ATTACH INACTIVE DAYFILE.
*
*         THE SPECIFIED INACTIVE DAYFILE ON EQUIPMENT, EQ, IS ATTACHED
*         TO THE CONTROL POINT AS A LIBRARY TYPE FILE WITH ITS TRACK
*         INTERLOCK BIT SET. THE FILE NAME IS TAKEN FROM THE FIRST
*         WORD OF THE FET.
*
*         IF A LIBRARY TYPE FILE WITH THE SAME FILE NAME IS FOUND
*         ATTACHED TO THE CONTROL POINT, THEN THE CALLER IS ABORTED.
*         IF THE DUPLICATE FILE IS NOT A LIBRARY TYPE FILE, THEN
*         IT IS RETURNED BEFORE CREATING THE NEW FILE.
*
*         THE LABEL TRACK ON THE DAYFILE DEVICE WILL BE INTERLOCKED TO
*         PREVENT PROBLEMS CAUSED BY MULTIPLE *DFTERM* RUNS.  THIS
*         INTERLOCK IS NORMALLY CLEARED BY A *CDBF* CALL.  TO ALLOW
*         FOR A POSSIBLE ABORT OF *DFTERM*, A LOCAL FILE *ZZZZLBT* OF
*         FILE TYPE *LIFT* WILL BE CREATED.  THIS FILE POINTS TO THE
*         INTERLOCKED LABEL.  *0DF* WILL CLEAR THE INTERLOCK WHEN
*         THE *ZZZZLBT* FILE IS RETURNED.
 
 
 ATD      BSS    0           ENTRY
          LDD    MA          CREATE THE *ZZZZLBT* FILE
          CWM    ATDD,ON
          SBN    1
          CRD    FN
 ATD0     LDN    NEEQ        SET THE NULL EQUIPMENT
          STD    FS
          LDN    2           RETURN IF NFL INCREASE PENDING
          STM    OVL0-1
          EXECUTE  0BF,OVL0
          UJN    ATD0.2      CHECK FOR FNT ENTRY CREATED
 
*         PROCESS DUPLICATE FILE.
 
          RJM    SFB         SET FILE BUSY
          NJN    ATD0.1      IF FILE BUSY REJECT
          RJM    DRF         DROP THE FILE
          UJN    ATD0        RETRY THE FILE CREATION
 
 ATD0.1   ABORT  /MESS/ERDF  * SFM DUPLICATE FILE FOUND.*
 
 ATD0.2   ZJN    ATD0.3      IF FNT CREATED
          LDN    NFIR
          LJM    ERS         ENTER PP RECALL STACK
 
 ATD0.3   LDD    FA          SAVE THE FNT OFFSET
          STM    ATDC
          RJM    GFE         GET THE DAYFILE FNT NAME
          CRD    FN
          RJM    VFN         VERIFY FILE NAME
          NJN    ATD1        IF NAME VERIFIES
          ABORT  /MESS/ERFN  * SFM FILE NAME ERROR.*
 
*         GET FIRST TRACK OF FILE TO ATTACH.
 
 ATD1     RJM    SDT         SET DAYFILE TYPE
          LDD    CN          SET EST ORDINAL
          STD    T5
          STM    ATDB        SAVE EST ORDINAL
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CN
          LDD    CN
          SHN    21-13
          MJN    ATD3        IF MASS STORAGE
 ATD2     ABORT  /MESS/EREQ  * SFM INCORRECT EQUIPMENT.*
 
 ATD3     RJM    RLA         READ SECTOR OF LOCAL AREAS
          ZJN    ATD2        IF NO ENTRY FOR THIS MACHINE
          PJN    ATD4        IF NO MASS STORAGE ERROR
          ERROR  /ERR/RMS    EC=3, UNCORRECTABLE RMS ERROR
 
 ATD4     ADD    TY          SET TRACK BYTE ADDRESS
          SBN    SDAY
          STD    T1
          LDI    T1          SET FIRST TRACK OF INACTIVE DAYFILE
          STD    T6
          STM    ATDA
          NJN    ATD5        IF FILE EXISTS
          ERROR  /ERR/FNF    EC=2, FILE NOT FOUND
 
*         SET TRACK INTERLOCK.
 
 ATD5     RJM    STI         SET TRACK INTERLOCK
          ZJN    ATD7        IF INTERLOCK SET
          ERROR  /ERR/DFB    EC=0, DAYFILE BUSY
 
*         ENTER FILE IN FNT TABLE.
 
 ATD6     RJM    SFB         SET FILE BUSY
          NJN    ATD7.1      IF FILE BUSY REJECT
          RJM    DRF         DROP FILE
 
 ATD7     LDN    NEEQ        SET NULL EQUIPMENT
          STD    FS
          LDN    2           RETURN TO ENTER PP STACK ON NFL INCREASE
          STM    OVL0-1
          EXECUTE 0BF,OVL0   MAKE FNT/FST ENTRY
          UJN    ATD7.2      CHECK IF FNT ENTRY CREATED
 
*         PROCESS DUPLICATE FILE.
 
          NFA    FA,R        READ FNT ENTRY OF DUPLICATE FILE
          CRD    FS
          LDD    FS+4        CHECK FILE TYPE
          SHN    -6
          LMN    LIFT
          NJN    ATD6        IF FILE NOT *LIBRARY* TYPE
 ATD7.1   LDN    0           CLEAR FNT ENTRY ADDRESS
          STD    FA
          LDM    ATDA        CLEAR TRACK INTERLOCK
          RJM    CTI
          ABORT  /MESS/ERDF  * SFM DUPLICATE FILE FOUND.*
 
 ATD7.2   ZJN    ATD8        IF FNT ENTRY CREATED
          LDM    ATDA        CLEAR TRACK INTERLOCK
          RJM    CTI
          LDN    NFIR        REASON CODE = NFL INCREASE PENDING
          LJM    ERS         ENTER PP RECALL STACK
 
*         BUILD FNT/FST ENTRY.
 
 ATD8     LDC    *           SET FIRST TRACK
 ATDA     EQU    *-1         (DAYFILE FIRST TRACK)
          STD    FS+1
          STD    FS+2        SET CURRENT TRACK
          LDC    *           SET EQUIPMENT
 ATDB     EQU    *-1         (EST ORDINAL)
          STD    FS
          STD    T5          SET EST ORDINAL
          LDN    FSMS        SET CURRENT SECTOR
          STD    FS+3
          LDC    1005        SET TRACK INTERLOCK, EOR
          STD    FS+4
          LDC    LIFT*100    SET FILE TYPE TO *LIBRARY*
          STD    FN+4
          RJM    LLT         LOCATE LABEL TRACK
          RJM    WTI         SET TRACK INTERLOCK
          NJP    ATD9        IF TRACK INTERLOCK NOT SET
          NFA    FA,R        STORE FNT ENTRY
          CWD    FN
          ADN    FSTL        STORE THE FST ENTRY
          CWD    FS
          LDC    **          COMPLETE THE *ZZZZLBT* FILE
 ATDC     EQU    *-1
          STD    FA
          NFA    FA,R
          ADK    FNTL
          CRD    FN
          ADN    FSTL-FNTL
          CRD    FS
          LDM    ATDB        SET THE EST ORDINAL
          STD    FS
          RJM    LLT         SET THE LABEL TRACK
          STD    FS+1
          STD    FS+2
          LDC    1005        SET THE TRACK INTERLOCK FLAG
          STD    FS+4
          LDC    LIFT*100    SET LIBRARY FILE TYPE
          STD    FN+4
          NFA    FA,R
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CWD    FS
          LDN    0           CLEAR THE FNT POINTER
          STD    FA
          LJM    SFMX
 
 ATD9     LDD    FS+1        CLEAR TRACK INTERLOCK ON DAYFILE
          RJM    CTI
          RJM    DRF         RETURN FNT ENTRY
          ERROR  /ERR/DFB    EC=1, DAYFILE BUSY
 
 ATDD     VFD    42/0LZZZZLBT,18/0
 GDI      SPACE  4,10
***       FUNCTION *GDIF* - GET DEVICE INFORMATION.
*
*         COPY DEVICE INFORMATION SECTOR FOR SPECIFIED DEVICE
*         INTO CENTRAL BUFFER STARTING AT *FIRST*.
*
*         THE CALLING PROGRAM MUST HAVE SYSTEM ORIGIN AND
*         AN *SSJ=*  ENTRY POINT.
 
 
 GDI      BSS    0           ENTRY
          LDD    HN          VALIDATE BUFFER POINTERS
          RJM    VBP
          MJN    GDI1        IF DATA FITS IN BUFFER AND IN FL
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 GDI1     RJM    GFE         READ EST ORDINAL
          ADN    7
          CRD    CM
          LDD    CM          VALIDATE EQUIPMENT
          RJM    VEQ
          RJM    RDI         READ DEVICE INFORMATION SECTOR
          ENDMS
          LDD    CN+3        WRITE SECTOR TO CENTRAL BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWM    BFMS+2,HN
          LDN    0           UPDATE BUFFER POINTERS
          STD    CN
          STD    CN+1
          STD    CN+2
          RJM    GFE         SET (OUT) = (FIRST)
          ADN    3
          CWD    CN
          LDD    T1          SET (IN) = (FIRST) + (WORDS TRANSFERRED)
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          RJM    GFE
          ADN    2
          CWD    CN
          LDN    22          LAST STATUS = EOR
          STD    LS
          LJM    SFMX        EXIT
 SDF      SPACE  4,10
***       FUNCTION *SDFF* - SET DEVICE INFORMATION.
*
*         SET FIELDS IN DEVICE INFORMATION SECTOR OF
*         SPECIFIED DEVICE.  WORD AT *WI* IS UPDATED WITH DATA
*         FOUND IN CENTRAL BUFFER AT *FIRST*.
*
*         THE CALLING PROGRAM MUST HAVE SYSTEM ORIGIN
*         PRIVILEGES AND AN *SSJ=* ENTRY POINT.
 
 
 SDF      BSS    0           ENTRY
          RJM    GFE         READ *FIRST*
          ADN    1
          CRD    CN
          ADN    7-1         READ (FET+7)
          CRD    CM
          LDD    CN+3
          LPN    37
          STD    CN+3
          SHN    14
          LMD    CN+4
          SHN    -6
          SBD    FL
          MJN    SDF1        IF DATA WITHIN FL
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 SDF1     LDD    CM+4        SAVE WORD INDEX
          LPN    77
          STM    SDFA
          SBN    MNIT
          PJN    SDF2        IF NOT RESERVED WORD
          ABORT  /MESS/ERIR  * SFM INCORRECT REQUEST.*
 
 SDF2     LDD    CM          VALIDATE EQUIPMENT
          RJM    VEQ
          LDN    0           FORCE LABEL TRACK INTERLOCK
          STM    RDIA
          RJM    RDI         READ DEVICE INFORMATION SECTOR
          LDC    *           CALCULATE ADDRESS OF WORD IN BUFFER
 SDFA     EQU    *-1         (INDEX OF WORD TO UPDATE)
          SHN    2
          ADM    SDFA
          ADC    BFMS+2
          STM    SDFB
          LDD    CN+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRM    *,ON        UPDATE WORD
 SDFB     EQU    *-1         (ADDRESS OF WORD WITHIN BUFFER)
          LDN    PDTL        UPDATE SECTOR MODIFICATION DATE
          CRM    BFMS+2+SMIT*5,ON
          LDC    BFMS+WLSF   REWRITE SECTOR
          RJM    WMS
          ENDMS
          RJM    RTI         RELEASE LABEL TRACK INTERLOCK
          LJM    SFMX        EXIT
 RSD      SPACE  4,10
          TITLE  SUBROUTINES.
 CBL      SPACE  4,10
**        CBL - CHECK DAYFILE BUFFER LENGTH.
*
*         ENTRY  (TY) = DAYFILE TYPE.
*
*         EXIT   (A) = BUFFER LENGTH.
*                TO *ABT* IF ZERO LENGTH DAYFILE BUFFER.
*
*         USES   FA, CM - CM+4.
*
*         CALLS  SDA.
 
 
 CBL      SUBR               ENTRY/EXIT
          RJM    SDA         SET DAYFILE ADDRESS
          SBN    1           READ BUFFER LENGTH (OUT POINTER) WORD
          CRD    CM
          LDD    CM+2
          NJN    CBLX        IF NOT ZERO LENGTH BUFFER
          STD    FA          CLEAR FST ADDRESS
          ABORT  /MESS/ERFE  * SFM FILE EMPTY.*
 CDF      SPACE  4,10
**        CDF - COPY DAYFILE.
*
*         ENTRY  (CN+3 - CN+4) = IN POINTER.
*
*         EXIT   (CN+3 - CN+4) ADVANCED.
*
*         USES   T1 - T3, CM - CM+7.
*
*         CALLS  SBA, SDA.
 
 
 CDF      SUBR               ENTRY/EXIT
          RJM    SDA         SET DAYFILE FET ADDRESS
          SBN    1
          CRD    CM+3
          SBN    1
          CRD    CM
          LDD    HN          SET BLOCK SIZE FOR READ
          STD    T3
 CDF1     LDD    CM+4        IN - OUT
          SBD    CM+7
          ZJN    CDFX        IF BUFFER EMPTY
          PJN    CDF2        IF IN .GT. OUT
          ADD    CM+5        ADD BUFFER LENGTH
 CDF2     SBD    T3
          PJN    CDF3        IF FULL BLOCK IN BUFFER
          ADD    HN          ADJUST BLOCK SIZE
          STD    T3
 CDF3     LDD    T3          SET WORD COUNT FOR READ
          STD    T2
          ADD    CM+7        ADD OUT - BUFFER LENGTH
          SBD    CM+5
          MJN    CDF4        IF NO WRAP AROUND
          ZJN    CDF4        IF NO WRAP AROUND
          STD    T1          WORD COUNT FOR FIRST READ
          LDD    CM+5        WORD COUNT FROM OUT TO END OF BUFFER
          SBD    CM+7
          STD    T2
          SHN    2
          ADD    T2
          ADC    BFMS        BUFFER ADDRESS FOR FIRST READ
          STM    CDFA
          RJM    SBA         READ WRAP AROUND
          CRM    *,T1
 CDFA     EQU    *-1
 CDF4     RJM    SBA         READ DAYFILE BLOCK
          ADD    CM+7
          CRM    BFMS,T2
          LDD    CN+3        STORE DATA READ
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWM    BFMS,T3
          LDD    T3          ADVANCE IN POINTER
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          LDD    T3          ADVANCE DAYFILE OUT POINTER
          RAD    CM+7
          SBD    CM+5
          MJN    CDF5        IF NO WRAP AROUND
          STD    CM+7
 CDF5     LJM    CDF1        LOOP FOR NEXT BLOCK
 CIB      SPACE  4,15
**        CIB - CLEAR FST INTERLOCK BIT.
*         THE TRACK INTERLOCK BIT IN THE FST FOR THE OLD
*         DAYFILE IS CLEARED.
*
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS.
*
*         EXIT   FST ENTRY REWRITTEN.
*
*         USES   FA, CM - CM+4, FN - FN+4.
*
*         CALLS  GFE, SAF.
*
*         MACROS NFA.
 
 
 CIB      SUBR               ENTRY/EXIT
          RJM    GFE         GET FET ADDRESS
          CRD    FN          READ FILE NAME
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    CIBX        IF FILE NOT FOUND
          NFA    FA,R
          ADN    FSTL
          CRD    CM          READ FST ENTRY
          LDD    CM+4        CLEAR INTERLOCK BIT
          LPC    6777
          STD    CM+4
          NFA    FA,R
          ADN    FSTL
          CWD    CM          REWRITE FST ENTRY
          LDN    0           CLEAR FNT ORDINAL
          STD    FA
          UJN    CIBX        RETURN
 SBA      SPACE  4,10
**        SBA - SET BUFFER ADDRESS.
*
*         ENTRY  (TY) = DAYFILE TYPE.
*                (CM - CM+1) = DAYFILE BUFFER ADDRESS.
*
*         EXIT   (A) = DAYFILE BUFFER ADDRESS.
*
*         MACROS NFA.
 
 
 SBA1     NFA    DAYN        SET JOB DAYFILE BUFFER ADDRESS
 
 SBA      SUBR               ENTRY/EXIT
          LDD    TY
          ZJN    SBA1        IF JOB DAYFILE
          LDD    CM          SET SYSTEM DAYFILE BUFFER ADDRESS
          SHN    14
          ADD    CM+1
          UJN    SBAX        RETURN
 RDI      SPACE  4,20
**        RDI - READ DEVICE INFORMATION SECTOR.
*
*         ENTRY  (T5) = EQUIPMENT.
*                (RDIA) = *PSN* IF LABEL TRACK IS TO BE INTERLOCKED.
*
*         EXIT   (T6) = LABEL TRACK.
*                (T7) = *DILT* SECTOR.
*                (BFMS) = DEVICE INFORMATION SECTOR.
*
*         ERROR  TO *DPP* IF ERROR FLAG SET.
*
*         CALLS  LLT, RMS, WTI.
*
*         MACROS SETMS.
 
 
 RDI      SUBR               ENTRY/EXIT
          RJM    LLT         LOCATE LABEL TRACK
 RDIA     UJN    RDI2        BYPASS LABEL TRACK INTERLOCK
*         PSN                (*SETDI* FUNCTION)
          RJM    WTI         SET LABEL TRACK INTERLOCK
          NJP    DPP         IF ERROR FLAG SET
          LDD    T6
          STM    RTIA
 RDI2     LDN    DILT        SET SECTOR
          STD    T7
          SETMS  IO,RW
          LDC    BFMS        READ SECTOR
          RJM    RMS
          UJP    RDIX        RETURN
 VBP      SPACE  4,15
**        VBP - VALIDATE BUFFER POINTERS.
*
*         ENTRY  (A) = BUFFER LENGTH REQUIRED.
*
*         EXIT   (A) .LT. 0 IF VALID POINTERS.
*                (CN+3 - CN+4) = (FIRST).
*
*         USES   T0, T1, CN - CN+4, T2 - T2+4.
*
*         CALLS  GFE.
 
 
 VBP      SUBR               ENTRY/EXIT
          STD    T1
          RJM    GFE         READ *FIRST*
          ADN    1
          CRD    CN
          ADN    3           READ *LIMIT*
          CRD    T2
          LDD    T2+3
          LPN    37
          STD    T2+3
          SHN    14
          LMD    T2+4
          SBN    1
          SHN    -6
          SBD    FL
          PJN    VBPX        IF LIMIT .GT. FL
          LDD    CN+3
          LPN    37
          STD    CN+3
          SHN    14
          LMD    CN+4
          ADD    T1          FIRST+BUFL
          STD    T2
          SHN    -14
          SBD    T2+3
          NJN    VBPX        IF (FIRST+BUFL) .NE. LIMIT
          LDD    T2
          SBD    T2+4
          UJN    VBPX        RETURN
 VEQ      SPACE  4,10
**        VEQ - VALIDATE EQUIPMENT.
*
*         ENTRY  (A) = EST ORDINAL.
*
*         EXIT   (CM - CM+4) = EST ENTRY.
*                TO *ABT* IF INCORRECT EQUIPMENT.
*
*         USES   T5, CM - CM+4.
*
*         MACROS ABORT, SFA.
 
 
 VEQ      SUBR               ENTRY/EXIT
          STD    T5
          ZJN    VEQ1        IF NOT LEGAL EST ORDINAL
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-13
          MJN    VEQX        IF MASS STORAGE EQUIPMENT
 VEQ1     ABORT  /MESS/EREQ  * SFM INCORRECT EQUIPMENT.*
          SPACE  4
          SPACE  4
 OVL0     EQU    BFMS-ZDFL
          ERRNG  OVL0-*-5    OVERFLOW INTO ZERO LEVEL OVERLAY AREA
          ERRNG  EPFW-OVL0-ZBFL  CHECK LENGTH OF *0BF*
          ERRNG  EPFW-OVL0-ZTDL  CHECK LENGTH OF *0TD*
 PRS      TITLE  PRESET.
**        PRS - PRESET PROGRAM.
*
*         EXIT   (LS) = LAST FET STATUS.
*                (FA) = 0.
*                (FI) = 0.
*                (MI) = 1.
*                (TE) = NUMBER OF ENTRIES IN FNT.
*                (FN - FN+4) = FIRST WORD OF FET.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDN    0           CLEAR FST ADDRESS
          STD    T1
          STD    FA
          STD    FI
          LDN    1           PRESET MACHINE INDEX
          STD    MI
          RJM    CRS         CHECK RECALL STATUS
          ZJN    PRS1        IF RECALL NOT SET
 
*         CHECK FUNCTION CODE.
 
          LDD    IR+2        CHECK FUNCTION CODE
          SHN    1
          ADD    IR+2
          STD    T7
          SBK    MXFN*3
          MJN    PRS2        IF LEGAL CODE
 PRS1     ABORT  /MESS/ERIR  * SFM INCORRECT REQUEST.*
 
*         CHECK FET ADDRESS.
 
 PRS2     LDD    IR+3        CHECK FET ADDRESS
          LPN    77
          STD    IR+3
          SHN    14
          MJN    PRS2.1      IF OUT OF RANGE
          LMD    IR+4
          ADN    1
          SHN    -6
          SBD    FL
          MJN    PRS2.2      IF NOT OUT OF RANGE
 PRS2.1   ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
*         CHECK FET LENGTH.
 
 PRS2.2   LDM    TFCN+2,T7
          LPN    77
          STM    FETL        SAVE REQUIRED FET LENGTH
          ZJN    PRS2.3      IF NO FET REQUIRED
          RJM    GFE         GET FET ADDRESS
          ADN    1
          CRD    CM
          LDD    CM+3        SET FET LENGTH
          SHN    -6
          ADN    5
          STD    T1
          LDM    FETL        CHECK FET LENGTH
          SBD    T1
          PJN    PRS2.1      IF FET NOT LONG ENOUGH
 PRS2.3   LDD    IR+3
          SHN    14
          LMD    IR+4
          ADD    T1
          SHN    -6
          SBD    FL
          PJN    PRS2.1      IF OUT OF RANGE
 
*         CHECK FOR PRIVILEGED ANALYST ACCESS.
 
          LDM    TFCN+2,T7
          SHN    21-7
          PJN    PRS3        IF NOT CHECKING FOR PRIVILEGED ANALYST
          RJM    VPA         VALIDATE PRIVILEGED ANALYST
          ZJN    PRS3.1      IF PRIVILEGED ANALYST ACCESS ALLOWED
 
*         CHECK FOR EITHER SYSTEM ORIGIN PRIVILEGES OR *SSJ=*.
 
 PRS3     LDM    TFCN+2,T7
          SHN    21-10
          PJN    PRS4        IF NOT CHECKING FOR *SYOT* OR *SSJ=*
          RJM    CUA         CHECK USER ACCESS
          ZJN    PRS3.1      IF CALLER HAS SYSTEM ORIGIN PRIVILEGES
          LDD    CP          CHECK FOR *SSJ=*
          ADK    SEPW
          CRD    CM
          LDD    CM
          SHN    21-2
          PJN    PRS5        IF CALLER IS NOT *SSJ=*
 PRS3.1   LJM    PRS7        PROCESS FUNCTION
 
*         CHECK FOR SYSTEM ORIGIN PRIVILEGES.
 
 PRS4     LDM    TFCN+2,T7   CHECK USER ACCESS REQUIRMENTS
          SHN    21-12
          PJN    PRS6        IF NO REQUIREMENTS
          RJM    CUA         CHECK USER ACCESS
          ZJN    PRS6        IF CALLER HAS SYSTEM ORIGIN PRIVILEGES
          LDD    CM          CHECK MAINTENANCE ACCESS
          NJN    PRS5        IF NOT MAINTENANCE ACCESS
          LDM    TFCN+2,T7
          SHN    21-11
          MJN    PRS6        IF MAINTENANCE ACCESS ALLOWED
 PRS5     LJM    PRS1        * SFM INCORRECT REQUEST.*
 
*         CHECK FOR *SSJ=*.
 
 PRS6     LDM    TFCN+2,T7
          SHN    21-13
          PJN    PRS7        IF NOT CHECKING FOR *SSJ=*
          LDD    CP          READ SPECIAL ENTRY POINTS
          ADC    SEPW
          CRD    CM
          LDD    CM
          SHN    21-2
          PJN    PRS5        IF *SSJ=* NOT PRESENT
 
*         PROCESS FUNCTION.
 
 PRS7     LDM    TFCN,T7     SET OVERLAY NAME
          STM    SFMA
          LDM    TFCN+1,T7   SET PROCESSOR ADDRESS
          STM    SFMB
          RJM    GFE         GET FET ADDRESS
          CRD    FN
          LDD    FN+4        SAVE LAST FET STATUS
          LPC    1776
          STD    LS
          LDN    DFPP        READ DAYFILE POINTER WORD
          CRD    CM
          LDD    CM          SET FWA-1 OF DAYFILE POINTERS
          SHN    14
          LMD    CM+1
          SBN    1
          STM    SDAA+1
          SHN    -14
          RAM    SDAA
          LDN    FNTP        SET FNT POINTER
          CRD    CM
          LDD    CM+2        SET NUMBER OF ENTRIES
          STD    TE
          RJM    IFP         INITIALIZE TABLE ACCESS ROUTINES
          LJM    PRSX        RETURN
 
 
 IFP      HERE               DUMP *IFP* REMOTE CODE
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCRS
 SSJ$     EQU    1           SET SSJ CHECKING FOR *COMPCUA*
*CALL     COMPCUA
*CALL     COMPVPA
 TFCN     SPACE  4,20
**        TFCN - TABLE OF FUNCTION CODE PROCESSORS.
*
*T,       12/O,12/N,1/S,1/P,1/M,1/E,1/A,1/0,6/L
*
*         N      FUNCTION PROCESSOR ADDRESS.
*         O      OVERLAY NAME.
*         S      *SSJ=* ENTRY POINT REQUIRED.
*         P      SYSTEM ORIGIN PRIVILEGES REQUIRED.
*         M      MAINTENANCE ACCESS ALLOWED.
*         E      EITHER *SSJ=* OR SYSTEM ORIGIN PRIVILEGES REQUIRED.
*         A      ALLOW ACCESS IF CALLER HAS PRIVILEGED ANALYST
*                VALIDATION AND IF *PRIVILEGED ANALYST MODE* ENABLED.
*         L      REQUIRED FET LENGTH - 1.
 
 
 TFCN     FCN
          FCN    TAFF,TAD,6,P,SSJ      TERMINATE ACTIVE DAYFILE
          FCN    AMDF,ADF,5,P,,,,A     ACCESS MASTER DAYFILE
          FCN    AAFF,AAC,5,P,,,,A     ACCESS ACCOUNT DAYFILE
          FCN    AELF,AER,5,P,,M,,A    ACCESS ERROR LOG
          FCN    AMLF,AMF,5,P,,M       ACCESS MAINTENANCE LOG
          FCN    AUDF,AUD,5            ACCESS USER DAYFILE
          FCN    RDTF,RDT,4,P          RETURN DEVICE TYPE
          FCN    PADF,PDF,6,P,SSJ      PROTECT ACTIVE DAYFILE
          FCN    CDBF,CDB,6,P,SSJ      CLEAR DAYFILE BYTE
          FCN    EFAF,EGF,5,P,SSJ      ENTER LOCAL FAST ATTACH FILE
          FCN    DFAF,DFA,5,P,SSJ      DELETE FAST ATTACH FILE
          FCN    ECFF,ECF,5,P,SSJ      ENTER *CPD* SAMPLE FILE
          FCN    ATDF,ATD,6,,SSJ       ATTACH INACTIVE DAYFILE
          FCN    EGFF,EGF,5,P,SSJ      ENTER GLOBAL FAST ATTACH FILE
          FCN    ELFF,ELF,5,P,SSJ      ENTER LINK FAST ATTACH FILE
          FCN    GDIF,GDI,6,P,SSJ      GET DEVICE INFORMATION
          FCN    SDFF,SDF,6,P,SSJ      SET DEVICE INFORMATION
          FCN    RSDF,RSD,0,,,,E       RETURN SYSTEM DATA
          FCN    CSTF,CST,0,P          CLEAR SUBSYSTEM ACCESS FLAG
          FCN    SSTF,CST,0,P          SET SUBSYSTEM ACCESS FLAG
          FCN    SCDF,SCD,4,P          SET *CPD* DROP FLAG
          FCN    CFFF,CFA,5,P,SSJ      COUNT FAST ATTACH FILES
          FCN    MDFF,DMM,4,P          DUMP MACHINE MEMORY
          FCN    GLAF,GLA,0            GET LID ATTRIBUTES
          FCN    GLTF,GLT,4,,,,E       GET LID TABLE
          FCN    GLPF,GLP,0,,,,E       GET PID ATTRIBUTES
          FCN    GSSF,GSS,0            GET ORIGIN TYPE ACCESS LEVELS
          FCN    GEAF,GEA,0            GET EQUIPMENT ACCESS LEVEL LIMITS
          FCN    GSMF,GSM,0            GET SYSTEM SECURITY MODE
          FCN    SPTF,SPT,0,,,,E       SET PID ATTRIBUTES
          FCN    ILTF,INT,0,,,,E       INITIALIZE LDT
          FCN    GLCF,GLC,0,,,,E       GET LID CONFIGURATION
          FCN    SUSF,SSS,0,P          SET SUBSYSTEM STATUS
          FCN    GTSF,GTS,0            GET *TMS* STATUS
          FCN    TPDF,TPD,0,,SSJ       TRANSFER RESOURCE PREVIEW DATA
          FCN    MXFN
          SPACE  4,10
          OVERFLOW
          OVERLAY (ERROR PROCESSOR.)
 ABP      SPACE  4,15
**        ABP - ABORT JOB.
*
*         ENTRY  (DA) = MESSAGE ADDRESS.
*                (FS - FS+4) = FST ENTRY.
*                (FA) = FST ADDRESS.
*                (FA) = 0, IF NO FILE.
*
*         USES   CM+1, FS+4.
*
*         CALLS  CFB, DFM.
*
*         MACROS MONITOR.
 
 
 ABP      ENTRY              ENTRY
          LDD    DA          ISSUE MESSAGE TO DAYFILE
          ZJN    ABP2        IF NO DAYFILE MESSAGE
 ABP0     RJM    DFM
          RJM    CFB         CLEAR FILE BUSY
 ABP1     MONITOR  ABTM      ABORT PROGRAM
          LJM    PPR         EXIT TO PP RESIDENT
 
 ABP2     LDC    /MESS/ERIE  * SFM INTERNAL ERROR.*
          UJN    ABP0        ISSUE MESSAGE
 
 
*         DAYFILE ERROR MESSAGES.
 
 
          QUAL   MESS
 ERAB     DATA   C* SFM ABORTED.*
 ERAE     DATA   C* SFM ARGUMENT ERROR.*
 ERAF     DATA   C* SFM FAMILY STILL ACTIVE.*
 ERDA     DATA   C* SFM DIRECT ACCESS FILE ERROR.*
 ERDC     DATA   C* SFM INCORRECT DAYFILE CODE.*
 ERDF     DATA   C* SFM DUPLICATE FILE FOUND.*
 EREQ     DATA   C* SFM INCORRECT EQUIPMENT.*
 ERFA     DATA   C* SFM LINK FAST ATTACH FILE NOT FOUND.*
 ERFE     DATA   C* SFM FILE EMPTY.*
 ERFF     DATA   C* SFM FILE NOT FOUND.*
 ERFN     DATA   C* SFM FILE NAME ERROR.*
 ERFT     DATA   C* SFM INCORRECT FILE TYPE.*
 ERFU     DATA   C* SFM FNT FULL.*
 ERIO     DATA   C* SFM I/O SEQUENCE ERROR.*
 ERIR     DATA   C* SFM INCORRECT REQUEST.*
 ERLE     DATA   C* SFM UNRECOVERABLE LINK DEVICE ERROR.*
 ERMS     DATA   C* SFM FILE NOT ON MASS STORAGE.*
 ERNH     DATA   C* SFM GLOBAL FAST ATTACH LIMIT.*
 ERSE     DATA   C* SFM SYSTEM SECTOR ERROR.*
 ERTE     DATA   C* SFM TRACK INTERLOCK ERROR.*
 ERUD     DATA   C* SFM UNABLE TO INTERLOCK DEVICE.*
 ERWC     DATA   C* SFM BML MESSAGE LENGTH ERROR.*
 ERIE     DATA   C* SFM INTERNAL ERROR.*
          QUAL   *
 ERP      SPACE  4,10
**        ERP - COMMON ERROR EXIT FROM SFM.
*
*         ENTRY  (DA) = ERROR CODE.
*
*         USES   DA, LS, CM - CM+4.
*
*         CALLS  GFE.
 
 
 ERP      ENTRY              ENTRY
          LDM    FETL        CHECK FET LENGTH
          ZJN    ERP0        IF ONE-WORD FET
          RJM    GFE         GET FET ADDRESS
          ADN    1
          CRD    CM
          LDD    CM+1        CHECK IF EP BIT SET
          SHN    21-10
          PJN    ERP1        IF EP BIT NOT SET
 ERP0     LDD    DA          SET ERROR CODE IN FET+0
          SHN    12
          RAD    LS
          SHN    -14
          STM    SFMC
          LJM    SFMX        RETURN TO USER
 
 ERP1     LDD    DA          CHECK ERROR TYPE
          LMN    /ERR/DFB
          NJN    ERP2        IF NOT DAYFILE BUSY ERROR
          LDN    TIRR        REASON CODE = TRACK INTERLOCK
          LJM    ERS         ENTER PP RECALL STACK
 
 ERP2     LDM    TEMT,DA     SET ERROR MESSAGE ADDRESS
          STD    DA
          LJM    ABP         ABORT JOB
          SPACE  4,10
**        DEFINED ERROR CODES.
*
*         EC     DESCRIPTION
*         1      DAYFILE BUSY.
*         2      MASS STORAGE NOT AVAILABLE.
*         3      FILE NOT FOUND.
*         4      UNCORRECTABLE RMS ERROR.
*         5      *CPD* NOT ACTIVE
*         6      RETURN INFORMATION TOO LONG FOR BUFFER.
*         7      LID UNKNOWN OR NOT LEGAL.
*         10     INCORRECT LID ATTRIBUTES.
*         11     CURRENT ATTRIBUTES NOT IN LID TABLE.
*         12     LID TABLE OVERFLOW.
*         13     TOO MANY HOST LIDS.
*         14     INCORRECT SUBFUNCTION CODE.
*         15     INCORRECT NETWORK STATUS PARAMETER.
*         16     CHECK PARAMETER BLOCK ENTRIES FOR ERROR.
 
 
 TEMT     INDEX
          INDEX  /ERR/DFB,ERPA
          INDEX  /ERR/TKL,ERPB
          INDEX  /ERR/FNF,ERPC
          INDEX  /ERR/RMS,ERPD
          INDEX  /ERR/CNF,ERPE
          INDEX  /ERR/LTL,ERPF
          INDEX  /ERR/LNL,NMSG
          INDEX  /ERR/ILA,NMSG
          INDEX  /ERR/LOA,NMSG
          INDEX  /ERR/LTO,NMSG
          INDEX  /ERR/TMH,NMSG
          INDEX  /ERR/IFC,NMSG
          INDEX  /ERR/IST,NMSG
          INDEX  /ERR/CPB,NMSG
          INDEX  /ERR/MXSE
 
 
 ERPA     DATA   C* SFM - DAYFILE BUSY.*
 ERPB     DATA   C* SFM - TRACK LIMIT.*
 ERPC     DATA   C* SFM - FILE NOT FOUND.*
 ERPD     DATA   C* SFM - UNCORRECTABLE RMS ERROR.*
 ERPE     DATA   C+ *CPD* NOT ACTIVE.+
 ERPF     DATA   C* SFM - LID TABLE TOO LONG FOR BUFFER.*
 
 NMSG     EQU    0           (NO DAYFILE MESSAGE ISSUED)
          SPACE  4,10
          OVERFLOW  OVLA
          OVERLAY (FAST ATTACH PROCESSORS.)
          SPACE  4
 EFA      TITLE  FUNCTION PROCESSORS
 CFA      SPACE  4,10
***       FUNCTION *CFFF* - COUNT FAST ATTACH FILES.
*
*         *CFA* COUNTS FAST ATTACH FILES FOR THE FAMILY OF THE CALLING
*         PROGRAM AND COMPARES IT TO THE DAF COUNT OF THE SAME FAMILY.
*         *CFA* MUST BE CALLED BY A SPECIAL SYSTEM JOB.
*
*         ENTRY  (IR+3 - IR+4) = FET FWA.
*
*         EXIT   (FET+5) = 36/ 0, 24/ C
*
*         MACROS SFA.
 
 
 CFA      ENTRY              ENTRY
          LDD    CP          GET FAMILY NAME
          ADN    PFCW
          CRD    CM
          SFA    EST,CM+3
          ADK    EQDE
          CRD    CM
          LDD    CM+4
          SHN    3
          ADN    PFGL
          CRD    CM
 
*         COUNT FAST ATTACH FILES ON SPECIFIED FAMILY.
 
          LDN    0           INITIALIZE FAFT COUNT
          STD    T1
          STD    QA
 CFA1     AOD    QA          ADVANCE FNT ORDINAL
          LMD    TE
          ZJN    CFA3        IF END OF FNT
          SFA    FNT,QA      READ FNT ENTRY
          CRD    CN
          ADN    FSTG        READ FST INFORMATION
          CRD    T3
          LDD    CN+4        CHECK FILE TYPE
          SHN    -6
          LMN    FAFT
          NJN    CFA1        IF NOT FAFT
          LDD    T3
          STD    T2          SAVE EST ORDINAL
          SFA    EST
          ADK    EQDE
          CRD    T3          EST WORD
          LDD    T3+4        READ FAMILY NAME
          SHN    3
          ADN    PFGL
          CRD    T3
          RJM    CFM         COMPARE FAMILY NAMES
          NJN    CFA1        IF NOT SAME FAMILY
          AOD    T1          INCREMENT FAFT COUNT
          UJN    CFA1        LOOP
 
*         GET DIRECT ACCESS FILE (DAF) COUNT FOR SPECIFIED FAMILY.
 
 CFA3     LDN    ESTP        GET EST POINTER
          CRD    FN
          LDD    FN+3        SAVE LAST MASS STORAGE ORDINAL + 1
          STD    FN+1
          LDN    0           INITIALIZE DAF COUNT
          STD    FN+3
          STD    FN+4
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    FN
 CFA4     AOD    FN          GET NEXT EST ENTRY
          LMD    FN+1
          ZJN    CFA5        IF END OF MASS STORAGE EQUIPMENTS
          SFA    EST,FN      READ EST ENTRY
          ADK    EQDE
          CRD    CN
          LDD    CN
          SHN    21-13
          PJN    CFA4        IF NOT MS EQUIPMENT
          LDD    CN+4        GET FAMILY NAME
          SHN    3
          ADN    PFGL
          CRD    T3
          RJM    CFM         COMPARE FAMILY NAMES
          NJN    CFA4        IF NOT SAME FAMILY
          LDD    CN+4        GET DAF COUNT
          SHN    3
          ADN    STLL
          CRD    CN
          LDD    CN+3        INCREMENT DAF COUNT
          RAD    FN+4
          SHN    -14
          RAD    FN+3
          UJN    CFA4        SEARCH FOR ANOTHER FAMILY DEVICE
 
*         STORE RESULT.
 
 CFA5     LDN    ZERL
          CRD    CM
          LDD    FN+3
          SHN    14
          ADD    FN+4
          SBD    T1          (DAF COUNT) - (FAFT COUNT)
          STD    CM+4
          SHN    -14
          STD    CM+3
          RJM    GFE         WRITE FET+5
          ADN    5
          CWD    CM
          LJM    SFMX        EXIT
 ECF      SPACE  4,10
***       FUNCTION *ECFF* - ENTER *CPD* SAMPLE FILE.
*
*         SPECIFIED FILE MUST BE A DIRECT ACCESS FILE.
*         NO ACTION TAKEN IF SPECIFIED FILE ALREADY ENTERED.
 
 
 ECF      ENTRY              ENTRY
          LCN    FAFT-PMFT   ENABLE SEARCH FOR *PMFT* FILE
          RAM    FATC
          RJM    VLF         VERIFY LOCAL FILE
          NJN    ECF1        IF FILE UNDEFINED IN SYSTEM FNT
          LJM    SFMX        RETURN
 
 ECF1     RJM    IFA         INITIALIZE SYSTEM FNT ENTRY
          LDD    QA
          STM    ECFA+2      SET FNT ORDINAL FOR *CPD* CALL
          NFA    FA,R
          ADN    FSTL        RESTORE FST INFORMATION
          CRD    FS
          LDD    IR+3        SET FET ADDRESS
          STM    ECFA+3
          LDD    IR+4
          STM    ECFA+4
          RJM    GFE         READ LIMIT WORD
          ADN    4
          CRD    CN
          LDD    FA          SET LOCAL FNT OFFSET
          STD    CN
          RJM    GFE         UPDATE FET
          ADN    4
          CWD    CN
          LDC    ECFA        ENABLE *CPD* CALL
          STM    SFMF
          LJM    SFMX        RETURN
 
 
 ECFA     VFD    18/3RCPD,6/40,12/0,24/0
 EFA      SPACE  4,10
***       FUNCTION *EFAF* - ENTER LOCAL FAST ATTACH FILE.
*
*         SPECIFIED FILE MUST BE A DIRECT ACCESS FILE.
*         NO ACTION TAKEN IF SPECIFIED FILE ALREADY ENTERED.
 EGF      SPACE  4
***       FUNCTION *EGFF* - ENTER GLOBAL FAST ATTACH FILE.
*
*         THE SPECIFIED FILE IS ENTERED INTO THE GLOBAL FAST
*         ATTACH STATUS IF IT RESIDES ON A SHARED DEVICE.  IF THE
*         FILE IS NOT ON A SHARED DEVICE, THE FUNCTION IS EXACTLY
*         THE SAME AS FUNCTION *EFAF*, ENTER LOCAL FAST ATTACH.
*
*         THE SPECIFIED FILE MUST BE A DIRECT ACCESS FILE.
 
 
 EGF      ENTRY              ENTRY
          RJM    VLF         VERIFY LOCAL FILE
          NJN    EGF1        IF FAST ATTACH FILE NOT FOUND
          LJM    SFMX        EXIT
 
 EGF1     LDD    ES          CHECK FILE ON SHARED DEVICE
          SHN    21-11
          PJN    EGF2        IF NOT SHARED DEVICE
          LDD    IR+2
          LMN    EFAF
          NJN    EGF3        IF NOT LOCAL FAST ATTACH
          RJM    SMI         GET MACHINE INDEX
          STD    MI
 EGF2     UJN    EGF6        UPDATE SYSTEM SECTOR
 
 EGF3     SOM    EGFA
          RJM    SMP         SET MMF PARAMETERS
          LDD    ES
          SHN    21-4
          MJN    EGF6        IF INDEPENDENT SHARED DEVICE
          LDN    DATI        SET *DATI* INTERLOCK
          RJM    SFR
          RJM    SFT         SEARCH *FAT* TABLE
          NJN    EGF4        IF ENTRY FOUND
          RJM    EFI         ENTER *FAT* TABLE ENTRY
          ZJN    EGF5        IF HOLE USED FOR ENTRY
          RJM    IFC         INCREMENT FAST ATTACH COUNT
          UJN    EGF5
 
 EGF4     RJM    UFI         UPDATE *FAT* ENTRY
 EGF5     LDN    DATI        CLEAR *DATI* INTERLOCK
          RJM    CFI
 EGF6     LDD    MI          SET SYSTEM SECTOR ADDRESS OF WRITE FLAG
          STD    BA
          SHN    2
          ADC    UCSS
          RAD    BA
          RJM    IFA         INITIALIZE FAST ATTACH FILE
          LDN    1           READ SYSTEM SECTOR
          RJM    RFS
          NJN    EGF8        IF SYSTEM SECTOR ERROR
          LDD    ES
          LPN    20
          ZJN    EGF7        IF NOT INDEPENDENT SHARED DEVICE
          LDN    4           SET MACHINE ACTIVE FLAG
 EGF7     ADN    1           SET LOCAL WRITE FLAG
*         ADN    0           (CLEAR LOCAL WRITE FLAG - GLOBAL FILE)
 EGFA     EQU    *-1
          STI    BA
          LDC    4000        SET FAST ATTACH INDICATOR
          LMD    FI
          STM    FISS
          LDM    CASS        CLEAR CURRENT ACCESS MODE
          SCN    37
          STM    CASS
          LDD    QA          SET FNT ORDINAL
          STM    FASS
          LDD    MA          COPY FILE NAME TO SYSTEM SECTOR
          CWD    FN
          CRM    FNSS,ON
          RJM    WFS         REWRITE SYSTEM SECTOR
 EGF8     LDD    FI          SET *FAT* INDEX IN FNT ENTRY
          RAD    FN+3
          SFA    FNT,QA      STORE FNT ENTRY
          CWD    FN
          ADN    FSTG
          CWD    FS
          LJM    SFMX        RETURN
 ELF      SPACE  4
***       FUNCTION *ELFF* - ENTER LINK FAST ATTACH FILE.
*
*         A SEARCH IS MADE OF THE ECS/FAT TABLE IN ORDER TO DETERMINE
*         IF A FILE WITH THE SPECIFIED NAME HAS ALREADY BEEN ENTERED
*         INTO GLOBAL FAST ATTACH STATUS.  THE EST ORDINAL AND
*         FIRST TRACK RETURNED FROM *PFM* IN *TERW* ARE USED TO
*         UNIQUELY IDENTIFY THE FILE.
 
 
 ELF      ENTRY              ENTRY
          LDD    CP          SET EQUIPMENT AND FIRST TRACK
          ADN    TERW
          CRD    CM
          LDD    CM+4        SET TRACK
          STD    FS+1
          LDD    CM+3        SET EQUIPMENT
          LPC    777
          STD    FS
          STD    T5
          SFA    EST         SET EQUIPMENT EST
          ADK    EQDE
          CRD    ES
          LDD    ES          CHECK FILE ON SHARED DEVICE
          SHN    21-11
          PJN    ELF1        IF FILE NOT ON SHARED DEVICE
          RJM    SMP         SET MMF PARAMETERS
          LDD    ES
          SHN    21-4
          MJN    ELF4        IF INDEPENDENT SHARED DEVICE
          LDN    DATI        SET *DATI* INTERLOCK
          RJM    SFR
          RJM    SFT         SEARCH *FAT* TABLE
          NJN    ELF2        IF FILE FOUND
 ELF1     ABORT  /MESS/ERFA  * SFM LINK FAST ATTACH FILE NOT FOUND.*
 
 ELF2     LDD    MI          CHECK MACHINE ALREADY ENTERED
          SHN    2           OFFSET = (MI+1)*5+(BA)
          ADD    MI
          ADN    5
          ADD    BA
          STD    T1
          LDI    T1
          ZJN    ELF5        IF MACHINE NOT ENTERED YET
          LDN    DATI        CLEAR *DATI* INTERLOCK
          RJM    CFI
 ELF3     LJM    SFMX        RETURN
 
 ELF4     LDD    ES+4        READ FAMILY NAME
          SHN    3
          ADN    PFGL
          CRD    CN
          LDD    MA          MOVE FILE NAME
          CWD    FN
          CRD    CM
          RJM    FAT         SEARCH FOR FAST ATTACH FILE
          NJN    ELF6        IF FILE NOT FOUND
          UJN    ELF3        RETURN
 
 ELF5     RJM    UFI         UPDATE *FAT* TABLE
          LDN    DATI        CLEAR *DATI* INTERLOCK
          RJM    CFI
 ELF6     RJM    IFA         INITIALIZE FAST ATTACH FILE
          LDD    ES
          LPN    20
          ZJN    ELF7        IF NOT INDEPENDENT SHARED DEVICE
          RJM    RFS         READ SYSTEM SECTOR
          NJN    ELF3        IF SYSTEM SECTOR ERROR
          LDD    MI
          SHN    2
          ADD    MI
          ADC    UCSS
          STD    T1
          LDN    4           SET MACHINE ACTIVE FLAG
          RAI    T1
          RJM    WFS         REWRITE SYSTEM SECTOR
 ELF7     LDD    FI          SET *FAT* INDEX IN FNT ENTRY
          RAD    FN+3
          SFA    FNT,QA      STORE FNT ENTRY
          CWD    FN
          ADN    FSTG
          CWD    FS
          LDD    FS          SET EST ORDINAL
          STD    CM+1
          LDN    IUCS        INCREMENT USER COUNT
          STD    CM+3
          MONITOR  SMDM
          LJM    SFMX
 DFA      SPACE  4
***       FUNCTION *DFAF* - DELETE FAST ATTACH FILE.
*
*         SPECIFIED FILE MUST BE ASSIGNED TO CONTROL POINT.
 
 
 DFA      ENTRY              ENTRY
          RJM    VLF         VERIFY LOCAL FILE
          ZJN    DFA1        IF FAST ATTACH FILE FOUND
          LJM    SFMX
 
 DFA1     LDC    DFAB-4      PRESET TABLE ADDRESS
          STD    CM
 DFA1.1   LDN    4           INCREMENT ADDRESS FOR NEXT ENTRY
          RAD    CM
          LDM    0,CM
          ZJN    DFA1.2      IF END OF TABLE
          LMD    FN
          NJN    DFA1.1      IF NO FILE NAME MATCH
          LDM    1,CM
          LMD    FN+1
          NJN    DFA1.1      IF NO FILE NAME MATCH
          LDM    2,CM
          LMD    FN+2
          NJN    DFA1.1      IF NO FILE NAME MATCH
          LDM    3,CM
          LMD    FN+3
          SCN    77
          ZJN    DFA2        IF IGNORE FAMILY ACTIVITY COUNT
 DFA1.2   LDD    CP          CHECK FAMILY ACTIVITY COUNT
          ADN    PFCW
          CRD    CM
          SFA    EST,CM+3
          ADK    EQDE
          CRD    CM
          LDD    CM+4
          SHN    3
          ADN    DULL
          CRD    CM
          LDD    CM+4
          LPC    3777
          SBN    1
          ZJN    DFA2        IF NO FAMILY ACTIVITY
          ABORT  /MESS/ERAF  * SFM FAMILY STILL ACTIVE.*
 
 DFA2     LDD    FS+4        CLEAR FAST ATTACH INDICATOR
          LPC    5777
          STD    FS+4
          LDC    SYFT*100    SET FILE TYPE
          STD    FN+4
          LDN    ZERL
          CRD    CN
          LDD    T1          SET FNT ORDINAL
          STD    QA
          SFA    FNT         READ FNT ENTRY
          CRD    CM
          CWD    FN
          ADN    FSTG
          CWD    CN
          LDD    CM+3        CHECK GLOBAL FAST ATTACH
          LPN    77
          ZJN    DFA3        IF NOT GLOBAL FAST ATTACH
          RJM    SMP
          LDD    ES
          SHN    21-4
          PJN    DFA7        IF NOT INDEPENDENT SHARED DEVICE
 
*         CLEAR FST ADDRESS FROM SYSTEM SECTOR.
 
 DFA3     LDD    FS          RESTORE EQUIPMENT
          STD    T5
          LDD    FS+1        RESTORE FIRST TRACK
          STD    T6
          LDN    0           READ SYSTEM SECTOR
          RJM    RFS
          NJN    DFA6        IF SYSTEM SECTOR ERROR
          LDD    ES
          LPN    20
          ZJN    DFA4        IF NOT SHARED DEVICE
          RJM    SMI         GET MACHINE INDEX
          STD    MI
          RJM    CAC
          ZJN    DFA4        IF LAST MACHINE RELEASING FILE
          LDN    0           CLEAR ACCESS MODE
          STM    CASS
          STI    T2          CLEAR LOCAL WRITE FLAG
          UJN    DFA5        REWRITE SYSTEM SECTOR
 
 DFA4     STM    FISS
 DFA5     RJM    WFS         REWRITE SYSTEM SECTOR
 DFA6     LJM    DFA11       DECREMENT USER COUNT
 
*         PROCESS MMF FAST ATTACH FILE.
 
 DFA7     LDN    DATI        SET *DATI* INTERLOCK
          RJM    SFR
          RJM    SFT         SEARCH *FAT* TABLE
          NJN    DFA8        IF FILE FOUND
          ABORT  /MESS/ERFF  * SFM FILE NOT FOUND.*
 
 DFA8     LDD    MI          SET LOCAL WORD OFFSET
          SHN    2
          ADD    MI
          ADN    5
          ADD    BA
          STM    DFAA
          LDN    ZERL        DELETE LOCAL ENTRY
          CRM    *,ON
 DFAA     EQU    *-1
          LDN    MXMF        PRESET SEARCH LOOP
          STD    T0
 DFA8.1   SOD    T0          CHECK FOR OTHER MACHINES
          MJN    DFA9        IF NO OTHER MACHINES ACTIVE
          SHN    2
          ADD    T0
          ADD    BA
          STD    T1
          LDM    2*5,T1
          NJN    DFA10       IF NOT LAST MACHINE OUT
          UJN    DFA8.1      CHECK NEXT MACHINE SLOT
 
*         PROCESS LAST ENTRY REMOVED.
 
 DFA9     LDN    ZERL        SET TO DELETE ENTRY
          CRD    CM
          LDN    0           CLEAR WORD ZERO OF *FAT* ENTRY
          RJM    WFW
          LDN    DATI        CLEAR *DATI* INTERLOCK
          RJM    CFI
          LJM    DFA3        UPDATE SYSTEM SECTOR AND FST
 
 DFA10    LDC    LDNI        CLEAR LOCAL ENTRY
          STM    UFIA
          RJM    UFI         UPDATE *FAT* ENTRY
          LDN    DATI        CLEAR *DATI* INTERLOCK
          RJM    CFI
          RJM    CFE         CLEAR LOCAL FNT ENTRY
          LDD    FS          DECREMENT COUNT FOR FAST ATTACH
          STD    CM+1
          LDN    DUCS
          STD    CM+3
          MONITOR  SMDM
 DFA11    LDD    FS          DECREMENT COUNT FOR LOCAL FILE
          STD    CM+1        SET EQUIPMENT
          LDN    DUCS
          STD    CM+3
          MONITOR  SMDM
          LJM    SFMX
 
 
*         TABLE OF SYSTEM FILES FOR FAMILY ACTIVITY OVERRIDE.
 
 DFAB     BSS    0
          DATA   7L"TMFC"    TMS DATABASE
          CON    0           END OF TABLE
 GTS      SPACE  4,10
***       FUNCTION *GTSF* - GET TMS STATUS.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*
*         EXIT   (ADDRESS) = BIT 59 SET IF TMS IS ENABLED.
*                            BIT 58 SET IF TFM BINARIES ON SYSTEM.
*                            BIT 57 SET IF TMS ACTIVE ON FAMILY.
*                            BIT 1 SET IF DEFAULT *TO=E*.
*                            BIT 0 SET IF DEFAULT *TO=F*.
 
 
 GTS      ENTRY              ENTRY
          LDD    CP          GET FAMILY EST ORDINAL
          ADN    PFCW
          CRD    CM
          SFA    EST,CM+3    GET EST ENTRY
          CRD    CM
          LDD    CM+4        GET FAMILY NAME FROM MST
          SHN    3
          ADN    PFGL
          CRD    CN
          LDD    MA          GET TAPE CATALOG NAME
          CWM    GTSC,ON
          LDD    MA
          CRD    CM
          RJM    FAT         FIND FAST ATTACH FILE
          STD    CM
          LDN    ZERL        PRESET PARAMETER WORD
          CRD    CN
          LDD    CM          SET FILE STATUS
          LMN    1
          SHN    11-0
          STD    CN
          EXECUTE  TFM,=
          LDC    100+1RT     SET NAME OF TMS PP PROGRAM *TFM*
          STD    CM+2
          LDC    2RFM
          STD    CM+3
          MONITOR  SPLM      SEARCH PERIPHERAL LIBRARY
          LDD    CM+4        CHECK IF TMS BINARIES IN SYSTEM
          ADD    CM+3
          ZJN    GTS1        IF NO BINARIES
          LDC    2000        FLAG BINARIES IN SYSTEM
          RAD    CN
 GTS1     LDN    SSTL        GET TMS ENABLED/DISABLED STATUS
          CRD    CM
          LDD    CM+2
          LPN    1
          LMN    1
          SHN    13-0
          RAD    CN
          NFA    TMSN        GET TMS CONTROL WORD
          CRD    CM
          LDD    CM+4        PRESET USER DEFAULTS
          SHN    1-12
          STD    CN+4
          SHN    21-13-1+12
          MJN    GTS3        IF DEFAULTS SET BY USER
          LDD    CP          FETCH EJT ORDINAL
          ADK    TFSW
          CRD    CM
          SFA    EJT,CM      CALCULATE EJT ENTRY ABSOLUTE ADDRESS
          ADK    SCLE        GET JOB ORIGIN TYPE
          CRD    CM
          LDD    CM
          LPN    17
          NJN    GTS2        IF NOT SYSTEM ORIGIN
          AOM    GTSA        CHANGE SHIFT COUNTS
          AOM    GTSB
 GTS2     LDK    TFML        GET TMS SYSTEM STATUS WORD
          CRD    CM
          LDD    CM+4        SET *TO=F* OR *TO=T*
 GTSA     SHN    0-12
*         SHN    0-11        SYSTEM ORIGIN
          LPN    1
          STD    CN+4
          LDD    CM+4        SET *TO=E* OR *TO=C*
 GTSB     SHN    1-10
*         SHN    1-7         SYSTEM ORIGIN
          LPN    2
          RAD    CN+4
 GTS3     LDD    CN+4        SET DEFAULT TAPE OPTIONS
          LMN    3
          LPN    3
          STD    CN+4
          LDN    0
          STD    T1
          RJM    GFE         WRITE REPLY WORD
          CWD    CN          RETURN TMS STATUS
          LJM    DPP         DROP PP
 
 GTSC     DATA   7L"TMFC"    TAPE CATALOG FILE NAME
 SCD      SPACE  4,10
***       FUNCTION *SCDF* - SET *CPD* DROP FLAG.
*
*         THIS FUNCTION WILL SET THE *CPD* DROP FLAG IN CMR.  AS A
*         RESULT, THE COPY OF *CPD* THAT IS RUNNING WILL TERMINATE.
*         IT WILL ALSO ASSIGN THE ACTIVE *SAMPLE* FILE (IF ONE EXISTS)
*         TO THE CALLING JOB AS A LOCAL FILE.
 
 
 SCD      ENTRY              ENTRY
 
*         CHECK IF *CPD* IS ACTIVE.
 
          LDN    PPCP        SET PP COMMUNICATION AREA ADDRESSES
          CRD    CM
          LDD    CM+4
          STD    DA
          LDN    PPUL
          CRD    CM
          LDD    CM+2
          SHN    3
          ADD    DA
          STD    T2
 SCD1     LDD    DA          CHECK PP PROGRAM NAME
          CRD    CM
          LDD    CM+1
          SCN    77
          SHN    6
          LMD    CM
          LMC    3RDCP
          ZJN    SCD2        IF *CPD* FOUND
          LDN    10
          RAD    DA
          LMD    T2
          NJN    SCD1        IF MORE PP-S TO CHECK
          STD    DA
          LJM    SCD4        PROCESS SAMPLE FILE
 
 SCD2     LDN    1           SET *CPD* DROP FLAG
          STD    CM+1
          STD    CM+2
          LDD    MA
          CWM    SCDA,ON
          MONITOR  UADM
 SCD3     DELAY              WAIT AWHILE
          PAUSE
          LDD    CM+1
          NJP    SFMX        IF ERROR FLAG SET
          LDD    DA
          CRD    CM
          LDD    CM+1        CHECK PP ASSIGNED
          SCN    77
          SHN    6
          LMD    CM
          LMC    3RDCP
          ZJN    SCD3        IF *CPD* STILL ACTIVE
 
*         PROCESS SAMPLE FILE.
 
 SCD4     LDN    0           INITIALIZE SEARCH INDEX
          STD    QA
 SCD5     AOD    QA          ADVANCE ORDINAL
          LMD    TE
          NJN    SCD6        IF NOT END OF FNT
          ERROR  /ERR/FNF    EC = 3, * SFM FILE NOT FOUND.*
 
 SCD6     SFA    FNT,QA      READ FNT ENTRY
          CRD    FN
          LDD    FN+4
          LMC    PMFT*100
          NJN    SCD5        IF INCORRECT TYPE
 
*         CREATE LOCAL FILE.
 
          RJM    EFN         ENTER FILE NAME
          LDN    ZERL
          CRD    CN
          LDD    MA
          CWD    FN
          CRD    CM
          LDD    CM+3        CLEAR MODE FLAGS
          SCN    77
          STD    CM+3
          LDC    SYFT*100    SET FILE TYPE
          STD    CM+4
          SFA    FNT,QA
          CRD    FN
          CWD    CM          RESTORE SYSTEM FNT SLOT
          ADN    FSTG
          CRD    FS
          CWD    CN
          NFA    FA,R        STORE FILE TYPE IN LOCAL FNT
          CWD    FN
          SOD    FS+4        SET FILE BUSY
          LDD    DA
          NJP    SFMX        IF *CPD* FOUND
          ERROR  /ERR/CNF    EC=5, * CPD NOT ACTIVE.*
 
 
 SCDA     CON    LIOS        INCREMENT LOW CORE FIELD BY ONE
          CON    INWL        WORD ADDRES
          CON    2*100+1     BIT ADDRESS/FIELD WIDTH
          CON    0
          CON    0
 CAC      SPACE  4,10
**        CAC - CHECK ACTIVITY COUNTS.
*
*         ENTRY  (BFMS) = SYSTEM SECTOR.
*                (MI) = MACHINE INDEX.
*
*         EXIT   (A) = 0 IF LAST MACHINE TO DELETE FILE.
*                (T2) = *UCSS* OFFSET FOR THIS MACHINE.
*
*         USES   CM, T2.
 
 
 CAC      SUBR               ENTRY/EXIT
          LDD    MI
          SHN    2
          ADD    MI
          ADC    UCSS
          STD    T2
          LDI    T2          CLEAR MACHINE ACTIVE FLAG
          SCN    4
          STI    T2
          LDN    0
          STD    CM
 CAC1     LDM    UCSS+5,CM   CHECK FOR OTHER MACHINES ACTIVE
          LPN    4
          NJN    CACX        IF MACHINE ACTIVE
          LDN    5
          RAD    CM          ADVANCE TO NEXT MACHINE
          ADC    -MISD*5
          NJN    CAC1        IF NOT ALL MACHINES CHECKED
          LDM    CASS        SET CURRENT ACCESS TO WRITE
          SCN    20
          LMN    20
          STM    CASS
          LDN    0
          UJN    CACX        RETURN
          TITLE  SUBROUTINES.
 CFE      SPACE  4,10
**        CFE - CLEAR LOCAL FNT ENTRY.
*
*         ENTRY  (FA) = INDEX OF FNT ENTRY.
*
*         EXIT   (A) = (FA) = 0.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR.
 
 
 CFE      SUBR               ENTRY/EXIT
          LDN    ZERL
          CRD    CM
          LDD    FA
          ZJN    CFEX        IF NO LOCAL FILE
          STD    CM+4
          LDN    DLFS        DELETE LOCAL FNT ENTRY
          STD    CM+1
          MONITOR  PLFM
*         LDN    0           CLEAR FNT INDEX
          STD    FA
          UJN    CFEX        RETURN
 CFI      SPACE  4,10
**        CFI - CLEAR FLAG REGISTER INTERLOCK.
*
*         ENTRY  (A) = INTERLOCK TO CLEAR. (*DATI* OR *FATI*)
*
*         EXIT   (A) = (ABTB).
*                INTERLOCK CLEARED.
*
*         USES   CM - CM+4.
 
 
 CFI      SUBR               ENTRY/EXIT
          SHN    6
          STD    CM+1
          LDN    CFRS        CLEAR FLAG REGISTER BITS
          SHN    11
          STD    CM+3
          MONITOR ECSM
          SOM    ABTB        CLEAR INTERLOCK HELD
          UJN    CFIX        RETURN
 CFM      SPACE  4,10
**        CFM - COMPARE FAMILY NAMES.
*
*         ENTRY  (T3 - T7) = FAMILY NAME A.
*                (CM - CM+4) = FAMILY NAME B.
*
*         EXIT   (A) = 0, IF SAME FAMILY NAME.
 
 
 CFM      SUBR               ENTRY/EXIT
          LDD    CM
          LMD    T3
          NJN    CFMX        IF NOT SAME FAMILY
          LDD    CM+1
          LMD    T3+1
          NJN    CFMX        IF NOT SAME FAMILY
          LDD    CM+2
          LMD    T3+2
          NJN    CFMX        IF NOT SAME FAMILY
          LDD    CM+3
          LMD    T3+3
          SHN    -6
          UJN    CFMX        RETURN
 ECS      SPACE  4
**        EXTENDED MEMORY - READ/WRITE EXTENDED MEMORY.
*
*         ENTRY  (A) = NUMBER OF WORDS*100.
*                (CM+3 - CM+4) SET UP FOR *ECSM*.
*
*         EXIT   TO *ABT* IF UNRECOVERED ERROR.
*
*         USES   CM - CM+4.
*                MESSAGE BUFFER IS USED FOR CM BUFFER.
 
 
 ECS      SUBR               ENTRY/EXIT
          STD    CM+1        SET WORDS TO READ/WRITE
          LDD    MA          SET BUFFER ADDRESS
          STD    CM+2
          MONITOR  ECSM      READ/WRITE EXTENDED MEMORY
          LDD    CM+1
          ZJN    ECSX        IF NO ERROR
          ABORT  /MESS/ERLE  * SFM UNRECOVERED LINK DEVICE ERROR.*
 EFI      SPACE  4,20
**        EFI - ENTER *FAT* ITEM.
*
*         ENTRY  (FN - FN+3) = FAST ATTACH FILE NAME.
*                (FS - FS+4) = FILE FST ENTRY.
*                (ES - ES+4) = FILE EST ENTRY.
*                (FC) = *FAT* TABLE COUNT.
*                (FI) = *FAT* TABLE INDEX OF HOLE
*                (ID) = MACHINE ID
*                (MI) = MACHINE INDEX
*
*         EXIT   (A) .EQ. 0 IF HOLD USED FOR ENTRY.
*                (A) .NE. 0 IF NEW ENTRY CREATED AT END OF TABLE.
*                TO *ABT* IF *FAT* SPACE NOT AVAILABLE.
*
*         USES   CM - CM+4, T1, T6, T7.
*                MESSAGE BUFFER USED FOR CM/ECS BUFFER.
*
*         CALLS  CEA, ECS.
 
 
 EFI      SUBR               ENTRY/EXIT
          LDD    FI
          NJN    EFI1        IF HOLE AVAILABLE
          AOM    EFIA        SET NEW ENTRY CREATED
          LDN    20          SET AVAILABLE ENTRY COUNT
 EFIB     SHN    0
          SBK    FAST
          SHN    6-FATS
          STD    T1
          LDD    FC
          STD    FI
          SBD    T1
          MJN    EFI1        IF SPACE AVAILABLE
          ABORT  /MESS/ERNH  * SFM GLOBAL FAST ATTACH LIMIT.*
 
*         SET *FAT* WORDS IN EXTENDED MEMORY.
 
 EFI1     LDN    ZERL        SET FIRST TRACK AND USER COUNTS
          CRD    CM
          LDD    FS+1
          STD    CM+1
          LDN    0           SET WORD TO WRITE
          STD    T3
 EFI2     AOD    T3          WRITE WORDS 1 THROUGH 1+MXMF
          RJM    WFW
          LDN    ZERL        SET LOCAL AREAS
          CRD    CM
          LDD    T3
          SBN    1+MXMF
          MJN    EFI2        IF NOT END OF LOCAL WORDS TO WRITE
          LDD    ID          SET MACHINE ID IN ENTRY BEING CREATED
          STD    CM
          LDD    MI
          ADN    1
          RJM    WFW         WRITE *FAT* WORD
          LDD    ES+4        SET FAMILY AND DEVICE NUMBER
          SHN    3
          ADN    PFGL
          CRD    CM
          LDN    0
          STD    CM+4
          LDN    2+MXMF
          RJM    WFW         WRITE *FAT* WORD
 
*         WRITE WORD 0 OF *FAT* ENTRY TO LINK DEVICE.
 
          LDD    MA          SET FILE NAME
          CWD    FN
          CRD    CM
          LDN    0
          RJM    WFW         WRITE FILE NAME
 EFIA     LDN    0           SET RETURN STATUS
*         LDN    1           SET IF NEW ENTRY CREATED
          LJM    EFIX        RETURN
 IFA      SPACE  4,15
**        IFA - INITIALIZE FAST ATTACH FILE.
*
*         ENTRY  (FN - FN+4) = FILE NAME.
*                (FS - FS+4) = FST INFORMATION.
*
*         EXIT   (QA) = ORDINAL OF GLOBAL FNT ENTRY.
*                (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK OF FAST ATTACH FILE.
*                (TY) = 0 IF FILE NAME FOUND IN FNT.
*
*         ERROR  TO *ABT* IF FILE INTERLOCK NOT AVAILABLE.
*
*         USES   CM - CM+7.
*
*         CALLS  CTE, SSF.
*
*         MACROS ABORT, MONITOR, SFA.
 
 
 IFA      SUBR               ENTRY/EXIT
          LDD    FN+3
          SCN    77          CLEAR MODE FIELD
          STD    FN+3
          RJM    SSF         SEARCH FOR *SYFT* TYPE FILE
          ZJN    IFA1        IF FILE NOT FOUND
          SFA    FNT
          STD    CM+4        SET ADDRESS OF FNT ENTRY
          SHN    -14
          STD    CM+3
          LDN    0           INTERLOCK FNT ENTRY
          STD    CM+1
          MONITOR  UTEM
          LDD    CM+1
          ZJN    IFA2        IF FILE INTERLOCKED
          LDN    0
          STD    FA
          ABORT  /MESS/ERIO  * SFM I/O SEQUENCE ERROR.*
 
 IFA1     LDC    SYFT*100+1  SET INTERLOCK IN REQUEST
          STD    FN+4
          LDD    MA          MOVE FILE NAME
          CWD    FN
          CRD    CM+3
          LDN    PFNT        CREATE FNT ENTRY
          RJM    CTE
          ZJN    IFA3        IF FNT FULL
          LDD    CM+1        SET FNT ORDINAL
          STD    QA
 IFA2     STD    TY          SET FNT CREATION STATUS
          LDC    FAFT*100    SET FILE TYPE
          STD    FN+4
          LDD    FS          SET EQUIPMENT
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDN    0           CLEAR USER COUNTS
          STD    FS+2
          STD    FS+3
          STD    FS+4
          LJM    IFAX        RETURN
 
 IFA3     STD    FA          CLEAR LOCAL FNT OFFSET
          ABORT  /MESS/ERFU  * SFM FNT FULL.*
 IFC      SPACE  4
**        IFC - INCREMENT FAST ATTACH COUNT.
*
*         EXIT   FAST ATTACH COUNT UPDATED IN MMF ENVIRONMENT TABLE.
*
*         USES   CM - CM+4.
*
*         CALLS  CEA, ECS, RET.
 
 
 IFC      SUBR               ENTRY/EXIT
          RJM    RET         READ *FAET* WORD
          LDD    MA          WRITE WORD BACK TO LINK DEVICE
          CWD    CM
          RJM    CEA         CONVERT EXTENDED MEMORY ADDRESS
          LDN    FAET
          RAD    CM+4
          SHN    -14
          ADC    WECS*1000   SET TO WRITE EXTENDED MEMORY
          RAD    CM+3
          LDN    1-1         SET TO WRITE 1 WORD
          RJM    ECS
          UJN    IFCX        RETURN
 RET      SPACE  4
**        RET - READ ENVIRONMENT TABLE.
*
*         ENTRY  (RETA) = LINK DEVICE LABEL TRACK.
*
*         EXIT   (FC) = *FAT* TABLE COUNT.
*                (CM - CM+4) = *FAET* WORD FROM ENVIRONMENT
*                TABLE WITH COUNT INCREMENTED BY 1.
*                (T6) = LINK DEVICE LABEL TRACK.
*                (T7) = ENVIRONMENT TABLE SECTOR.
*
*         USES   CM - CM+4.
*
*         CALLS  CEA, ECS.
 
 
 RET      SUBR               ENTRY/EXIT
          LDC    0           SET LABEL TRACK
 RETA     EQU    *-1
          STD    T6
          LDN    ETLT        SET ENVIRONMENT TABLE SECTOR
          STD    T7
          RJM    CEA         CONVERT EXTENDED MEMORY ADDRESS
          LDN    FAET        READ *FAT* COUNT
          RAD    CM+4
          SHN    -14
          ADC    RECS*1000   SET TO READ EXTENDED MEMORY
          RAD    CM+3
          LDN    1-1         SET TO READ 1 WORD
          RJM    ECS         READ EXTENDED MEMORY
          LDD    MA          READ ENTRY
          CRD    CM
          AOD    CM+4        INCREMENT COUNT
          STD    FC
          UJN    RETX        RETURN
 RFS      SPACE  4,15
**        RFS - READ FILE SYSTEM SECTOR.
*
*         ENTRY  (A) = 0 IF LOCAL FNT ENTRY NOT TO BE CLEARED.
*                (QA) = FNT ORDINAL.
*                (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*                (TY) = FNT CREATION STATUS.
*
*         EXIT   (A) = 0 IF SYSTEM SECTOR READ WITHOUT ERROR.
*
*         USES   T3, CM - CM+4.
*
*         CALLS  CFE, RSS, RTI, WTI.
*
*         MACROS ABORT, ENDMS, MONITOR, SETMS, SFA.
 
 
 RFS3     LDD    T6          SET TRACK INTERLOCKED STATUS
          STM    RTIA
          LDD    T3
          ZJN    RFS4        IF LOCAL FNT ENTRY NOT TO BE CLEARED
          RJM    CFE         CLEAR LOCAL FNT ENTRY
*         LDN    0           READ SYSTEM SECTOR
 RFS4     RJM    RSS
          ZJN    RFSX        IF NO ERRORS
          ENDMS
          RJM    RTI         RELEASE TRACK INTERLOCK
          AOM    SFMD
 
 RFS      SUBR               ENTRY/EXIT
          STD    T3
          SETMS  IO,(DE,RW)
          RJM    WTI         SET TRACK INTERLOCK
          ZJN    RFS3        IF INTERLOCK SET
          LDD    TY
          ZJN    RFS2        IF FNT ENTRY NOT CREATED
          LDD    QA
          STD    CM+1
          LDN    PFNT        RELEASE FNT ENTRY
          STD    CM+2
          MONITOR  MTRM
 RFS1     ABORT  /MESS/ERDA  * SFM DIRECT ACCESS FILE ERROR.*
 
 RFS2     LDC    SYFT*100    RESET FILE TYPE
          STD    FN+4
          SFA    FNT,QA      RESTORE FNT ENTRY
          CWD    FN
          UJN    RFS1        ABORT
 SFR      SPACE  4,10
**        SFR - SET FLAG REGISTER INTERLOCK.
*
*         ENTRY  (A) = INTERLOCK TO OBTAIN, (*DATI* OR *FATI*).
*
*         EXIT   (A) = (ABTB).
*
*         ERROR  TO *ABT* IF ERROR FLAG SET.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR, PAUSE.
 
 
 SFR2     STD    CM          CLEAR WAITING MESSAGE
          LDD    CP
          ADN    MS2W
          CWD    CM
          AOM    ABTB        SET INTERLOCK OBTAINED
 
 SFR      SUBR               ENTRY/EXIT
          SHN    6
          STM    SFRA        SAVE SUBFUNCTION
 SFR1     LDN    SFRS        SET FLAG REGISTER BITS
          SHN    11
          STD    CM+3
          LDC    *           REQUEST FLAG REGISTER INTERLOCK
 SFRA     EQU    *-1
          STD    CM+1
          MONITOR ECSM
          LDD    CM+1        CHECK INTERLOCK STATUS
          ZJN    SFR2        IF INTERLOCK ACHIEVED
          LDD    CP          SET WAITING MESSAGE
          ADN    MS2W
          CWM    SFRB,TR
          PAUSE
          LDD    CM+1        CHECK ERROR FLAG
          ZJN    SFR1        IF NOT ERROR FLAG SET
          ABORT  /MESS/ERAB  * SFM ABORTED.*
 
 SFRB     DATA   C*$WAITING - RECOVERY INTERLOCK.*
 SFS      SPACE  4
**        SFS - SEARCH *FAT* SECTOR.
*
*         ENTRY  (FN - FN+3) = FAST ATTACH FILE NAME.
*                (FS - FS+4) = FILE FST ENTRY.
*                (ES - ES+4) = FILE EST ENTRY.
*                (FI) = CURRENT *FAT* INDEX.
*                (BFMS - BFMS+502) = *FAT* SECTOR.
*                (FC) = *FAT* TABLE COUNT.
*
*         EXIT   (A) .EQ. 0 IF MATCHING ENTRY FOUND.
*                (A) .LT. 0 IF END OF TABLE.
*                (BA) = BASE ADDRESS OF MATCHED ENTRY.
*                (FI) = BASE ADDRESS OF LAST HOLE ENCOUNTERED.
*                (HI) = *FAT* INDEX OF LAST HOLE.
*
*         USES   CM - CM+4.
 
 
 SFS6     LDN    2           SET NO MATCH STATUS
 SFS7     SBN    1
 
 SFS      SUBR               ENTRY/EXIT
          LDC    BFMS+2      SET BASE ADDRESS
          STD    BA
          UJN    SFS2
 
 SFS0     LDD    FI          SET HOLE INFORMATION
          STD    HI
          LDD    BA
          STM    SFTA
 SFS1     LDK    FATL*5      INCREMENT BASE ADDRESS
          RAD    BA
          LMC    BFMS+2+100*5 CHECK FOR END OF SECTOR
          ZJN    SFS6        IF END OF SECTOR
 SFS2     AOD    FI          INCREMENT TABLE INDEX
          LPN    77
          LMD    FC          CHECK FOR END OF TABLE
          ZJN    SFS7        IF END OF TABLE
          LDI    BA          COMPARE FILE NAME
          ZJN    SFS0        IF HOLE
          LMD    FN
          NJN    SFS1        IF NOT A MATCH
          LDM    1,BA
          LMD    FN+1
          NJN    SFS1        IF NOT A MATCH
          LDM    2,BA
          LMD    FN+2
          NJN    SFS1        IF NOT A MATCH
          LDM    3,BA
          LMD    FN+3
          SCN    77
          NJN    SFS1        IF NOT A MATCH
 
          LDM    1*5+1,BA    CHECK FIRST TRACK
          LMD    FS+1
          NJN    SFS1        IF NOT MATCHING FIRST TRACK
 
          LDD    ES+4
          SHN    3
          ADN    PFGL
          CRD    CM
          LDM    MXMF*5+2*5+0,BA
          LMD    CM
          NJN    SFS3        IF NOT MATCHING FAMILY
          LDM    MXMF*5+2*5+1,BA
          LMD    CM+1
          NJN    SFS3        IF NOT MATCHING FAMILY
          LDM    MXMF*5+2*5+2,BA
          LMD    CM+2
          NJN    SFS3        IF NOT MATCHING FAMILY
          LDM    MXMF*5+2*5+3,BA
          LMD    CM+3
          ZJN    SFS4        IF MATCHING DEVICE NUMBER
 SFS3     LJM    SFS1
 
 SFS4     LJM    SFSX        MATCHING ENTRY FOUND
 SFT      SPACE  4,20
**        SFT - SEARCH *FAT* TABLE.
*
*         ENTRY  (DA - DA+1) = LINK DEVICE PARAMETERS.
*
*         EXIT   (A) .EQ. 0, IF ENTRY NOT FOUND.
*                (FI) = *FAT* INDEX OF FILE/HOLE.
*                (BA) = BASE ADDRESS OF FILE/HOLE.
*                (FC) = *FAT* COUNT.
*
*         USES   T4 - T7.
*
*         CALLS  RDS, RET, SFS.
*
*         MACROS ENDMS, SETMS.
 
 
 SFT      SUBR               ENTRY/EXIT
          LDD    DA          SET LINK DEVICE PARAMETERS
          STD    T5
          SETMS  IO
          RJM    RET         READ ENVIRONMENT TABLE
          LDD    DA+1
          STD    T6
          LDN    FAST        SET STARTING *FAT* SECTOR
          STD    T7
          LCN    0           INITIALIZE *FAT* INDICIES
          STD    FI
          ADN    1
          STD    HI
 SFT1     LDC    BFMS        SET BUFFER ADDRESS
          RJM    RDS         READ *FAT* SECTOR
          MJN    SFT4        IF READ ERROR
          RJM    SFS         SEARCH *FAT* SECTOR
          ZJN    SFT3        IF FILE FOUND
          MJN    SFT2        IF END OF TABLE FOUND
          AOD    T7          INCREMENT TO NEXT SECTOR
          LMN    20          CHECK FOR END-OF-TABLE
          NJN    SFT1        IF NOT END-OF-TABLE
 
 SFT2     SOM    SFTB        SET FILE NOT FOUND
          LDD    HI          SET HOLE ADDRESS
          STD    FI
          LDC    0           BASE ADDRESS OF FILE/HOLE
 SFTA     EQU    *-1
          STD    BA
 SFT3     ENDMS
 SFTB     LDN    1           SET RETURN STATUS
*         LDN    0           SET IF FILE NOT FOUND
          LJM    SFTX        RETURN
 
 SFT4     ABORT  /MESS/ERLE  * SFM UNRECOVERED LINK DEVICE ERROR.*
 SMP      SPACE  4
**        SMP - SET MULTI-MAINFRAME PARAMETERS.
*
*         ENTRY  (ES - ES+4) = FILE EQUIPMENT EST ENTRY.
*                (T5) = EST ORDINAL.
*
*         EXIT   (DA) = EST ORDINAL OF LINK DEVICE.
*                (DA+1) = *FAT* TRACK.
*                (MI) = MACHINE INDEX.
*                (FI) = MACHINE INDEX.
*                (ID) = MACHINE ID.
*                (RETA) = LINK DEVICE LABEL TRACK.
*
*         USES   CM - CM+4.
*
*         CALLS  SMI.
*
*         MACROS SFA.
 
 
 SMP      SUBR               ENTRY/EXIT
          RJM    SMI         GET MACHINE INDEX FOR DEVICE
          STD    MI
          STD    FI
          LDC    MMFL        SET *MMFL* PARAMETERS
          CRD    CM
          LDD    CM          SET MACHINE ID
          STD    ID
          LDD    ES
          SHN    21-4
          MJN    SMPX        IF INDEPENDENT SHARED DEVICE
          LDD    CM+1        SET LINK EQUIPMENT
          LPC    777
          STD    DA
          SFA    EST         SET *FAT* TRACK
          ADK    EQDE
          CRD    CM
          ADK    EQAE-EQDE
          CRD    CN
          LDD    CN+2        SET LINK DEVICE SHIFT COUNT
          SHN    -6
          LPN    3
          RAM    EFIB
          LDD    CM+4
          SHN    3
          ADN    ALGL
          CRD    CM
          LDD    CM+4
          STD    DA+1
          LDD    CM+1        SET LABEL TRACK
          STM    RETA
          UJP    SMPX        RETURN
 SSF      SPACE  4
**        SSF - SEARCH FOR *SYFT* FILE.
*
*         ENTRY  (FN - FN+4) = FILE NAME.
*
*         EXIT   (A) = (QA) = FNT ORDINAL IF FILE FOUND.
*                    = 0 IF FILE NOT FOUND
*
*         USES   CN - CN+4.
*
*         MACROS SFA.
 
 
 SSF2     STD    QA          SET FILE NOT FOUND
 
 SSF      SUBR               ENTRY/EXIT
          LDN    0
          STD    QA
 SSF1     AOD    QA          ADVANCE FNT ORDINAL
          LMD    TE
          ZJN    SSF2        IF END OF FNT
          SFA    FNT,QA      READ FNT ENTRY
          CRD    CN
          LDD    CN+4        CHECK FILE TYPE
          SHN    -6
          LMN    SYFT
          NJN    SSF1        IF NOT *SYFT* FILE
          LDD    CN          COMPARE FILE NAME
          ZJN    SSF1        IF EMPTY ENTRY
          LMD    FN
          NJN    SSF1        IF NOT MATCHING NAME
          LDD    CN+1
          LMD    FN+1
          NJN    SSF1        IF NOT MATCHING NAME
          LDD    CN+2
          LMD    FN+2
          NJN    SSF1        IF NOT MATCHING NAME
          LDD    CN+3
          LMD    FN+3
          SCN    77
          NJN    SSF1        IF NOT MATCHING NAME
          LDD    QA
          UJN    SSFX        EXIT
 UFI      SPACE  4
**        UFI - UPDATE *FAT* ITEM.
*
*         ENTRY  (ID) = MACHINE ID.
*                (MI) = MACHINE INDEX.
*                (FI) = INDEX OF ENTRY.
*
*         EXIT   *FAT* ITEM UPDATED AND WRITTEN BACK TO LINK DEVICE.
*
*         USES   CM - CM+4, T6, T7.
*
*         CALLS  CEA, CFI, ECS, SFR.
 
 
 UFI      SUBR               ENTRY/EXIT
          LDN    FATI        SET *FATI* INTERLOCK
          RJM    SFR
          LDN    ZERL        SET ENTRY TO WRITE
          CRD    CM
 UFIA     LDD    ID          SET MACHINE ID
*         LDN    0           IF CLEAR ENTRY
          STD    CM
          LDD    MI
          ADN    1
          RJM    WFW         WRITE LOCAL MACHINE WORD
          LDM    UFIA
          LMC    LDNI+0
          NJN    UFI1        IF NOT CLEARING ENTRY
          LDN    ZERL        CLEAR ATTACH MODES IN GLOBAL ENTRY
          CRD    CM
          LDD    FS+1        PRESERVE FIRST TRACK
          STD    CM+1
          LDN    1
          RJM    WFW         WRITE *FAT* WORD
 UFI1     LDN    FATI        CLEAR *FATI* INTERLOCK
          RJM    CFI
          LJM    UFIX        RETURN
 VLF      SPACE  4,15
**        VLF - VERIFY LOCAL FILE.
*
*         EXIT   (A) = 0, IF FAST ATTACH ENTRY FOUND.
*                (T1) = FNT INDEX FOR FAST ATTACH FILE.
*                (T5) = EQUIPMENT.
*                (FN - FN+4) = FNT ENTRY.
*
*         ERROR  TO *ABT* IF LOCAL FILE NOT FOUND.
*                TO *ABT* IF LOCAL FILE NOT TYPE *PMFT*.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         CALLS  CFS, FAT, SAF.
*
*         MACROS NFA.
 
 
 VLF      SUBR               ENTRY/EXIT
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    VLF1        IF FILE NOT FOUND
          RJM    CFS         CHECK FILE STATUS
          NFA    FA,R        READ FNT ENTRY
          CRD    FN
          LDD    CM+4        CHECK FILE TYPE
          SHN    -6
          LMN    PMFT
          ZJN    VLF2        IF DIRECT ACCESS FILE
          LDN    /MESS/ERFT-/MESS/ERFF  * SFM INCORRECT FILE TYPE.*
 VLF1     ADC    /MESS/ERFF  * SFM FILE NOT FOUND.*
          LJM    ABT         PROCESS ERROR
 
*         SEARCH FOR EXISTING FAST ATTACH FILE.
 
 VLF2     LDD    ES+4        GET DEVICE NAME FROM MST
          SHN    3
          ADN    PFGL
          CRD    CN
          RJM    FAT         SEARCH FOR FAST ATTACH FILE
          STD    T0          SAVE RESPONSE
          LDD    FS          RESTORE EQUIPMENT
          STD    T5
          LDD    T0          (A) = RESPONSE FROM *COMPFAT*.
          UJN    VLFX        RETURN
 WFS      SPACE  4,15
**        WFS - WRITE FILE SYSTEM SECTOR.
*
*         ENTRY  (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*                TRACK INTERLOCK SET.
*
*         EXIT   TRACK INTERLOCK CLEARED.
*
*         CALLS  RTI, WSS.
*
*         MACROS ENDMS.
 
 
 WFS      SUBR               ENTRY/EXIT
          RJM    WSS         WRITE SYSTEM SECTOR
          ENDMS
          RJM    RTI         RELEASE TRACK INTERLOCK
          UJN    WFSX        RETURN
 WFW      SPACE  4,10
**        WFW - WRITE *FAT* WORD.
*
*         ENTRY  (A) = OFFSET IN *FAT* OF WORD TO WRITE.
*                (FI) = *FAT* INDEX OF ENTRY.
*                (CM - CM+4) = WORD TO WRITE.
*
*         USES   T1, T6, T7, CM - CM+4.
*
*         CALLS  CEA, ECS.
 
 
 WFW      SUBR               ENTRY/EXIT
          STM    WFWA        SAVE OFFSET OF WORD TO WRITE
          LDD    MA          STORE WORD TO WRITE
          CWD    CM
          LDD    DA+1        SET *FAT* TRACK
          STD    T6
          LDN    FAST        SET FIRST *FAT* SECTOR
          STD    T7
          RJM    CEA         CONVERT EXTENDED MEMORY ADDRESS
          LDD    FI
          SHN    FATS
          ADC    *           ADD OFFSET OF WORD TO WRITE
 WFWA     EQU    *-1
          RAD    CM+4
          SHN    -14
          ADC    WECS*1000   SET TO WRITE EXTENDED MEMORY
          RAD    CM+3
          LDK    1*100-100   SET TO WRITE 1 WORD
          RJM    ECS         WRITE EXTENDED MEMORY
          UJN    WFWX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCEA
*CALL     COMPCTE
*CALL     COMPFAT
*CALL     COMPSMI
          SPACE  4
          ERRNG  BFMS-*      CODE OVERLAPS SECTOR BUFFER
          OVERFLOW  OVLA,EPFW
          OVERLAY (RETURN SYSTEM DATA PROCESSORS.)
          SPACE  4,10
*CALL     COMSEVT
*CALL     COMSMTR
*CALL     COMSPDT
*CALL     COMSMLS
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO CALLS
*CALL     COMSSSD
          SPACE  4,10
**        ASSEMBLY CONSTANTS.
 
 
 TJCBL    EQU    JCBE*MXJC-JCBE  LENGTH OF *JCB* TABLE
          TITLE  SECURITY FUNCTIONS.
 GEAF     SPACE  4,10
***       FUNCTION *GEAF* - GET EQUIPMENT ACCESS LEVEL LIMITS.
*
*         ENTRY.
*
*T,ADDR   48/ ,12/ EO
*
*         EO     EST ORDINAL.
*
*         EXIT.
*
*T,ADDR   36/ ,12/ ALL ,12/ EO
*
*         ALL    ACCESS LEVEL LIMITS.
*         EO     EST ORDINAL.
 
 
 GEA3     ABORT  /MESS/ERIR  * SFM INCORRECT REQUEST.*
 
 GEA4     ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 
 GEA      ENTRY              ENTRY
          RJM    CSS
          MJN    GEA3        IF NO SUBSYSTEM OR SSJ= ENTRY POINT
          RJM    GFE         GET REPLY WORD
          CRD    CN
          LDN    ESTP        CHECK IF ORDINAL WITHIN EST
          CRD    CM
          LDD    CN+4
          SBD    CM+2
          PJN    GEA4        IF NOT WITHIN EST
          SFA    EST,CN+4    READ EST ENTRY
          ADK    EQDE
          CRD    CM
          ADK    EQAE-EQDE   READ ACCESS LEVELS
          CRD    T1
          LDD    CM
          SHN    21-13
          PJN    GEA1        IF NOT MASS STORAGE
          LDD    CM+4
          SHN    3
          ADK    PFGL
          CRD    CM
          LDD    CM+4
          SHN    -6
          UJN    GEA2        SET ACCESS LEVEL
 
 GEA1     LDD    T1+3        SET ACCESS LEVEL IN REPLY WORD
          LPN    77
 GEA2     STD    CN+3
          RJM    GFE         WRITE REPLY WORD
          CWD    CN
          LJM    DPP         DROP PP
 GSMF     SPACE  4,15
***       FUNCTION *GSMF* - GET SYSTEM SECURITY MODE.
*
*         RETURNS A NONZERO VALUE IF THE SYSTEM IS RUNNING IN
*         A SECURED MODE.
*
*         EXIT.
*
*T ADDR   48/0, 12/ SM
*
*         SM = 0 IF SYSTEM IN UNSECURED MODE.
*         SM = 1 IF SYSTEM IN SECURED MODE.
 
 
 GSM      ENTRY              ENTRY
          LDN    SSML        GET SYSTEM SECURITY MODE
          CRD    CM
          LDN    ZERL
          CRD    CN
          LDD    CM
          LPN    7
          ZJN    GSM1        IF SYSTEM UNSECURED
          AOD    CN+4
 GSM1     RJM    GFE         WRITE REPLY WORD
          CWD    CN
          LJM    DPP         DROP PP
 GSSF     SPACE  4,15
***       FUNCTION *GSSF* - GET ORIGIN TYPE ACCESS LEVELS.
*
*         RETURNS SECURITY MODE, OUTPUT QUEUE SPECIAL HANDLING
*         LEVEL, AND ORIGIN TYPE SECURITY ACCESS LIMITS.
*
*         EXIT.
*
*T,ADDR   3/ ,3/ OQSH ,3/ ,3/ SM ,12/ SY ,12/ BC ,12/ RB ,12/ IA
*
*         OQSH = OUTPUT QUEUE SPECIAL HANDLING LEVEL.
*         SM = SECURITY MODE.
*         SY = 3/ , 3/SYOT LOWER LIMIT, 3/ , 3/SYOT UPPER LIMIT.
*         BC = 3/ , 3/BCOT LOWER LIMIT, 3/ , 3/BCOT UPPER LIMIT.
*         RB = 3/ , 3/RBOT LOWER LIMIT, 3/ , 3/RBOT UPPER LIMIT.
*         IA = 3/ , 3/IAOT LOWER LIMIT, 3/ , 3/IAOT UPPER LIMIT.
 
 
 GSS      ENTRY              ENTRY
          RJM    CSS
          MJN    GSS2        IF NO SUBSYSTEM OR SSJ= ENTRY POINT
          LDN    SSML        GET SECURITY MODE AND OQSH
          CRD    CN
          LDN    IAOT        PRESET LOOP CONTROL
          STD    T1
 GSS1     LDN    0           GET NEXT SERVICE CONTROL WORD
          SFA    JCB
          ADD    T1
          CRD    CM
          LDD    CM+1        SET ACCESS LIMITS IN REPLY WORD
          LPN    7
          STD    CM+2
          LDD    CM+1
          LPN    70
          SHN    3
          ADD    CM+2
          STM    CN+1,T1
          SOD    T1
          PJN    GSS1        IF MORE LIMITS TO OBTAIN
          RJM    GFE         RETURN REPLY WORD
          CWD    CN
          LJM    DPP         DROP PP
 
 GSS2     ABORT  /MESS/ERIR  * SFM INCORRECT REQUEST.*
 CSS      SPACE  4,10
**        CSS - CHECK FOR SSJ= ENTRY POINT OR SUBSYSTEM ID.
*
*         EXIT   (A) .GE. 0 IF EITHER FOUND.
*
*         USES   CM - CM+4, CN - CN+4.
 
 
 CSS      SUBR               ENTRY/EXIT
          LDD    CP          CHECK FOR SSJ= ENTRY POINT
          ADK    JCIW
          CRD    CM
          ADK    SEPW-JCIW
          CRD    CN
          LDD    CN
          LPN    4
          NJN    CSSX        IF SSJ= ENTRY POINT FOUND
          LDD    CM+2        CHECK FOR SUBSYSTEM ID
          ADC    -LSSI
          UJN    CSSX        RETURN
          TITLE  MAIN ROUTINE.
 RSD      SPACE  4,10
***       FUNCTION *RSDF* - RETURN SYSTEM DATA.
 
 
 
 RSD      ENTRY              ENTRY
 RSD0     LDD    IR+3        CHECK CONTROL WORD ADDRESS
          SHN    14
          ADD    IR+4
          SHN    -6
          SBD    FL
          PJN    RSD2        IF NEXT CONTROL WORD  NOT IN BOUNDS
          RJM    GFE         READ CONTROL WORD
          CRD    ES
          LDD    ES          CHECK SUBFUNCTION
          NJN    RSD1        IF NOT END OF REQUESTS
          LJM    DPP         DROP PPU
 
 RSD1     SBN    MXSF
          MJN    RSD3        IF VALID SUBFUNCTION
 RSD2     ABORT  /MESS/ERIR  * SFM INCORRECT REQUEST.*
 
 RSD3     LDD    ES+3        CHECK RETURN ADDRESS
          LPN    77
          STD    ES+3
          SHN    14
          LMD    ES+4
          MJN    RSD4        IF INCORRECT ADDRESS
          ADD    ES+2
          SHN    -6
          SBD    FL
          MJN    RSD5        IF WITHIN FL
 RSD4     ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 RSD5     LDM    TRSD,ES     SET PROCESSING ADDRESS
          STM    RSDA
          RJM    *
 RSDA     EQU    *-1
 
*         EXIT TO SUBFUNCTION PROCESSORS WITH -
*                (ES - ES+4) = CONTROL WORD.
*
*         RETURN FROM SUBFUNCTION PROCESSORS WITH -
*                (ES - ES+4) = CONTROL WORD.
*                (FC) = WORD COUNT.
 
 RSD6     LDC    4000        SET DATA NOT AVAILABLE
          RAD    ES
          LDN    0           RETURN ZERO WORDS RETURNED
          STD    FC
 RSD7     LDD    FC          SET NUMBER OF WORDS RETURNED
          STD    ES+2
          RJM    GFE         RETURN CONTROL WORD
          CWD    ES
          AOD    IR+4        INCREMENT ADDRESS TO NEXT CONTROL WORD
          SHN    -14
          RAD    IR+3
          LJM    RSD0        PROCESS NEXT CONTROL WORD
 TRSD     SPACE 4,10
*         TRSD -  TABLE OF SUBFUNCTION PROCESSORS.
 
 
 TRSD     INDEX
          INDEX  RDDF,RDD
          INDEX  SDIF,SDI
          INDEX  PDAF,PDA
          INDEX  PDLF,PDL
          INDEX  RFDF,RFD
          INDEX  RSSF,RSS
          INDEX  RSCF,RSC
          INDEX  RCIF,RCI
          INDEX  IOSF,IOS
          INDEX  MXSF
          TITLE  SUBFUNCTION PROCESSORS.
 IOS      SPACE  4,20
**        IOS - RETURN BUFFER I/O STATISTICS.
*
*T,FA     12/*IOSF*, 12/ , 12/ WC, 6/ , 18/ ADDR
*
*         WC     LENGTH OF BUFFER TO RECEIVE DATA
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN)
*
*         ADDR   FWA OF CM BUFFER
*
*T,ADDR   12/ DT, 18/ ESTO, 30/
*T        30/ RCNT0, 30/ WCNT0
*T,       30/ RCNT1, 30/ WCNT1
*T,       30/ RCNT2, 30/ WCNT2
*T,       30/ RCNT3, 30/ WCNT3
*T,       30/ RCNT4, 30/ WCNT4
*T,       30/ RCNT5, 30/ WCNT5
*T,       30/ RCNT6, 30/ WCNT6
*T,       30/ RCNT7, 30/ WCNT7
*
*         DT = DEVICE TYPE
*         ESTO = EST ORDINAL IN DISPLAY CODE
*
*
*         -----------------------------------------------------------
*         I   FIELD      I          LENGTH OF READ TRANSFER IN-     I
*         I              I         *CBT*S               SECTORS     I
*         -----------------------------------------------------------
*         I              I                     I                    I
*         I   RCNT0      I           1         I       1 - 40B      I
*         I   RCNT1      I         2 - 3       I     41B - 140B     I
*         I   RCNT2      I         4 - 7       I    141B - 340B     I
*         I   RCNT3      I       10B - 17B     I    341B - 740B     I
*         I   RCNT4      I       20B - 37B     I    741B - 1740B    I
*         I   RCNT5      I       40B - 77B     I   1741B - 3740B    I
*         I   RCNT6      I      100B - 177B    I   3741B - 7740B    I
*         I   RCNT7      I     MORE THAN 177B  I   MORE THAN 7740B  I
*         I              I                     I                    I
*         -----------------------------------------------------------
*
*
*         -----------------------------------------------------------
*         I   FIELD      I      LENGTH OF WRITE TRANSFER IN-        I
*         I              I         *CBT*S               SECTORS     I
*         -----------------------------------------------------------
*         I              I                     I                    I
*         I   WCNT0      I           1         I       1 - 40B      I
*         I   WCNT1      I         2 - 3       I     41B - 140B     I
*         I   WCNT2      I         4 - 7       I    141B - 340B     I
*         I   WCNT3      I       10B - 17B     I    341B - 740B     I
*         I   WCNT4      I       20B - 37B     I    741B - 1740B    I
*         I   WCNT5      I       40B - 77B     I   1741B - 3740B    I
*         I   WCNT6      I      100B - 177B    I   3741B - 7740B    I
*         I   WCNT7      I     MORE THAN 177B  I   MORE THAN 7740B  I
*         I              I                     I                    I
*         -----------------------------------------------------------
 
 
 IOS      SUBR               ENTRY/EXIT
          RJM    LPT         LOCK *PROBE* TABLE
          ZJN    IOS2        IF *PROBE* TABLE LOCKED
 IOS1     LJM    RSD6        IF DATA NOT AVAILABLE
 
 IOS2     STD    FC          INITIALIZE WORD COUNT
          LDN    1           INITIALIZE PUT/IOST INDEX
          STD    T3
          LDK    BIOL        READ BUFFER TABLE POINTER
          CRD    CM
          LDD    CM+1        READ *PUT* TABLE POINTER
          SHN    14
          ADD    CM+2
          NJN    IOS2.1      IF BUFFERED I/O TABLES PRESENT
          LDC    4000        CLEAR PROBE INTERLOCK
          STD    FN
          LDC    PRBP
          CWD    FN
          UJN    IOS1        RETURN WITH NO DATA
 
 IOS2.1   ADK    PUTP
          CRD    FS
          ADK    IOSP-PUTP   READ FWA OF I/O STATISTICS TABLE
          CRD    FN
          LDD    FS+3        CLEAR FLAGS
          LPN    77
          STD    FS+3
          LDD    FN+1        SET LENGTH OF *IOST* ENTRY
          SHN    -6
          STD    T2
          ADN    1           SET LENGTH OF *PROBE* ENTRY
          STD    T1
 IOS3     LDD    T3          READ EST ORDINAL FROM PUT
          SHN    PUTLS
          ADK    UNCT
          ADD    FS+4
          SHN    6
          ADD    FS+3
          SHN    14
          CRD    CM
          LDD    CM+1        CONVERT EST ORDINAL TO DISPLAY CODE
          LPC    707
          ADC    2R00
          SHN    6
          STM    IOSA+2
          SHN    -6
          SCN    77
          STM    IOSA+1
          LDD    CM+1
          SHN    -3
          LPN    7
          ADN    1R0
          RAM    IOSA+1
          SFA    EST,CM+1    READ DEVICE EST
          CRD    CM
          LDD    CM+3        SET DEVICE TYPE
          STM    IOSA
          LDD    T3          READ I/O STATISTICS TABLE
          SHN    PUTLS
          ADD    FN+4
          SHN    6
          ADD    FN+3
          SHN    14
          CRM    IOSB,T2
          LDD    ES+2        CHECK IF ROOM IN BUFFER
          SBD    FC
          SBD    T1
          PJN    IOS4        IF ROOM FOR DATA
          LDC    PRBP        CLEAR PROBE INTERLOCK
          CRD    FN
          LDC    4000
          STD    FN
          LDC    PRBP
          CWD    FN
          ABORT  /MESS/ERAE  *SFM ARGUMENT ERROR.*
 
 IOS4     LDD    ES+3        RETURN DATA TO CALLER
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          ADD    FC
          CWM    IOSA,T1
          LDD    T1          UPDATE WORD COUNT
          RAD    FC
          AOD    T3          INCREMENT INDEX
          LDD    FS
          SBD    T3
          MJN    IOS5        IF NO MORE *PUT*S
          LJM    IOS3        PROCESS NEXT *PUT*
 
 IOS5     LDC    PRBP        CLEAR PROBE INTERLOCK
          CRD    FN
          LDC    4000
          STD    FN
          LDC    PRBP
          CWD    FN
          LJM    RSD7        RETURN
 RDD      SPACE  4,10
**        RDD - RETURN DAYFILE DATA FROM SECTOR OF LOCAL AREAS.
*
*T,FA     12/*RDDF* ,12/ EQ ,12/ WC ,6/ ,18/ADDR
*
*         EQ     EST ORDINAL TO CHECK FOR DAYFILES
*         WC     LENGTH OF CM BUFFER TO RECEIVE DATA
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN)
*         ADDR   FWA OF CM BUFFER
*
*
*T,ADDR   12/ SDF ,12/ ADF ,12/ELD ,12/ BML ,12/
*
*         SDF    FIRST TRACK OF SYSTEM DAYFILE
*         ADF    FIRST TRACK OF ACCOUNT DAYFILE
*         ELD    FIRST TRACK OF ERRLOG
*         BML    FIRST TRACK OF BINARY MAINTENCE LOG
*
*         IF A DAYFILE DOES NOT EXIST ON A DEVICE, THE FIRST TRACK
*         WILL BE SET TO ZERO.
 
 
 RDD      SUBR               ENTRY
          LDN    ESTP        GET EST POINTERS
          CRD    CN
          LDD    ES+1        SET EQUIPMENT
          STD    T5
          SBD    CN+2
          PJN    RDD1        IF EQUIPMENT OUT OF EST
          SFA    EST,T5      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM          CHECK EQUIPMENT TYPE
          SHN    21-13
          MJN    RDD2        IF MASS STORAGE
 RDD1     ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 RDD2     LDN    ZERL
          CRD    CN
          RJM    RLA         READ SECTOR OF LOCAL AREAS (SLA)
          MJN    RDD3        IF READ ERROR
          ZJN    RDD3        IF NO SLA ENTRY FOR THIS MACHINE
          STM    RDDA
 RDD3     LDD    ES+3        STORE DAYFILE DATA
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          CWM    CN,ON
 RDDA     EQU    *-1
          LDN    1
          STD    FC
          LJM    RSD7        RETURN
 SDIF     SPACE  4,20
***       SDI - RETURN AND/OR CLEAR STATISTICAL DATA AREA.
*
*         THE STATISTICAL DATA AREA IS RETURNED TO THE
*         SPECIFIED BUFFER.
*
*T,FA     12/ *SDIF* ,12/ FLAGS ,12/ WC ,6/ ,18/ ADDR
*
*         FLAGS  1, RETURN DATA TO CM BUFFER
*                2, CLEAR STATISTICAL DATA AREA IN CMR
*                3, RETURN DATA TO CM BUFFER AND THEN CLEAR
*                   THE STATISTICAL DATA AREA IN CMR
*         WC     LENGTH OF CM BUFFER
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN)
*         ADDR   FWA OF CM BUFFER
 
 
 SDI      SUBR               ENTRY
          LDN    0           PRESET NUMBER OF WORDS TO WRITE
          STD    FC
          LDD    ES+1
          SHN    21-0
          PJN    SDI2        IF DATA NOT TO BE RETURNED
          LDN    SDAL        SET NUMBER OF WORDS TO RETURN
          STD    FC
          LDD    ES+2        CHECK BUFFER SIZE
          SBD    FC
          PJN    SDI1        IF BUFFER LARGE ENOUGH
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 SDI1     LDC    SDAP        READ STATISTICAL AREA POINTER
          CRD    CM
          LDD    CM
          STM    SDIA+3
          SHN    14
          ADD    CM+1
          STM    SDIA+4
          CRM    BFMS,FC
          LDD    ES+3        WRITE STATISTICAL DATA TO BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          CWM    BFMS,FC
 SDI2     LDD    ES+1
          SHN    21-1
          PJN    SDI3        IF STATISTICAL DATA AREA NOT TO BE CLEARED
          LDN    ZERL        CLEAR STATISTICAL DATA AREA
          CRD    CM
          LDD    MA
          CWM    SDIA,ON
          CWD    CM
          MONITOR CSTM
 SDI3     LJM    RSD7        RETURN
 
 
 SDIA     VFD    36/SDAL,24/0
 PDLF     SPACE  4,10
***       PDLF - RETURN *PROBE* DATA TABLE LENGTH.
*
*         THE MINIMUM BUFFER SIZE REQUIRED FOR THE *PROBE* DATA TABLES
*         IS RETURNED TO THE CALLER.
*
*T,FA     12/ *PDLF* ,12/ ,12/ WC ,6/ 18/ ADDR
*
*         WC     LENGTH OF CM BUFFER
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN)
*         ADDR   FWA OF CM BUFFER
*
*
*T,ADDR   60/ REQUIRED BUFFER SIZE FOR *PROBE* DATA
 
 
 PDL      SUBR               ENTRY
          LDN    1           SET WORD COUNT
          STD    FC
          LDD    ES+2        CHECK BUFFER SIZE
          SBD    FC
          PJN    PDL1        IF BUFFER LARGE ENOUGH
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 PDL1     RJM    LPT         LOCK *PROBE* TABLE
          ZJN    PDL2        IF *PROBE* TABLE LOCKED
          LJM    RSD6        RETURN DATA NOT AVAILABLE STATUS
 
 PDL2     LDN    ZERL
          CRD    CM
          RJM    DPT         DETERMINE *PROBE* TABLE LENGTH
          STD    CM+4
          SHN    -14
          STD    CM+3
          LDD    ES+3        RETURN TABLE LENGTH TO CM BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          CWD    CM
          LDC    PRBP        UNLOCK *PROBE* TABLE
          CWD    FN
          LJM    RSD7        RETURN
 PDAF     SPACE  4,20
**        PDAF - RETURN/CLEAR *PROBE* DATA TABLES.
*
*T,FA     12/ *PDAF* ,12/ FLAGS ,12/ WC ,6/ ,18/ ADDR
*
*         FLAGS  1, RETURN DATA TO CM BUFFER
*                2, CLEAR *PROBE* DATA AREA IN CMR
*                3, RETURN DATA TO CM BUFFER AND THEN CLEAR
*                   THE *PROBE* DATA AREA IN CMR
*         WC     LENGTH OF CM BUFFER
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN)
*         ADDR   FWA OF CM BUFFER
 
 
 PDA      SUBR               ENTRY
          LDN    0
          STD    FC
          RJM    LPT         LOCK *PROBE* TABLE
          ZJN    PDA2        IF *PROBE* TABLE LOCKED
          LJM    RSD6        RETURN DATA NOT AVAILABLE STATUS
 
 PDA1     LJM    PDA6        CLEAR *PROBE* DATA TABLES
 
 PDA2     LDD    ES+1
          SHN    21-0
          PJN    PDA1        IF *PROBE* DATA NOT TO BE RETURNED
          RJM    DPT         DETERMINE *PROBE* TABLE LENGTH
          STD    FC          SET WORD COUNT
          SBD    ES+2
          ZJN    PDA3        IF BUFFER LARGE ENOUGH
          MJN    PDA3        IF BUFFER LARGE ENOUGH
          LDC    PRBP        UNLOCK *PROBE* TABLE
          CWD    FN
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 PDA3     LDC    TPRDL
          STD    T1
          LDN    0           INITIALIZE TABLE INDEX
          STD    T2
          LDK    PDTL        READ PACKED DATE AND TIME
          CRD    CN
          UJN    PDA5        WRITE PACKED DATE AND TIME TO BUFFER
 
 PDA4     LDD    FN+3        READ NEXT WORD TO TRANSFER
          SHN    14
          LMD    FN+4
          ADD    T2
          CRD    CN
          AOD    T2          INCREMENT TABLE INDEX
 PDA5     LDD    ES+3        WRITE WORD TO BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          ADD    T2
          CWD    CN
          SOD    T1
          PJN    PDA4        IF DATA LEFT TO TRANSFER
          RJM    RPC         RETURN *PLD* COUNTS
 PDA6     LDD    ES+1
          SHN    21-1
          PJN    PDA7        IF TABLE NOT TO BE CLEARED
          LDC    PRBP        READ *PROBE* TABLE POINTER
          CRD    CM
          LDD    CM+1        CLEAR FUNCTION CODE
          LPN    77
          STD    CM+1
          MONITOR  CSTM
          LDK    PDTL        READ PACKED DATE AND TIME
          CRD    CN
          LDD    FN+3
          SHN    14
          LMD    FN+4
          CWD    CN
          RJM    CBS         CLEAR BUFFERED I/O STATISTICS
 PDA7     LDC    PRBP        UNLOCK *PROBE* TABLE
          CWD    FN
          LJM    RSD7        RETURN
 CBS      SPACE  4,10
**        CBS - CLEAR BUFFERED I/O STATISTICS.
*
*         USES   T1, CM - CM+4, CN - CN+4, FS - FS+4.
 
 
 CBS      SUBR
          LDK    BIOL        FETCH BUFFERED I/O CONTROL TABLE ADDRESS
          CRD    FS
          LDD    FS+1
          SHN    14
          LMD    FS+2
          ZJN    CBSX        IF NO BUFFERED I/O DEVICES DEFINED
          CRD    CN          READ POINTER WORD
          ERRNZ  IBSP        *IBSP* MUST BE ZERO
 
*         BUILD A BLOCK OF ZEROES FOR CLEARING MEMORY.
 
          LDN    10*5
          STD    T1
 CBS1     LDN    0
          STM    BFMS,T1
          SOD    T1
          PJN    CBS1        IF MORE TO CLEAR
 
*         CLEAR STATISTICS WORDS.
 
          LDN    IBSL        SET LENGTH OF STATISTICS AREA
          STD    T1
          LDD    CN+3
          SHN    14
          LMD    CN+4
          CWM    BFMS,T1     CLEAR STATISTICS BLOCK
 
*         CLEAR CHANNEL TABLE REQUEST COUNTERS.
 
          LDN    0           PRESET FOR *UTEM* FUNCTION
          STD    CM+2
          LDD    FS+1        READ CHANNEL TABLE POINTER WORD
          SHN    14
          LMD    FS+2
          ADN    CCTP
          CRD    CN
          SOD    CN
 CBS2     SHN    CCTLS
          ADN    CCNT
          ADD    CN+4
          SHN    6
          ADD    CN+3
          SHN    14
          STD    CM+4        SET ADDRESS FOR *UTEM*
          SHN    -14
          STD    CM+3
          LDN    1
          STD    CM+1        NUMBER OF UPDATES TO PROCESS
          LDD    MA
          CWM    CBSA,ON     WRITE *UTEM* PARAMETERS
          MONITOR  UTEM      CLEAR REQUEST COUNTER
          SOD    CN
          PJN    CBS2        IF MORE CHANNEL TABLES TO PROCESS
 
*         CLEAR *PUT* STATISTICS AREAS.
 
          LDN    INST-RDST+1
          STD    T1          SET LENGTH OF STATISTICS AREA
          LDD    FS+1
          SHN    14
          LMD    FS+2
          ADN    PUTP
          CRD    CN          READ *PUT* POINTER
          LDD    CN+3        CLEAR FLAGS
          LPN    77
          STD    CN+3
          LDD    CN
 CBS3     SHN    PUTLS
          ADN    RDST
          ADD    CN+4
          SHN    6
          ADD    CN+3
          SHN    14
          CWM    BFMS,T1     CLEAR STATISTICS AREA
          SOD    CN
          PJN    CBS3        IF MORE *PUT*S TO CLEAR
          LJM    CBSX        RETURN
 
 CBSA     VFD    6/0,6/36D,6/0,42/0  *UTEM* PARAMETERS
 RFDF     SPACE  4,20
**        RFDF - RETURN FAMILY ORDINAL TABLE FROM LOW CORE.
*
*T,FA     12/*RFDF* ,12/LENGTH ,12/ WC ,6/ ,18/ADDR
*
*         WC     LENGTH OF CM BUFFER
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN. THIS WILL
*                BE THE NUMBER OF FOT ORDINALS CURRENTLY RESERVED.)
*         LENGTH  ZERO ON CALL. *SFM* WILL RETURN THE MAXIMUM NUMBER
*                OF FOT ORDINALS THAT MAY USED.
*         ADDR   FWA OF CM BUFFER
*
*
*T,ADDR   42/*FAMILY NAME*,18/ FOT ORDINAL
*
*         ONE CM WORD WILL BE RETURNED FOR EACH ORDINAL THAT IS
*         CURRENTLY RESERVED.
 
 
 RFD      SUBR               ENTRY
          LDC    FOTP        GET FOT POINTER
          CRD    CM
          LDD    CM+2        CALCULATE FOT ORDINALS IN USE
          SBN    1
          SBD    CM+3
          STD    FC          NUMBER OF WORDS TO BE RETURNED
          LDD    ES+2        CHECK CM BUFFER LENGTH
          SBD    FC
          PJN    RFD1        IF CM BUFFER LARGE ENOUGH
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 RFD1     LDD    CM          TRANSFER FOT TO PP BUFFER
          SHN    14
          ADD    CM+1
          ADN    1           BEGIN WITH SECOND WORD
          CRM    BFMS,FC
          LDC    BFMS        SET FWA OF BUFFER
          STD    T1
          LDN    1           INITIALIZE ORDINAL
          STD    T2
 RFD2     LDM    3,T1        SET FOT ORDINAL
          SCN    77
          STM    3,T1
          LDD    T2
          STM    4,T1
          LDN    5           ADVANCE POINTER
          RAD    T1
          AOD    T2          ADVANCE ORDINAL
          SBD    FC
          SBN    1
          MJN    RFD2        IF NOT END OF TABLE
          LDD    ES+3        RETURN FOT TO CM BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          CWM    BFMS,FC
          SOD    CM+2        RETURN TOTAL NUMBER OF ORDINALS POSSIBLE
          STD    ES+1
          LJM    RSD7        RETURN
 RSC      SPACE  4,10
**        RSCF - RETURN SERVICE CLASS CONTROL TABLE FROM LOW CORE.
*
*T,FA     12/ *RSCF* ,12/ 0 ,12/ WC ,6/ 0 ,18/ ADDR
*
*         WC     NUMBER OF WORDS IN CM BUFFER.  MUST BE AT LEAST *SCTE*.
*                *SFM* WILL RETURN THE NUMBER OF WORDS WRITTEN.
*         ADDR   FWA OF CM BUFFER.
*
*         A COPY OF THE *SCT* IS RETURNED IN THE CM BUFFER.
 
 
 RSC      SUBR               ENTRY
          LDN    SCTE        SET NUMBER OF WORDS TO RETURN
          STD    FC
          LDD    ES+2
          SBD    FC
          PJN    RSC1        IF BUFFER LARGE ENOUGH
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 RSC1     LDK    JBCP        GET ADDRESS OF *SCT*
          CRD    CM
          LDD    CM          RETURN *SCT* TO CM BUFFER
          SHN    14
          ADD    CM+1
          CRM    SBUF,FC
          LDD    ES+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          CWM    SBUF,FC
          LJM    RSD7        RETURN
 RSSF     SPACE  4,25
**        RSSF - RETURN SUBSYSTEM DATA.
*
*T,FA     12/*RSSF* ,12/ ,12/ WC ,6/ ,18/ADDR
*
*         WC     LENGTH OF CM BUFFER
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN)
*         ADDR   FWA OF THE CM BUFFER
*
*
*T,ADDR   41/ , 1/F, 6/ CP, 12/ EJTO
*
*         CP     CONTROL POINT NUMBER WHERE SUBSYSTEM MUST RESIDE
*                WHEN IT IS ACTIVE
*         F      ENABLE/DISABLE FLAG
*                =0, IF SUBSYSTEM ENABLED
*                =1, IF SUBSYSTEM DISABLED
*         EJTO   EJT ORDINAL OF THE SUBSYSTEM (ZERO IF NOT ACTIVE)
*
*         ONE CM WORD WILL BE RETURNED FOR EACH SUBSYSTEM THAT IS
*         SUPPORTED BY THE OPERATING SYSTEM.
 
 
 RSS      SUBR               ENTRY
          LDN    SBUFL/5     SAVE NUMBER OF CM WORDS TO BE RETURNED
          STD    FC
          LDC    SBUFL
          STD    T2
          LDD    ES+2        CHECK CM BUFFER
          SBD    FC
          PJN    RSS1        IF BUFFER LARGE ENOUGH
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 RSS1     LDN    0           CLEAR PP BUFFER
          STM    SBUF-1,T2
          SOD    T2
          NJN    RSS1        IF NOT END OF BUFFER
*         STD    T2          INITIALIZE CP AND EJTO INDEX
          STD    T3          INITIALIZE RETURN DATA BUFFER INDEX
          STD    T4          INITIALIZE *TSSS* INDEX
          LDC    SSCP        GET FWA OF THE SSCT
          CRD    CM
          LDN    SSCTL*2     LENGTH OF SSCT AND SSAT (IN CM WORDS)
          STD    T1
          LDD    CM+2        READ SSCT AND SSAT
          SHN    14
          ADD    CM+3
          CRM    BFMS,T1
          LDK    SSSL        READ STATUS WORD
          CRD    CM
 RSS2     LDM    BFMS,T2     GET CONTROL POINT NUMBER
          LPN    37
          STM    SBUF+3,T3
          LDM    BFMS+SSCTL*5,T2  GET EJT ORDINAL
          STM    SBUF+4,T3
          LDM    TSSS,T4     GET *SSSL* BYTE POSITION
          STD    T1
          LDM    TSSS+1,T4   CHECK STATUS BIT
          STM    RSSA
          LDM    CM,T1
          LPC    **
 RSSA     EQU    *-1         (SUBSYSTEM MASK BIT)
          ZJN    RSS3        IF SUBSYSTEM ENABLED
          LDC    100B        SET DISABLED STATUS
          RAM    SBUF+3,T3
 RSS3     LDN    5           LENGTH OF ONE ENTRY IN PP BUFFER
          RAD    T3          INCREMENT RETURN BUFFER INDEX
          LDN    2           INCREMENT TABLE INDEX
          RAD    T4
          AOD    T2          INCREMENT CP AND EJTO INDEX
          SBN    MXSI-LSSI   TOTAL NUMBER OF SUPPORTED SUBSYSTEMS
          ZJN    RSS4        IF ALL SUBSYSTEMS PROCESSED
          LJM    RSS2        PROCESS NEXT ENTRY
 
 RSS4     LDD    ES+3        RETURN SUBSYSTEM DATA TO CM BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          CWM    SBUF,FC
          LJM    RSD7        RETURN
 
 
**        TSSS - TABLE OF SUBSYSTEM STATUS INFORMATION.
*
*T        12/ BYTE, 12/ MASK
 
 
 TSSS     INDEX
 .SUB     HERE
          INDEX  MXSI*2-LSSI*2
 
 
 SBUF     EQU    BFMS+SSCTL*5*2    FWA RETURN DATA PP BUFFER
 .NSS     SET    MXSI-LSSI         TOTAL NUMBER OF SUBSYSTEMS POSSIBLE
 SBUFL    EQU    .NSS*5            LENGTH OF PP BUFFER
 SBUFE    EQU    SBUF+SBUFL        END OF PP BUFFER
          ERRNG  7777-SBUFE        TEST FOR PP BUFFER OVERFLOW
 DPT      SPACE  4,10
**        DPT - DETERMINE *PROBE* TABLE LENGTH.
*
*         ENTRY  NONE.
*
*         EXIT   (A) = MINIMUM SIZE OF CM BUFFER NEEDED TO
*                RECEIVE *PROBE* DATA.
*
*         USES   T1 - T7.
*
 
 
 DPT      SUBR               ENTRY/EXIT
          LDC    PLDP        FETCH PLD POINTER
          CRD    T1
          ADN    PSTP-PLDP   GET PST POINTER
          CRD    T3
          LDD    T3+2        COMPUTE LENGTH OF *PLD*
          SBD    T1
          SHN    14
          ADD    T3+3
          SBD    T1+1
          ADC    TPRDL
          UJN    DPTX        RETURN
 LPT      SPACE  4,35
**        LPT - LOCK *PROBE* TABLES.
*
*         ENTRY  NONE.
*
*         EXIT   (A) .EQ. 0 IF *PROBE* TABLES LOCKED
*                (A) .NE. 0 IF *PROBE* TABLES NOT PRESENT.
*                (FN - FN+4) = *PROBE* TABLE POINTER.
*
*         USES   CM - CM+4, FN - FN+4.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 LPT2     LDC    PRBP        READ *PROBE* DATA POINTER
          CRD    FN
          LDC    4000        CLEAR *PROBE* TABLE LOCK FLAG
          RAD    FN
          LDN    0           SET *PROBE* TABLE INTERLOCKED
 
 LPT      SUBR               ENTRY/EXIT
          LDC    SSTL        READ *PROBE* STATUS
          CRD    CM
          LDD    CM+2
          LPC    100
          NJN    LPTX        IF *PROBE* NOT ENABLED
 LPT1     LDD    MA          LOCK *PROBE* TABLE
          CWM    LPTA,ON
          LDN    1
          STD    CM+1
          STD    CM+2
          MONITOR  UADM
          LDD    CM+1
          ZJN    LPT2        IF *PROBE* TABLE LOCKED
          DELAY
          PAUSE
          LDD    CM+1
          ZJN    LPT1        IF NO ERROR FLAG
          LJM    DPP         DROP PPU
 
 
 LPTA     CON    LDOS        DECREMENT LOW CORE FIELD BY ONE
          CON    PRBP        WORD ADDRESS
          CON    59D*100+1   BIT ADDRESS/FIELD WIDTH
          CON    0
          CON    0
 RPC      SPACE  4,10
**        RPC - RETURN *PLD* COUNTS.
*
*         ENTRY  (FN - FN+4) = *PROBE* TABLE POINTERS.
*
*         EXIT   *PROBE*/*PLD* INFORMATION WRITTEN TO BUFFER.
*
*         USES   CM - CM+4, CN - CN+4, DA - DA+1, T3 - T7.
*
*         CALLS  DPT, SDR.
*
*         DEFINE (DA - DA+1) = FWA OF *PROBE* TABLE *TSPL*.
*                (T3) = LENGTH OF *TSPL*.
*                (T4) = *TSPL* TABLE INDEX.
*                (T5) = *PLD* INDEX.
*                (T6 - T7) = FWA OF *PLD*.
*
*         NOTE   THIS ROUTINE COMBINES THE INFORMATION FROM THE
*                *PROBE* TABLE *TSPL* WITH INFORMATION FROM THE *PLD*
*                TO CREATE THE FOLLOWING ENTRY THAT IS RETURNED TO THE
*                CM BUFFER.
*
*T        18/ PPU ,6/ R ,6/  ,30/ COUNT
*
*         PPU    NAME OF PPU PROGRAM.
*         R      PPU PROGRAM RESIDENCE.
*                0 = ASR RESIDENT.
*                1 = CM RESIDENT
*                2 = DISK RESIDENT
*         COUNT  NUMBER OF TIMES THE PPU PROGRAM WAS LOADED.
 
 
 RPC      SUBR               ENTRY/EXIT
          RJM    DPT         DETERMINE *PROBE* TABLE LENGTH
          ADC    -TPRDL
          STD    T3
          LDC    TSPL        SET FWA OF *TSPL*
          ADD    FN+4
          STD    DA+1
          SHN    -14
          ADD    FN+3
          STD    DA
          LDC    PLDP        FETCH PLD POINTER
          CRD    T6
          LDN    0           INITIALIZE *PROBE* TABLE INDEX
          STD    T4
          STD    T5          INITIALIZE *PLD* INDEX
 RPC1     LPN    1
          NJN    RPC2        IF MORE DATA TO PROCESS
          LDD    DA          READ *PROBE* DATA
          SHN    14
          ADD    DA+1
          ADD    T4
          CRD    CM
          AOD    T4          INCREMENT PROBE TABLE INDEX
 RPC2     LDN    0           CHECK IF LAST *PLD* ENTRY ENCOUNTERED
*         LDN    1           (LAST *PLD* ENTRY ENCOUNTERED)
 RPCA     EQU    *-1
          NJN    RPCX        IF END OF *PLD*
          LDD    T6          READ *PLD* ENTRIES
          SHN    14
          ADD    T7
          ADD    T5
          CRD    CN
 
*         THE LAST ENTRY OF THE *PLD* IS RESERVED FOR *SFP*.
*         THIS *PLD* ENTRY HAS NO PP NAME.  THEREFORE, *SFP*
*         MUST BE SET INTO THE ENTRY BEFORE IT IS RETURNED TO
*         THE CM BUFFER.
 
          LDD    CN          CHECK FOR *SFP* *PLD* ENTRY
          NJN    RPC3        IF NOT *SFP* ENTRY
          LDC    3RPSF       SET *SFP* AS PPU NAME
          STD    CN
          SHN    -6
          LMD    CN+1
          SCN    77
          LMD    CN+1
          STD    CN+1
          AOM    RPCA        FLAG LAST *PLD* ENTRY ENCOUNTERED
 RPC3     LDD    T5
          LPN    1
          NJN    RPC4        IF RETURNING SECOND ENTRY OF *PROBE* DATA
          LDD    CM+4        SET *PROBE* COUNT INTO FIRST *PLD* ENTRY
          STD    CN+4
          LDD    CM+3
          STD    CN+3
          LDD    CM+2
          LPN    77
          STD    CN+2
          UJN    RPC5        SET DEVICE RESIDENCE
 
 RPC4     LDD    CM+2        SET *PROBE* COUNT FOR SECOND *PLD* ENTRY
          SCN    77
          SHN    6
          LMD    CM+1
          SHN    6
          STD    CN+4
          LPC    770000
          LMD    CM
          SHN    6
          STD    CN+3
          SHN    -14
          STD    CN+2
 RPC5     LDD    CN+1        SET DEVICE RESIDENCE
          RJM    SDR
          STD    CN+1
          LDD    ES+3        RETURN DATA TO CM BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          ADC    TPRDL+1
          ADD    T5
          CWD    CN
          AOD    T5
          LJM    RPC1        LOOP FOR MORE DATA
 SDR      SPACE  4,15
**        SDR - SET DEVICE RESIDENCE.
*
*         ENTRY  (A) = BYTE 1 OF *PLD* ENTRY.
*
*         EXIT   (A) = BYTE 1 OF *PROBE/PLD* ENTRY
*
*         USES   T1, T2, FS - FS+4.
*
*         MACROS SFA.
*
*         NOTE   0 = ASR.
*                1 = CM RESIDENT.
*                2 = DISK RESIDENT.
 
 
 SDR      SUBR               ENTRY/EXIT
          STD    T2
          SHN    0-5         CHECK FOR CM RESIDENCE
          LPN    1
          STD    T1
          NJN    SDR1        IF CM RESIDENT
          LDD    T2          EXTRACT EST ORDINAL
          LPN    37
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    FS
          LDD    FS          CHECK IF SYSTEM FILE PRESENT
          SHN    1-12
          LPN    2
          STD    T1
 SDR1     LDD    T2          SET RESIDENCE CODE
          SCN    77
          LMD    T1
          UJN    SDRX        RETURN
 RCIF     SPACE  4,15
**        RCIF - RETURN/UPDATE SYSTEM SERVICE CLASS DATA.
*
*         *RCI* READS OR UPDATES THE CONTENTS OF THE *JCB* (JOB
*         CONTROL AREA) TABLE IN CMR.
*
*T FA     12/ *RCIF* ,11/ ,1/ F,12/ WC,6/ ,18/ ADDR
*
*         F      = 0 IF DATA TO BE READ.
*                = 1 IF DATA TO BE UPDATED.
*         WC     CM BUFFER LENGTH
*                (*SFM* WILL RETURN NUMBER OF WORDS WRITTEN).
*         ADDR   FWA OF CM BUFFER.
*
*         NOTE - FOR THE UPDATE OPTON - THE LAST TWO WORDS OF EACH
*                *JCB* (WORDS *JCTT* AND *CTMT*) ARE NOT UPDATED.
 
 
 RCI      SUBR               ENTRY/EXIT
 
*         CHECK FOR SYSTEM ORIGIN AND *SSJ=* ENTRY POINT.
 
          RJM    CUA         CHECK USER ACCESS
          NJN    RCI1        IF NOT SYSTEM ORIGIN
          LDD    CP
          ADK    SEPW
          CRD    CM
          LDD    CM
          SHN    21-2
          MJN    RCI2        IF SYSTEM ORIGIN AND *SSJ=*
 RCI1     ABORT  /MESS/ERIR  * SFM INCORRECT REQUEST.*
 
*         CHECK FOR READ OR UPDATE OPTION.
 
 RCI2     LDK    TJCBL       SET LENGTH OF *JCB* TABLE
          STD    FC
          SBD    ES+2        CHECK CM BUFFER
          ZJN    RCI3        IF BUFFER CORRECT SIZE
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 RCI3     LDN    1           INITIALIZE SERVICE CLASS NUMBER
          STD    T1
          LDN    0           INITIALIZE CM BUFFER OFFSET
          STD    T2
          LDD    ES+1        CHECK READ/WRITE FLAG
          LPN    1
          NJN    RCI5        IF DATA TO BE WRITTEN
 
*         READ *JCB* TABLE TO JOB BUFFER.
 
          LDN    JCBE        SET WORD COUNT
          STD    T3
 RCI4     SFA    JCB,T1      GET *JCB* ADDRESS
          CRM    RCIB,T3     READ NEXT *JCB* ENTRY
          RJM    GCA         GET CM BUFFER ADDRESS
          ADD    T2
          CWM    RCIB,T3     WRITE NEXT *JCB* ENTRY TO CM BUFFER
          LDN    JCBE        ADJUST OFFSET FOR NEXT SERVICE CLASS
          RAD    T2
          AOD    T1          INCREMENT SERVICE CLASS
          SBN    MXJC
          NJN    RCI4        IF MORE *JCB* ENTRIES TO COPY
          LJM    RSD7        RETURN
 
*         UPDATE *JCB*.
 
 RCI5     LDN    JCBE-2      DO NOT UPDATE LAST TWO WORDS OF EACH *JCB*
          ERRNZ  JCBE-JCTT-2 CODE DEPENDS ON VALUE
          STD    T3          SET WORD COUNT
 RCI6     RJM    GCA         GET CM BUFFER ADDRESS FOR NEXT *JCB* ENTRY
          ADD    T2
          CRM    RCIB,T3     READ NEXT UPDATED *JCB* ENTRY
          SFA    JCB,T1
          CWM    RCIB,T3     UPDATE NEXT *JCB* ENTRY
          LDN    ZERL
          CRD    CM
          LDN    CCSS        CONVERT CPU SCHEDULING PARAMETERS
          STD    CM+2
          LDD    T1          SET SERVICE CLASS
          STD    CM+4
          MONITOR  SCTM      SET SYSTEM CONTROL PARAMETERS
          LDN    JCBE        ADJUST OFFSET FOR NEXT SERVICE CLASS
          RAD    T2
          AOD    T1          INCREMENT SERVICE CLASS
          SBN    MXJC
          NJN    RCI6        IF MORE *JCB* ENTRIES TO UPDATE
 
*         ISSUE JOB LIMIT CHANGED EVENT.
 
 RCI7     LDN    ZERL
          CRD    CM
          LDN    SCFE
          STD    CM+4
          MONITOR  EATM
          LJM    RSD7        RETURN
 GCA      SPACE  4,10
**        GCA - GET CM BUFFER ADDRESS.
*
*         ENTRY  (ES+3 - ES+4) = FWA CM BUFFER FOR JOB.
*
*         EXIT   (A) = FWA CM BUFFER FOR JOB.
 
 
 GCA      SUBR               ENTRY/EXIT
          LDD    ES+3        GET FWA CM BUFFER
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    ES+4
          UJN    GCAX        RETURN
 
 
 RCIB     EQU    *           *JCB* BUFFER
 RCIBL    EQU    JCBE*5      *JCB* BUFFER LENGTH
          ERRPL  RCIB+RCIBL-BFMS  BUFFER OVERFLOWS *BFMS*
 
*         BUFFER FOR I/O STATISTICS.
 
 IOSA     VFD    12/0,18/0,6/0,12/0,12/0
 IOSB     EQU    IOSA+5
          ERRPL  IOSB+PUTL*5-BFMS  BUFFER OVERFLOWS *BFMS*
          SPACE  4,10
**        COMMON DECKS.
 
 
 QUAL$    SET    0           FORCE UNQUALIFIED COMMON DECKS
*CALL     COMPCUA
          SPACE  4,10
          OVERFLOW  OVLA,EPFW
          OVERLAY  (MISCELLANEOUS FUNCTIONS.)
          SPACE  4,10
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO CALLS
*CALL     COMSSSD
          TITLE  CSTF/SSTF/SUSF FUNCTION PROCESSOR.
***       FUNCTION *CSTF* - CLEAR SUBSYSTEM ACCESS FLAG.
*
*         THE SUBSYSTEM ACESS FLAG (BIT 11D OF THE SUBSYSTEM-S SSCT
*         ENTRY) WILL BE CLEARED.
*
*         EXIT CONDITIONS.
*
*T STATUS 48/  0,9/  0,2/  ST,1/  C
*         C      COMPLETION BIT.
*         ST = 0 IF SUBSYSTEM ACCESS FLAG WAS SET AT TIME OF CALL.
*         ST = 1 IF SUBSYSTEM ACCESS FLAG WAS ALREADY CLEAR.
 SST      SPACE  4,10
***       FUNCTION *SSTF* - SET SUBSYSTEM ACCESS FLAG.
*
*         THE SUBSYSTEM ACCESS FLAG (BIT 11D OF THE SUBSYSTEM-S SSCT
*         ENTRY) WILL BE SET.
*
*
*T STATUS 48/  0,9/  0,2/  ST,1/  C
*         C      COMPLETION BIT.
*         ST = 0 IF SUBSYSTEM ACCESS FLAG WAS CLEAR AT TIME OF CALL.
*         ST = 1 IF SUBSYSTEM ACCESS FLAG WAS ALREADY SET.
 
 
 CST      ENTRY              ENTRY
          LDN    ZERL        CLEAR STATUS WORD
          CRD    CN
          AOD    CN+4        SET COMPLETE BIT
          LDD    CP          GET SUBSYSTEM IDENTIFICATION NUMBER
          ADN    JCIW
          CRD    CM
          LDD    IR+2
          SBN    CSTF-CSCF
          SHN    14
          LMD    CM+2
 
          ERRNZ  SSTF-CSTF-1       VALUES MUST BE CONSECUTIVE
          ERRNZ  SSCF-CSCF-1       VALUES MUST BE CONSECUTIVE
 
          RJM    AST         SET/CLEAR SUBSYSTEM ACCESS FLAG
          NJN    CST1        IF FLAG IS ALREADY IN DESIRED STATE
          LDN    2           SET REPLY CODE
          RAD    CN+4
 CST1     LDD    IR+3        RETURN STATUS TO CALLER
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          CWD    CN
          LJM    DPP         DROP PP
 SUSF     SPACE  4,10
***       FUNCTION *SUSF* - SET SUBSYSTEM STATUS.
*
*         THE CONTROL POINT NUMBER, IF SPECIFIED, WILL BE PLACED
*         INTO THE SUBSYSTEM-S SSCT ENTRY.  THE *SSSL* STATUS BIT
*         WILL BE SET TO THE SPECIFIED STATUS (ENABLED OR DISABLED).
*
*         ENTRY
*
*T,ADDR   41/ , 1/F, 6/ CP, 12/ SSID
*
*         F = 1, IF SUBSYSTEM TO BE DISABLED.
*           = 0, IF SUBSYSTEM TO BE ENABLED.
*         CP = CONTROL POINT NUMBER + 40B, IF SPECIFIED.
*         SSID = SUBSYSTEM ID.
 
 
 SSS3     ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 SSS      ENTRY              ENTRY
          RJM    GFE         GET PARAMETER WORD
          CRD    CM
          LDD    CM+4        SAVE SSID
          STD    T6
          SBK    MXSI+1
          PJN    SSS3        IF SSID OUT OF RANGE
          ADK    MXSI-LSSI
          MJN    SSS3        IF SSID OUT OF RANGE
          LDD    CM+3
          SHN    21-5        SAVE ENABLE/DISABLE FLAG
          STD    T7
          PJN    SSS1        IF NO CONTROL POINT SPECIFIED
          SHN    6
          LPN    37
          STD    T1          SAVE CONTROL POINT
          LDN    NCPL        CHECK CONTROL POINT
          CRD    CM
          LDD    T1
          SBD    CM+1
          SBN    1
          PJN    SSS3        IF INVALID CONTROL POINT NUMBER
          LDN    SECF
          SHN    14
          LMD    T6
          RJM    AST         UPDATE SSCT
 
*         UPDATE *SSSL* STATUS BIT.
 
 SSS1     LDC    MXSI        COMPUTE TABLE OFFSET
          SBD    T6
          SHN    1
          STD    T6
          LDM    TSSS,T6     GET *SSSL* BYTE NUMBER
          ADN    CM
          STD    T5
          LDM    TSSS+1,T6   SET MASK
          STD    T6
          LCN    0
          LMD    T6
          STM    SSSA
          LDD    T7
          NJN    SSS2        IF *DISABLE*
          STD    T6          CLEAR STATUS BITS
 SSS2     LDK    SSSL        READ STATUS WORD
          CRD    CM
          LDI    T5
          LPC    *
 SSSA     EQU    *-1
          LMD    T6
          STI    T5
          LDK    SSSL        REWRITE STATUS WORD
          CWD    CM
          LJM    DPP         DROP PP
 TSSS     SPACE 4,10
**        TSSS - TABLE OF SUBSYSTEM STATUS INFORMATION.
*
*T        12/ BYTE, 12/ MASK
 
 
 TSSS     INDEX
 .SUB     HERE
          INDEX  MXSI*2-LSSI*2
          TITLE  MDFF FUNCTION PROCESSOR.
 DMM      SPACE  4,15
***       FUNCTION *MDFF* - DUMP MACHINE MEMORY.
*
*         ENTRY CONDITIONS.
*T FET+5  24/ ,12/ 0,24/ FWA/100
*         FWA = ABSOLUTE ADDRESS OF FIRST WORD TO DUMP.
*         FIRST, IN, OUT, LIMIT SET TO RECEIVE DUMP DATA.
*
*         EXIT CONDITIONS.
*T FET+5  24/ MEMORY SIZE/100,12/ 0,24/ UNCHANGED
*
*         MEMORY SIZE IS FROM CMR WORD *MABL*.
*         MEMORY DATA FROM FWA IS WRITTEN INTO THE BUFFER
*         AND *IN* IS SET CORRECTLY.  MEMORY WILL BE DUMPED
*         IN ANY NUMBER OF 100 WORD BLOCKS NEEDED TO FILL
*         THE BUFFER TO .LT. 100 REMAINING FREE WORDS.
*
*         IN A SECURED SYSTEM, ONLY CMR AND THE CALLER-S FIELD
*         LENGTH WILL BE RETURNED.  THE REST OF CENTRAL MEMORY
*         WILL BE WRITTEN AS BINARY ZEROES.
 
 
 DMM      ENTRY              ENTRY
          LDN    2           SET VALIDATION OPTION
          STD    CM+1
          LDD    IR+4        SET FET ADDRESS
          STD    CM+4
          LDD    IR+3
          STD    CM+3
          MONITOR VFPM       VALIDATE FET PARAMETERS
          LDD    CM+1
          ZJN    DMM1        IF NO ERROR
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 DMM1     LDK    CMRL        GET CMR SIZE
          CRD    ES
          ADK    SSTL-CMRL   GET SECURITY UNLOCK STATUS
          CRD    CN
          ADK    SSML-SSTL   GET SYSTEM SECURITY MODE
          CRD    CM
          LDD    CM
          LPN    7
          ZJN    DMM3        IF NOT SECURED SYSTEM
          LDD    CN
          SHN    21-11
          MJN    DMM3        IF SECURITY UNLOCK STATUS
          AOM    DMMC        SET SECURED SYSTEM FLAG
          LDC    500D        CLEAR BUFFER
          STD    T2
 DMM2     LDN    0
          STM    ZBUF-1,T2
          SOD    T2
          NJN    DMM2        IF MORE TO CLEAR
 DMM3     LDK    MABL        READ HARDWARE OPTIONS
          CRD    CM
          LDD    CM+1
          SHN    21-13
          PJN    DMM4        IF CM EXTENSION PRESENT
          LDM    DMMB        SET NO CME MODE
          STM    DMMA
 DMM4     LDN    6
          STD    T1
          RJM    GFE         GET FET ADDRESS
          CRM    BUF,T1      READ FET
          LDD    CM+3        ADJUST 262K MEMORY SIZE
          ADN    1
          SCN    1
          STM    BUF+5*5+1
          STD    ES+1
          SHN    -14
          ADD    CM+2
          STM    BUF+5*5
          STD    ES
          RJM    GFE
          ADN    5
          CWM    BUF+5*5,ON
          LDM    BUF+1*5+3   SET FET PARAMETERS
          LPN    37
          STD    FT
          LDM    BUF+1*5+4
          STD    FT+1
          LDM    BUF+2*5+3
          STD    IN
          LDM    BUF+2*5+4
          STD    IN+1
          LDM    BUF+4*5+3
          LPN    37
          STD    LM
          LDM    BUF+4*5+4
          STD    LM+1
          RJM    CIB         GET BUFFER SIZE
          SHN    -6          MAKE MULTIPLE OF 100
          NJN    DMM5        IF LARGE ENOUGH
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 DMM5     STD    CN          SAVE WORD COUNT/100
          LDM    BUF+5*5+3   GET FWA/100
          STD    CN+3
          LDM    BUF+5*5+4
          STD    CN+4
          SBD    ES+1        FWA - MACHINE SIZE
          SHN    -21
          LMC    -0
          ADD    CN+3
          SBD    ES
          MJN    DMM6        IF FWA .LT. MACHINE SIZE
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 DMM6     LDN    0
*         LDN    1           (SECURED SYSTEM)
 DMMC     EQU    *-1
          ZJP    DMM9        IF NOT SECURED SYSTEM
          LDD    CN+3
          NJN    DMM7        IF FWA PAST CMR
          LDD    CN+4
          SBD    ES+4
          MJP    DMM9        IF FWA WITHIN CMR
 
*         CHECK FOR REQUESTED BLOCK FWA WITHIN CALLER-S FL
 
 DMM7     LDD    CP          CHECK FOR FWA .LT. FWA OF CALLER-S FL
          ADK    FLSW+1
          CRD    CM
          LDD    CN+4
          SBD    CM+2
          SHN    -21
          LMC    -0
          ADD    CN+3
          SBD    CM+1
          MJN    DMM8        IF FWA .LT. THAN FWA OF CALLER-S FL
          LDD    CM+3        CALCULATE LWA+1 OF CALLER-S FL
          LPC    3777
          ADD    CM+2
          ADD    CM+4
          STD    CM+2
          SHN    -14
          RAD    CM+1
          LDD    CN+4        CHECK FOR FWA .GT. LWA OF CALLER-S FL
          SBD    CM+2
          SHN    -21
          LMC    -0
          ADD    CN+3
          SBD    CM+1
          MJN    DMM9        IF FWA WITHIN CALLER-S FL
 DMM8     LDC    ZBUF        SET BUFFER ADDRESS FOR ZEROES
          STM    DMMD
          UJN    DMM12       PAUSE AND WRITE BUFFER
 
 DMM9     LDC    BUF         SET BUFFER ADDRESS FOR CM DATA
          STM    DMMD
          LRD    CN+3        SET *R* REGISTER TO FWA
*         UJN    DMM10       (CME NOT PRESENT)
 DMMA     EQU    *-1
 
          LDC    400000      SET RELATIVE ADDRESS = 0
          UJN    DMM11       READ DATA FROM CM
 
 DMM10    LDD    CN+4
          SHN    6
 DMM11    CRM    BUF,HN
 DMM12    PAUSE              RESET *R* REGISTER
          LDD    HN
          STD    T1
          LDC    BUF         WRITE TO CM BUFFER
 DMMD     EQU    *-1         (BUFFER ADDRESS)
          RJM    WBB
          SOD    CN          DECREMENT BLOCK COUNT
          ZJN    DMM14       IF NO SPACE REMAINS
          AOD    CN+4        ADVANCE ABSOLUTE ADDRESS
          SHN    -14
          RAD    CN+3
          SBD    ES          COMPARE TO LIMIT VALUE
          NJN    DMM13       IF NOT EQUAL
          LDD    CN+4
          SBD    ES+1
 DMM13    NJP    DMM6        IF NOT END OF MEMORY
 DMM14    LDN    ZERL        RETURN IN POINTER
          CRD    CM
          LDD    IN
          STD    CM+3
          LDD    IN+1
          STD    CM+4
          RJM    GFE
          ADN    2
          CWD    CM
          SBN    2           SET COMPLETION BIT
          CRD    CM
          LDD    CM+4
          SCN    1
          LMN    1
          STD    CM+4
          RJM    GFE
          CWD    CM
          LJM    DPP         EXIT
 
 DMMB     BSS    0
          LOC    DMMA
          UJN    DMM10       CME NOT PRESENT
          LOC    *O
 TPDF     SPACE  4,10
***       FUNCTION *TPDF* - TRANSFER RESOURCE PREVIEW DATA.
*
*         ENTRY
*
*T,ADDR   60/ FIRST WORD OF PREVIEW DATA
*
*         SSID = SUBSYSTEM ID.
 
 
 TPD      ENTRY              ENTRY
          LDK    LPDS-1      SET PREVIEW DATA LENGTH
          STD    T1
          LDD    IR+3
          SHN    14
          ADD    IR+4
          ADD    T1          DATA LWA + 1
          SHN    -6
          SBD    FL
          MJN    TPD1        IF DATA WITHIN FL
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 TPD1     RJM    GFE         SET DATA ADDRESS
          CRM    BUF,T1      READ PREVIEW DATA
          LDN    ZERL
          CRD    CM
          CRD    FS
          LDK    LDSP
          CRD    CN
          LDK    LLDS        SET PREVIEW BUFFER INTERLOCK WORD ADDRESS
          RAD    CN+3
          STD    CM+4
          SHN    -14
          RAD    CN+2
          STD    CM+3
          MONITOR  UTEM      INTERLOCK PREVIEW BUFFER
          LDD    CM+1
          NJN    TPD2        IF BUFFER NOT INTERLOCKED
          LCN    0           SET NON-ZERO FIELD (REQUIRED BY *UTEM*)
          STD    FS
          LDD    CN+2        SET PREVIEW DATA ADDRESS
          SHN    14
          ADD    CN+3
          ADN    1
          CWM    BUF,T1      UPDATE PREVIEW BUFFER
          ADK    -LPDS       CLEAR BUFFER INTERLOCK
          CWD    FS
 TPD2     LJM    DPP         EXIT
          SPACE  4
*         COMMON DECKS.
 
 
 QUAL$    SET    1
 AST$     SET    1           ASSEMBLE TABLE UPDATE CODE IN *COMPAST*
*CALL     COMPAST
*CALL     COMPCIB
*CALL     COMPWBB
 
 
          USE    BUFFER
 BUF      EQU    *
 ZBUF     EQU    *+500D      ZERO BUFFER FOR *MDFF*
          ERRPL  ZBUF+500D-EPFW
          OVERLAY  (LID MANAGEMENT PROCESSOR.)
          SPACE  4
          TITLE  LID TABLE FUNCTION PROCESSORS.
 GLAF     SPACE  4,15
***       GLAF - GET LID ATTRIBUTES.
*
*         *GLAF* RETURNS VARIOUS ATTRIBUTES FOR A SPECIFIED LID.
*
*         ENTRY -
*T FET+0  18/LID,42/1
*                LID = THREE CHARACTER ALPHANUMERIC LID.
*         EXIT -
*T FET+0  18/LID,12/AT,6/ ,3/RFU,3/NW,8/RC,9/0,1/C
*                AT = 1/H,1/L,1/E,1/V,1/SH,1/SL,1/B,3/RFU,2/RFI
*                     H = HOST.
*                     L = LINKED MAINFRAME.
*                     E = ENABLED LID.
*                     V = PRE-VALIDATION REQUIRED.
*                     SH = STORE AND FORWARD LID ON HOST.
*                     SL = STORE AND FORWARD LID ON LINKED MAINFRAME.
*                     B = LOOPBACK LID ON HOST MAINFRAME.
*                     RFU = RESERVED FOR FUTURE USE.
*                     RFI = RESERVED FOR INSTALLATION.
*                NW = 1/SSF,1/RHF,1/NHP.
*                     SSF = SCOPE 2 STATION FACILITY.
*                     RHF = REMOVE HOST FACILITY.
*                     NHP = NETWORK HOST PRODUCTS.
*                     NOTE - ONLY NETWORKS WITH CURRENTLY AVAILABLE
*                            PATHS TO ENABLED *PID*S ARE RETURNED.
*                RC = RESPONSE CODE.
 
 
 GLA      ENTRY
          RJM    GFE         READ LID
          CRD    ES
          LDD    ES+1        ENSURE PROPER FORMAT ON LID
          SCN    77
          STD    ES+1
          LDN    0           CLEAR REMAINING FIELDS
          STD    ES+2
          STD    ES+3
          STD    ES+4
          STD    FN+4        CLEAR INITIAL NEXT PID INDEX
          LDK    LIDP        FWA OF LDT
          CRD    T1
          LDN    1           INITIALIZE INDEX INTO LDT
          STD    T6
          LDD    T1          GET LDT HEADER
          SHN    14
          LMD    T2
          CRD    CM
 GLA1     LDD    FN+4        INCREMENT NEXT PID INDEX
          RAD    T6
          RJM    RPE         READ PID ENTRY
          MJN    GLA2        IF ENABLED PID FOUND
 
*         ALL PIDS HAVE BEEN PROCESSED.  WRITE REPLY BLOCK AND RETURN.
 
          RJM    GFE         WRITE REPLY BLOCK
          CWD    ES
          LJM    SFMX        RETURN
 
 GLA2     LDN    3-1         SET POINTER TO FWA-1 OF FIRST LID ENTRY
          STD    FI
 GLA3     RJM    RLE         READ LID ENTRY
          NJN    GLA1        IF NO MATCHING LIDS FOR THIS PID
          LDD    CN+2
          SHN    21-13
          PJN    GLA3.3      IF LID NOT ENABLED
          LDD    ES+1        SET ENABLED PID/LID FLAG
          SCN    10
          LMN    10
          STD    ES+1
 GLA3.3   LDD    CN+2
          SHN    21-12
          MJN    GLA3.5      IF STORE/FORWARD
          LDD    FS+1
          SHN    21-3
          PJN    GLA4        IF NO PRE-VALIDATION ON PID
          UJN    GLA3.7      SET PRE-VALIDATION FLAG
 
 GLA3.5   SHN    21-11+12-21
          PJN    GLA4        IF NO PRE-VALIDATION ON LID
 GLA3.7   LDD    ES+1        SET PRE-VALIDATION FLAG
          SCN    4
          LMN    4
          STD    ES+1
 GLA4     LDD    FS+1
          SHN    21-5
          MJN    GLA7        IF HOST
          LDD    CN+2
          SHN    21-12
          MJN    GLA5        IF STORE/FORWARD
          LDD    ES+1        SET *L* FLAG
          SCN    20
          LMN    20
          STD    ES+1
          UJN    GLA10       CHECK FOR ENABLED NETWORKS
 
 GLA5     LDD    ES+1        SET *SL* FLAG
          SCN    1
          LMN    1
          STD    ES+1
 GLA6     LJM    GLA3        PROCESS NEXT LID
 
 GLA7     LDD    CN+2
          SHN    21-12
          MJN    GLA8        IF STORE/FORWARD
          LDD    ES+1        SET *H* FLAG
          SCN    40
          LMN    40
          UJN    GLA9        UPDATE ATTRIBUTES FIELD
 
 GLA8     LDD    ES+1        SET *SH* FLAG
          SCN    2
          LMN    2
 GLA9     STD    ES+1
          LDD    CN+2
          SHN    21-10
          PJN    GLA10       IF LOOPBACK FLAG NOT SET
          LDD    ES+2        SET *B* FLAG
          LPC    3777
          LMC    4000
          STD    ES+2
 
*         CHECK FOR ENABLED NETWORKS.
 
 GLA10    LDD    CN+2        CHECK FOR STORE/FORWARD ATTRIBUTE
          SHN    21-12
          MJN    GLA6        IF STORE/FORWARD
          LDD    FS+4        CHECK FOR *NAM* ENABLED
          LPN    17
          LMK    /NTS/ISV
          NJN    GLA11       IF *NAM* NOT AVAILABLE
          LDD    ES+3        SET *NAM* ENABLED FLAG
          SHN    -6+22
          SCN    NANS
          LMN    NANS
          SHN    6
          STD    ES+3
 GLA11    LDD    FS+4        CHECK FOR *RHF* ENABLED
          SHN    0-4
          LPN    17
          LMK    /NTS/ISV
          NJN    GLA12       IF *RHF* NOT AVAILABLE
          LDD    ES+3        SET *RHF* ENABLED FLAG
          SHN    -6+22
          SCN    RHNS
          LMN    RHNS
          SHN    6
          STD    ES+3
 GLA12    LDD    FS+4        CHECK FOR *SSF* ENABLED
          SHN    0-10
          LMK    /NTS/ISV
          NJN    GLA13       IF *SSF* NOT AVAILABLE
          LDD    ES+3        SET *SSF* ENABLED FLAG
          SHN    -6+22
          SCN    SSNS
          LMN    SSNS
          SHN    6
          STD    ES+3
 GLA13    LJM    GLA3        PROCESS NEXT LID
 GLCF     SPACE  4,40
***       GLCF - GET LID CONFIGURATION.
*
*         *GLCF* RETURNS MULTIPLE ENTRIES, WHERE EACH ENTRY CONSISTS
*         OF THE LID ATTRIBUTES, THE ENABLED PID, ITS ATTRIBUTES, AND
*         THE VARIOUS NETWORK STATUSES ASSOCIATED WITH THAT PID.  SEE
*         *PPCOM* FOR THE FORMAT OF THE LDT, THE CONTENTS OF THE
*         ATTRIBUTES FIELD, AND THE CONTENTS OF THE NETWORK STATUS
*         FIELD.
*
*         ENTRY -
*T FET+0  12/WC,30/0,8/RC,9/0,1/1
*T        18/LID,42/
*T        60/
*T         .
*T         .
*T         .
*T        60/
*                WC = WORD COUNT (INCLUDING TWO HEADER WORDS) OF THE
*                  AVAILABLE REPLY BLOCK SIZE.
*                RC = RESPONSE CODE.
*                LID = THREE CHARACTER ALPHANUMERIC LOGICAL ID.
*
*         EXIT -
*T FET+0  60/ UNCHANGED
*T        18/LID, 30/, 12/NP
*T        18/PID1, 1/S, 1/B, 6/, 10/RFI, 12/, 12/NW
*T                       .
*T                       .
*T                       .
*T        18/PIDN, 1/S, 1/B, 6/, 10/RFI, 12/, 12/NW
*                NP = NUMBER OF ENABLED PIDS FOUND IN LDT THAT DEFINE
*                  THIS LID.  NOTE THAT IF THIS NUMBER EXCEEDS (WC)-2,
*                  A *BUFFER TOO SMALL* ERROR WILL BE RETURNED TO THE
*                  CALLER.
*                PIDI = THREE CHARACTER ALPHANUMERIC ENABLED PHYSICAL
*                  ID.
*                S = STORE AND FORWARD FLAG.
*                B = LOOPBACK FLAG.
*                RFI = RESERVED FOR INSTALLATION.
*                NW = NETWORK STATUSES.
 
 
 GLC11    ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 GLC      ENTRY
          LDD    IR+3        CHECK REPLY BLOCK ADDRESS
          SHN    14
          LMD    IR+4
          SHN    -6
          SBD    FL
          PJN    GLC11       IF ADDRESS BEYOND FL
          RJM    GFE         GET REPLY BLOCK WORD COUNT
          CRD    CM
          ADN    1           GET LID TO BE MATCHED
          CRD    ES
          LDD    IR+3        CHECK LWA OF REPLY BLOCK
          SHN    14
          LMD    IR+4
          ADD    CM
          SHN    -6
          SBD    FL
          PJN    GLC11       IF LWA OUT OF RANGE
          LDD    CM          SAVE REPLY BLOCK WORD COUNT
          SBN    2           DO NOT COUNT HEADER WORDS
          STD    T7
          ZJN    GLC1        IF NO REPLY BLOCK LENGTH SPECIFIED
          PJN    GLC2        IF REPLY BLOCK LENGTH SPECIFIED
 GLC1     ERROR  /ERR/LTL    RETURN BUFFER TOO SMALL
 
 GLC1.5   ERROR  /ERR/LNL    LID NOT LEGAL
 
 GLC2     LDD    ES          CHECK LID
          ZJN    GLC1.5      IF LID IS INCORRECT
          LDD    ES+1        ENSURE PROPER FORMAT ON LID
          SCN    77
          ZJN    GLC1.5      IF LID IS INCORRECT
          STD    ES+1
          LDN    1           INITIALIZE TABLE OFFSET
          STD    T6
          LDK    LIDP        GET FWA OF LDT
          CRD    T1
          LDD    T1          GET LDT HEADER
          SHN    14
          LMD    T2
          CRD    CM
          LDN    0           INITIALIZE NUMBER OF PIDS RETURNED
          STD    ES+4
 
*         CHECK NEXT PID IN THE LDT.
 
 GLC3     LDD    CM+4
          NJN    GLC4        IF MORE PIDS TO CHECK
          LJM    GLC10       FINISH PROCESSING
 
 GLC4     SOD    CM+4        DECREMENT REMAINING PID COUNT
          LDD    T1          GET FIRST WORD OF PID ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          CRD    FS
          ADN    1           SECOND WORD OF PID ENTRY
          CRD    FN
          ADN    1           THIRD WORD OF PID ENTRY
          CRD    CN
          LDD    FS+1
          SHN    21-4
          MJN    GLC6        IF PID ENABLED
 GLC5     LDD    FN+4        POINT TO NEXT PID
          RAD    T6
          UJN    GLC3        CHECK NEXT PID
 
 GLC6     LDN    3-1         FWA-1 OF FIRST LID ENTRY
          STD    ES+2
          LDD    CN+4        NUMBER OF LID SLOTS
          STD    T3
 
*         CHECK NEXT LID IN THE LDT.
 
 GLC7     AOD    ES+2        POINT TO NEXT LID ENTRY
          SOD    T3          DECREMENT LID COUNT
          MJN    GLC5        IF NO MORE LIDS FOR THIS PID
          LDD    T1          READ TABLE ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          ADD    ES+2
          CRD    CN
 
*         COMPARE LID TO LID ENTRY IN THE LDT.
 
          LDD    ES
          LMD    CN
          NJN    GLC7        IF LIDS DO NOT MATCH
          LDD    ES+1
          LMD    CN+1
          NJN    GLC7        IF LIDS DO NOT MATCH
          LDD    CN+2
          SHN    21-13
          PJN    GLC7        IF LID NOT ENABLED
 
*         RETURN LID-S ATTRIBUTES ALONG WITH PID INFORMATION.
 
          SHN    5-12-21+13
          LPN    50          SAVE *S* AND *B* FLAGS
          STD    CN+2
          LPN    10
          SHN    1           POSITION *B* FLAG
          RAD    CN+2
          SCN    10          CLEAR OLD *B* FLAG
          STD    CN+2
          LDD    FS+1
          SCN    77
          LMD    CN+2        MERGE FLAGS INTO REPLY WORD
          STD    FS+1
          LDN    0           CLEAR REMAINING FIELDS
          STD    FS+2
          STD    FS+3
          SOD    T7          DECREMENT SIZE OF REPLY BLOCK
 GLCA     EQU    *-1
*         UJN    GLC9        (BYPASS IF REPLY BLOCK TOO SMALL)
          PJN    GLC8        IF ROOM LEFT IN REPLY BLOCK
          AOM    GLCB        INDICATE REPLY BLOCK TOO SMALL
          ISTORE GLCA,(UJN GLC9)  BYPASS LOGIC WHEN REPLY BLOCK FULL
          UJN    GLC9        INCREMENT PID COUNT
 
 GLC8     RJM    GFE         WRITE RETURN INFORMATION
          ADN    2           ALLOW FOR HEADER WORDS
          ADD    ES+4
          CWD    FS
 GLC9     AOD    ES+4        INCREMENT ENABLED PID COUNT
          LJM    GLC7        PROCESS NEXT LID
 
 GLC10    LDN    0           CLEAR FIELD
          STD    ES+2
          RJM    GFE         RETURN PID COUNT
          ADN    1
          CWD    ES
          LDD    ES+4
          ZJN    GLC12       IF NO MATCHING LIDS FOUND
          LDN    0
 GLCB     EQU    *-1
*         LDN    1           (REPLY BUFFER TOO SMALL)
          ZJP    SFMX        IF ENOUGH ROOM IN REPLY BUFFER
          LJM    GLC1        REPLY BUFFER TOO SMALL
 
 GLC12    ERROR  /ERR/LNL    UNKNOWN LID
 GLP      SPACE  4,20
***       GLPF - GET PID ATTRIBUTES.
*
*         *GLPF* RETURNS THE THREE PID WORDS ASSOCIATED WITH THE SPECI-
*         FIED PID TO THE REPLY BUFFER.  SEE *PPCOM* FOR THE FORMAT OF
*         THE THREE PID WORDS.
*
*         ENTRY -
*T FET+0  18/PID,24/0,8/0,9/0,1/0
*T,       60/0
*T,       60/0
*T,       60/0
*                PID = PID TO BE MATCHED.
*
*         EXIT -
*T FET+0  18/PID,24/0,8/RC,9/0,1/1
*T,       60/WORD 1 OF PID ENTRY
*T,       60/WORD 2 OF PID ENTRY
*T,       60/WORD 3 OF PID ENTRY
 
 
 GLP2     ABORT  /MESS/ERAE  * SFM - ARGUMENT ERROR.*
 
 GLP      ENTRY              ENTRY
          LDD    IR+3        CHECK REPLY BLOCK ADDRESS
          SHN    14
          LMD    IR+4
          SHN    -6
          SBD    FL
          PJN    GLP2        IF ADDRESS OUT OF RANGE
          LDD    IR+3        CHECK REPLY BLOCK LWA
          SHN    14
          LMD    IR+4
          ADN    4
          SHN    -6
          SBD    FL
          PJN    GLP2        IF ADDRESS OUT OF RANGE
          RJM    GFE         GET SEARCH PID
          CRD    FN
          LDD    FN+1        ENSURE 3 CHARACTER PID
          SCN    77
          STD    FN+1
          RJM    FMP         FIND MATCHING PID IN LID TABLE
          ZJN    GLP1        IF NO MATCH FOUND
          LDD    T1          GET PID ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          CRM    GLPA,TR
          RJM    GFE         WRITE PID INFORMATION
          ADN    1
          CWM    GLPA,TR
          LJM    SFMX        RETURN
 
 GLP1     ERROR  /ERR/LNL    * PID/LID NOT LEGAL*
 
 GLPA     BSS    3*5         PID BUFFER
 GLTF     SPACE  4,10
***       GLTF - GET LID TABLE.
*
*         *GLTF* RETURNS THE ENTIRE LID TABLE (INCLUDING THE HEADER)
*         TO THE BUFFER ASSOCIATED WITH THE USER-S FET.  THE FET
*         POINTERS ARE UPDATED TO REFLECT THE PRESENCE OF THIS
*         DATA IN THE BUFFER.  SEE *PPCOM* FOR THE FORMAT OF
*         THE LID TABLE.  IF THE LID TABLE IS TOO LONG FOR THE BUFFER,
*         ERROR CODE 6 IS RETURNED, AND FET+5, BYTE 0 CONTAINS THE
*         LENGTH OF THE LID TABLE.
 
 
 GLT      ENTRY
          LDK    LIDP        FWA OF LDT
          CRD    ES
          LDD    ES          INITIALIZE LDT ADDRESS
          RAM    GLTA
          LDD    ES+1
          STM    GLTA+1
          LDD    ES          GET LENGTH OF LDT
          SHN    14
          LMD    ES+1
          CRD    ES
          RJM    GFE         READ FET POINTERS
          ADN    1
          CRD    CM          *FIRST*
          ADN    3
          CRD    CN          *LIMIT*
          LDD    CM+3
          LPN    77
          STD    CM+3
          LDD    CN+3
          LPN    77
          STD    CN+3
          SHN    14
          LMD    CN+4
          SHN    -6
          SBD    FL
          PJN    GLT1        IF *LIMIT* OUT OF RANGE
          LDD    CN+3
          SBD    CM+3
          MJN    GLT1        IF *FIRST* NOT WITHIN *LIMIT*
          SHN    14
          ADD    CN+4
          SBD    CM+4
          SBN    1
          PJN    GLT2        IF *FIRST* LESS THAN *LIMIT*
 GLT1     ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 GLT2     LDN    ZERL        CALCULATE NEW VALUE OF *IN*
          CRD    FN
          LDD    CM+3
          SHN    14
          LMD    CM+4
          ADD    ES          LENGTH OF TABLE
          STD    FN+4
          SHN    -14
          STD    FN+3
          LDD    CN+3        CHECK IF ENOUGH SPACE IN BUFFER
          SBD    FN+3
          MJN    GLT3        IF NO SPACE IN BUFFER
          SHN    14
          ADD    CN+4
          SBD    FN+4
          SBN    1
          PJN    GLT4        IF ENOUGH SPACE IN BUFFER
 GLT3     RJM    GFE         RETURN LID TABLE LENGTH
          ADN    5
          CWD    ES
          ERROR  /ERR/LTL    EC=6, LID TABLE TOO LONG FOR BUFFER
 
 GLT4     LDN    0           INITIALIZE TABLE OFFSET
          STD    T2
 GLT5     LDD    ES          LDT LENGTH
          NJN    GLT6        IF LDT DEFINED
          LDN    1           RETURN LDT HEADER
          STD    ES
 GLT6     STD    T1
          ADC    -LIDTL
          MJN    GLT7        IF REMAINDER OF LDT FITS IN BUFFER
          ZJN    GLT7        IF REMAINDER OF LDT FITS IN BUFFER
          LDK    LIDTL       PROCESS ONE BUFFER OF DATA
          STD    T1
 GLT7     LDC    **          READ LDT INTO BUFFER
 GLTA     EQU    *-2
          CRM    LIDT,T1
          LDD    CM+3        RETURN LDT TO USER-S FL
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          ADD    T2
          CWM    LIDT,T1
          LDD    ES
          SBD    T1
          ZJN    GLT8        IF ENTIRE LDT WRITTEN TO USER-S FL
          STD    ES
          LDD    T1          UPDATE LDT ADDRESS
          RAM    GLTA+1
          SHN    -14
          RAM    GLTA
          LDD    T1          UPDATE OFFSET TO USER-S FL
          RAD    T2
          LJM    GLT5        READ/WRITE THE LDT TO USER-S FL
 
 GLT8     LDK    ZERL        RETURN *IN* AND *OUT* TO FET
          CRD    CN
          LDD    CM+3
          STD    CN+3
          LDD    CM+4
          STD    CN+4
          RJM    GFE
          ADN    2
          CWD    FN
          ADN    1
          CWD    CN
          LJM    SFMX        COMPLETE *SFM* PROCESSING
 INT      SPACE  4,10
***       ILTF - INITIALIZE THE LDT.
*
*         *ILTF* WRITES THE ENTIRE LDT (INCLUDING THE HEADER) FROM THE
*         BUFFER ASSOCIATED WITH THE USER-S FET TO THE FWA OF THE
*         TABLE, FOUND IN *LIDP*.  SEE *PPCOM* FOR THE FORMAT OF THE
*         LDT.
 
 
 INT      ENTRY
          RJM    ILT         INTERLOCK THE LDT
          RJM    GFE         READ LENGTH OF PARAMETER BLOCK
          CRD    FN
 
*         TEST IF PARAMETER BLOCK LENGTH IS WITHIN FL.
 
          LDD    IR+3
          SHN    14
          LMD    IR+4
          ADD    FN
          ADN    1           INCLUDE PARAMETER BLOCK HEADER
          SHN    -6
          SBD    FL
          MJN    INT1        IF PARAMETER BLOCK WITHIN FL
          RJM    CLI         CLEAR THE LDT INTERLOCK
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 INT1     LDN    1           INITIALIZE PARAMETER BLOCK OFFSET
          STD    T2
          LDK    LIDP        READ FWA OF LDT
          CRD    FS
          LDD    FS          FWA OF LDT
          RAM    INTA
          LDD    FS+1
          STM    INTA+1
 
*         ENSURE THE NEW TABLE FITS WITHIN LDT-S ALLOTTED SPACE.
 
          LDD    FN
          ZJN    INT2        IF NO PARAMETER BLOCK LENGTH SPECIFIED
          SBD    FS+2
          MJN    INT3        IF TABLE FITS WITHIN ALLOTTED SPACE
          ZJN    INT3        IF TABLE EXCEEDS ALLOTTED SPACE
 INT2     RJM    CLI         CLEAR THE LDT INTERLOCK
          ERROR  /ERR/LTL    RETURN INFORMATION TOO LARGE
 
*         CALCULATE NUMBER OF CM WORDS TO READ/WRITE.
 
 INT3     LDD    FN          REMAINING NUMBER OF CM WORDS TO PROCESS
          STD    T1
          ADC    -LIDTL
          MJN    INT4        IF PARAMETER BLOCK FITS IN PP BUFFER
          ZJN    INT4        IF PARAMETER BLOCK FITS IN PP BUFFER
          LDK    LIDTL       PROCESS ONE BUFFER OF DATA
          STD    T1
 INT4     RJM    GFE         CURRENT ADDRESS OF PARAMETER BLOCK
          ADD    T2
          CRM    LIDT,T1
          LDC    **          WRITE BUFFER TO LDT IN CM
 INTA     EQU    *-2
          CWM    LIDT,T1
          LDD    FN
          SBD    T1
          ZJN    INT5        IF ENTIRE PARAMETER BLOCK PROCESSED
          STD    FN
          LDD    T1          INCREMENT ADDRESS FOR NEXT BLOCK OF DATA
          RAM    INTA+1
          SHN    -14
          RAM    INTA
          LDD    T1          INCREMENT PARAMETER BLOCK OFFSET
          RAD    T2
          UJN    INT3        PROCESS REMAINING PARAMETER BLOCK
 
 INT5     RJM    CLI         CLEAR THE LDT INTERLOCK
          LJM    SFMX        RETURN
 SPT      SPACE  4,10
**        SPTF - SET PID ATTRIBUTES.
*
*         *SPTF* CAN PERFORM A NUMBER OF DIFFERENT TASKS DEPENDING UPON
*         THE SUBFUNCTION ISSUED WITH THIS FUNCTION.  SEE *COMCCMD* FOR
*         THE ENTRY AND EXIT FORMATS FOR THE VARIOUS SUBFUNCTIONS.
 
 
 SPT4     RJM    CLI         CLEAR THE INTERLOCK
          ERROR  /ERR/LNL    LID/PID NOT LEGAL
 
 SPT      ENTRY
          RJM    ILT         INTERLOCK THE LDT
          LDK    LIDP        GET LDT ADDRESS
          CRD    FS
          LDD    FS+2
          SBN    2
          MJN    SPT4        IF NO LDT DEFINED
          RJM    GFE
          CRD    FN
          LDD    FN+1        CHECK NUMBER OF PIDS
          ZJN    SPT2        IF NO PIDS
          LDD    FN          VALIDATE SUBFUNCTION
          SBN    MXSP
          MJN    SPT1        IF VALID SUBFUNCTION
          RJM    CLI         CLEAR THE LDT INTERLOCK
          ERROR  /ERR/IFC    INCORRECT SUBFUNCTION CODE
 
*         CHECK IF PARAMETER BLOCK IS WITHIN FL.
 
 SPT1     LDD    IR+3
          SHN    14
          LMD    IR+4
          ADD    FN+1
          SHN    -6
          SBD    FL
          PJN    SPT2        IF PARAMETER BLOCK BEYOND FL
          LDM    TSPT,FN     SET PROCESSOR ADDRESS
          STM    SPTA
          RJM    *           PROCESS SUBFUNCTION
 SPTA     EQU    *-1         (PROCESSOR ADDRESS)
          RJM    CLI         CLEAR THE LDT INTERLOCK
          LDM    PERA
          NJN    SPT3        IF ERROR DETECTED IN PARAMETER BLOCK
          LJM    SFMX        RETURN
 
 SPT2     RJM    CLI         CLEAR THE LDT INTERLOCK
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 SPT3     ERROR  /ERR/CPB    CHECK PARAMETER BLOCK FOR ERRORS
          SPACE  4,10
*         TABLE OF SUBFUNCTION PROCESSOR ADDRESSES.
 
 TSPT     INDEX
          INDEX  SPAF,SPA
          INDEX  SNSF,SNS
          INDEX  SMFF,SMF
          INDEX  ALDF,ALD
          INDEX  DLDF,DLD
          INDEX  SLTF,ALD
          INDEX  MXSP
          TITLE  SUBROUTINES.
 ALD      SPACE  4,15
**        ALD - ADD LID AND/OR SET NEW LID ATTRIBUTES.
*
*         ENTRY  (FN) = SUBFUNCTION TO BE PROCESSED.
*                (FN+1) = NUMBER OF ENTRIES TO PROCESS.
*
*         EXIT   ALL PARAMETER BLOCK ENTRIES PROCESSED.
*
*         USES   ES+2, T3, CM - CM+4, FN - FN+4.
*
*         CALLS  FMP, GFE, RLE.
*
*         MACROS PERR.
 
 
 ALD      SUBR               ENTRY/EXIT
          LDD    FN
          LMK    ALDF
          ZJN    ALD1        IF ADDING LID AND ATTRIBUTES
 
*         ONLY THE LID ATTRIBUTES ARE BEING CHANGED.  SOME BRANCH
*         ADDRESSES AND SOME FLAGS MUST BE ALTERED TO ALLOW ONLY
*         CHANGING THE ATTRIBUTES.
 
          LDC    ZJNI+ALD7-ALDA  CHANGE BRANCH ADDRESS
          STM    ALDA
          LDC    UJNI+77-ALDB+ALD4  CHANGE BRANCH ADDRESS
          STM    ALDB
          SOM    ALDC
          LDN    0           INITIALIZE PARAMETER BLOCK INDEX
 ALD1     STD    T3
          LDD    FN+1        NUMBER OF PARAMETER BLOCK ENTRIES
          STD    ES+2
 ALD2     AOD    T3          INCREMENT PARAMETER BLOCK INDEX
          SBD    ES+2
          MJN    ALD3        IF MORE ENTRIES TO PROCESS
          NJN    ALDX        IF ALL ENTRIES PROCESSED
 ALD3     RJM    GFE         READ PARAMETER BLOCK ENTRY
          ADD    T3
          CRD    FN
          RJM    FMP         FIND MATCHING PID
          NJN    ALD6        IF MATCH
 ALD4     PERR   /ERR/LNL    PID/LID NOT LEGAL
 ALD5     UJN    ALD2        PROCESS NEXT ENTRY
 
 ALD6     LDD    FN+1        SET UP LID TO BE MATCHED
          LPN    77
          SHN    14
          LMD    FN+2
          SHN    14
          STD    ES
          SHN    -6
          SCN    77
          STD    ES+1
          LDN    3-1         INDEX - 1 TO FIRST LID
          STD    FI
          RJM    RLE         READ LID ENTRY
          ZJN    ALD4        IF LIDS MATCH
*         ZJN    ALD7        IF SETTING ATTRIBUTES ONLY
 ALDA     EQU    *-1
          PJN    ALD8        IF HOLE FOUND
*         UJN    ALD4        PID/LID NOT LEGAL (SETTING ATTRIBUTES)
 ALDB     EQU    *-1
          PERR   /ERR/LTO    LID TABLE OVERFLOW
          UJN    ALD5        PROCESS NEXT ENTRY
 
 ALD7     LDD    T1          SAVE LID ADDRESS
          SHN    14
          LMD    T2
          ADD    T6
          ADD    FI
          STD    T5
          SHN    -14
          STD    T4
 ALD8     LDD    T4          GET LDT ENTRY
          SHN    14
          LMD    T5
          CRD    CM
 
*         SET NEW LID ATTRIBUTES.
 
          LDD    FN+3        CHECK ATTRIBUTES
          LPC    177
          ZJN    ALD9        IF VALID ATTRIBUTES
          PERR   /ERR/ILA    INCORRECT LID ATTRIBUTE
          UJN    ALD11       PROCESS NEXT ENTRY
 
 ALD9     LDD    FN+3
          STD    CM+2
          LDN    1
*         LDN    0           (SETTING NEW ATTRIBUTES ONLY)
 ALDC     EQU    *-1
          ZJN    ALD10       IF SETTING NEW ATTRIBUTES ONLY
          LDD    ES          INSERT LID
          STD    CM
          LDD    ES+1
          STD    CM+1
 ALD10    LDD    T4          REWRITE LDT ENTRY
          SHN    14
          LMD    T5
          CWD    CM
          PERR   /ERR/CMP    REQUEST COMPLETE
 ALD11    LJM    ALD2        PROCESS NEXT ENTRY
 
          ERRNG  37+ALDA-ALD7  ERROR IF OUT OF RANGE
          ERRNG  37+ALD4-ALDB  ERROR IF OUT OF RANGE
 CLI      SPACE  4,10
**        CLI - CLEAR LID TABLE INTERLOCK.
*
*         USES   FS - FS+4.
 
 
 CLI      SUBR               ENTRY/EXIT
          LDK    LIDP        READ LDT POINTER
          CRD    FS
          LDD    FS+4        CLEAR INTERLOCK BIT
          SCN    1
          STD    FS+4
          LDC    LIDP        REWRITE POINTER WORD
          CWD    FS
          UJN    CLIX        RETURN
 DLD      SPACE  4,15
**        DLD - DELETE LID.
*
*         ENTRY  (FN+1) = NUMBER OF ENTRIES TO PROCESS.
*
*         EXIT   LID DELETED FROM LDT, IF MATCH FOUND.
*
*         USES   T3, CN - CN+2, ES - ES+2, FN - FN+4.
*
*         CALLS  FMP, GFE, RLE.
*
*         MACROS PERR.
 
 
 DLD      SUBR               ENTRY/EXIT
          LDN    0           INITIALIZE PARAMETER BLOCK INDEX
          STD    T3
          LDD    FN+1        NUMBER OF PARAMETER BLOCK ENTRIES
          STD    ES+2
 DLD1     AOD    T3          INCREMENT PARAMETER BLOCK INDEX
          SBD    ES+2
          MJN    DLD2        IF MORE ENTRIES TO PROCESS
          NJN    DLDX        IF ALL ENTRIES PROCESSED
 DLD2     RJM    GFE         READ PARAMETER BLOCK ENTRY
          ADD    T3
          CRD    FN
          RJM    FMP         FIND MATCHING PID
          NJN    DLD4        IF MATCH
          PERR   /ERR/LNL    PID/LID NOT LEGAL
 DLD3     UJN    DLD1        PROCESS NEXT ENTRY
 
 DLD4     LDD    FN+1        SET UP LID TO BE MATCHED
          LPN    77
          SHN    14
          LMD    FN+2
          SHN    14
          STD    ES
          SHN    -6
          SCN    77
          STD    ES+1
          LDN    3-1         INDEX - 1 TO FIRST LID
          STD    FI
          RJM    RLE         READ LID ENTRY
          ZJN    DLD6        IF LIDS MATCH
          PERR   /ERR/LNL    PID/LID NOT LEGAL
 DLD5     UJN    DLD3        PROCESS NEXT ENTRY
 
 DLD6     LDK    ZERL        CLEAR LID ENTRY
          CRD    CN
          LDD    T1          UPDATE LDT ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          ADD    FI
          CWD    CN
          PERR   /ERR/CMP    REQUEST COMPLETE
          UJN    DLD3        PROCESS NEXT ENTRY
 FMP      SPACE  4,15
**        FMP - FIND MATCHING PID.
*
*         ENTRY  (FN - FN+1) = PID BEING MATCHED.
*
*         EXIT   (A) = 0, IF NO MATCH FOUND.
*                (A) .NE. 0, IF MATCH FOUND.
*                (T1 - T2) = FWA OF LDT.
*                (T6) = TABLE OFFSET OF MATCHING PID, IF ONE FOUND.
*
*         USES   T1, T2, T6, CM - CM+4, CN - CN+4, FS - FS+4.
*
*         CALLS  CLI.
*
*         MACROS ERROR.
 
 
 FMP      SUBR               ENTRY/EXIT
          LDK    LIDP        GET LDT ADDRESS
          CRD    CM
          LDD    CM+1        SAVE LDT ADDRESS
          STD    T2
          LDD    CM
          STD    T1
          SHN    14          READ LDT HEADER
          LMD    T2
          CRD    CM
          LDN    1           INITIAL LID TABLE POINTER OFFSET
          STD    T6
          LDD    CM+4
          NJN    FMP1        IF PIDS DEFINED IN LDT
          RJM    CLI         CLEAR THE LDT INTERLOCK
          ERROR  /ERR/LNL    LID/PID NOT LEGAL
 
 FMP1     LDD    T1          GET PID
          SHN    14
          LMD    T2
          ADD    T6
          CRD    CM
          ADN    1           GET SECOND WORD OF PID
          CRD    FS
          ADN    1           GET THIRD WORD OF PID
          CRD    CN
 
*         CHECK FOR MATCHING PIDS.
 
          LDD    CM+1
          LMD    FN+1
          SCN    77
          SHN    6
          ADD    CM
          LMD    FN
          NJN    FMP3        IF NO MATCH
          LDN    1           INDICATE MATCH FOUND
 FMP2     LJM    FMPX        RETURN
 
 FMP3     LDD    FS+4
          ZJN    FMP2        IF ALL PIDS SEARCHED
          RAD    T6          POINT TO NEXT PID
          UJN    FMP1        READ NEXT PID ENTRY
 ILT      SPACE  4,10
**        ILT - INTERLOCK LID TABLE.
*
*         EXIT   LID TABLE INTERLOCKED.
*
*         USES   CM - CM+4.
*
*         MACROS ABORT, DELAY, MONITOR, PAUSE.
 
 
 ILT      SUBR               ENTRY/EXIT
 ILT1     LDN    ZERL        INTERLOCK LID TABLE
          CRD    CM
          ADK    LIDP-ZERL   FWA OF LDT
          STD    CM+4
          MONITOR  UTEM
          LDD    CM+1
          ZJN    ILTX        IF TABLE INTERLOCKED
          DELAY
          PAUSE
          LDD    CM+1
          ZJN    ILT1        IF NO ERROR FLAG
          ABORT  /MESS/ERAB  *SFM ABORTED*
 PER      SPACE  4,10
**        PER - PROCESS PARAMETER BLOCK ENTRY ERROR.
*
*         ENTRY  (A) = ERROR CODE.
*                (T3) = PARAMETER BLOCK ENTRY INDEX.
*
*         EXIT   ERROR CODE PLACED IN PARAMETER BLOCK ENTRY AND WORD
*                REWRITTEN TO USER-S FL.
*                (PERA) = ERROR CODE, IF ERROR DETECTED.
*
*         USES   FN+4.
*
*         CALLS  GFE.
 
 
 PER      SUBR               ENTRY/EXIT
          STD    FN+4
          LMK    /ERR/CMP
          ZJN    PER1        IF NO ERROR DETECTED
          STM    PERA        SAVE ERROR CODE
 PER1     RJM    GFE         REWRITE PARAMETER BLOCK ENTRY
          ADD    T3          ADDRESS INDEX
          CWD    FN
          UJN    PERX        RETURN
 
 PERA     CON    0           ERROR CODE
 RLE      SPACE  4,15
**        RLE - READ LID ENTRY.
*
*         ENTRY  (ES - ES+1) = LID TO BE MATCHED.
*                (FI) = INDEX - 1 TO NEXT LID.
*                (T1 - T2) = FWA OF LDT.
*                (T6) = LDT INDEX OF FIRST WORD OF PID BEING PROCESSED.
*                (CN+4) = NUMBER OF LIDS IN THIS PID.
*
*         EXIT   (A) = 0, IF LIDS MATCH.
*                    .GT. 0, IF HOLE FOUND.
*                    .LT. 0, IF NO HOLE/MATCHING LID FOUND.
*                (T4 - T5) = LDT ADDRESS, IF HOLE FOUND.
*
*         USES   FI, T0, T4, T5, T6, CN - CN+4.
 
 
 RLE3     LDD    T4
          NJN    RLEX        IF HOLE FOUND
          LCN    1           INDICATE NO HOLE/MATCHING LID FOUND
 
 RLE      SUBR               ENTRY/EXIT
          LDD    CN+4        NUMBER OF LID SLOTS
          STD    T0
          LDN    0           INITIALIZE FIRST HOLE POINTER
          STD    T4
          STD    T5
 RLE1     AOD    FI          SET INDEX TO NEXT LID ENTRY
          SOD    T0          DECREMENT LID COUNT
          MJN    RLE3        IF NO MORE LID SLOTS FOR THIS PID
          LDD    T1          READ TABLE ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          ADD    FI
          CRD    CN
 
*         COMPARE LID TO LID ENTRY IN LDT.
 
          LDD    CN
          ZJN    RLE2        IF NO LID PRESENT
          LMD    ES
          NJN    RLE1        IF NO MATCH
          LDD    CN+1
          LMD    ES+1
          SCN    77
          ZJN    RLEX        IF MATCH
          UJN    RLE1        CHECK NEXT LID ENTRY
 
*         PROCESS HOLE IN THE LDT.
 
 RLE2     LDD    T4
          NJN    RLE1        IF PRIOR HOLE FOUND
          LDD    T1          SAVE POINTERS TO FIRST HOLE
          SHN    14
          LMD    T2
          ADD    T6
          ADD    FI
          STD    T5
          SHN    -14
          STD    T4
          UJN    RLE1        CHECK NEXT LID ENTRY
 RPE      SPACE  4,15
**        RPE - READ PID ENTRY.
*
*         ENTRY  (T1 - T2) = FWA OF LDT.
*                (T6) = LDT INDEX OF PID CURRENTLY BEING PROCESSED.
*                (CM+4) = REMAINING NUMBER OF PIDS TO PROCESS.
*
*         EXIT   (A) = 0, IF ALL PIDS HAVE BEEN PROCESSED.
*                (A) .LT. 0, IF ENABLED PID FOUND.
*                (FS - FS+4) = FIRST WORD OF PID ENTRY.
*                (FN - FN+4) = SECOND WORD OF PID ENTRY.
*                (CN - CN+4) = THIRD WORD OF PID ENTRY.
*
*         USES   CM+4, T6, CN - CN+4, FN - FN+4, FS - FS+4.
 
 
 RPE      SUBR               ENTRY/EXIT
 RPE1     LDD    CM+4
          ZJN    RPEX        IF ALL PIDS PROCESSED
          SOD    CM+4        DECREMENT REMAINING PID COUNT
          LDD    T1          GET FIRST WORD OF PID ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          CRD    FS
          ADN    1           GET SECOND WORD OF PID ENTRY
          CRD    FN
          ADN    1           GET THIRD WORD OF PID ENTRY
          CRD    CN
          LDD    FS+1
          SHN    21-4
          MJN    RPEX        IF PID ENABLED
          LDD    FN+4        POINT TO NEXT PID
          RAD    T6
          UJN    RPE1        CHECK NEXT PID
 SMF      SPACE  4,10
**        SMF - SET MAINFRAME DESCRIPTOR.
*
*         ENTRY  (FN+1) = NUMBER OF ENTRIES TO PROCESS.
*
*         EXIT   MAINFRAME DESCRIPTION UPDATED IN PID ENTRY IN THE LDT.
*
*         USES   T0, T3, FN - FN+4, FS - FS+4.
*
*         CALLS  FMP, GFE.
*
*         MACROS PERR.
 
 
 SMF      SUBR               ENTRY/EXIT
          LDN    0           INITIALIZE PARAMETER BLOCK OFFSET
          STD    T3
          LDD    FN+1        NUMBER OF PARAMETER BLOCK ENTRIES
          STD    T0
 SMF1     AOD    T3          INCREMENT PARAMETER BLOCK OFFSET
          SBD    T0
          MJN    SMF2        IF MORE ENTRIES TO PROCESS
          NJN    SMFX        IF ALL ENTRIES PROCESSED
 SMF2     RJM    GFE         READ PARAMETER BLOCK ENTRY
          ADD    T3
          CRD    FN
          RJM    FMP         FIND MATCHING PID
          NJN    SMF3        IF MATCH
          PERR   /ERR/LNL    PID/LID NOT LEGAL
          UJN    SMF1        PROCESS NEXT ENTRY
 
*         WRITE NEW MAINFRAME DESCRIPTION TO THE LDT.
 
 SMF3     LDD    FN+2
          SCN    77
          SHN    6
          LMD    FN+1
          SHN    6
          STD    FS
          LDD    FN+2
          LPN    77
          SHN    14
          LMD    FN+3
          SHN    -6
          STD    FS+1
          LDD    FN+4
          SCN    77
          SHN    6
          LMD    FN+3
          SHN    6
          STD    FS+2
          LDD    FS+3
          LPN    77
          STD    FS+3
          LDD    FN+4
          SHN    6
          RAD    FS+3
          LDD    T1          PID ADDRESS IN LDT
          SHN    14
          LMD    T2
          ADD    T6
          ADN    1
          CWD    FS
          PERR   /ERR/CMP    REQUEST COMPLETE
          LJM    SMF1        PROCESS NEXT ENTRY
 SNS      SPACE  4,10
**        SNS - SET NETWORK STATUS.
*
*         ENTRY  (FN+1) = NUMBER OF ENTRIES TO PROCESS.
*
*         EXIT   ALL ENTRIES IN THE PARAMETER BLOCK HAVE THEIR APPRO-
*                PRIATE NETWORK STATUS FIELDS UPDATED.
*
*         USES   T0, T3, FN - FN+4.
*
*         CALLS  CLI, FMP, GFE, UTE.
*
*         MACROS ABORT, PERR.
 
 
 SNS      SUBR               ENTRY/EXIT
          LDD    FN+1        SAVE PID COUNT
          STD    T0
          SBN    1
          NJN    SNS1        IF MORE THAN ONE PID TO PROCESS
          LDM    SNSB        ALLOW CLEARING OF ALL PIDS OPTION
          STM    SNSA
 SNS1     LDD    FN+2        CHECK FOR VALID NETWORK
          STD    T4          SAVE NETWORK FLAG
          ZJN    SNS2        IF NO NETWORKS SPECIFIED
          SCN    SSNS+RHNS+NANS
          ZJN    SNS3        IF VALID NETWORK FLAGS
 SNS2     RJM    CLI         CLEAR THE LDT INTERLOCK
          ABORT  /MESS/ERAE  * SFM ARGUMENT ERROR.*
 
 SNS3     STD    T3          INITIALIZE PARAMETER BLOCK INDEX
 SNS4     AOD    T3          INCREMENT PARAMETER BLOCK INDEX
          SBD    T0
          MJN    SNS5        IF MORE ENTRIES TO PROCESS
          NJN    SNSX        IF ALL ENTRIES PROCESSED
 SNS5     RJM    GFE         READ PID ENTRY
          ADD    T3          ADD INDEX
          CRD    FN
          UJN    SNS6        CHECK PID
 
 SNSA     EQU    *-1
*         LDD    FN+1        (IF SETTING STATUS ON ALL PIDS PERMITTED)
          SCN    77
          SHN    6
          LMD    FN
          LMC    3R***
          ZJN    SNS8        IF SETTING STATUS ON ALL PIDS
 
 SNS6     LDD    FN+4        CHECK FOR VALID STATUS
          SBK    /NTS/RS3
          MJN    SNS9        IF VALID STATUS
          SBK    /NTS/DAB-/NTS/RS3
          ERRNZ  /NTS/DAB-/NTS/RS7-1
          ZJN    SNS9        IF VALID STATUS
          PERR   /ERR/IST    INCORRECT NETWORK STATUS
 SNS7     UJN    SNS4        PROCESS NEXT PARAMETER BLOCK ENTRY
 
 SNS8     LDD    FN+4
          LMK    /NTS/NAV
          NJP    SNS2        IF NOT *NETWORK NOT AVAILABLE*
          RJM    UTE         UPDATE ALL LDT TABLE ENTRIES
          LJM    SNSX        RETURN
 
 SNS9     RJM    FMP         FIND MATCHING PID
          ZJN    SNS10       IF NO MATCH
          RJM    UTE         UPDATE LDT TABLE ENTRY
          UJN    SNS7        PROCESS NEXT PARAMETER BLOCK ENTRY
 
 SNS10    PERR   /ERR/LNL    PID/LID NOT LEGAL
          UJN    SNS7        PROCESS NEXT PARAMETER BLOCK ENTRY
 
 SNSB     LDD    FN+1        (USED IF *** OPTION ALLOWED)
 SPA      SPACE  4,10
**        SPA - SET PID ATTRIBUTES.
*
*         ENTRY  (FN+1) = NUMBER OF ENTRIES TO PROCESS.
*
*         EXIT   ALL ENTRIES IN THE PARAMETER BLOCK HAVE THEIR APPRO-
*                PRIATE PID ATTRIBUTE FIELDS UPDATED.
*
*         USES   T1 - T3, T6, FN - FN+4.
*
*         CALLS  FMP, GFE.
*
*         MACROS PERR.
 
 
 SPA      SUBR               ENTRY/EXIT
          LDD    FN+1        SET PID COUNT
          STD    T3
 SPA1     RJM    GFE         GET PARAMETER WORD
          ADD    T3
          CRD    FN
          RJM    FMP         FIND MATCHING PID IN LID TABLE
          NJN    SPA2        IF PID FOUND
          PERR   /ERR/LNL    PID/LID NOT LEGAL
          UJN    SPA3        DECREMENT PID COUNT
 
 SPA2     LDD    T1          GET PID ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          CRD    CM
          LDD    CM+1        CLEAR OLD PID ATTRIBUTES
          SCN    34
          STD    CM+1
          LDD    FN+4        SET PID ATTRIBUTES
          SHN    4-13
          LPN    34
          RAD    CM+1
          LDD    T1          REPLACE PID ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          CWD    CM
          PERR   /ERR/CMP    REQUEST COMPLETE
 SPA3     SOD    T3          DECREMENT PID COUNT
          NJP    SPA1        IF MORE PIDS TO PROCESS
          LJM    SPAX        RETURN
 UTE      SPACE  4,15
**        UTE - UPDATE LDT TABLE ENTRY.
*
*         ENTRY  (A) = 0, IF NETWORK STATUS OF ALL PIDS IN LDT ARE TO
*                    BE UPDATED.
*                (A) .NE. 0, IF NETWORK STATUS OF ONLY ONE PID IS TO BE
*                    UPDATED.
*                (T1 - T2) = ADDRESS OF LDT ENTRY TO BE UPDATED, IF
*        ONLY             ONE PID BEING UPDATED.
*                (T4) = NETWORK FLAG.
*                (FN - FN+4) = CURRENT PID ENTRY BEING PROCESSED.
*                (FN+3) = 1, IF ENABLING OR DISABLING NETWORK.
*                       = 0, IF SETTING NEW NETWORK STATUS.
*                (FN+4) = 8/0,1/E,3/ST.
*
*         EXIT   THE NETWORK STATUS FIELD OF THE APPROPRIATE PID(S) HAS
*         S) HAS BEEN UPDATED.
*
*         USES   T1, T2, CN, CN+1, CM - CM+4, FS - FS+4.
*
*         CALLS  CLI.
*
*         MACROS ABORT, PERR.
 
 
 UTE      SUBR               ENTRY/EXIT
          STD    CN          SAVE PID UPDATE STATUS
          NJN    UTE1        IF UPDATING STATUS OF ONE PID
          STD    T6          INITIALIZE LDT INDEX
          LDK    LIDP        GET FWA OF LDT
          CRD    CM
          LDD    CM          SET POINTER TO FIRST PID IN LDT
          SHN    14
          LMD    CM+1
          ADN    1
          STD    T2
          SHN    -14
          STD    T1
 
*         STORE APPROPRIATE NETWORK STATUS MASK AND NEW NETWORK STATUS.
 
 UTE1     LDD    FN+3        SET APPROPRIATE MASK
          ADC    TUTE+2
          STM    UTEA
          LDN    0           INITIALIZE ADDRESS FOR TABLE SEARCH
          STD    CN+1
          STM    UTEC        CLEAR STATUS MASK
          LDD    FN+4        PRESET STATUS
          SHN    4
          RAD    FN+4
          SCN    17
          SHN    4
          RAD    FN+4
 UTE2     LDM    TUTE,CN+1
          ZJN    UTE5        IF NETWORK NOT FOUND
          LMD    T4
          SBD    T4
          MJN    UTE3        IF MATCH ON NETWORK
          LDM    TUTE+1,CN+1  NETWORK CLEARING MASK
          UJN    UTE4        BUILD MASK
 
 UTE3     LDM    TUTE+2,CN+1  STATUS
*         LDM    TUTE+3,CN+1 (ENABLE/DISABLE NETWORK)
 UTEA     EQU    *-1
 UTE4     LMM    UTEC
          STM    UTEC
          LDN    TUTEL       INCREMENT NETWORK POINTER
          RAD    CN+1
          UJN    UTE2        CHECK NEXT NETWORK
 
 UTE5     LCN    0           FORM NEW NETWORK STATUS
          LMM    UTEC
          STM    UTEB
          LDD    FN+4
          LPC    **
 UTEB     EQU    *-1
          STD    FN+4
 
*         READ LDT PID ENTRY AND UPDATE APPROPRIATE NETWORK STATUS.
 
 UTE6     LDD    T1          READ NETWORK STATUS
          SHN    14
          LMD    T2
          ADD    T6
          CRD    CM
          ADN    1           READ NEXT PID OFFSET
          CRD    FS
          LDD    CM+4        CLEAR CURRENT NETWORK STATUS
          LPC    **
 UTEC     EQU    *-1
          LMD    FN+4        NEW NETWORK STATUS
          STD    CM+4
          LDD    T1          REWRITE *LDT* ENTRY
          SHN    14
          LMD    T2
          ADD    T6
          CWD    CM
          PERR   /ERR/CMP    REQUEST COMPLETED
          LDD    CN
          NJN    UTE7        IF UPDATING ONLY ONE PID ENTRY
          LDD    FS+4
          ZJN    UTE7        IF NO MORE PIDS IN *LDT*
          RAD    T6          UPDATE POINTER TO NEXT PID
          UJN    UTE6        PROCESS NEXT PID IN *LDT*
 
 UTE7     LJM    UTEX        RETURN
 
 TUTE     BSS    0
          CON    NANS,17,10,7         *NAM*
 TUTEL    EQU    *-TUTE      LENGTH OF TABLE ENTRY
          CON    RHNS,360,200,160     *RHF*
          CON    SSNS,7400,4000,3400  *SSF*
          CON    0           END OF TABLE
          SPACE  4,10
**        LID TABLE BUFFER.
 
 LIDL1    EQU    200*5       PP WORD LENGTH OF BUFFER
 LIDL2    MIN    5*MXLDT,LIDL1  LDT PP BUFFER LENGTH
 LIDTL    EQU    LIDL2/5     CM WORD LENGTH OF BUFFER
 LIDT     EQU    BFMS-LIDL2  LDT BUFFER ADDRESS
 
 
          SPACE  4,10
          ERRNG  LIDT-*
          OVERFLOW  OVLA,EPFW
          OVERLAY (DAYFILE TERMINATION PROCESSOR.)
 TAD      SPACE  4,15
***       FUNCTION *TAFF* - TERMINATE ACTIVE DAYFILE.
*
*         SSJ= REQUIRED. A NEW FILE IS CREATED WITH A DAYFILE
*         FORMATTED SYSTEM SECTOR AND EOI SECTOR ON EQUIPMENT, EQ.
*         THE TRACK INTERLOCK IS SET FOR THE SPECIFIED DAYFILE AND A
*         TERMINATING DAYFILE MASSAGE IS ISSUED TO FLUSH THE BUFFER
*         AND INTERLOCK THE DAYFILE. THE TERMINATED DAYFILE IS THEN
*         ATTACHED TO THE CONTROL POINT AS A LOCKED LIBRARY FILE AND
*         THE NEW DAYFILE IS STARTED BY WRITING ITS FST ENTRY INTO
*         THE DAYFILE POINTER AREA AND SETTING ITS TRACK INTERLOCK
*         AFTER MOVING A CREATION DATE MESSAGE INTO THE DAYFILE BUFFER.
*
*         THE LABEL TRACK ON THE DAYFILE DEVICE WILL BE INTERLOCKED TO
*         PREVENT PROBLEMS CAUSED BY MULTIPLE *DFTERM* RUNS.  THIS
*         INTERLOCK IS NORMALLY CLEARED BY A *CDBF* CALL.  TO ALLOW
*         FOR A POSSIBLE ABORT OF *DFTERM*, A LOCAL FILE *ZZZZLBT* OF
*         FILE TYPE *LIFT* WILL BE CREATED.  THIS FILE POINTS TO THE
*         INTERLOCKED LABEL.  *0DF* WILL CLEAR THE INTERLOCK WHEN
*         THE *ZZZZLBT* FILE IS RETURNED.
 
 
 TAD      ENTRY              ENTRY
          LDD    MA          CREATE THE *ZZZZLBT* FILE
          CWM    TADI,ON
          SBN    1
          CRD    FN
 TAD0     LDN    NEEQ        SET THE NULL EQUIPMENT
          STD    FS
          LDN    2           RETURN IF NFL INCREASE PENDING
          STM    OVL0-1
          EXECUTE  0BF,OVL0
          UJN    TAD0.2      CHECK FOR FNT ENTRY CREATED
 
*         PROCESS DUPLICATE FILE.
 
          RJM    SFB         SET FILE BUSY
          NJN    TAD0.1      IF FILE BUSY REJECT
          RJM    DRF         DROP THE FILE
          UJN    TAD0        RETRY THE FILE CREATION
 
 TAD0.1   ABORT  /MESS/ERDF  * SFM DUPLICATE FILE FOUND.*
 
 TAD0.2   ZJN    TAD0.3      IF FNT CREATED
          LDN    NFIR
          LJM    ERS         ENTER PP RECALL STACK
 
 TAD0.3   LDD    FA          SAVE THE FNT OFFSET
          STM    TADC
          RJM    GFE         READ FILE NAME
          CRD    FN
          RJM    VFN         VERIFY FILE NAME
          NJN    TAD1        IF FILE NAME VERIFIES
          ABORT  /MESS/ERFN  * SFM FILE NAME ERROR.*
 
 TAD1     RJM    SDT         SET DAYFILE TYPE
          LDD    CN          SET EST ORDINAL FOR NEW DAYFILE
          STD    T5
          ADD    TH          SET MASS STORAGE ASSIGNMENT BY *0BF*
          STD    FS
          LDN    0           SELECT NO RETURN WITHOUT FILE CREATED
          STM    OVL0-1
          EXECUTE 0BF,OVL0
          UJN    TAD4        FNT/FST CREATED
 
*         PROCESS DUPLICATE FILE.
 
          NFA    FA,R        READ FNT ENTRY
          CRD    FS
          LDD    FS+4        CHECK FILE TYPE
          SHN    -6
          LMN    LIFT
          NJN    TAD3        IF NOT LIBRARY FILE TYPE
 TAD2     LDN    0
          STD    FA          CLEAR FNT INDEX
          ABORT  /MESS/ERDF  * SFM DUPLICATE FILE FOUND.*
 
 TAD3     RJM    SFB         SET FILE BUSY
          NJN    TAD2        IF FILE BUSY REJECT
          RJM    DRF         DROP FILE
          LJM    TAD         RETRY FUNCTION
 
*         BUILD DAYFILE SYSTEM SECTOR AND EOI SECTOR.
 
 TAD4     LDD    FA          SAVE THE FNT OFFSET
          STM    TADT
          LDC    501-DTEI-3*5
          STD    T1
 TAD5     LDN    0           CLEAR SYSTEM SECTOR / EOI BUFFER
          STM    BFMS+DTEI+3*5,T1
          SOD    T1
          PJN    TAD5        IF NOT END OF BUFFER
          LDD    CN          SET EST ORDINAL
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          NJN    TAD6        IF TRACK ASSIGNED
          RJM    DRF         DROP NEW DAYFILE
          LDM    TADC
          STD    FA
          RJM    DRF         DROP *ZZZZLBT* FILE
          ERROR  /ERR/TKL    EC=2, MASS STORAGE NOT AVAILABLE
 
 TAD6     STD    T6
          LDM    TDYN-1,TY   SET DAYFILE NAME IN SYSTEM SECTOR
          STM    TADA
          LDD    MA
          CWM    *,ON
 TADA     EQU    *-1
          SBN    1
          CRM    FNSS,ON
          SBN    1           SET DAYFILE NAME IN DAYFILE MESSAGE
          CRM    TADF+1,ON
          LDD    FA          SAVE FNT INDEX
          STM    TADB
          NFA    FA,R        SET FST INFORMATION IN SYSTEM SECTOR
          ADN    FSTL
          CRM    EQSS,ON
          LDN    0           CLEAR FNT INDEX
          STD    FA
          STM    FASS
          LDN    PDTL        SET DATE AND TIME GROUP IN EOI
          CRM    BFMS+DTEI,TR
 
*         WRITE SYSTEM SECTOR AND EOI SECTOR OF NEW DAYFILE.
 
          SETMS  IO
          RJM    WSS         WRITE SYSTEM SECTOR
          RJM    WEI         WRITE EOI SECTOR
          ENDMS
 
*         SET EOI IN TRT AND BUILD FST FOR NEW DAYFILE.
 
          LDD    T5          SET EQUIPMENT
          STD    CM+1
          LDD    T6          SET FIRST TRACK
          STD    FS+2
          LPC    3777
          STD    CM+2
          LDD    T7          SET SECTOR
          STD    FS+3
          STD    CM+3
          MONITOR DTKM       DROP TRACKS
          RJM    WTI         SET TRACK INTERLOCK ON NEW DAYFILE
          ZJN    TAD7        IF TRACK INTERLOCK SET
          LJM    DPP         DROP PPU
 
*         SET TRACK INTERLOCK ON OLD DAYFILE.
 
 TAD7     RJM    SDA         READ DAYFILE FST
          CRD    FN
          LDD    FN          SET DAYFILE EST ORDINAL
          STD    T5
          LDD    FN+1        SET DAYFILE FIRST TRACK
          STD    T6
          LDC    **          SET FNT INDEX
 TADB     EQU    *-1         (FNT INDEX)
          STD    FA
          RJM    STI         SET TRACK INTERLOCK
          ZJN    TAD9        IF TRACK INTERLOCK SET
 TAD8     LDC    **          DROP NEW DAYFILE
 TADT     EQU    *-1
          STD    FA
          RJM    DRF
          LDM    TADC        DROP *ZZZZLBT* FILE
          STD    FA
          RJM    DRF         DROP FILE
          ERROR  /ERR/DFB    EC=1, DAYFILE BUSY
 
*         INTERLOCK THE LABEL TRACK TO PREVENT *1CK* FROM UPDATING
*         THE LOCAL AREA SECTOR UNTIL *DFTERM* ISSUES THE *CDBF*
*         FUNCTION.  THIS INTERLOCK IS NECESSARY ONLY WHEN ANOTHER
*         *DFTERM* IS EXECUTING AND IS TERMINATING ANOTHER DAYFILE
*         ON THE SAME DEVICE.
 
 TAD9     RJM    LLT         LOCATE LABEL TRACK
          STD    T2
          RJM    WTI         SET LABEL TRACK INTERLOCK
          ZJN    TAD10       IF LABEL TRACK INTERLOCK SET
          LDD    FN          CLEAR TRACK INTERLOCK ON OLD FILE
          STD    T5
          LDD    FN+1
          RJM    CTI         CLEAR TRACK INTERLOCK
          UJN    TAD8        DROP NEW FILE
 
 TAD10    LDC    **          COMPLETE THE *ZZZZLBT* FILE
 TADC     EQU    *-1
          STD    T1
          NFA    T1,R
          ADK    FNTL
          CRD    CM
          ADN    FSTL-FNTL
          CRD    CN
          LDD    T5          SET THE EST ORDINAL
          STD    CN
          LDD    T2          SET THE LABEL TRACK
          STD    CN+1
          STD    CN+2
          LDC    1005        SET THE TRACK INTERLOCK FLAG
          STD    CN+4
          LDC    LIFT*100    SET LIBRARY FILE TYPE
          STD    CM+4
          NFA    T1,R
          ADK    FNTL
          CWD    CM
          ADN    FSTL-FNTL
          CWD    CN
 
*         BUILD FNT FOR OLD DAYFILE.
 
          NFA    FA,R        READ FNT
          CRD    CN
          LDC    LIFT*100+SSST  SET LIBRARY FILE TYPE
          STD    CN+4
          LDD    CN+3        SET WRITE LOCKOUT
          SCN    77
          LMN    1
          STD    CN+3
 
*         SET TIME IN CREATION MESSAGES FOR NEW DAYFILE.
 
          LDN    TIML        SET TIME
          CRM    TADD,ON
 
*         TERMINATE OLD DAYFILE.
 
          LDC    2RTE        RESET MESSAGE
          STM    TADF+5
          LDD    TY
          LMN    ERLF
          NJN    TAD11       IF NOT ERRLOG TERMINATION
          LDC    2R
          UJN    TAD12       SET BLANKS
 
 TAD11    LDM    TADF+4
          SCN    77
          LMN    1R
 TAD12    STM    TADF+4
          LDC    TADF
          RJM    DFM         ISSUE MESSAGE TO SYSTEM DAYFILE
          LDM    TDMO-1,TY   SET PROCESSOR ADDRESS
          STD    T1
          LJM    0,T1        SET PROCESSOR ADDRESS
 
 TAD13    LDC    JNMN+TADE   TERMINATE SYSTEM DAYFILE
          UJN    TAD15       ISSUE MESSAGE
 
 TAD14    LDC    EJNN+TADE   TERMINATE ERRLOG DAYFILE
 TAD15    RJM    FDB         FLUSH DAYFILE BUFFER
          LDN    2           SET *CREATION DATE* IN MESSAGE
          STD    T1
          LDD    MA
          CWM    TADH,T1
          SBD    T1
          CRM    TADF+5,T1
          LDN    DTEL        SET DATE
          CRM    TADG,ON
          LDN    6
          UJN    TAD17       WRITE CREATION MESSAGE TO BUFFER
 
 TAD16    LDN    TADML       SET MESSAGE LENGTH
          STD    CM+1
          LDC    BMLN+TADM   TERMINATE MAINTENANCE LOG
          RJM    FDB
          LDC    DS0101      SET MAINTENANCE LOG CREATION SYMPTOM
          STM    TADM+1
          LDN    2
          STD    T1
          LDD    MA          MOVE MESSAGE
          CWM    TADM,T1
          SBN    2
          CRM    TADF,T1
          LDN    PDTL        SET DATE AND TIME IN MESSAGE
          CRM    TADD,ON
          LDN    4           SET MESSAGE LENGTH
          STM    TADD
 TAD17    UJN    TAD19       WRITE CREATION MESSAGE TO BUFFER
 
 TAD18    LDN    DTEL        TERMINATE ACCOUNT DAYFILE
          CRM    TADL,ON
          LDN    2           MOVE ACCOUNT MESSAGE
          STD    T1
          LDD    MA
          CWM    TADK,T1
          LDD    MA
          CRM    TADF,T1
          LDC    AJNN+TADE
          RJM    FDB         FLUSH DAYFILE BUFFER
          LCN    1RE-1RB     SET *ABSY* IN MESSAGE
          RAM    TADF
          LDN    4
 TAD19    STD    T1          SAVE WORD COUNT
          LDC    2R
          STD    CM
          LDD    MA          SET JOB NAME IN CREATION MESSAGES
          CWM    TADE,ON
          SBN    1
          CRD    CM+1
          CWD    CM
          CRM    TADE,ON
 
*         SET NEW DAYFILE FST AND WRITE MESSAGE TO BUFFER.
 
          RJM    SDA         SET DAYFILE FST ADDRESS
          SBN    1           READ DAYFILE OUT POINTER
          CRD    CM
          SBN    1           READ IN POINTER
          CRD    ES
          LDD    TY          SET BUFFER INDEX
          SHN    6
          LMN    3           CLEAR BUFFER INTERLOCK
          STD    FS+4
          LDN    0           SET OUT = FIRST
          STD    CM+4
          LDD    T1          SET IN
          STD    ES+4
          LDD    ES+2        CLEAR THE THRESHOLD INCREMENT
          SCN    7
          STD    ES+2
          LDD    ES          WRITE CREATION MESSAGE TO BUFFER
          SHN    14
          ADD    ES+1
          CWM    TADD,T1
          LDM    TDMP-1,TY   SET PROCESSOR ADDRESS
          STD    T4
          LJM    0,T4        PROCESS APPROPRIATE DAYFILE
 
 TAD20    LDN    7           SET BML MESSAGE LENGTH
          STD    T3
          STM    TADD
          LDN    ZERL        CLEAR BML MESSAGE AREA
          CRM    TADF,ON
          LDC    DM0400      SET SYSTEM CREATION INFORMATION ID
          STM    TADF
          LDC    SS0100      SET SYSTEM TITLE SYMPTOM
          STM    TADF+1
          LDC    TADF+5      SET INFORMATION READ ADDRESS
          UJN    TAD22       SAVE MESSAGE ADDRESS
 
 TAD21    LCN    1RY-1RT     CHANGE ACCOUNT MESSAGE TO *ABST*
          RAM    TADF+1
          LDN    ZERL        TERMINATE LINE
          CRM    TADF+4*5,ON
          LDC    TADF+3      SET INFORMATION READ ADDRESS
 TAD22    STM    TADQ
          STM    TADR
 TAD23    LDN    4           READ SYSTEM TITLE
          STD    T4
          LDN    SYTL
          CRM    TADF,T4
 TADQ     EQU    *-1
          RJM    CML         DETERMINE MESSAGE LENGTH
          RJM    BWA         DETERMINE BUFFER ADDRESS
          CWM    TADD,T3     WRITE MESSAGE TO BUFFER
          LDD    TY
          LMN    BMLF
          NJN    TAD24       IF NOT BML
          LDN    5           SET BML MESSAGE LENGTH
          STD    T3
          STM    TADD
          LDC    SS0101      SET SYSTEM VERSION SYMPTOM
          STM    TADF+1
          UJN    TAD25       PROCESS SYSTEM VERSION
 
 TAD24    LMN    BMLF&ACCF
          NJN    TAD25       IF NOT ACCOUNT FILE
          LDN    1RV-1RT     CHANGE ACCOUNT MESSAGE TO *ABSV*
          RAM    TADF+1
          LDN    ZERL        TERMINATE LINE
          CRM    TADF+2*5,ON
 TAD25    LDN    2           READ SYSTEM VERSION
          STD    T4
          LDN    SVNL
          CRM    TADF,T4
 TADR     EQU    *-1
          RJM    CML         DETERMINE MESSAGE LENGTH
          RJM    BWA         DETERMINE BUFFER WORD ADDRESS
          CWM    TADD,T3     WRITE MESSAGE TO BUFFER
          RJM    SDA         SET DAYFILE POINTER ADDRESS
          SBN    2
          CWD    ES
          ADN    1
          CWD    CM
          ADN    1           STORE BUFFER STATUS
          CWD    FS
 
*         WRITE FNT/FST ATTACHING OLD DAYFILE TO CONTROL POINT.
 
          LDC    1005        SET TRACK INTERLOCK AND NOT BUSY
          STD    FN+4
          NFA    FA,R        STORE FNT ENTRY
          CWD    CN
          ADN    FSTL
          CWD    FN
          LDD    TY
          LMN    ERLF
          ZJN    TAD26       IF ERRLOG
          LMN    ERLF&BMLF
          NJN    TAD27       IF NOT BML
          AOM    TADS
 
 TAD26    LDN    ESTP        GET NUMBER OF MASS STORAGE DEVICES+1
          CRD    CM
          LDD    CM+3
          STD    LO
          LDC    OVL0        SET MASS STORAGE LOAD ADDRESS
          STD    LA
 TADS     LDN    1           ISSUE MESSAGE TO ERRLOG
*         LDN    2           ISSUE MESSAGE TO BML
          RJM    IME         PROCESS MASS STORAGE
 TAD27    LDN    0           CLEAR FNT INDEX
          STD    FA
          LJM    SFMX        RETURN
 
 
*         DAYFILE MESSAGES.
 
 
 TADD     DATA   H* HH.MM.SS.*
 TADE     VFD    24/4L"SJSN",24/4HS.  ,12/SYSC
 TADF     DATA   C*  XXXXXXX TERMINATED.*
 TADG     DATA   C* YY/MM/DD.    *
 TADH     DATA   H* CREATION DATE      *
 TADK     DATA   H*AESY, *
 TADL     DATA   C* YY/MM/DD.  *
 TADI     VFD    42/0LZZZZLBT,18/0
 
 TADM     CON    DM0406,DS0103  MAINTENANCE LOG MESSAGE
          BSSZ   TADM+2*5-*
 TADML    EQU    *-TADM      LENGTH OF MAINTENANCE LOG MESSAGE
 TDMO     SPACE  4,10
**        TDMO - TABLE OF DAYFILE MESSAGE OPTIONS.
*
*         THIS TABLE IS USED TO ISSUE THE TERMINATING
*         DAYFILE MESSAGE TO THE CORRECT DAYFILE.
 
 
 TDMO     BSS    0
          LOC    SDAY
          CON    TAD13       SYSTEM DAYFILE
          CON    TAD18       ACCOUNT DAYFILE
          CON    TAD14       ERRLOG DAYFILE
          CON    TAD16       MAINTENANCE LOG
          LOC    *O
 TDMP     SPACE  4,10
**        TDMP - TABLE OF DAYFILE MESSAGE PROCESSOR OPTIONS.
*
*         THIS TABLE IS USED TO ISSUE THE SYSTEM TITLE
*         AND VERSION TO THE CORRECT DAYFILE.
 
 
 TDMP     BSS    0
          LOC    SDAY
          CON    TAD23       SYSTEM DAYFILE
          CON    TAD21       ACCOUNT DAYFILE
          CON    TAD23       ERRLOG DAYFILE
          CON    TAD20       MAINTENANCE DAYFILE
          LOC    *O
 BWA      SPACE  4,10
**        BWA -  GET BUFFER WORD ADDRESS.
*
*         ENTRY  (ES - ES+4) = FWA OF DAYFILE BUFFER POINTER.
*                (T3) = LENGTH OF MESSAGE.
*
*         EXIT   (A) = ADDRESS OF FREE BUFFER WORD.
*                (ES+4) = WORD COUNT UPDATED.
*
*         USES   ES+4.
 
 
 BWA      SUBR               ENTRY/EXIT
          LDD    T3          LENGTH OF MESSAGE
          RAD    ES+4        UPDATE WORD COUNT
          LDD    ES
          SHN    14
          ADD    ES+1
          ADD    ES+4        ADD TO IN POINTER
          SBD    T3
          UJN    BWAX        RETURN
 CML      SPACE  4,10
**        CML - CHECK MESSAGE LENGTH.
*
*         ENTRY  (TY) = TYPE OF DAYFILE.
*
*         EXIT   (T3) = MESSAGE LENGTH IF NOT BML.
*
*         USES   T3, T4.
 
 
 CML      SUBR               ENTRY/EXIT
          LDD    TY          CHECK DAYFILE TYPE
          LMN    BMLF
          ZJN    CMLX        IF BML
          LDC    TADF+4      FIRST WORD TO CHECK FOR END
          STD    T4
          LDN    3           PRESET MESSAGE LENGTH
          STD    T3
 CML1     LDI    T4
          ZJN    CMLX        IF END OF MESSAGE
          AOD    T3          INCREMENT MESSAGE LENGTH
          LDN    5           INCREMENT END OF MESSAGE ADDRESS
          RAD    T4
          UJN    CML1        CHECK NEXT CM WORD
          SPACE  4,10
*         COMMON DECKS.
 
 
          LIST   X
*CALL     COMPPDI
          LIST   *
          SPACE  4,10
          ERRNG  OVL0-*      OVERFLOW INTO OVERLAY LOAD AREA
          SPACE  4,10
          OVERFLOW  OVLA,EPFW
          TTL    SFM - SYSTEM FILE MANAGER.
          SPACE  4
          END