Retro1.org codex

PFM

[00013] PFM - PERMANENT FILE MANAGER.
[00015] PERMANENT FILE MANAGER.
[00076] MACRO DEFINITIONS.
[00080] COMPARE - COMPARE TWO 36 BIT FIELDS.
[00103] ERROR - CALL ERROR PROCESSOR.
[00138] ERRMSG - SETUP ERROR MESSAGE CONSTANTS.
[00164] EXIT - CALL ERROR PROCESSING FOR SPECIAL (NON-ABORT) EXIT.
[00186] OVERLAY - GENERATE OVERLAY CONSTANTS.
[00217] CSR - DEFINE 24 BIT QUANTITY FROM 18 BIT EQUATE.
[00232] COMMON DECKS.
[00260] STORAGE ASSIGNMENTS AND ASSEMBLY CONSTANTS.
[00324] MEMORY ASSIGNMENTS.
[00326] PERMANENT FILE MANAGER RESIDENT MEMORY LOCATIONS.
[00509] RESIDENT SUBROUTINES.
[00511] SFA - SET FET ADDRESS.
[00525] CCI - CLEAR CATALOG INTERLOCK.
[00550] CTA - CALCULATE TRT ADDRESS.
[00567] ERR - PROCESS ERROR.
[00611] HNG - HANG PP.
[00620] PDA - PROCESS DEVICE AVAILABILITY.
[00650] PDV - PROCESS DEVICE STATUS.
[00670] PES - PROCESS I/O ERROR STATUS.
[00692] SFN - SET FILE NAME.
[00724] SPN - SET PERMANENT FILE NAME.
[00745] PRESET.
[00862] PRS - PRESET ROUTINE.
[01439] TCTL - TABLE OF COMMAND CODE CONTROLS.
[01488] TPFI - TABLE OF PF INCREMENT VALUES BY FUNCTION.
[01521] PRESET SUBROUTINES.
[01523] CCA - CHECK CATALOG ACCESSABILITY.
[01677] CRF - CALL *0RF*.
[01717] CRR - CHECK AUXILIARY DEVICE REQUEST.
[01760] CRX - CHECK *CPUPFM*/*RESEX* RETURN STATUS.
[01815] CUN - COMPARE USER NAMES.
[01867] FIF - FIND INTERLOCK FILES.
[01900] FMS - FORM MASK FOR FILE RESIDENCE CHECK.
[01933] GCA - GET CATALOG ADDRESS.
[01967] POA - PROCESS OPTIONAL USER NAME.
[02207] RCL - RECALL PFM.
[02246] RSX - REQUEST RESOURCE VALIDATION.
[02285] SAM - SET UP ACCOUNTING MESSAGE.
[02327] SRF - SET UP RESERVE FNT.
[02384] SUC - SET USER CONTROLS.
[02489] SWI - SWAP USER INDICES.
[02594] OVERLAYABLE PRESET SUBROUTINES.
[02596] CPN - COMPARE NAMES.
[02622] PER - PROCESS ERROR REPLY FROM *CPUPFM*.
[02672] PFP - PROCESS FET PARAMETERS.
[02863] PSR - PROCESS SPECIAL REQUEST BLOCK.
[03048] PXT - PROCESS EXPIRATION TERM.
[03142] SAP - SAVE ACCESS PARAMETERS.
[03236] SEP - SET ERROR PROCESSING OPTIONS.
[03255] SLT - SEARCH COMMON LIBRARY TABLE FOR ALTERNATE USER NAME.
[03328] VCA - VERIFY CATALOG ADDRESS.
[03401] VFA - VERIFY FET ADDRESS.
[03460] VRP - VERIFY PARAMETERS.
[03531] VUA - VALIDATE USER ACCESS.
[03567] PLF - PROCESS LOCAL FILE.
[03701] SUBROUTINES.
[03703] CAA - CHECK FOR APPLICATION ACCOUNTING.
[03727] CFA - CHECK FOR FAST ATTACH FILE.
[03835] CSA - CHECK SPECIFIED ACCESS LEVEL.
[03865] CFS - CHECK FILE SIZE FOR THE CATALOG SEARCH.
[03905] EFN - ESTABLISH FNT ENTRY FOR FAST ATTACH FILE.
[03962] IAM - ISSUE ACCOUNT FILE MESSAGE.
[04002] PDS - PROCESS DEVICE STATUS.
[04026] PEF - PROCESS EXISTING FILE.
[04151] PIF - PROCESS INTERLOCK FILES.
[04218] SSF - SEARCH FOR SYSTEM FILE.
[04497] SUBROUTINES.
[04499] CDA - CHECK DEVICE ACCESSIBILITY.
[04577] CML - CHECK MASS STORAGE LIMIT.
[04602] CPF - CHECK FOR PRESERVED FILE.
[04632] CPR - CHECK PROPER PERMANENT FILE RESIDENCE.
[04741] DDN - DETERMINE DEVICE NAME.
[04773] DFR - DETERMINE FILE RESIDENCY.
[05018] DSA - DETERMINE SPACE AVAILABLE ON A DEVICE.
[05064] PDS - PROCESS DEVICE STATUS.
[05120] SFT - SET FNT/FST INFORMATION.
[05201] MSR - *COMPRNS* MASS STORAGE READ ERROR PROCESSOR.
[05224] RESIDENT SUBROUTINES.
[05226] CAI - CLEAR ALLOCATION INTERLOCK.
[05250] CSA - COMPUTE SECTOR ADDRESS.
[05273] DPR - DELAY PRIOR TO RETRY.
[05298] DTK - DROP TRACKS.
[05319] ITC - INTERLOCK TRACK CHAIN.
[05341] RMD - RESET TO MASTER DEVICE.
[05361] UCE - UPDATE CATALOG ENTRY.
[05426] WBI - WRITE BUFFER IN PLACE.
[05493] PERMIT SEARCH ROUTINES.
[05495] CPI - CHECK PERMISSION INFORMATION.
[05654] SPI - SEARCH PERMISSION INFORMATION.
[05762] CATALOG SEARCH ROUTINES.
[05764] CCD - CHECK CATALOG DATA.
[05903] ICT - INTERLOCK CATALOG TRACK.
[05932] ISP - INITIALIZE SEARCH OF PERMANENT FILES.
[05981] PCE - PROCESS CATALOG READ ERROR.
[05990] SCH - SEARCH CATALOGS.
[06234] SHL - SEARCH CATALOG FOR HOLE.
[06313] SPECIAL REQUEST BLOCK CATALOG ACCESS ROUTINES.
[06315] ACE - ACCESS CATALOG ENTRY.
[06412] COF - COMPARE FIELD OF 36 BITS.
[06440] RSC - READ CATALOG ENTRY, SEARCH CATALOG IF NECESSARY.
[06459] RVC - READ AND VERIFY CATALOG ENTRY.
[06500] REQUEST PREPROCESSORS.
[06949] LOAD OVERLAY PROCESSOR.
[06951] LCO - LOAD COMMAND OVERLAY.
[06974] INITIALIZATION SUBROUTINES.
[06976] CCT - CHECK FOR CPU TRANSFER.
[07068] CLF - CREATE LOCAL FILE.
[07119] DSR - DETERMINE IF FILE STAGING REQUIRED.
[07151] MCB - MOVE CATALOG BUFFER.
[07183] SDB - SWAP DISK BUFFERS.
[07271] SSP - SET STATISTICAL PARAMETERS.
[07291] VFI - VERIFY THAT FILE IS INDIRECT ACCESS.
[07309] OVERLAYABLE INITIALIZATION ROUTINES.
[07392] CMD - CREATE *TCMD* TABLE ENTRIES.
[07422] TCMD - TABLE OF COMMAND PROCESSOR ADDRESSES.
[07514] ALLOCATION ROUTINES.
[07516] ACS - ALLOCATE CATALOG SPACE.
[07588] AFS - ALLOCATE FILE SPACE.
[07665] CATALOG UPDATE ROUTINES.
[07667] CCS - CREATE CATALOG SECTOR.
[07804] CDA - COMPARE DISK ADDRESSES.
[07834] CIA - CLEAR INDIRECT ALLOCATION INTERLOCK.
[07888] DCE - DELETE CATALOG ENTRY.
[08081] FCE - FORM CATALOG ENTRY.
[08257] FHE - FORM HOLE ENTRY.
[08320] IIA - INTERLOCK INDIRECT ALLOCATION.
[08362] REB - REREAD END BUFFER.
[08424] RTK - REQUEST LINKED TRACK.
[08470] EOI - EOI SECTOR BUFFER.
[08522] ALLOCATION ROUTINES.
[08524] APS - ALLOCATE PERMIT SPACE.
[08581] PERMIT UPDATE ROUTINES.
[08583] CPE - CREATE PERMIT ENTRY.
[08648] FPE - FORM PERMIT ENTRY IN BUFFER.
[08702] RTK - REQUEST LINKED TRACK.
[08748] UPI - UPDATE PERMIT INFORMATION.
[08864] WNP - WRITE NEW PERMIT BUFFER.
[08919] EOI - EOI SECTOR BUFFER.
[08954] COMMAND PROCESSING.
[09221] SUBROUTINES.
[09223] VSS - VERIFY SYSTEM SECTOR.
[09256] COMMAND PROCESSING (OVERLAYABLE).
[09350] SUBROUTINES (OVERLAYABLE).
[09352] CML - CHECK MASS STORAGE LIMIT.
[09380] POF - PROCESS OLD PRIMARY FILE.
[09459] COMMAND PROCESSING.
[09661] SUBROUTINES.
[09663] CSS - CREATE SYSTEM SECTOR IN BUFFER.
[09715] CUC - CHECK USER CONTROLS.
[09813] COMMAND PROCESSING.
[09997] SUBROUTINES.
[09999] CSS - CREATE SYSTEM SECTOR IN BUFFER.
[10054] CUC - CHECK USER CONTROLS.
[10134] VSS - VERIFY SYSTEM SECTOR.
[10192] COMMAND PROCESSING.
[10560] SUBROUTINES.
[10562] CFE - CREATE FNT/FST ENTRY FOR ATTACHED FILE.
[10644] PFE - PROCESS FILE ERROR CONDITION.
[10679] OVERLAYABLE SUBROUTINES.
[10684] CFM - CHECK FILE MODE.
[10856] CSL - CHECK SIZE LIMITS.
[10913] DLT - DETERMINE LOCAL USER TABLE TO UPDATE.
[11037] COMMAND PROCESSING.
[11039] CAT - CATALOG MAIN PROGRAM.
[11079] CATX - TERMINATE PROGRAM.
[11089] DPP - DROP PP.
[11097] PAS - *PFID* ACCESS SEARCH.
[11105] NCS - NORMAL CATALOG SEARCH.
[11114] ACS - ALTERNATE CATALOG SEARCH.
[11136] PDS - PERMIT DATA SEARCH.
[11281] SUBROUTINES.
[11283] SBS - SET STATUS OF BUFFER.
[11320] RBS - READ BUFFER FOR SEARCH.
[11369] MSR - MASS STORAGE READ ERROR PROCESSOR.
[11376] SHB - SEARCH CATALOG BUFFER.
[11535] WDB - WRITE BUFFER TO CENTRAL.
[11627] CCP - CHECK CATALOG PERMISSION.
[11820] DFS - DETERMINE FILE SIZE.
[11896] SPB - SEARCH PERMIT BUFFER.
[11938] CSA - COMPUTE SECTOR ADDRESS.
[11980] PCA - PROCESS CATALOG ADDRESS ACCESS MODE.
[12045] OVERLAYABLE SUBROUTINES.
[12047] CSU - CHECK FOR SPECIAL USER.
[12095] ISP - INITIALIZE SEARCH OF PERMANENT FILES.
[12284] COMMAND PROCESSING.
[12579] SUBROUTINES.
[12581] CUC - CHECK USER CONTROLS.
[12615] SUC - SET USER COUNTS IN SYSTEM SECTOR.
[12637] WSE - WRITE MASS STORAGE ERROR PROCESSOR.
[12696] COMMAND PROCESSING.
[12808] TRP - TERMINATE PROGRAM.
[12812] SUBROUTINES.
[12814] DDF - DELETE DIRECT ACCESS FILE.
[13016] SCP - SAVE CATALOG PARAMETERS.
[13034] SDD - SEARCH FOR DIRECT ACCESS DEVICE.
[13071] WCB - REWRITE CATALOG BUFFER.
[13112] WCE - REWRITE CATALOG ENTRY.
[13161] COMMAND PROCESSING.
[13353] SUBROUTINES.
[13355] UEP - UPDATE EXISTING PERMIT ENTRY.
[13413] COMMAND PROCESSING.
[13452] SUBROUTINES.
[13454] CAL - CHECK ACCESS LEVEL.
[13509] CCE - CHANGE CATALOG ENTRY.
[13725] CFB - CHECK FOR FILE BUSY.
[13794] CFN - CHECK FILE NAMES.
[13879] ICT - INTERLOCK CATALOG TRACK.
[13908] ISP - INITIALIZE SEARCH OF PERMANENT FILES.
[13955] PCC - PROCESS CATALOG READ ERROR FOR *CHANGE*.
[13964] SCT - SEARCH CATALOG.
[14052] SFL - SET FILE NAMES.
[14110] COMMAND PROCESSING.
[14206] SUBROUTINES.
[14208] CDA - COMPARE DISK ADDRESSES.
[14243] UAF - UPDATE CARTRIDGE ALTERNATE STORAGE FLAGS.
[14353] UFL - UPDATE FILE LENGTH.
[14418] UTF - UPDATE TAPE ALTERNATE STORAGE FLAGS.
[14573] WCE - REWRITE CATALOG ENTRY.
[14623] DEVICE-TO-DEVICE TRANSFER MAIN LOOP.
[14624] DTD - DEVICE TO DEVICE TRANSFER.
[14716] SUBROUTINES.
[14718] DPC - DECREMENT PRU COUNTER.
[14744] IBA - INCREMENT BUFFER ADDRESS.
[14767] PLE - PROCESS LENGTH ERROR.
[14787] PTE - PROCESS TRANSFER ERROR.
[14811] SDP - SWAP DISK PARAMETERS.
[14852] SNS - SET NEXT SECTOR.
[14884] WES - WRITE EOI SECTOR.
[14932] WNS - WRITE NEXT SECTOR.
[14997] WSE - WRITE MASS STORAGE ERROR PROCESSOR.
[15041] CES - CREATE EOI SECTOR.
[15104] ADT - APPEND DISK TRANSFER.
[15344] SUBROUTINES.
[15397] CTC - CHECK FOR TAPE ALTERNATE STORAGE COPY OF FILE.
[15458] GEE - GET EST ORDINAL FOR EVENT.
[15504] ISM - ISSUE REQUEST STAGE MESSAGE.
[15622] STR - SETUP *TDAM* REQUEST.
[15851] UPF - UPDATE PFC ON USER ACCESS.
[15928] SUBROUTINES.
[15930] IDR - INITIATE *DMP=* AND SET UP *PFM* RECALL REQUEST.
[16013] PWS - PREWRITE SYSTEM SECTOR AND EOI.
[16115] SCF - SET UP COMMUNICATION FILES.
[16273] SCP - SET UP CPU PARAMETERS.
[16923] SYSTEM ERROR PROCESSING.
[16925] SEP - SYSTEM ERROR PROCESSING.
[17007] E0C - EXIT 0 CASE PROCESSING.
[17043] E1C - EXIT 1 CASE PROCESSING.
[17105] E2C - EXIT 2 CASE PROCESSING.
[17132] E3C - EXIT 3 CASE PROCESSING.
[17152] E4C - EXIT 4 CASE PROCESSING.
[17186] E5C - EXIT 5 CASE PROCESSING.
[17214] E6C - EXIT 6 CASE PROCESSING.
[17252] E7C - EXIT 7 CASE PROCESSING.
[17271] SUBROUTINES.
[17273] CPN - COPY NAME.
[17308] GEA - GET ERROR MESSAGE RETURN ADDRESS.
[17325] IDM - ISSUE DAYFILE MESSAGE.
[17416] MEC - MODIFY ERROR CODES.
[17442] MFN - MERGE FILE NAME WITH MESSAGE.
[17512] PAF - PROCESS PF ACTIVITY COUNT AND LOCAL FILE FNT.
[17554] PEA - PROCESS ERRORS REQUIRING SPECIAL ACTION.
[17593] PEM - PROCESS ERROR MESSAGE.
[17664] TDMO - TABLE OF DAYFILE MESSAGE OPTIONS.
[17676] PPF - PROCESS SPECIAL *PFM* FILES.
[17730] RCL - RECALL PFM.
[17777] REM - RETURN ERROR MESSAGE.
[17822] SEQ - SET EQUIPMENT INFORMATION IN MESSAGE.
[17955] UFF - UPDATE FET FIELDS.
[17996] WCM - WRITE CONTROL POINT MESSAGE.
[18025] ERROR MESSAGES.
[18152] OVERLAYABLE SUBROUTINES.
[18154] CAD - CHECK FOR ACCESS DENIED.
[18210] CAI - CLEAR ALLOCATION AND *DAPF* INTERLOCKS.
[18249] CEI - CHECK FOR ERROR IDLE REQUIRED.
[18277] CLE - CHECK FOR LENGTH ERROR.
[18299] PDE - PROCESS *DMP=* JOB.
[18323] PRT - PROCESS PRESERVED AND RESERVED TRACKS.
[18397] CLF - COMPLETE LOCAL FILE FST.
[18420] DPP - DROP PP.
[18521] SFS - SET FET STATUS.
Source Code

          IDENT  PFM,PFM 
          PERIPH
          BASE   MIXED
          SST
 EOR$     SET    0           UNCONDITIONAL POSITIONING IN *COMPRNS*
 EQV$     SET    0           DON-T VERIFY EST ORDINAL IN SYSTEM SECTOR
 QUAL$    SET    0           DEFINE UNQUALIFIED COMMON DECKS
 MSR$     SET    0           ERROR PROCESSING RNS MASS STORAGE READS
 IRA$     SET    0           EXTERNAL PRESET OF RANDOM ADDRESSING DECKS
 SCA$     SET    0           SET NO REJECT ON *UNLOAD*
*COMMENT  PFM - PERMANENT FILE MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  PFM - PERMANENT FILE MANAGER.
          SPACE  4,10
***       PFM - PERMANENT FILE MANAGER.
*         R. A. LARSEN.      71/01/19.
*         J. L. WARDELL.     72/07/14.
*         S. L. BETH.        74/10/25.
*         S. L. KSANDER.     75/02/20.
*         W. B. CHAPIN.      79/04/27.
*         P. C. SMITH.       79/04/27.
*         M. D. LEMBCKE.     83/01/12.
*         P. C. SMITH.       83/12/07.
*         B. J. SALCEDO.     85/01/22.
          SPACE  4,15
***       *PFM* IS A PERMANENT FILE DRIVER CAPABLE OF CREATING
*         PERMANENT FILES ON ANY SYSTEM MASS STORAGE DEVICE.  FILES
*         MAY BE OF ANY LENGTH AND ARE ALLOCATED ON THE DEVICE
*         ACCORDING TO THEIR LENGTH.
*
*         *PFM* WILL PERFORM ALL THE NECESSARY TASKS TO COMPLETE THE
*         PERMANENT FILE REQUEST.  THESE TASKS ARE SEARCH, CREATE OR
*         MODIFY USERS FILE CATALOG AND TRANSFER FILE FROM MASS
*         STORAGE TO MASS STORAGE IF REQUIRED.
*
*         *PFM* MAY BE CALLED BY ANY ROUTINE THAT SETS UP THE PROPER
*         CALL BLOCK IN CENTRAL MEMORY.
 QUAL     SPACE  4,10
*         DEFINE QUAL BLOCK ORDER.
 
 
          QUAL   PRS
          QUAL   3PA
          QUAL   3PB
          QUAL   3PC
          QUAL   3PD
          QUAL   3PE
          QUAL   3PF
          QUAL   3PG
          QUAL   3PH
          QUAL   3PI
          QUAL   3PJ
          QUAL   3PK
          QUAL   3PL
          QUAL   3PM
          QUAL   3PN
          QUAL   3PO
          QUAL   3PP
          QUAL   3PQ
          QUAL   3PR
          QUAL   3PS
          QUAL   3PT
          QUAL   3PU
          QUAL
 SPFM     SPACE  4,10
          LIST   F,X
*CALL     COMSPFM
          LIST   *
          SPACE  4,10
**        ROUTINES USED.
*
*         0AV - ACCOUNT VERIFICATION.
*         0BF - BEGIN FILE.
*         0DF - DROP FILES.
*         0RF - UPDATE RESOURCE FILE.
          TITLE  MACRO DEFINITIONS.
          SPACE  4,10
**        MACROS.
 COMPARE  SPACE  4,15
**        COMPARE - COMPARE TWO 36 BIT FIELDS.
*
*         COMPARE X,Y
*
*         ENTRY  X = FIELD TO BE COMPARED WITH *PFC* ENTRY FIELD Y.
*                Y = FIELD IN *PFC* ENTRY TO BE COMPARED WITH X.
*                (CI) = *PFC* ENTRY BASE ADDRESS.
*
*         EXIT   (A) = ZERO IF FIELDS ARE IDENTICAL.
*
*         CALLS  COF.
*
*         USES   T1, T2, T3.
 
 
 COMPARE  MACRO  X,Y
          MACREF COMPARE
   LDC X
   STD T1
   LDC Y
   RJM COF
 COMPARE  ENDM
 ERROR    SPACE  4,25
**        ERROR - CALL ERROR PROCESSOR.
*
*         ERROR  MNE,CH,IW,EQ,EXC,EI
*
*         ENTRY  MNE = ERROR MESSAGE MNEMONIC.
*                CH = IF SET DO NOT RELEASE CHANNEL.
*                IW = IF SET DO NOT CLEAR CATALOG INTERLOCK
*                     (DUMMY PARAMETER).
*                EQ = IF SET, (EQ) = EST ORDINAL OF DEVICE FOR ERROR
*                                    PROCESSING.
*                     IF CLEAR, (A) = EST ORDINAL.
*                EXC = EXIT CASE FOR COMPLETION PROCESSING:
*                  0   NORMAL ERROR PROCESSING (EP CONTROLLED).
*                  1   TIME-DEPENDENT ROLLOUT (EP AND UP CONTROLLED).
*                  2   PF-STAGE ROLLOUT (UP OR RT CONTROLLED).
*                  3   UNCONDITIONAL ABORT.
*                  4   TIME-DEPENDENT RECALL (EP AND UP CONTROLLED).
*                  5   SECURITY VIOLATION ERROR PROCESSING.
*                  6   TIME-DEPENDENT ROLLOUT (RT CONTROLLED).
*                  7   ISSUE ERRLOG MESSAGE BUT DO NOT ABORT JOB.
*                EI = IF SET, SET ERROR IDLE ON DEVICE GIVEN IN *EQ*.
*
*         NOTES  IF MODIFYING THIS MACRO, CHECK ALL CALLS TO IT.
 
 
 ERROR    MACRO  MNE,CH,IW,EQ,EXC,EI
          MACREF ERROR
 .A       IFC    NE,$EQ$$
          LDD    EQ
 .A       ENDIF
 
          RJM    ERR
          VFD    3/EXC,7//ERRMSG/MNE,1/EI,1/CH
 ERROR    ENDM
 ERRMSG   SPACE  4,10
**        ERRMSG - SETUP ERROR MESSAGE CONSTANTS.
*
*NUM      ERRMSG CLASS,MSG
*
*         ENTRY  *NUM* = ERROR CODE MNEMONIC.
*                *CLASS* = ERROR TYPE FOR MESSAGE PROCESSING.
*                *MSG* = ERROR MESSAGE INCLOSED IN PARENTHESIS.
 
 
          NOREF  .LEN
 
          MACRO  ERRMSG,NUM,CLASS,MSG
          MACREF ERRMSG
          INDEX  /ERRMSG/NUM,CLASS
 ERRMT    RMT
          INDEX  /ERRMSG/NUM,(=C*MSG*)
 ERRMT    RMT
 .MSGM    MICRO  1,,*MSG*
 .LEN     MICCNT .MSGM
 .A       IFEQ   CLASS,0
          ERRNG  29D-.LEN    MESSAGE TOO LONG
 .A       ELSE
          ERRNG  38D-.LEN    MESSAGE TOO LONG
 .A       ENDIF
          ENDM
 EXIT     SPACE  4,15
**        EXIT - CALL ERROR PROCESSING FOR SPECIAL (NON-ABORT) EXIT.
*
*         EXIT   MNE,CH,IW,EQ,EXC,EI
*
*         SEE *ERROR* MACRO FOR EXPLANATION OF PARAMETERS.
 
 EXIT     MACRO  MNE,CH,IW,EQ,EXC,EI
          MACREF EXIT
 .A       IFC    NE,$EQ$$
          LDD    EQ
 .A       ENDIF
 
          RJM    ERR
          VFD    3/EXC,7//ERRMSG/MNE,1/EI,1/CH
 EXIT     ENDM
 OVERLAY  SPACE  4,10
**        OVERLAY CONTROL.
 
 
 .N       SET    0
 OVLB     MICRO  1,, 3P      BASE OVERLAY NAME
 OVERLAY  SPACE  4,10
**        OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*
*         OVERLAY (TEXT),LOAD,NQ
*         ENTRY  *TEXT* = TEXT OF SUBTITLE.
*                *LOAD* = IF DEFINED SPECIFIES ORGIN ADDRESS.
*                *NQ* IF SPECIFIED OVERLAY IS NOT QUALIFIED.
 
 
          PURGMAC OVERLAY
 
 OVERLAY  MACRO  TEXT,LOAD,NQ
          QUAL
          NOREF  .N
 .N       SET    .N+1
 .M       MICRO  .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ
 .O       MICRO  1,3, "OVLB"".M"
 .P       MICRO  2,2, ".O"
 .Q       MICRO  1,3, O".P"
          IFC    EQ,*NQ**,1
          QUAL   ".O"
          TTL    PFM/".O" - TEXT
          TITLE
          IDENT  ".O",".Q"X  TEXT
*COMMENT  PFM - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          ORG    LOAD OVLC
 ".Q"     SUBR
          MACREF OVERLAY
          ENDM
 CSR      SPACE  4,10
**        CSR - DEFINE 24 BIT QUANTITY FROM 18 BIT EQUATE.
*
*         CSR    R
*                *R* = VALUE TO BE EXPANDED TO 24 BITS.
 
 
 CSR      MACRO  R
          LOCAL  N,O,P,Q
          MACREF CSR
 N        SET    R
 O        SET    R/100B
 P        SET    O*100B
 Q        SET    R-P
          CON    O,Q*100B
          ENDM
          TITLE  COMMON DECKS.
          SPACE  4,10
*CALL     COMPMAC
*CALL     COMSACC
*CALL     COMSCPS
*CALL     COMSEVT
*CALL     COMSLFD
*CALL     COMSLSD
*CALL     COMSMMF
*CALL     COMSMLS
 MSP$     EQU    1
*CALL     COMSMSP
*CALL     COMSMST
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSPIM
*CALL     COMSREM
          QUAL   RSX
*CALL     COMSRSX
          QUAL   *
*CALL     COMSSCD
*CALL     COMSSRU
*CALL     COMSSSD
*CALL     COMSSSJ
*CALL     COMSWEI
*CALL     COMSZOL
          SPACE  4,10
          TITLE  STORAGE ASSIGNMENTS AND ASSEMBLY CONSTANTS.
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 FS       EQU    20 - 24     FST ENTRY
 UI       EQU    25 - 26     USER INDEX
 LF       EQU    27 - 30     LENGTH OF FILE
 CN       EQU    30 - 34     SCRATCH
 P0       EQU    31          TEMPORARY LOCATIONS
 P1       EQU    32
 P2       EQU    33
 P3       EQU    34
 EB       EQU    35          END BUFFER
 PI       EQU    36 - 37     PERMITTED USER INDEX
 FN       EQU    40 - 44     FILE NAME
 PB       EQU    45          POINTER TO PERMIT BUFFER
 PP       EQU    46          INDEX IN PERMIT BUFFER
 NF       EQU    45 - 46     NUMBER OF FILES IN CATALOG
 SA       EQU    45 - 46     SPACE AVAILABLE
 HL       EQU    47          LENGTH OF HOLE
 FA       EQU    57          LOCAL FNT ENTRY OFFSET
 EQ       EQU    60          PERMANENT FILE EST ORDINAL
 RI       EQU    61 - 62     PERMIT RANDOM INDEX
 CS       EQU    61 - 62     CUMULATIVE SIZE OF FILES IN CATALOG
 BB       EQU    63          BUFFER BASE ADDRESS
*         THE NEXT FIVE CELLS MUST BE CONTIGUOUS.
 HB       EQU    63          POINTER TO HOLE BUFFER
 HP       EQU    64          INDEX IN HOLE BUFFER
 CB       EQU    65          POINTER TO FILE CATALOG BUFFER
 RT       EQU    CB          *RT* BOOLEAN (1 = SET)
 CI       EQU    66          INDEX IN FILE CATALOG BUFFER
 UP       EQU    CI          *UP* BOOLEAN (1 = SET)
 EP       EQU    67          END BUFFER POINTER
*EP       EQU    EP          *EP* BOOLEAN (1 = SET)
 
 CC       EQU    IR+2        COMMAND CODE
 
****
          SPACE  4,10
*         ASSEMBLY CONSTANTS.
 
 
 BUF1     EQU    BFMS-505    CATALOG BUFFER + TRACK AND SECTOR POINTERS
 BUF2     EQU    BUF1-505    CATALOG BUFFER + TRACK AND SECTOR POINTERS
 MXRL     EQU    7           MAXIMUM TDAM RETRY COUNT
 SSLE     EQU    10          LENGTH OF SYSTEM SECTOR DATA (CM WORDS)
 UIRT     EQU    300         UTILITY INTERLOCK ROLLOUT TIME
          SPACE  4,10
*         *ERROR*/*EXIT* MACRO PARAMETER VALUES.
 
 
 EC0      EQU    0           NORMAL ERROR PROCESSING (EP CONTROLLED)
 EC1      EQU    1           TIME-DEPENDENT ROLLOUT (EP/UP CONTROLLED)
 EC2      EQU    2           PF-STAGE ROLLOUT (UP OR RT CONTROLLED)
 EC3      EQU    3           UNCONDITIONAL ABORT
 EC4      EQU    4           TIME-DEPENDENT RECALL (EP/UP CONTROLLED)
 EC5      EQU    5           SECURITY VIOLATION
 SVE      EQU    EC5         SECURITY VIOLATION
 EC6      EQU    6           TIME-DEPENDENT ROLLOUT (RT CONTROLLED)
 EC7      EQU    7           ISSUE ERRLOG MESSAGE BUT DO NOT ABORT JOB
 
 CH       EQU    1           CHANNEL NOT INTERLOCKED
 EI       EQU    1           SET ERROR IDLE
 
          TITLE  MEMORY ASSIGNMENTS.
 PFM      SPACE  4,10
**        PFM - PERMANENT FILE MANAGER RESIDENT MEMORY LOCATIONS.
 
 
          ORG    PPFW
 
 PFM      LJM    /PRS/PRS
 PFAC     EQU    *-2         ACCOUNTING WORD OF USER
          BSSZ   3
 PFSN     BSSZ   5           SYSTEM FILE NAME
 
 
*         THE NEXT 5 BYTES MUST BE CONTIGUOUS.
 
 SVAL     CON    0           SECURITY VALIDATION BITS
 PFAL     CON    0           JOB ACCESS LEVEL
 PFFC     BSSZ   3           JOB ACCESS CATEGORIES
 
 
*         THE NEXT 8 CM WORDS MUST REMAIN IN THE SAME ORDER AS THE
*         CALL BLOCK (FET).
 
 TFET     EQU    *
 PFFN     BSSZ   5           PERMANENT FILE NAME
 PFSR     EQU    PFFN+3      SPECIAL REQUESTS
 MODE     EQU    PFFN+4      MODE OF FILE PERMISSION
 PFOU     BSSZ   5           USER NAME
 CTDN     EQU    PFOU+3      DEVICE NUMBER FOR CATALOG LIST
 PRU      EQU    PFOU+3      PRUS DESIRED FOR DEFINE
 PFPW     BSSZ   3           PASSWORD
 EMRA     BSSZ   2           ERROR MESSAGE RETURN ADDRESS
 PUCW     BSSZ   5           USER CONTROL WORD
 PFPN     BSSZ   5           PF CONTROL WORD (42/ PN, 6/, 12/ FAM EQ)
*                            PN = PACK NAME.
 PFNF     BSSZ   5           NEW FILE NAME
 PFXT     EQU    PFNF+3      ACCESS EXPIRATION DATE/TERM
          BSSZ   5
 PFRS     EQU    *           PREFERRED RESIDENCE *PR*
 PFBR     EQU    *           BACKUP REQUIREMENT *BR*
 PFSS     CON    0           SUBSYSTEM *SS* (3/PR,3/BR,6/SS)
 PFAP     BSSZ   1           ALTERNATE CATLIST PERMISSION
          BSSZ   1           RESERVED
 PFRB     BSSZ   2           (6/0,18/RB)
*                            RB = SPECIAL REQUEST BLOCK POINTER
 TFETL    EQU    *-TFET      LENGTH OF FET PARAMETERS
 
 
*         THE NEXT 4 CM WORDS MUST REMAIN IN THE SAME ORDER AS THE
*         SPECIAL REQUEST BLOCK.
 
 PFSB     BSSZ   2           RESERVED
 PFID     BSSZ   3           PERMANENT FILE CATALOG ADDRESS
 PFES     BSSZ   1           ALTERNATE STORAGE ERROR STATUS
 PFAT     BSSZ   1           CARTRIDGE ALTERNATE STORAGE TYPE
 PFTS     EQU    PFAT        TAPE ALTERNATE STORAGE TAPE SEQUENCE NUMBER
 PFAA     BSSZ   3           CARTRIDGE ALTERNATE STORAGE ADDRESS
 PFTV     EQU    PFAA+1      TAPE ALTERNATE STORAGE TAPE VSN
 PFOA     BSSZ   2           OPTICAL DISK ADDRESS
 PFCD     BSSZ   3           CREATION DATE
 PFFM     BSSZ   3           FAMILY AND USER INDEX
 PFSU     BSSZ   2           USER INDEX
 
 
*         THE FOLLOWING THREE BYTES ARE USED FOR ONE PURPOSE
*         FOR DIRECT ACCESS FUNCTIONS, AND FOR A DIFFERENT PURPOSE
*         FOR INDIRECT ACCESS FUNCTIONS.
 
 FRSM     BSS    0           DEVICE ACCESS MASK FOR FILE RESIDENCY
*                            1/A,1/B,2/,8/DEVICE MASK
*                            A = SPECIAL USER INDEX PRESENT
*                            B = *LIFT* FILES ALLOWED.
 MXFS     CON    0           MAXIMUM INDIRECT FILE SIZE ALLOWED
 MXDS     BSS    0           MAXIMUM DIRECT ACCESS FILE SIZE (2 WORDS)
 MXCS     CON    0,0         MAXIMUM CUMULATIVE INDIRECT FILE
*                            ALLOWED
 MXNF     CON    0           MAXIMUM NUMBER OF FILES ALLOWED
 
 
*         THE NEXT TWO TERMS MUST BE CONTIGUOUS.
 
 ACNF     CON    0,0         ACTUAL NUMBER OF FILES
 CIFS     CON    0,0         ACTUAL CUMULATIVE INDIRECT FILE SIZE
 
 
*         DEVICE TO DEVICE TRANSFER POINTERS
*         (CATALOG SEARCH POINTERS).
 
 SDAA     CON    0           EST ORDINAL
 SDAB     CON    0           TRACK
 SDAC     CON    0           SECTOR
 
 
*         *PFM* INTERNAL STATUS BITS.
 
 STAT     CON    0           *PFM* INTERNAL STATUS BITS
 
 STXD     EQU    1           PASSWORD EXPIRATION DATE SPECIFIED
 STRX     EQU    2           RESEX INITIATED ON THIS REQUEST
 STAB     EQU    4           ABORT AFTER PERMIT CHECK (*APPEND*)
 STTA     EQU    10          TAPE ALTERNATE STORAGE REQUEST
 STPR     EQU    20          PERMITS HAVE BEEN READ
 STBR     EQU    40          *BFMS* (*END* BUFFER) HAS BEEN REUSED
 STAC     EQU    100         STATISTICAL ACCUMULATION ENABLED
 STPD     EQU    200         PRIVATE DEVICE
 STEC     EQU    400         APPEND TO END OF CHAIN
 STBD     EQU    1000        MASTER DEVICE IS BUFFERED DEVICE
 STNS     EQU    2000        NO JOB SUSPENSION WHEN DEVICE INACCESSIBLE
 STXC     EQU    4000        EXTENDING INDIRECT CHAIN
 
 STAU     CON    0           *PFM* INTERNAL STATUS BITS (PART 2)
 
 STAJ     BITSET 0           ABORT JOB
 STDP     BITSET 1           DROP PP
 STDS     BITSET 2           DROP PP WITH ERROR STATUS IN FET
 STRP     BITSET 3           RECALL *PFM*
 
 
*         *PFM* RESTART FLAGS FOR RECALL.
 
 PWRF     BSS    1           RESTART FLAGS
 
 RFAM     BITSET 0           ACCOUNTING MESSAGES ISSUED FLAG
 RFAC     BITSET 1           ACCESS COUNTS UPDATED FLAG
 RFPC     BITSET 2           PERMIT COUNTS UPDATED FLAG
 RFRR     BITSET 3           RETRY REQUEST FLAG
 
 
*         MISCELLANEOUS MEMORY LOCATIONS.
 
 ACCM     CON    0           ACTUAL ACCESS MODE (ON *GET*/*OLD*)
 AILK     CON    0           TRACK FOR ALLOCATION INTERLOCK
 AIPF     CON    0,0         ACCUMULATOR INCREMENT FOR PF ACCESS
 AIPR     CON    0,0         ACCUMULATOR INCREMENT FOR PRU COUNT
 APDK     BSSZ   5           DEFERRED DELINK REQUEST (*APPEND*)
*                            (SECOND BYTE NONZERO IF DELINK REQUESTED)
 APLF     CON    0,0         LENGTH OF APPENDAGE
 APSC     CON    0           FIRST SECTOR OF *APPEND* ORIGINAL FILE
 APTK     CON    0           FIRST TRACK OF *APPEND* ORIGINAL FILE
 CPTF     CON    0           CPU TRANSFER FLAG
 DAHP     CON    0           DIRECT ACCESS HOLE TRACK
          CON    0           DIRECT ACCESS HOLE SECTOR
          CON    0           DIRECT ACCESS HOLE OFFSET
 DAIF     CON    0           DIRECT ACCESS FILE INTERLOCK FLAG
 DTMD     CON    EPRW        DEVICE TRANSFER MODE (NONZERO = REWRITE)
 DVLW     BSSZ   5           DEVICE LAYOUT WORD
 EBSC     CON    0           END BUFFER SECTOR, IF END BUFFER IN *BFMS*
 EBTK     CON    0           END BUFFER TRACK, IF END BUFFER IN *BFMS*
 EPFA     CON    0           EST ORDINAL IF PF ACTIVITY COUNT SET
 EPOP     CON    0           ERROR OPTIONS (7/,1/SA,1/UP,1/EP,1/RT,1/IP)
 EXPC     CON    0           EXPLICIT PERMIT COUNT
 FERT     CON    0           NON-ZERO IF REAL-TIME BIT SET IN FET
 FETL     CON    TFETL/5+10B MAXIMUM POSITION OF FET PF PARAMETERS
 FNMD     CON    0           *FNT* STATUS MODE EQUIVALENCE
 FNTA     CON    0           FNT ADDRESS FOR LOCAL FILE
 FNTB     CON    0           FNT ADDRESS FOR /PFM*PFN/
 FNTC     CON    0           FNT ADDRESS FOR /PFM*ILK/
 FNTD     CON    0           FNT ADDRESS FOR /PFM*APF/
 IACP     CON    100         INCREMENT ACCESS COUNT IN PERMIT
 IAIF     CON    0           INDIRECT ALLOCATION INTERLOCK FLAG
 JORG     CON    0           JOB ORIGIN TYPE
 LFAL     CON    0           LOCAL FILE ACCESS LEVEL
 LFEF     CON    0           LOCAL FILE EMPTY FLAG
 MSTA     CON    0           ADDRESS OF MASTER DEVICE MST/10
 NPHA     CON    0           NEXT PERMIT HOLE ADDRESS (FROM *SPI*)
 PFCA     CON    0           ADDRESS OF PFC ENTRY (*SAVE*/*REPLACE*)
 PFDN     CON    0           DEVICE NUMBER OF EXISTING FILE
 PFEQ     CON    0           DIRECT ACCESS PERMANENT FILE EST ORDINAL
 PFFT     CON    0           DIRECT ACCESS PERMANENT FILE FIRST TRACK
 PFPT     CON    0077        MULTI-LEVEL PERMISSION FLAG
 PFSP     CON    0           SECURITY PROCESSING BIT
 PFUC     BSSZ   1           USER CONTROLS
 PTKT     CON    0           PRESERVED TRACK
 PWCC     CON    0           *PFM* COMMAND CODE FROM *RPFSTAT* REQUEST
 PXDT     BSSZ   2           PASSWORD EXPIRATION DATE
 RQDT     VFD    5/0,1/0,18/DFPT  REQUESTED DEVICE TYPE
*                (BIT 18 SET IF DEVICE TYPE SPECIFIED IN FET)
*                (THE ACTUAL VALUE OF *DFPT* IS READ FROM *PFNL*)
 RTKE     CON    0           RESERVED TRACK EST ORDINAL
 RTKT     CON    0           RESERVED TRACK
 SAPF     CON    20          SET ACCOUNTING PERMIT FLAG
 SSID     CON    0           SUBSYSTEM ID
 SSJS     CON    0           NONZERO IF CALLER IS *SSJ=* PROGRAM
 SSOM     CON    0           OPERATING SYSTEM SECURITY MODE
 SSYS     CON    0           NON-ZERO IF CALLER IS SUBSYSTEM
          TITLE  RESIDENT SUBROUTINES.
 SFA      SPACE  4,10
**        SFA - SET FET ADDRESS.
*
*         ENTRY  (SFAA - SFAA+1) PRESET TO FET ADDRESS BY *PRS*.
*
*         EXIT   (A) = ABSOLUTE FET ADDRESS.
 
 
 SFA      SUBR               ENTRY/EXIT
 SFAB     LDN    0
*         LDD    RA          (FET ADDRESS VALIDATED)
          SHN    6
 SFAA     ADC    0           PRESET FET ADDRESS
          UJN    SFAX        RETURN
 CCI      SPACE  4,10
**        CCI - CLEAR CATALOG INTERLOCK.
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*                (CCIA) = CATALOG TRACK.
*                (CCIB) = NONZERO IF CATALOG TRACK INTERLOCK SET.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR.
 
 
 CCI      SUBR               ENTRY
 CCIB     LDN    0           (NONZERO IF INTERLOCK SET)
          ZJN    CCIX        IF CATALOG TRACK INTERLOCK NOT SET
          LDD    EQ
          STD    CM+1
          LDC    **          (CATALOG TRACK)
 CCIA     EQU    *-1
          STD    CM+2
          LDN    CTIS        CLEAR TRACK INTERLOCK
          STD    CM+3
          MONITOR STBM
          SOM    CCIB        CLEAR *INTERLOCK SET* FLAG
          UJN    CCIX        RETURN
 CTA      SPACE  4,10
**        CTA - CALCULATE TRT ADDRESS.
*
*         ENTRY  (A) = ADDRESS OF *TRLL* IN MST.
*
*         EXIT   (A) = FWA OF TRT.
*
*         USES   CM - CM+4.
 
 
 CTA      SUBR               ENTRY/EXIT
          CRD    CM          GET FWA OF TRT
          LDD    CM+3
          LPN    77
          SHN    14
          LMD    CM+4
          UJN    CTAX        RETURN
 ERR      SPACE  4,25
**        ERR - PROCESS ERROR.
*
*         ENTRY  (A) = EST ORDINAL IF REQUIRED FOR THE ERROR.
*                (T4) = CHANNEL TO BE RELEASED.
*                ((ERR)) = VFD 3/EXC,7/MNE,1/EIF,1/CIF.
*                (EXC) = EXIT CASE.
*                (MNE) = MESSAGE MNEUMONIC ERROR CODE VALUE.
*                (EIF) = ERROR IDLE FLAG.
*                (CIF) = CHANNEL NOT INTERLOCKED FLAG.
*                (CSWD - CSWD+4) = CATALOG STATUS INTERLOCK WORD.
*                (ERRB) = 0 IF PFM CREATED FNT/FST ENTRY.
*                (ERRC) = FOLDED EVENT FOR ROLLOUT.
*                (ERRD) = ROLLOUT TIME.
*                (ERRE) = EST ORDINAL FOR EVENT.
*
*         EXIT   (P1) = (ERR+0).
*                (P2) = EST ORDINAL.
*
*         USES   P1, P2, T1.
*
*         CALLS  CCI.
*
*         MACROS ENDMS, EXECUTE.
 
 
 ERR      CON    0           ENTRY, PARAMETER ADDRESS
          STD    P2          SAVE EST ORDINAL
          LDM    ERR         SAVE PARAMETERS *EXC*, *MNE*, *ERC*
          STD    T1
          LDI    T1
          STD    P1
          LPN    1
          NJN    ERR1        IF CHANNEL NOT INTERLOCKED
          ENDMS              RELEASE CHANNEL IF RESERVED
 ERR1     RJM    CCI         CLEAR CATALOG INTERLOCK IF SET
          EXECUTE  3PT       PROCESS ERROR
 
 ERRB     CON    0           FILE PRESENT BOOLEAN
 ERRC     CON    0           FOLDED EVENT FOR ROLLOUT
*                            (TRACK FOR BAD CATALOG/PERMIT SECTOR)
 ERRD     CON    0           ROLLOUT TIME
*                            (SECTOR FOR BAD CATALOG/PERMIT SECTOR)
 ERRE     CON    0           EST ORDINAL FOR EVENT
 HNG      SPACE  4,10
**        HNG - HANG PP.
*
*         MACROS MONITOR.
 
 
 HNG      CON    0           ENTRY (RETURN ADDRESS)
 HNG1     MONITOR  HNGM      HANG
          UJN    HNG1        CONTINUE TO HANG
 PDA      SPACE  4,20
**        PDA - PROCESS DEVICE AVAILABILITY.
*
*         ENTRY  (A) = 0 IF DEVICE AVAILABLE.
*                (A) .NE. 0 IF DEVICE INACCESSIBLE.
*                (T4) = CHANNEL FOR DEVICE, IF RESERVED.
*                (T5) = EST ORDINAL OF DEVICE.
*                (FERT) = REAL-TIME PROCESSING FLAG.
*                (STAT) = *STNS* BIT SET FOR NO JOB SUSPENSION.
*                (SSYS) = SUBSYSTEM FLAG.
*                DRIVER SOFTWARE IS LOADED.
*
*         EXIT   RETURN IF PROCESSING IS TO CONTINUE.
*
*                TO *ERR* IF DEVICE IS INACCESSIBLE AND CALLER HAS
*                REAL-TIME PROCESSING SET IN FET OR IS NOT A SUBSYSTEM.
*
*         MACROS ERROR.
 
 
 PDA      SUBR               ENTRY/EXIT
          ZJN    PDAX        IF DEVICE AVAILABLE, RETURN
          LDM    STAT
          LPK    STNS
          NJN    PDAX        IF PROCESSING TO CONTINUE, RETURN
          LDM    FERT
          NJN    PDA1        IF REAL-TIME PROCESSING SELECTED
          LDM    SSYS
          NJN    PDAX        IF SUBSYSTEM, RETURN
 PDA1     ERROR  WID,,,T5,EC6  * WAITING - INACCESSIBLE DEVICE.*
 PDV      SPACE  4,20
**        PDV - PROCESS DEVICE STATUS.
*
*         ENTRY  (T4) = CHANNEL FOR DEVICE, IF RESERVED.
*                (T5) = EST ORDINAL OF DEVICE.
*                (FERT) = REAL-TIME PROCESSING FLAG.
*                (STAT) = *STNS* BIT SET FOR NO JOB SUSPENSION.
*                (SSYS) = SUBSYSTEM FLAG.
*                DRIVER SOFTWARE IS LOADED.
*
*         EXIT   RETURN IF PROCESSING IS TO CONTINUE.
*
*         CALLS  PDA.
 
 
 PDV      SUBR               ENTRY/EXIT
          LDM    MSD         GET DEVICE STATUS
          LPC    100
          RJM    PDA         PROCESS DEVICE AVAILABILITY
          UJN    PDVX        IF PROCESSING TO CONTINUE, RETURN
 PES      SPACE  4,15
**        PES - PROCESS I/O ERROR STATUS.
*
*         ENTRY  (T4) = CHANNEL FOR DEVICE.
*                (T5) = EST ORDINAL OF DEVICE.
*                (RDCT) = DRIVER STATUS.
*                A MASS STORAGE DRIVER HAS ENCOUNTERED AN I/O ERROR.
*
*         EXIT   ERROR IS UNRECOVERABLE.
*                DEVICE IS INACCESSIBLE BUT CALLER IS ALLOWED
*                TO PROCEED.
*
*         CALLS  PDA.
 
 
 PES      SUBR               ENTRY/EXIT
          LDM    RDCT        CHECK DRIVER STATUS
          SHN    21-12
          MJN    PESX        IF UNRECOVERABLE ERROR, RETURN
*         LDN    1           DEVICE INACCESSIBLE
          RJM    PDA         PROCESS DEVICE STATUS
          UJN    PESX        RETURN
 SFN      SPACE  4,10
**        SFN - SET FILE NAME.
*
*         ENTRY  (A) = ADDRESS OF FILE NAME TO BE MOVED.
*
*         EXIT   (FN - FN+3) = FILE NAME.
*                (FN+4) = FNT STATUS FIELD.
*
*         USES   FN - FN+4.
 
 
 SFN      SUBR               ENTRY/EXIT
          STM    SFNA
          LDD    MA
          CWM    *,ON
 SFNA     EQU    *-1
          SBN    1
          CRD    FN
          LDD    FN+3
          SCN    77
          STD    FN+3
 SFNB     LDN    0           SET FILE STATUS
*         LDN    ST          (FILE STATUS FIELD FOR FNT)
          STD    FN+4
          UJN    SFNX
          SPACE  4,10
*         RESIDENT COMMON DECKS.
 
 
*CALL     COMPSEI
          SPACE  4,10
 OVLA     EQU    *+5         OVERLAY LOAD ADDRESS
 SPN      SPACE  4,15
**        SPN - SET PERMANENT FILE NAME.
*
*         SETS PERMANENT FILE NAME INTO (FN - FN+4).
*
*         ENTRY  (PFFN - PFFN+4) = PERMANENT FILE NAME.
*                (PFSN - PFSN+4)= LOCAL FILE NAME.
*
*         EXIT   (FN - FN+4) = PERMANENT FILE NAME.
*
*         CALLS  SFN.
 
 
 SPN      SUBR               ENTRY/EXIT
          LDM    PFFN
          ZJN    SPN1        IF PF NAME NOT SPECIFIED
          LDN    PFFN-PFSN
 SPN1     ADC    PFSN
          RJM    SFN
          UJN    SPNX
          SPACE  4,15
 OVLD     EQU    *+5         LOCAL FILE PROCESSING LOAD ADDRESS
          TITLE  PRESET.
          QUAL   PRS
***       PFM PRESET PROCESSING INCLUDES -
*
*         VERIFICATION OF FET PARAMETERS.
*         VERIFICATION OF USER VALIDATION ALLOWANCES.
*         PLACING REQUEST IN RECALL IF CATALOG REQUIRED IS INTERLOCKED.
*         ISSUING ACCOUNTING MESSAGES.
*         LOADING OF PROPER FUNCTION PROCESSOR OVERLAY.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         FOR DESCRIPTIONS OF ERROR MESSAGES CONSULT DOCUMENTATION OF
*         ERROR PROCESSING OVERLAY (3PT).
          SPACE  4,15
***       ACCOUNT FILE MESSAGES.
*
*         ACCOUNTING MESSAGES ARE ISSUED EVEN IF OPERATION IS
*         NOT SUCCESSFUL.  I.E. FILE NOT FOUND, ETC....
*         MESSAGE IS OF FOLLOWING FORMAT.
*
*         GPFC, FILENAME, USERNAME, PACKNAME.
*
*                GPFC - G=GROUP (S=STATISTICS, A=ACCOUNTING,
*                                M=MULTI LEVEL SECURITY).
*                       P=PERMANENT FILE RELATED MESSAGE.
*                       FC=PF FUNCTION CODE MNEMONIC.
*
*         COMMA SEPARATORS WILL BE PRESENT EVEN IF DATA FIELD IS
*         EMPTY.  (E.G.  GPFC, FILENAME, ,PACKNAME.)
*
*
*         *SPAC, FILENAME, USERNAME, PACKNAME.*
*                *SETPFAC* OPERATION.
*
*         *SPAL, FILENAME, USERNAME, PACKNAME.*
*                *SETPFAL* OPERATION.
*
*         *SPAP, FILENAME, USERNAME, PACKNAME.*
*                *APPEND* OPERATION.
*
*         *SPAS, FILENAME, USERNAME, PACKNAME.*
*                *ASSIGNPF* OPERATION.
*
*         *SPCG, FILENAME, USERNAME, PACKNAME.*
*                *CHANGE* OPERATION.
*
*         *SPCT, FILENAME, USERNAME, PACKNAME.*
*                *CATLIST* OPERATION.
*
*         *SPDD, FILENAME, USERNAME, PACKNAME.*
*                *DROPDS* OPERATION.
*
*         *SPDF, FILENAME, USERNAME, PACKNAME.*
*                *DEFINE* OPERATION.
*
*         *SPDI, FILENAME, USERNAME, PACKNAME.*
*                *DROPIDS* OPERATION.
*
*         *SPDP, FILENAME, USERNAME, PACKNAME.*
*                *DELPFC* OPERATION.
*
*         *SPGT, FILENAME, USERNAME, PACKNAME.*
*                *GET* OR *OLD* OPERATION.
*
*         *SPPG, FILENAME, USERNAME, PACKNAME.*
*                *PURGE* OPERATION.
*
*         *SPPM, FILENAME, USERNAME, PACKNAME.*
*                *PERMIT* OPERATION.
*
*         *SPRP, FILENAME, USERNAME, PACKNAME.*
*                *REPLACE* OPERATION.
*
*         *SPRS, FILENAME, USERNAME, PACKNAME.*
*                *RPFSTAT* OPERATION.
*
*         *SPSA, FILENAME, USERNAME, PACKNAME.*
*                *SETASA* OPERATION.
*
*         *SPSD, FILENAME, USERNAME, PACKNAME.*
*                *SETDA* OPERATION.
*
*         *SPSF, FILENAME, USERNAME, PACKNAME.*
*                *SETAF* OPERATION.
*
*         *SPSP, FILENAME, USERNAME, PACKNAME.*
*                *STAGEPF* OPERATION.
*
*         *SPSV, FILENAME, USERNAME, PACKNAME.*
*                *SAVE* OPERATION.
*
*         *SPUA, FILENAME, USERNAME, PACKNAME.*
*                *UATTACH* OPERATION.
*
*         *SPUG, FILENAME, USERNAME, PACKNAME.*
*                *UGET* OPERATION.
*
*         *SPUR, FILENAME, USERNAME, PACKNAME.*
*                *UREPLACE* OPERATION.
*
*
*         *MFFI, FILENAME, LEVELNAME.*
*                AN INVALID ATTEMPT WAS MADE TO CHANGE THE ACCESS
*                LEVEL ON FILE FILENAME TO LEVEL LEVELNAME.
*
*         *MPNF, FILENAME, USERNAME, PACKNAME.*
*                AN UNSUCCESSFUL ATTEMPT WAS MADE TO ACCESS FILE
*                FILENAME UNDER ALTERNATE USER USERNAME ON PACK
*                PACKNAME.
*
*
*         *STRS, FILENAME, USERINDEX, FAMPACK.*
*                A REQUEST HAS BEEN SENT TO *MAGNET* TO STAGE FILE
*                FILENAME, OF USER INDEX USERINDEX ON FAMILY/PACK
*                FAMPACK, TO DISK FROM TAPE ALTERNATE STORAGE.
 PRS      SPACE  4,35
**        PRS - PRESET ROUTINE.
*         CHECK INPUT PARAMETERS.
*
*         ENTRY  (IR - IR+4) = CALL.
*                (MP - MP+4) = PARAMETER WORD FROM MESSAGE BUFFER.
*
*         EXIT   (UI - UI+1) = CALLING USER INDEX.
*                (PFUI - PFUI+1) = CALLING USER INDEX.
*                (PI - PI+1) = OPTIONAL USER INDEX.
*                (PFPI - PFPI+1) = OPTIONAL USER INDEX.
*                (SFAA - SFAA+1) = RELATIVE FET ADDRESS.
*                (PCPD) = CURRENT PACKED DATE.
*                (PFAL) = JOB ACCESS LEVEL.
*                (PFFC - PFFC+2) = JOB ACCESS CATEGORY SET.
*                (PFFN - PFFN+3) = PERMANENT FILE NAME.
*                (PFSN - PFSN+3) = SYSTEM FILE NAME.
*                (PFAC - PFAC+4) = USER NAME OF CALLING JOB.
*                (PFOU - PFOU+4) = ALTERNATE USER NAME IN CALL BLOCK.
*                (PFPW - PFPW+3) = FILE PASSWORD.
*                (PUCW - PUCW+4) = USER CONTROL WORD.
*                (PFPN - PFPN+3) = PACKNAME + FAMILY EST ORDINAL.
*                (PFUC) = USER CONTROLS.
*                (PFNF - PFNF+3) = NEW FILE NAME.
*                (PWCC) = COMMAND CODE FROM *RPFSTAT* REQUEST.
*                (PWRF) = RESTART FLAGS FOR *PFM* RECALL.
*                (PXDT - PXDT+1) = VALIDATED EXPIRATION DATE.
*                (PXDT - PXDT+1) = 0 IF NONEXPIRING PASSWORD/PERMIT.
*                (SSID) = SUBSYSTEM ID.
*                (SSOM) = OPERATING SYSTEM SECURITY MODE.
*                (SSYS) = SUBSYSTEM FLAG.
*                (SVAL) = SECURITY VALIDATION BITS.
*                ACCOUNTING MESSAGE ISSUED.
*                USER CONTROLS SET (SEE *SUC* EXIT CONDITIONS.)
 
 
 PRS      BSS    0           ENTRY
          LDD    MP          SAVE RESTART FLAGS FOR *PFM* RECALL
          STM    PWRF
          LDD    MP+2        SAVE COMMAND CODE FROM *RPFSTAT* REQUEST
          STM    PWCC
          LDD    MP+3        SET EST ORDINAL FROM *RPFSTAT* REQUEST
          STD    EQ
          LDN    ZERL        CLEAR *MS2W*
          CRD    CM
          LDD    CP
          ADK    MS2W
          CWD    CM
          LDN    0           CLEAR FST POINTER
          STD    FA
          LDD    CP          FETCH EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      READ EJT
          ADN    SCLE
          CRD    CM
          LDD    CM          SET SERVICE CLASS
          SHN    14
          RAM    SUCA
          SHN    -14         SET JOB ORIGIN TYPE
          LPN    17
          STM    JORG
          RJM    VFA         VERIFY FET ADDRESS
          MJN    PRS1        IF ADDRESS OUT OF RANGE
          RJM    SEP         SET ERROR PROCESSING OPTIONS
          LDD    CP
          ADN    STSW
          CRD    CM
          ADN    JCIW-STSW
          CRD    CN
          LDD    CN+2        SAVE SUBSYSTEM ID
          STM    SSID
          SBK    LSSI+1
          MJN    PRS0.1      IF NOT A SUBSYSTEM
          LDN    1           SET SUBSYSTEM FLAG
          STM    SSYS
 PRS0.1   LDD    CC          CHECK FUNCTION CODE
          LPN    77
          ZJN    PRS1        IF ZERO FUNCTION CODE
          STD    CC
          SBN    CCRS
          ZJN    PRS3        IF *RPFSTAT* COMMAND
          LDD    CM+1
          NJN    PRS2        IF ERROR AT CONTROL POINT
          LDD    CC
          SBN    CCLM
          MJN    PRS3        IF LEGAL COMMAND CODE
 PRS1     ERROR  PAE,CH,IW   * PFM ARGUMENT ERROR.*
 
 PRS2     EXECUTE  3PU       TERMINATE PROGRAM
 
 PRS3     RJM    VUA         VALIDATE USER ACCESS
          LDK    SSML        SAVE SYSTEM SECURITY MODE
          CRD    CM
          LDD    CM
          LPN    7
          STM    SSOM
 PRS4     RJM    PFP         PROCESS FET PARAMETERS
 
*         CHECK FOR VALID USER INDEX.
 
          LDD    CN+3        SET USER INDEX OF CALLING USER
          LPN    37
          STM    PRSJ
          STD    UI
          SHN    14
          ADD    CN+4
          STM    PRSJ+1
          STD    UI+1
          ZJN    PRS5        IF USER INDEX NOT SPECIFIED
          LMC    IFUI
          NJN    PRS6        IF NOT INDIRECT FLAW USER INDEX
 PRS5     ERROR  PFN,CH,IW   * DEVICE UNAVAILABLE.*
 
*         DETERMINE USERS PERMISSION TO CREATE PERMANENT FILES.
 
 PRS6     LDM    TCTL,CC
          SHN    21-3
          PJN    PRS8        IF COMMAND NOT CREATING INDIRECT FILES
          LDD    FN+4        COMPARE ACCESS CONTROL BITS
          SHN    21-3
          MJN    PRS9        IF USER ALLOWED TO CREATE INDIRECT FILES
 PRS7     ERROR  IUA,CH,IW   *USER ACCESS NOT VALID.*
 
 PRS8     SHN    21-2-21+3
          PJN    PRS10       IF USER NOT CREATING DIRECT FILE
          LDD    FN+4
          SHN    21-2
          PJN    PRS7        IF USER NOT ALLOWED TO CREATE DIRECT FILES
 
 PRS9     LDM    PFPN
          ZJN    PRS10       IF NOT REMOVABLE PACK REQUEST
          LDD    FN+4
          SHN    21-10
          PJN    PRS7        IF USER NOT ALLOWED TO CREATE FILES ON RP
 
*         VERIFY FILE NAMES.
 
 PRS10    LDD    CC
          LMN    CCCG        CHECK FOR CHANGE COMMAND
          NJN    PRS11       IF NOT CHANGE
          LDM    PFNF
          ZJN    PRS11       IF NEW NAME NOT SPECIFIED
          LDC    PFNF
          RJM    SFN
          RJM    VFN
          ZJN    PRS12       IF ERROR IN NAME
 
 PRS11    RJM    SFA         READ SYSTEM FILE NAME
          CRM    PFSN,ON
          LDM    PFSN+3
          SCN    77
          STM    PFSN+3
          LDC    PFSN        VERIFY SYSTEM FILE NAME
          RJM    SFN
          RJM    VFN
          NJN    PRS13       IF NAME OK
 
 PRS12    ERROR  FNE,CH,IW   *FILE NAME ERROR.*
 
 PRS13    LDM    PFFN
          ZJN    PRS14       IF NO PF NAME SPECIFIED
          LDC    PFFN        VERIFY PF NAME
          RJM    SFN
          RJM    VFN
          ZJN    PRS12       IF ERROR IN NAME
 
*         CHECK RANGE ON SPECIAL REQUEST SUBFUNCTION.
 
 PRS14    LDM    PFSR        GET SPECIAL REQUEST
          LPN    77
          SBN    SRLM
          PJN    PRS16       IF INVALID SPECIAL REQUEST VALUE
 
*         CHECK PARAMETER RANGE.
 
          LDM    PFFN+4      CHECK MODE RANGE
          STD    T0
          LPN    37
          SBN    PTLM
          MJN    PRS17       IF MODE IN RANGE
 
 PRS16    ERROR  ILR,CH,IW   *PFM INCORRECT REQUEST.*
 
 PRS17    LDD    T0          CHECK CATALOG TYPE
          SHN    -6
          LPN    37
          SBN    FCPB+1
          PJN    PRS16       IF CATALOG TYPE OUT OF RANGE
          RJM    CRX         CHECK FOR *RESEX*/*CPUPFM* ERROR STATUS
          LDD    CC
          LMN    CCRS
          NJN    PRS18       IF NOT *RPFSTAT* REQUEST
          LDM    PWCC        ORIGINAL COMMAND CODE
          ZJP    PRS7        IF *CPUPFM* HAS NOT JUST BEEN CALLED
          LDD    CM+2        ERROR REPLY
          RJM    PER         PROCESS ERROR REPLY
          RAM    PRSK        SET PARAMETER WORD FOR *ERROR* MACRO
          RJM    FIF         FIND INTERLOCK FILES
          LJM    PRS41       SKIP *RESEX* PROCESSING
 
*         DETERMINE CATALOG TO ACCESS AND SET ADDRESS.
 
 PRS18    RJM    POA         PROCESS OPTIONAL USER NAME
          MJN    PRS16       IF INCORRECT REQUEST
          LDC    PFPN        SET CATALOG ADDRESS
          RJM    GCA
          STM    MSTA        MST ADDRESS/10B
          MJN    PRS22       IF CATALOG NOT AVAILABLE
          SHN    3
          ADN    PUGL        READ MST USER NAME WORD
          CRD    FS
          ADN    STLL-PUGL   READ DEVICE STATUS WORD
          CRD    CM
          LDD    CM
          LPN    MLUNL
          ZJN    PRS19       IF UNLOAD NOT REQUESTED
          RJM    CRR         CHECK FOR CURRENT ATTACHMENT TO PACK
          ZJN    PRS22       IF FIRST ACCESS TO PACK
 PRS19    LJM    PRS25       CHECK FOR AUXILIARY DEVICE
 
*         CATALOG NOT AVAILABLE.
 
 PRS20    LDD    MA          SET PACK NAME FOR *0RF*
          CWM    PFPN,ON
          SBN    1
          CRD    FN
          LDN    0           CLEAR EST ORDINAL
          STD    EQ
          RJM    CRF         *UNLOAD* REMOVABLE PACK RESOURCE
 PRS21    ERROR  PFN,CH,IW   * PERMANENT FILES NOT AVAILABLE.*
 
 PRS22    LDM    PFPN
          ZJN    PRS21       IF NOT AUXILIARY DEVICE REQUEST
          LDM    EPOP        CHECK ERROR PROCESSING STATUS
          SHN    21-2
          PJN    PRS20       IF ERROR PROCESSING NOT SELECTED
          SHN    21-3-21+2+22  CHECK USER ERROR PROCESSING SELECTED
          MJN    PRS20       IF USER ERROR PROCESSING SELECTED
          RJM    CRX         CHECK RESEX STATUS
          NJN    PRS24       IF RESEX HAS BEEN ACTIVATED
 PRS23    LJM    RSX         ACTIVATE RESEX
 
 PRS24    LPN    /STATUS/MV  CHECK RESEX STATUS
          ZJN    PRS23       IF PACK AVAILABLE
 
          ERROR  RSE,CH,IW   * RESEX FAILURE.*
*                            NON-FATAL ERROR DETECTED WITH
*                            NO PACK AVAILABLE AND ERROR
*                            PROCESSING SET.
 
*         CATALOG AVAILABLE - DETERMINE IF REQUEST CAN BE CONTINUED.
 
 PRS25    LDM    PFPN        CHECK AUXILIARY DEVICE REQUEST
          NJN    PRS26       IF AUXILIARY DEVICE REQUEST
          LJM    PRS39       CHECK CATALOG ACCESSABILITY
 
*         PROCESS AUXILIARY DEVICE REQUEST.
*         DETERMINE IF DEVICE FOUND IS PROPER TYPE.
 
 PRS26    LDM    RQDT+1      PRESET REQUESTED DEVICE TYPE
          STM    PRSA+1
          LDM    RQDT
          LPN    77
          LMC    LMCI
          STM    PRSA
          SFA    EST,T5      READ EST
          ADK    EQDE
          CRD    T7
          LDD    T7
          SHN    21-10
          PJN    PRS27       IF NOT REMOVABLE
          LDD    T7+4        GET UNIT COUNT
          SHN    3
          ADN    DDLL
          CRD    CM+3
          LDD    CM+3
          LPN    7
          ADN    1R1
          SHN    14
          LMD    T7+3        DEVICE TYPE
          SHN    6
 PRSA     LMC    *           CHECK DEVICE TYPE
*         LMC    (RQDT)      PRESET TO REQUESTED TYPE
          NJN    PRS26.1     IF NOT PROPER TYPE
          LDD    T7
          LPN    2
          ZJN    PRS27       IF DEVICE *ON* OR *IDLE*
 PRS26.1  ERROR  IDR,CH,IW   *INCORRECT DEVICE REQUEST.*
 
*         DETERMINE IF ALTERNATE ACCESS TO PRIVATE DEVICE.
 
 PRS27    LDD    FS
          NJN    PRS28       IF PRIVATE DEVICE
          LJM    PRS36       CHECK EST OF DEVICE
 
 PRS28    LDM    PFUC        DISABLE ALL BUT INDIRECT FILE SIZE LIMITS
          LPN    7
          LMC    7770
          STM    PFUC
          LDK    STPD        SET *PRIVATE DEVICE* FLAG
          RAM    STAT
          LDM    TCTL,CC     CHECK FUNCTION TYPE
          LPN    2
          NJN    PRS29       IF NOT ALTERNATE CATALOG ACCESS
          LDM    PFOU        SET CATALOG FOR ACCESS
          ZJN    PRS29       IF NO OPTIONAL USER
          LDC    PFOU
          UJN    PRS30       SET UP OPTIONAL USER
 
 PRS29    LDC    PFAC        GET USER NAME OF CALLER
 PRS30    RJM    SFN
          LDN    3
          STD    T1
          LDD    FS+3        CLEAR LOWER CHARACTER OF USER NAME
          SCN    77
          STD    FS+3
 PRS31    LDM    FN,T1       COMPARE NEXT BYTE OF USER NAMES
          LMM    FS,T1
          NJN    PRS31.1     IF NOT CORRECT USER
          SOD    T1
          PJN    PRS31       IF MORE BYTES TO COMPARE
          UJN    PRS34       PROCESS ACCESS BY/SPECIFYING DEVICE OWNER
 
 PRS31.1  LDM    TCTL,CC     CHECK FUNCTION TYPE
          LPN    14
          ZJN    PRS32       IF NOT FILE CREATION REQUEST
          LJM    PRS21       *DEVICE UNAVAILABLE.*
 
*         ALTERNATE ACCESS TO PRIVATE DEVICE.
 
 PRS32    LDM    TCTL,CC     CHECK FUNCTION TYPE
          LPN    2
          NJN    PRS35       IF NOT ALTERNATE CATALOG ACCESS
          LDM    PFOU        CHECK USER NAME
          NJN    PRS35       IF OPTIONAL USER CALL
          LDD    MA          SET DEVICE OWNER AS OPTIONAL USER
          CWD    FS          COPY ALTERNATE USER NAME
          CRM    PFOU,ON
          RJM    POA         PROCESS OPTIONAL USER NAME
          PJN    PRS33       IF USER NAME VALID
          ERROR  ILR,CH,IW   *PFM INCORRECT REQUEST*
 
 PRS33    LDM    TCTL,CC     CHECK FUNCTION TYPE
          LPN    2
          NJN    PRS35       IF NOT ALTERNATE CATALOG ACCESS
 
*         CHECK IF RESOURCE CONTROL NEEDED.
 
 PRS34    LDC    PFPN        RESET CATALOG POINTER
          RJM    GCA         GET CATALOG ADDRESS
          STM    MSTA        MST ADDRESS/10B
          PJN    PRS36       IF CATALOG FOUND
          LJM    PRS22       TREAT AS IF CATALOG NOT FOUND
 
 PRS35    RJM    SPN         SET PERMANENT FILE NAME
          ERROR  FNF,CH,IW   * (FILENAM) NOT FOUND.*
 
 PRS36    SFA    EST,T5      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-10
          PJN    PRS39       IF NOT REMOVABLE
          RJM    CRX         CHECK RESEX RETURN STATUS
          NJN    PRS38       IF *RESEX* HAS BEEN ACTIVATED
          LDM    TCTL,CC
          SHN    21-5
          PJN    PRS39       IF NOT DA REQUEST
          RJM    CRR         CHECK IF FIRST AUXILIARY REQUEST ON DEVICE
          NJN    PRS39       IF NOT 1ST DA FILE ON THIS PACK
          RJM    CCA         CHECK FOR ERROR IDLE OR PF UTILITY ACTIVE
          LJM    RSX         ACTIVATE *RESEX*
 
 PRS37    EXIT   PFN,CH,IW   * DEVICE UNAVAILABLE.*
 
 PRS38    LPN    /STATUS/MV  CHECK RESEX STATUS
          NJN    PRS37       IF PACK NOT AVAILABLE
          LDD    CM+2
          LPN    /STATUS/OK
          NJN    PRS39       IF REQUEST COMPLETE
 
          ERROR  RSE,CH,IW   * RESEX FAILURE.*
 
*         REQUEST CAN BE PROCESSED DETERMINE IF CATALOG CAN BE ACCESSED
 
 PRS39    RJM    CCA         CHECK CATALOG ACCESSABILITY
 
*         CATALOG CAN BE ACCESSED - PROCEED WITH REQUEST.
 
          LDM    TCTL,CC     CHECK COMMAND
          SHN    21-4
          PJN    PRS40       IF USER CONTROLS NOT NEEDED
          RJM    SUC         SET USER CONTROLS
 PRS40    RJM    SRF         SET RESERVE FNT
 
*         SET UP APPROPRIATE ACCOUNTING MESSAGE.
 
 PRS41    LDM    PWRF        RESTART FLAGS
          LPK    RFAM
          NJN    PRS43       IF ACCOUNTING MESSAGES ISSUED
          LDK    RFAM        SET ACCOUNTING MESSAGES ISSUED FLAG
          RAM    PWRF
          LDD    CC
          LMN    CCPM
          ZJN    PRS42       IF PERMIT FUNCTION
          LDN    PFOU&PFAC   SPECIFY USER NAME
 PRS42    LMC    PFAC        SPECIFY REQUESTING USER NAME
          RJM    SAM         SET UP ACCOUNTING MESSAGE
 
*         ISSUE DAYFILE MESSAGE(S).
 
          LDC    PRSF+ACFN   ISSUE *S* TYPE ACCOUNT LOG MESSAGE
          RJM    DFM
          LDM    TCTL,CC     CHECK IF *A* TYPE MESSAGE NEEDED
          SHN    21-6
          PJN    PRS43       IF *A* TYPE MESSAGE NOT NEEDED
          LDC    2RAP        PRESET MESSAGE CODE
          STM    PRSF
          LDC    PRSF+ACFN   ISSUE *A* TYPE ACCOUNT LOG MESSAGE
          RJM    DFM
 
*         INCREMENT ACCOUNTING INFORMATION.
 
 PRS43    LDM    TPFI,CC     PF INCREMENT FOR REQUESTED FUNCTION
          RAM    AIPF+1
          LDM    PFPN        CHECK AUXILIARY PACK REQUEST
          ZJN    PRS44       IF NOT AUXILIARY PACK REQUEST
          LDN    IPAD        PF INCREMENT FOR AUXILIARY DEVICE
          RAM    AIPF+1
 PRS44    LDM    PFOU        CHECK FOR OPTIONAL USER
          ZJN    PRS45       IF NO OPTIONAL USER
          LDN    IPVA        PF INCREMENT FOR *VALIDUS* ACCESS
          RAM    AIPF+1
 
 PRS45    LDM    PRSJ
          STD    UI
          LDM    PRSJ+1
          STD    UI+1
          LDM    STAT        CHECK *CPUPFM*/*RESEX* STATUS
          LPK    STRX
          ZJN    PRS46       IF *CPUPFM*/*RESEX* NOT ACTIVATED
          LDN    ZERL        CLEAR SPCW STATUS
          CRD    CM
          LDD    CP
          ADC    SPCW
          CWD    CM
          LDD    CC
          LMN    CCRS
          NJN    PRS46       IF NOT *RPFSTAT* REQUEST
          LDN    CAPS        CLEAR *CPUPFM* ACTIVE STATUS
          STD    CM+1
          MONITOR  SJCM
          EXIT   NEC,CH,IW,EQ  PROCESS ERROR CODE FROM *CPUPFM*, IF ANY
 PRSK     EQU    *-1         (ERROR CODE)
 
*         PROCESS RESOURCE FILE CLEAN UP.
 
 PRS46    LDM    TCTL,CC     CHECK ACCESS TYPE
          SHN    21-5
          PJN    PRS47       IF NOT DIRECT ACCESS OPERATION
          SHN    21-7-21+5+22
          PJN    PRS47       IF NO FNT CREATED
          NFA    FNTA,R      SET EST ORDINAL IN FST
          ADK    FNTL
          CRD    CN
          ADN    FSTL-FNTL
          CRD    CM
          LDD    EQ
          STD    CM
          LDD    CN+4
          LPN    77
          LMC    PMFT*100B
          STD    CN+4
          NFA    FNTA,R
          ADK    FNTL
          CWD    CN
          ADN    FSTL-FNTL
          CWD    CM
          UJN    PRS48       PROCESS REQUEST
 
 PRS47    RJM    CRF         *UNLOAD* REMOVABLE PACK RESOURCE
 PRS48    LDN    ZERL
          CRD    FS
          LDD    CC          CHECK COMMAND CODE
          LMN    CCCT
          NJN    PRS49       IF NOT CATLIST COMMAND
          EXECUTE  3PJ       EXIT TO CATLIST PROCESSOR
 
 PRS49    LMN    CCPM&CCCT   CHECK COMMAND CODE
          ZJN    PRS51       IF *PERMIT* COMMAND
          LDM    PFOU        CHECK USER NAME
          ZJN    PRS51       IF NO USER NAME
 
*         PROCESS USER NAME.
 
          RJM    CUN         COMPARE USER NAME
          NJN    PRS50       IF NOT A MATCH
          STM    PFPT        SET MATCH OF MULTI LEVEL USER DETECTED
 PRS50    RJM    SWI         SWAP INDICES
 
*         DETERMINE CATALOG ADDRESS AND ACCESSABILITY.
 
 PRS51    LDC    PFPN        SET CATALOG ADDRESS
          RJM    GCA
          MJP    PRS21       IF DEVICE NOT FOUND
 
*         PRESERVE CATALOG ADDRESS PARAMETERS.
 
          STM    MSTA        MST ADDRESS/10B
          SHN    3
          ADK    DILL        CHECK FOR BUFFERED DEVICE
          CRD    T0
          LDD    T0+3
          SHN    21-12
          PJN    PRS52       IF NOT BUFFERED DEVICE
          LDC    STBD        SET *BUFFERED DEVICE* FLAG
          RAM    STAT
 PRS52    LDD    T5          SAVE EST ORDINAL OF MASTER DEVICE
          STD    EQ
          STM    SDAA
          LDD    T6          SAVE CATALOG TRACK
          STM    CCIA
 
*         PROCESS LOCAL FILE AS REQUIRED IN *TCTL*.
 
          LDM    TCTL,CC
          SHN    21-11
          MJN    PRS53       IF LOCAL FILE PROCESSING REQUIRED
          RJM    SPN         SET PERMANENT FILE NAME
          EXECUTE 3PC        EXIT TO COMMAND PROCESSOR
 
 PRS53    EXECUTE  3PA       EXIT TO LOCAL FILE PROCESSOR
          SPACE  4,10
 PRSB     DATA   2H,         MESSAGE SEPARATOR
          CON    0           END OF STRING
 PRSC     DATA   1L.         MESSAGE TERMINATOR
 
*         ACCOUNTING MESSAGE ASSEMBLY AREA.
 
 PRSF     DATA   6HSPXX,     MESSAGE CODE
 
*         ACCOUNTING CODES.
 
 PRSH     CON    0           (ZERO WORD REQUIRED FOR *COMPACS* CALL)
          LOC    1
 
          DATA   2HSV        SAVE
          DATA   2HGT        GET
          DATA   2HPG        PURGE
          DATA   2HCT        CATLIST
          DATA   2HPM        PERMIT
          DATA   2HRP        REPLACE
          DATA   2HAP        APPEND
          DATA   2HDF        DEFINE
          DATA   2HAT        ATTACH
          DATA   2HCG        CHANGE
          DATA   2HUA        UATTACH
          DATA   2HSA        SETASA
          DATA   2HSF        SETAF
          DATA   2HSD        SETDA
          DATA   2HDD        DROPDS
          DATA   2HAS        ASSIGNPF
          DATA   2HGT        OLD
          DATA   2HAC        SETPFAC
          DATA   2HAL        SETPFAL
          DATA   2HUG        UGET
          DATA   2HUR        UREPLACE
          DATA   2HDI        DROPIDS
          DATA   2HDP        DELPFC
          DATA   2HRS        RPFSTAT
          DATA   2HSP        STAGEPF
          LOC    *O
 
 .1       MAX    *,PRSF+20   DAYFILE MESSAGE AREA
          ORG    .1
 PRSJ     CON    0,0         USER INDEX
 TCTL     SPACE  4,30
**        TCTL - TABLE OF COMMAND CODE CONTROLS.
*
*T        1/L,1/K,1/J,1/I,1/H,1/G,1/F,1/E,1/D,1/C,1/B,1/A
*
*                A           PREVENT ALTERNATE CATALOG ACCESS.
*                B           PREVENT SET OF UI FOR ALTERNATE CATALOG
*                C           CREATE DA FILE
*                D           CREATE IDA FILE
*                E           SET USER CONTROLS
*                F           DA REQUEST
*                G           ISSUE *A* TYPE ACCOUNTING MESSAGE
*                H           FNT POTENTIALLY REQUIRED
*                I           ALLOW EXPIRATION DATE
*                J           LOCAL FILE PROCESSING REQUIRED
*                K           SPECIAL REQUEST BLOCK FUNCTIONS.
*                L           CALL WITHOUT AUTO RECALL (EP/UP REQUEST)
 
 
 TCTL     EQU    *-1         FWA OF COMMAND CODE CONTROLS
          LOC    1
 
          CON    1431        SAVE
          CON    1200        GET
          CON    2000        PURGE
          CON    0000        CATLIST
          CON    0402        PERMIT
          CON    1420        REPLACE
          CON    1020        APPEND
          CON    1665        DEFINE
          CON    1260        ATTACH
          CON    0401        CHANGE
          CON    3261        UATTACH
          CON    3000        SETASA
          CON    2000        SETAF
          CON    3060        SETDA
          CON    2001        DROPDS
          CON    3265        ASSIGNPF
          CON    1200        OLD
          CON    0001        SETPFAC
          CON    0001        SETPFAL
          CON    7201        UGET
          CON    7020        UREPLACE
          CON    2001        DROPIDS
          CON    3000        DELPFC
          CON    0000        RPFSTAT
          CON    2000        STAGEPF
 
          LOC    *O
 TPFI     SPACE  4,20
**        TPFI - TABLE OF PF INCREMENT VALUES BY FUNCTION.
 
 
 TPFI     EQU    *-1         FWA OF PF INCREMENT VALUES BY FUNCTION
          LOC    1
 
          CON    IPSV        SAVE
          CON    IPGT        GET
          CON    IPPG        PURGE
          CON    IPCT        CATLIST
          CON    IPPM        PERMIT
          CON    IPRP        REPLACE
          CON    IPAP        APPEND
          CON    IPDF        DEFINE
          CON    IPAT        ATTACH
          CON    IPCG        CHANGE
          CON    IPUA        UATTACH
          CON    IPSA        SETASA
          CON    IPAF        SETAF
          CON    IPSD        SETDA
          CON    IPDD        DROPDS
          CON    IPAN        ASSIGNPF
          CON    IPGT        OLD
          CON    IPAC        SETPFAC
          CON    IPAL        SETPFAL
          CON    IPUG        UGET
          CON    IPUR        UREPLACE
          CON    IPDI        DROPIDS
          CON    IPDP        DELPFC
          CON    IPRS        RPFSTAT
          CON    IPSP        STAGEPF
 
          LOC    *O
          TITLE  PRESET SUBROUTINES.
 CCA      SPACE  4,60
**        CCA - CHECK CATALOG ACCESSABILITY.
*
*         CHECK CATALOG TRACK INTERLOCK, PF UTILITY INTERLOCK AND
*         ERROR IDLE STATUS; INCREMENT PF ACTIVITY COUNT.  NONE OF
*         THIS IS DONE FOR *ATTACH* WITH *FA* SPECIAL REQUEST.  FOR
*         *ATTACH* WITH *MA* SPECIAL REQUEST, OR FOR ANY REQUEST FROM
*         A SUBSYSTEM WITH EP/UP SET, OR FOR ANY REQUEST FROM ANYONE
*         WITH EP/IP SET, CATALOG TRACK INTERLOCK STATUS IS NOT
*         CHECKED.  FOR *ASSIGNPF*, *CATLIST*, AND *DELPFC*, CATALOG
*         TRACK INTERLOCK STATUS AND PF UTILITY INTERLOCK STATUS ARE
*         NOT CHECKED AND PF ACTIVITY COUNT IS NOT INCREMENTED.
*         ERROR IDLE IS IGNORED FOR *UATTACH*/*UGET*, AND FOR ANY
*         REQUEST WITH THE *IE* SPECIAL REQUEST SPECIFIED.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (EPOP) = ERROR PROCESSING OPTIONS.
*                (MSTA) = MST ADDRESS/10B.
*                (PFSR) = SPECIAL REQUEST FROM *FET*.
*                (SSJS) = *SSJ=* STATUS.
*                (T5) = MASTER DEVICE EST ORDINAL.
*
*         EXIT   (EPFA) = EST ORDINAL IF PF ACTIVITY COUNT SET.
*                (EQ) = MASTER DEVICE EST ORDINAL.
*
*                TO *ERR* IF ERROR IDLE SET ON THE DEVICE.
*                TO *ERR* IF PF UTILITY ACTIVE.
*                TO *RCL* IF CATALOG TRACK INTERLOCK NOT AVAILABLE
*                (UNLESS CALLER HAS *EP* AND *IP* SET, OR UNLESS
*                 CALLER IS SUBSYSTEM, WITH *EP* AND *UP* SET).
*
*                THE FOLLOWING CELLS ARE SETUP FOR EXITS WHICH MAY
*                CAUSE THE JOB TO BE ROLLED.
*                (ERRC) = SET FOR ROLLOUT EVENT.
*                (ERRD) = SET FOR EVENT TIME.
*                (ERRE) = SET FOR EVENT TYPE.
*
*         USES   EQ, CM - CM+4.
*
*         CALLS  DTS.
*
*         MACROS MONITOR, ERROR, EXIT, SFA.
 
 
 CCA      SUBR               ENTRY/EXIT
          LDD    T5          SET EST ORDINAL
          STD    EQ
          STD    CM+1
 
*         CHECK FOR *ATTACH* WITH *FA* OR *MA* SPECIAL REQUEST.
 
          LDD    CC          CHECK COMMAND CODE
          LMN    CCAT
          NJN    CCA1        IF NOT *ATTACH* REQUEST
          LDM    PFSR        CHECK FOR SPECIAL REQUEST
          LPN    77
          LMN    SRFA
          ZJN    CCAX        IF *FA* SPECIAL REQUEST
          LMN    SRMA&SRFA
          ZJN    CCA2.1      IF *MA* SPECIAL REQUEST
 
*         CHECK CATALOG TRACK INTERLOCK AVAILABILITY.
 
 CCA1     LDD    CC          CHECK FOR *ASSIGNPF*
          LMN    CCAN
          ZJN    CCA2        IF INTERLOCK NOT NEEDED
          LMN    CCCT&CCAN   CHECK FOR *CATLIST*
          ZJN    CCA2        IF INTERLOCK NOT NEEDED
          LMN    CCDP&CCCT   CHECK FOR *DELPFC*
          ZJN    CCA2        IF INTERLOCK NOT NEEDED
          LMN    CCSP&CCDP   CHECK FOR *STAGEPF*
 CCA2     ZJP    CCA6        IF INTERLOCK NOT NEEDED
          RJM    DTS         DETERMINE TRACK INTERLOCK STATUS
          PJN    CCA3.1      IF CATALOG TRACK NOT ALREADY INTERLOCKED
 
*         PROCESS CATALOG TRACK ALREADY INTERLOCKED.  IF THE CALLER
*         HAS EP/IP SET, OR IF CALLER IS A SUBSYSTEM WITH EP/UP SET,
*         CONTINUE TO PROCESS REQUEST.  OTHERWISE, RECALL *PFM*
*         IMMEDIATELY.
 
          LDM    EPOP        CHECK ERROR PROCESSING OPTIONS
          LPN    5
          LMN    5
 CCA2.1   ZJN    CCA4        IF *EP* AND *IP* SET
          LDM    EPOP        CHECK ERROR PROCESSING OPTION
          LPN    14
          LMN    14
          NJN    CCA3        IF EITHER *EP* OR *UP* IS NOT SET
          LDM    SSID
          NJN    CCA4        IF SUBSYSTEM
 CCA3     LDK    /ERRMSG/INA * INTERLOCK NOT AVAILABLE*
          LJM    RCL         RECALL PFM
 
*         CHECK DEVICE ACCESSIBILITY.
 
 CCA3.1   NJN    CCA4        IF NOT INACCESSIBLE DEVICE
          ERROR  WID,CH,IW,T5,EC6
 
*         INCREMENT PF ACTIVITY.
 
 CCA4     LDD    T5          EST ORDINAL
          STD    CM+1
          LDN    IPAS        INCREMENT PF ACTIVITY
          STD    CM+3
          MONITOR  STBM
          LDD    CM+1
          ZJN    CCA5        IF ACTIVITY INCREMENTED
          LDM    MSTA        CHECK MST
          SHN    3
          ADK    TDGL
          CRD    CM
          LDD    CM+1
          SHN    21-6
          MJN    CCA4.1      IF PF UTILITY INTERLOCK SET
          EXIT   PEA,CH,IW,,EC4  * PFM EXCESS ACTIVITY.*
 
*         PROCESS PF UTILITY INTERLOCK SET.
 
 CCA4.1   LDN    PFUE        SET EVENT FOR ROLLOUT
          STM    ERRC
          LDC    UIRT        SET USER INTERLOCK ROLLOUT TIME
          STM    ERRD
          EXIT   PFA,CH,IW,,EC2  * PF UTILITY ACTIVE.*
 
 CCA5     LDD    T5          SET EST ORDINAL FOR PF ACTIVITY INCREMENT
          STM    EPFA
 
*         CHECK FOR ERROR IDLE.
 
 CCA6     SFA    EST,T5
          ADK    EQDE
          CRD    CM
          LDD    CC
          LMN    CCUA
          ZJN    CCA7        IF *UATTACH*, IGNORE ERROR IDLE
          LMN    CCUG&CCUA
          ZJN    CCA7        IF *UGET*, IGNORE ERROR IDLE
          LDD    CM+4        CHECK FOR ERROR IDLE
          SHN    3
          ADN    ACGL
          CRD    CM
          LDD    CM+4
          LPN    20
          NJN    CCA8        IF ERROR IDLE
 CCA7     LJM    CCAX        RETURN
 
 CCA8     LDM    SSJS
          ZJN    CCA9        IF NOT *SSJ=* JOB
          LDM    PFSR
          LPN    77
          LMN    SRIE
          ZJN    CCA7        IF *IGNORE ERROR IDLE* SPECIAL REQUEST
          LDN    VSNE/10000  SET EVENT TYPE
 CCA9     ERROR  PFN,CH,IW   * DEVICE UNAVAILABLE.*
 CRF      SPACE  4,15
**        CRF - CALL *0RF*.
*
*         ENTRY  (EQ) = REMOVABLE DEVICE EST ORDINAL.
*                     = 0, IF DEVICE UNAVAILABLE.
*                (FN - FN+4) = PACK NAME, IF DEVICE UNAVAILABLE.
*
*         EXIT   (FA) = 0.
*
*         USES   FS - FS+4.
*
*         CALLS  PES, *0RF*.
*
*         MACROS EXECUTE, NFA.
 
 
 CRF      SUBR               ENTRY/EXIT
          LDM    STAT        CHECK *RESEX* STATUS
          LPN    STRX
          ZJN    CRF2        IF *RESEX* NOT ACTIVATED
          LDK    RFCN+FSTL
          STD    FA          SET FNT POINTER
          NFA    FA,R
          ADN    FSTL        FETCH RESOURCE FILE STATUS
          CRD    FS
          LDD    FS+1        CHECK ERROR ON PREVIOUS UPDATE
          SCN    1
          NJN    CRF1        IF PROCESSING ERROR
          LDD    EQ
          STD    FS          SET EST ORDINAL
          LDN    5
          STD    FS+1        SET *0RF* OPTION
 CRF1     LDN    1
          STM    LOCF-1      SET RESOURCE UPDATE CONTROL
          EXECUTE  0RF,LOCF
          LPC    1S17        CLEAR FNT POINTER
 CRF2     STD    FA
          PJN    CRF3        IF RESOURCE FILE UPDATED
          RJM    PES         PROCESS ERROR STATUS
 CRF3     LJM    CRFX        RETURN
 CRR      SPACE  4,10
**        CRR - CHECK AUXILIARY DEVICE REQUEST.
*
*         ENTRY  (T5) = EST ORDINAL OF DEVICE TO BE ACCESSED.
*
*         EXIT   (A) = 0 IF FIRST ACCESS TO PACK.
*
*         USES   T1, T2, CM - CM+4, FN - FN+4.
 
 
 CRR3     LCN    1           INDICATE EQUIPMENT ASSIGNED
 
 CRR      SUBR               ENTRY/EXIT
 
*         SEARCH FNT FOR ANOTHER FILE ASSIGNED TO DEVICE.
 
          LDD    CP          SET NFL SIZE
          ADN    FLSW
          CRD    FN
          LDD    FN
          SHN    6
          ADN    1
          STD    T1
          LDC    FNTN        SET FIRST FNT ENTRY ADDRESS
          STD    T2
 CRR1     NFA    T2,R
          ADK    FNTL
          CRD    FN
          ADN    FSTL-FNTL
          CRD    CM
          LDD    CM          CHECK EQUIPMENT ASSIGNMENT
          LMD    T5
          NJN    CRR2        IF NO MATCH ON EST ORDINAL
          LDD    FN+4        CHECK FILE TYPE
          SHN    -6
          LMN    PMFT
          ZJN    CRR3        IF *PMFT* FILE ON CORRECT EQUIPMENT
 CRR2     LDN    LENF        ADVANCE FNT ADDRESS
          RAD    T2
          SBD    T1
          MJN    CRR1        IF NOT END OF NFL
          LDN    0
          UJN    CRRX
 CRX      SPACE  4,30
**        CRX - CHECK *CPUPFM*/*RESEX* RETURN STATUS.
*
*         ENTRY  (CP) = CP ADDRESS.
*
*         EXIT   (A) = (CM+2) = RETURN STATUS.
*T,       3/ PI,9/ RS
*                PI = PROCESSOR INDEX (0 = *RESEX*,  1 = *CPUPFM*).
*                RS = RETURN STATUS.
*                (CM - CM+4) = CP WORD *SPCW*.
*
*         *RESEX* RETURN STATUS -
*T,       3/ 0,3/ ST,2/ 0,1/ P,1/ O,1/ E,1/ C
*                ST = ERROR CODE.
*                            0 = *RESEX* FAILURE - SYSTEM ERROR.
*                            1 = INCORRECT DEVICE REQUEST.
*                            2 = UNRECOGNIZED EQUIPMENT TYPE.
*                            3 = INCORRECT USER REQUEST.
*
*                P = 0 IF PACK AVAILABLE.
*                E = 1 IF ERROR.
*                O = 1 IF ASSIGNMENT WILL OVERCOMMIT.
*                C = 1 IF OPERATION ALLOWED.
*
*                TO *ERR* IF *RESEX* ERROR STATUS DETECTED.
*
*         *CPUPFM* RETURN STATUS -
*T,       3/ 1,9/ EC
*                EC = *PFM* ERROR CODE.
*                EC = 0 IF NORMAL COMPLETION.
 
 
 CRX2     LDN    0           SET *CPUPFM*/*RESEX* NOT ACTIVATED
 
 CRX      SUBR
          LDD    CP          READ RETURN STATUS
          ADC    SPCW
          CRD    CM
          LDD    CM
          NJN    CRX2        IF *DMP=* PROGRAM IN PROGRESS
          LDD    CM+2        CHECK RETURN STATUS
          ZJN    CRX2        IF *DMP=* PROGRAM NOT ACTIVATED
          SHN    -11
          NJN    CRX1        IF NOT *RESEX*
          LDD    CM+2
          LPN    /STATUS/FE  CHECK RESEX STATUS
          ZJN    CRX1        IF NOT FATAL ERROR
          ERROR  NEM,CH,IW   ABORT WITH NO MESSAGE
 
 CRX1     LDM    STAT        SET *CPUPFM*/*RESEX* ACTIVATED STATUS
          SCN    STRX
          LMN    STRX
          STM    STAT
          LDD    CM+2        SET RETURN STATUS
          UJN    CRXX        RETURN
 CUN      SPACE  4,15
**        CUN - COMPARE USER NAMES.
*
*         ENTRY  (PFOU) = USER NAME SPECIFIED IN FET.
*                (PFAC) = USER NAME OF CALLING JOB.
*
*         EXIT   (A) = 0 IF USER NAMES MATCH.
*                (A) .NE. 0 IF USER NAMES DO NOT MATCH.
*
*         USES   T1, T2, CM - CM+4.
*
*         CALLS  SFN.
 
 
 CUN      SUBR               ENTRY/EXIT
          LDC    PFOU        SET USER NAME
          RJM    SFN
          LDD    MA          TRANSFER USER NAME
          CWM    PFAC,ON
          SBN    1
          CRD    CM
          LDD    CM+3        CLEAR LOWER CHARACTER OF USER NAME
          SCN    77
          STD    CM+3
          LDN    0           INITIALIZE COUNT
          STD    T1
 
*         COMPARE USER NAMES ALLOWING A (*) IN (CM) TO MATCH ANY
*         CORRESPONDING CHARACTER IN THE USER NAME IN (FN).
 
 CUN1     AOD    T1          TEST FOR END OF LOOP
          LMN    5
          ZJN    CUNX        IF USER NAMES MATCH
          LDM    CM-1,T1     USER NAME OF THE REQUESTOR JOB
          STD    T2
          LMC    2R**
          ZJN    CUN1        IF (**), SKIP CHARACTER COMPARE
          SCN    77
          ZJN    CUN3        IF UPPER CHARACTER = (*)
          LDD    T2          COMPARE UPPER CHARACTER
          LMM    FN-1,T1
          SCN    77
 CUN2     NJN    CUNX        IF USER NAME DOES NOT MATCH
          LDD    T2          CHECK LOWER CHARACTER FOR (*)
          LMN    1R*
          LPN    77
          ZJN    CUN1        IF LOWER CHARACTER = (*)
 CUN3     LDD    T2          COMPARE LOWER CHARACTER
          LMM    FN-1,T1
          LPN    77
          ZJN    CUN1        IF LOWER CHARACTER MATCHES
          UJN    CUN2        RETURN, USER NAMES DO NOT MATCH
 FIF      SPACE  4,10
**        FIF - FIND INTERLOCK FILES.
*
*         EXIT   (FNTB, FNTC, FNTD) = FNT ADDRESSES, IF FILES PRESENT.
*
*         CALLS  SAF, SFN.
 
 
 FIF      SUBR               ENTRY/EXIT
          LDC    FIFA        SEARCH FOR /PFM*ILK/
          RJM    SFN
          RJM    SAF
          ZJN    FIF2        IF NOT FOUND
          LDD    FA          SAVE FNT ADDRESS
          STM    FNTC
 FIF2     LDC    FIFB        SEARCH FOR /PFM*PFN/
          RJM    SFN
          RJM    SAF
          ZJN    FIF3        IF NOT FOUND
          LDD    FA          SAVE FNT ADDRESS
          STM    FNTB
 FIF3     LDC    FIFC        SEARCH FOR /PFM*APF/
          RJM    SFN
          RJM    SAF
          ZJN    FIF4        IF NOT FOUND
          LDD    FA          SAVE FNT ADDRESS
          STM    FNTD
 FIF4     UJP    FIFX        RETURN
 
 
 FIFA     VFD    60/7L"ILK"
 FIFB     VFD    60/7L"PFN"
 FIFC     VFD    60/7L"APF"
 FMS      SPACE  4,15
**        FMS - FORM MASK FOR FILE RESIDENCE CHECK.
*
*         ENTRY  (UI - UI+1) = USER INDEX.
*                (JORG) = JOB ORIGIN.
*
*         EXIT   (FRSM) = MASK FOR FILE RESIDENCE CHECK.
 
 
 FMS      SUBR               ENTRY/EXIT
          LDD    UI+1        FORM MASK FOR ACCESS CHECK
          LPN    7
          LMC    SHNI
          STM    FMSA
          LDN    1           POSITION MASK
 FMSA     PSN    0
*         SHN    N           N = SHIFT COUNT TO POSITION MASK
          STM    FRSM        SAVE MASK
          LDD    UI          CHECK FOR SPECIAL USER INDEX
          SHN    14
          LMD    UI+1
          ADC    -AUIMX
          MJN    FMS1        IF NOT SPECIAL USER INDEX
          LDC    4000        SET SPECIAL USER INDEX
          RAM    FRSM
 FMS1     LDM    JORG        CHECK JOB ORIGIN
          LMK    SYOT
          NJN    FMS2        IF NOT SYSTEM ORIGIN
          LDM    SSJS
          ZJN    FMS2        IF NOT SSJ= PROCESS
          LDC    2000        SET *LIFT* FILE ALLOWED FOR DEFINE
          RAM    FRSM
 FMS2     LJM    FMSX        RETURN
 GCA      SPACE  4,20
**        GCA - GET CATALOG ADDRESS.
*
*         ENTRY  (A) = ADDRESS OF PERMANENT FILE DEVICE DESCRIPTION.
*                (UI - UI+1) = USER INDEX.
*                (FERT) = REAL-TIME PROCESSING FLAG.
*                (SSYS) = SUBSYSTEM FLAG.
*
*         EXIT   (A) = ADDRESS OF MST/10B IF DEVICE FOUND.
*                (A) .LT. 0 IF CATALOG NOT AVAILABLE.
*                (T5) = EST ORDINAL.
*                (T6) = CATALOG TRACK.
*
*                TO *ERR* IF CATALOG NOT AVAILABLE AT THIS TIME
*                AND CALLER HAS REAL-TIME PROCESSING SET IN FET
*                OR IS NOT A SUBSYSTEM.
*
*         CALLS  SCA.
*
*         MACROS ERROR.
 
 
 GCA2     LCN    0           RETURN WITH (A) .LT. 0
 
 GCA      SUBR               ENTRY/EXIT
          RJM    SCA         SET CATALOG ADDRESS
          PJN    GCAX        IF DEVICE AVAILABLE
          ADN    1
          NJN    GCA2        IF DEVICE NOT FOUND
          LDM    FERT
          NJN    GCA1        IF REAL-TIME PROCESSING SELECTED
          LDM    SSYS
          NJN    GCA2        IF SUBSYSTEM
 GCA1     ERROR  WID,CH,IW,T5,EC6  * WAITING - INACCESSIBLE DEVICE.*
 POA      SPACE  4,25
**        POA - PROCESS OPTIONAL USER NAME.
*
*         ENTRY  (CC) = COMMAND CODE
*                (UI - UI+1) = CALLING USER INDEX.
*                (FERT) = REAL-TIME PROCESSING FLAG.
*                (RDCT) = DRIVER STATUS.
*                (SSYS) = SUBSYSTEM FLAG.
*
*         EXIT   (A) .LT. 0 IF INCORRECT REQUEST.
*                (UI - UI+1) = USER INDEX OF CATALOG TO BE ACCESSED.
*                (PI - PI+1) = USER INDEX OF OPTIONAL USER.
*                (PFUC) = USER CONTROLS.
*
*         ERROR  (STAU) = *STDP* BIT SET TO DROP PP.
*                TO *3PU* IF USER NAME NOT VALID ON *CATLIST* REQUEST
*                AND NO FILE NAME WAS SPECIFIED.
*
*                TO *ERR* IF UNRECOVERABLE ERROR ON VALIDUS FILE
*                OR DEVICE INACCESSIBLE.
*
*         USES   FN+3, FN+4, T4, T6, T7, CM - CM+4, CN - CN+4.
*
*         CALLS  CPN, SFA, SFN, SLT, SPN, *0AV*.
*
*         MACROS ERROR, EXECUTE, NFA, SFA.
 
 
 POA14    LCN    1           SET INCORRECT REQUEST
 
 POA      SUBR               ENTRY/EXIT
          LDN    0
          STD    PI          CLEAR OPTIONAL USER INDEX
          STD    PI+1
          LDD    CC
          LMN    CCPM
          ZJN    POAX        IF *PERMIT* REQUEST
          LDM    PFOU        OPTIONAL USER
 POA0     ZJN    POAX        IF NO OPTIONAL USER NAME
          LMM    PFAC        JOB USER NAME
          NJN    POA2        IF USER NAMES DO NOT MATCH
          LDM    PFOU+1
          LMM    PFAC+1
          NJN    POA2        IF USER NAMES DO NOT MATCH
          LDM    PFOU+2
          LMM    PFAC+2
          NJN    POA2        IF USER NAMES DO NOT MATCH
          LDM    PFOU+3
          LMM    PFAC+3
          SHN    -6
          NJN    POA2        IF USER NAMES DO NOT MATCH
          STM    PFOU        CLEAR OPTIONAL USER NAME
 POA1     UJN    POA0        RETURN
 
 POA2     LDM    PFRB        CHECK FOR SPECIAL REQUEST BLOCK
          LPN    37
          ADM    PFRB+1
          ZJN    POA3        IF NO SPECIAL REQUEST BLOCK
 POA2.1   LDN    0           IGNORE OPTIONAL USER NAME
          UJN    POA1        RETURN
 
 POA3     LDM    TCTL,CC     CHECK ALTERNATE CATALOG ACCESS LEGAL
          SHN    21-0
          PJN    POA3.1      IF ALTERNATE CATALOG ACCESS VALID
          SHN    21-12-21+0+22
          MJN    POA2.1      IF SRB-TYPE FUNCTION WITH NO SRB
          AOM    POAC        INDICATE NONVALID ALTERNATE CATALOG ACCESS
 POA3.1   LDM    SSJS
          ZJN    POA4        IF NOT *SSJ=*
          LDM    JORG        CHECK JOB ORIGIN
          LMK    SYOT
          ZJN    POA6        IF SYSTEM ORIGIN
 POA4     LDN    0
*         LDN    1           (ALTERNATE CATALOG ACCESS NOT VALID)
 POAC     EQU    *-1
          NJN    POA4.1      IF ALTERNATE CATALOG ACCESS NOT ALLOWED
          LDD    CC
          LMN    CCCT
          NJN    POA6        IF NOT *CATLIST* REQUEST
          LDM    PFFN+4
          ZJN    POA6        IF NOT PERMIT LIST
          LDM    PFFN
          NJN    POA5        IF FILE NAME SPECIFIED
 POA4.1   LJM    POA14       RETURN INCORRECT REQUEST STATUS
 
 POA5     LDN    2           SET TO BYPASS PRESET OF USER INDEX
          RAM    TCTL,CC
 
*         CHECK USER NAME CACHE IN NFL/CPA.
 
 POA6     LDC    PFOU        SET USER NAME
          RJM    SFN
          LDD    CP          CHECK USER NAME CACHE IN CPA
          ADK    PFCW
          CRD    CN
          NFA    PUCN
          CRD    CM
          LDN    FN
          RJM    CPN         COMPARE USER NAMES
          NJN    POA6.0      IF NO MATCH
          LDD    CM+4        SET USER INDEX
          STD    T2
          LDD    CM+3
          LPN    37
          STD    T1
          LDD    CN+2        SET VALIDATIONS
          STM    PFUC
          LJM    POA7        CONTINUE
 
*         CHECK COMMON LIBRARY TABLE IN CMR.
 
 POA6.0   SFA    EST,PFPN+4  SET FAMILY NAME
          ADK    EQDE
          CRD    CM
          LDD    CM+4        READ FAMILY NAME
          SHN    3
          ADN    PFGL
          CRD    CN
          RJM    SLT         CHECK COMMON LIBRARY TABLE
          STM    POAA        SAVE SEARCH RESULT
          ZJP    POA7        IF VALIDATION NOT REQUIRED
 
*         CALL *0AV* TO VALIDATE USER.
 
          LDN    0           SET VALIDATION FUNCTION
          STD    FN+4
          EXECUTE 0AV,LOCF   VALIDATE USER NAME
          PJN    POA6.3      IF NO ERROR
          LDM    RDCT        DRIVER STATUS
          SHN    21-12
          MJN    POA6.2      IF UNRECOVERABLE ERROR
          LDM    SSYS
          ZJN    POA6.1      IF NOT A SUBSYSTEM
          LDM    FERT
          ZJN    POA6.2      IF REAL-TIME PROCESSING NOT SELECTED
 POA6.1   ERROR  WID,CH,IW,T5,EC6  * WAITING - INACCESSIBLE DEVICE.*
 
 POA6.2   ERROR  MSE,CH,IW,T5  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
*         CHECK FOR VALID USER NAME.
 
 POA6.3   LDM    AHFC*5,T3   SAVE USER LIMIT INDICES
          STM    PFUC
 POA7     LDD    T1
          STD    PI
          RAD    FN+3
          LPN    77          SAVE ONLY USER INDEX PORTION OF BYTE
          SHN    14
          ADD    T2
          STD    PI+1
          STD    FN+4
          ZJN    POA8        IF USER NAME NOT VALID
          LMC    IFUI
          ZJN    POA8        IF INDIRECT FLAW USER INDEX SPECIFIED
          LJM    POA10       PROCESS VALID USER NAME
 
*         PROCESS NON-VALID USER NAME.
 
 POA8     LDD    CC          CHECK COMMAND CODE
          LMN    CCCT
          NJN    POA9        IF NOT *CATLIST* REQUEST
          LDM    PFFN+4
          NJN    POA10       IF PERMIT CATLIST
          LDM    PFFN
          NJN    POA9        IF FILE NAME SPECIFIED
          RJM    SFA         SET EOI STATUS TO INDICATE EMPTY CATALOG
          CRD    CM
          LDD    CM+3
          SCN    77
          STD    CM+3
          LDD    CM+4
          LPN    2
          ADC    1031
          STD    CM+4
          RJM    SFA
          CWD    CM
          LDK    STDP        SET *DROP PP* STATUS BIT
          RAM    STAU
          EXECUTE  3PU       DROP PP
 
 POA9     RJM    SPN         SET PERMANENT FILE NAME
          ERROR  FNF,CH,IW   *(FILENAME) NOT FOUND.*
 
*         PROCESS VALID USER NAME.
 
 POA10    LDM    TCTL,CC
          LPN    2
          NJN    POA11       IF NOT ALTERNATE USER ACCESS
          LDD    PI          SET CATALOG TO BE ACCESSED
          STD    UI
          LDD    PI+1
          STD    UI+1
 POA11    LDC    7776
*         LDC    7776        (NORMAL USER NAME - NOT IN CLT)
*         LDC    0           (USER NAME AND VALIDATION INFO IN CLT)
*         LDC    1           (USER NAME BUT NOT VALIDATION INFO IN CLT)
 POAA     EQU    *-1
          ZJN    POA12       IF ALL INFORMATION IN CLT
          SBN    1
          ZJN    POA13       IF VALIDATION INFORMATION NEEDED IN CLT
 
*         UPDATE USER NAME CACHE IN NFL/CPA.
 
          LDD    CP
          ADK    PFCW
          CRD    CN
          LDM    PFUC        UPDATE USER VALIDATION INFORMATION
          STM    CN+2
          LDD    CP
          ADK    PFCW
          CWD    CN
          NFA    PUCN        SAVE USER NAME AND USER INDEX
          CWD    FN
          LDN    0           SET RETURN STATUS
 POA12    LJM    POAX        RETURN
 
*         UPDATE COMMON LIBRARY TABLE ENTRY.
 
 POA13    LDD    CN+3        CLEAR DEVICE NUMBER FROM FAMILY NAME
          SCN    77
          STD    CN+3
          LDD    T5          SAVE NEW EST ORDINAL
          STD    CN+4        MERGE EST ORDINAL WITH FAMILY NAME
          STM    PFPN+4      CHANGE EST ORDINAL
          LDC    0           GET ENTRY ORDINAL
 POAB     EQU    *-1
          STD    T4
          SFA    CLT
          ADK    CLTU
          CWD    FN          WRITE USER INDEX IN TABLE
          ADN    CLTF-CLTU
          CWD    CN          WRITE FAMILY NAME AND EST ORDINAL IN TABLE
          ADN    CLTV-CLTF   SET PERMANENT FILE VALIDATION INFORMATION
          CRD    CM
          LDM    PFUC
          STD    CM+4
          SFA    CLT,T4
          ADN    CLTV
          CWD    CM
          LJM    POAX        RETURN
 RCL      SPACE  4,15
**        RCL - RECALL PFM.
*
*         ENTRY  (A) = ERROR CODE.
*                (PWRF) = RESTART FLAGS.
*
*         EXIT   (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
*                (FN - FN+4) = RECALL REQUEST FOR MONITOR.
*                (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
*                (AIPF, AIPF+1) = 0.
*                (STAU) = *STRP* BIT SET TO RECALL *PFM*.
*                TO *3PU* TO RECALL *PFM*.
*
*         USES   P1, CN - CN+4, FN - FN+4, MP - MP+4.
*
*         MACROS EXECUTE.
 
 
 RCL      BSS    0           ENTRY
          STD    P1          SAVE ERROR CODE
          LDN    0           CLEAR PF ACCUMULATOR INCREMENT
          STM    AIPF
          STM    AIPF+1
          LDN    ZERL
          CRD    FN          SET RECALL REQUEST
          CRD    MP
          LDM    PWRF        SET RESTART FLAGS FOR RECALL
          STD    MP
          LDD    P1          SET ERROR CODE
          STD    MP+1
          LDD    IA          READ INPUT REQUEST REGISTER
          CRD    CN
          LDC    PTMF        SET TIMED RECALL
          STD    FN+1
          LDC    250D        SET DELAY TO 250D MILLISECONDS
          STD    FN+4
          LDK    STRP        SET *RECALL PFM* STATUS BIT
          RAM    STAU
          EXECUTE  3PU       RECALL *PFM*
 RSX      SPACE  4,10
**        RSX - REQUEST RESOURCE VALIDATION.
*
*         CALL *RESEX* AS A *DMP=* PROGRAM.
*
*         EXIT   TO *RCL*.
*
*         USES   CM - CM+4, FN - FN+4.
*
*         MACROS ERROR, MONITOR.
 
 
 RSX      BSS    0           ENTRY
          LDD    CP          CHECK FOR *DMP=* IN PROGRESS
          ADC    SPCW
          CRD    CM
          LDD    CM+1
          SHN    -6
          ADD    CM
          ZJN    RSX1        IF NOT *DMP=* IN PROGRESS
          ERROR  ILR,CH,IW   * PFM INCORRECT REQUEST.*
 
 RSX1     LDD    MA          SET INPUT REGISTER
          CWD    IR
          CRD    FN
          LDD    FN+1
          SCN    77
          LMN    20          SET STATUS TO LEAVE RA+1 SET WITH PFM CALL
          STD    FN+1
          LDN    0           CLEAR RETURN STATUS
          STD    FN+2
          LDD    CP          WRITE CP REQUEST
          ADC    SPCW
          CWD    FN
          LDN    ROSR        REQUEST SCHEDULER ROLLOUT
          STD    CM+1
          MONITOR ROCM
*         LDN    0           (NO ERROR CODE)
          LJM    RCL         RECALL PFM
 SAM      SPACE  4,15
**        SAM - SET UP ACCOUNTING MESSAGE.
*
*         ENTRY  (A) = ADDRESS OF USER NAME.
*                (PFPN) = OPTIONAL PACK NAME.
*                (CC) = COMMAND CODE.
*
*         EXIT   (PRSF) - (PRSH+PRSHL-1) = MESSAGE AREA SET UP.
*
*         CALLS  ACS, SFN, SPN.
*
*         USES   P0, T1, FN - FN+4.
 
 
 SAM      SUBR               ENTRY/EXIT
          STD    P0          SAVE ADDRESS OF USER NAME
          LDM    PRSH,CC     SET PFM FUNCTION IN MESSAGE BUFFER
          STM    PRSF+1
          RJM    SPN         SET PERMANENT FILE NAME
          LDC    PRSH        INITIALIZE MESSAGE POINTER FOR ACS CALLS
          STD    T1
          LDN    FN          INSERT FILE NAME IN MESSAGE BUFFER
          RJM    ACS
          LDC    PRSB        APPEND COMMA SEPARATOR
          RJM    ACS
          LDI    P0          CHECK USER NAME
          ZJN    SAM1        IF NULL USER NAME
          LDD    P0          CLEAR LOWER 3 CHARACTERS OF USER NAME
          RJM    SFN
          LDN    FN          APPEND USER NAME IN MESSAGE BUFFER
          RJM    ACS
 SAM1     LDC    PRSB        APPEND COMMA SEPARATOR
          RJM    ACS
          LDM    PFPN        CHECK FOR OPTIONAL PACK NAME
          ZJN    SAM2        IF NO PACK NAME
          LDC    PFPN        CLEAR LOWER 3 CHARACTERS OF PACK NAME
          RJM    SFN
          LDN    FN          APPEND OPTIONAL PACK NAME
          RJM    ACS
 SAM2     LDC    PRSC        APPEND MESSAGE TERMINATOR
          RJM    ACS
          LJM    SAMX        RETURN
 SRF      SPACE  4,15
**        SRF - SET UP RESERVE FNT.
*
*         RESERVE AN FNT ENTRY IF STATUS *H* IS SET IN *TCTL*.
*
*         ENTRY  (CC) = COMMAND CODE.
*
*         EXIT   (FNTA) = ADDRESS OF RESERVE FNT ENTRY.
*                (PRSF) = EXIT PROCESSING STATUS.
*
*         CALLS  SFN, *0BF*.
*
*         USES   T4, CM - CM+4, FS - FS+4.
*
*         MACROS EXECUTE, EXIT.
 
 
 SRF      SUBR               ENTRY/EXIT
          LDM    TCTL,CC     CHECK FOR FNT NEEDED
          SHN    21-7
 SRF1     PJN    SRFX        IF FNT NOT NEEDED
          LDC    SRFB        SET RESERVED FNT NAME
          RJM    SFN
          LDN    NEEQ        ASSIGN NULL EQUIPMENT
          STD    FS
          LDN    5           RETURN ON NFL INCREASE, LOCAL FILE LIMIT
          STM    LOCF-1
          EXECUTE  0BF,LOCF  CREATE PFM*** FILE
          NJN    SRF2        IF FILE NOT CREATED
 
*         USE EXISTING FNT ENTRY (ADVANCE EXIT FROM *0BF*).
 
          LDD    FA          SAVE RESERVE FNT POINTER
          STM    FNTA
          LDD    FN+4        SAVE FILE STATUS
          LPN    77
          RAM    SFNB
          LDN    0           CLEAR FST POINTER
          STD    FA
          LDD    FS          CHECK FOR RESERVED SPACE
          NJN    SRF1        IF SPACE RESERVED
          EXIT   PFN,CH,IW,,EC4  * DEVICE UNAVAILABLE.*
 
 SRF2     MJN    SRF5        IF REJECT ON NFL INCREASE
          LMN    4
          NJN    SRF6        IF NOT LOCAL FILE LIMIT
          ERROR  LFL,CH,IW   * LOCAL FILE LIMIT.*
 
 SRF5     LDN    0           SET SCHEDULER ROLLOUT
          STM    ERRC
          STM    ERRD
          EXIT   WNF,CH,IW,,EC1  * WAITING FOR NFL.*
 
 SRF6     EXIT   WNF,CH,IW,,EC4  * WAITING FOR NFL.*
 
 
 SRFB     VFD    60/6LPFM***
 SUC      SPACE  4,30
**        SUC - SET USER CONTROLS.
*         IF INDIVIDUAL CONTROL NOT SET USE
*         SERVICE CLASS SPECIFIED LIMITS.
*
*         ENTRY  (PFUC) = USER CONTROL.
*T PFUC   3/ DS, 3/ FC, 3/ CS, 3/ FS
*                DS = INDEX FOR DIRECT ACCESS FILE SIZE.
*                FC = INDEX FOR NUMBER OF FILES IN CATALOG.
*                CS = INDEX FOR CUMULATIVE SIZE OF INDIRECT FILES.
*                FS = INDEX FOR INDIRECT FILE SIZE.
*                (JORG) = JOB ORIGIN.
*
*
*         EXIT   (MXFS) = MAXIMUM INDIRECT FILE SIZE/10B.
*                (IMSK) SET TO DEVICE ACCESS MASK FOR *DEFINE*.
*                (MXNF) = MAXIMUM NUMBER OF FILES/100B.
*                (MXCS - MXCS+1) = MAXIMUM CUMULATIVE SIZE FOR IAPF-S.
*                (MXDS - MXDS+1) = MAXIMUM SIZE OF DIRECT ACCESS FILE.
*
*         CALLS  FMS, RJC.
*
*         USES   FS - FS+4, T1.
 
 
 SUC      SUBR               ENTRY/EXIT
 
*         SET PERMANENT FILE CONTROLS.
 
 SUCA     LDN    0           (SERVICE CLASS SET IN *PRS*)
          LMN    DSSC
          NJN    SUC1        IF NOT DEADSTART SEQUENCING
          LDN    SSSC&DSSC   USE SUBSYSTEM SERVICE CLASS
 SUC1     LMN    DSSC        READ JOB CONTROL PARAMETERS
          RJM    RJC
          ZJN    SUCX        IF SERVICE CLASS UNDEFINED
          ADN    PFCT
          CRD    FS
 
*         SET LIMIT FOR INDIVIDUAL FILE SIZE.
 
          LDD    FS          SET SERVICE CLASS CONTROL AS DEFAULT
          LPN    7
          STD    T1
          LDM    PFUC        CHECK INDIVIDUAL *FS* VALUE
          LPN    7
          ZJN    SUC2        IF NOT INDIVIDUAL CONTROL SET
          STD    T1
 SUC2     LDM    TMFS,T1     SET CONTROL VALUE
          STM    MXFS
 
*         SET LIMIT FOR NUMBER OF FILES.
 
          LDD    FS          SET SERVICE CLASS CONTROL AS DEFAULT
          SHN    -6
          LPN    7
          STD    T1
          LDM    PFUC        CHECK INDIVIDUAL *FC* VALUE
          SHN    -6
          LPN    7
          ZJN    SUC3        IF NO INDIVIDUAL CONTROL SET
          STD    T1
 SUC3     LDM    TMNF,T1     SET CONTROL VALUE
          STM    MXNF
 
*         SET LIMIT FOR CUMULATIVE SIZE OF INDIRECT ACCESS FILES.
 
          LDD    FS          SET SERVICE CLASS CONTROL AS DEFAULT
          SHN    -3
          LPN    7
          SHN    1
          STD    T1
          LDM    PFUC        CHECK INDIVIDUAL *CS* VALUE
          SHN    -3
          LPN    7
          ZJN    SUC4        IF NO INDIVIDUAL CONTROL SET
          SHN    1
          STD    T1
 SUC4     LDM    TMCS,T1     SET CONTROL VALUE
          STM    MXCS
          LDM    TMCS+1,T1
          STM    MXCS+1
 
*         SET DIRECT ACCESS FILE SIZE CONTROLS.
 
          LDM    TCTL,CC
          SHN    21-5
          PJN    SUC6        IF NOT DIRECT ACCESS REQUEST
          RJM    FMS         FORM MASK FOR FILE RESIDENCE CHECK
          LDD    FS          SET SERVICE CLASS CONTROL AS DEFAULT
          SHN    -11
          LPN    7
          SHN    1
          STD    T1
          LDM    PFUC        CHECK INDIVIDUAL *DS* VALUE
          SHN    -11
          LPN    7
          ZJN    SUC5        IF NO INDIVIDUAL CONTROL SET
          SHN    1
          STD    T1
 SUC5     LDM    TMDS,T1     SET INDIVIDUAL CONTROL
          STM    MXDS
          LDM    TMDS+1,T1
          STM    MXDS+1
 SUC6     LJM    SUCX        EXIT
 SWI      SPACE  4,15
**        SWI - SWAP USER INDICES.
*
*         ENTRY  (UI - UI+1) = USER INDEX.
*                (PI - PI+1) = PERMIT INDEX.
*
*         EXIT   (UI - UI+1) = PERMIT INDEX.
*                (PI - PI+1) = USER INDEX.
 
 
 SWI      SUBR               ENTRY/EXIT
          LDD    UI          SWAP USER AND PERMIT INDICES
          STD    T1
          LDD    PI
          STD    UI
          LDD    T1
          STD    PI
          LDD    UI+1
          STD    T1
          LDD    PI+1
          STD    UI+1
          LDD    T1
          STD    PI+1
          UJN    SWIX        RETURN
 TMFS     SPACE  4,15
**        TABLE OF INDIVIDUAL FILE SIZE LIMITS.
 
 
 TMFS     BSS    0
          LOC    0
          CON    0
          CON    FSRNG1
          CON    FSRNG2
          CON    FSRNG3
          CON    FSRNG4
          CON    FSRNG5
          CON    FSRNG6
          CON    FSRNG7
          LOC    *O
 TMNF     SPACE  4,15
**        TABLE OF NUMBER OF FILE LIMITS.
 
 
 TMNF     BSS    0
          LOC    0
          CON    0
          CON    NFRNG1
          CON    NFRNG2
          CON    NFRNG3
          CON    NFRNG4
          CON    NFRNG5
          CON    NFRNG6
          CON    NFRNG7
          LOC    *O
 TMCS     SPACE  4,15
**        TABLE OF CUMULATIVE FILE SIZE LIMITS.
 
 
 TMCS     BSS    0
          LOC    0
          CON    0,0
          CSR    CSRNG1
          CSR    CSRNG2
          CSR    CSRNG3
          CSR    CSRNG4
          CSR    CSRNG5
          CSR    CSRNG6
          CSR    CSRNG7
          LOC    *O
 TMDS     SPACE  4,15
**        TABLE OF DIRECT ACCESS FILE SIZE LIMITS.
 
 
 TMDS     BSS    0
          LOC    0
          CON    0,0
          CSR    DSRNG1
          CSR    DSRNG2
          CSR    DSRNG3
          CSR    DSRNG4
          CSR    DSRNG5
          CSR    DSRNG6
          CSR    DSRNG7
          LOC    *O
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPACS
 DTS$     EQU    0           CHECK FOR INACCESSIBLE DEVICE
*CALL     COMPDTS
 CLT$     EQU    0           DEFINE *COMPGFP* ACCESS TO CLT
 EJT$     EQU    0           DEFINE *COMPGFP* ACCESS TO EJT
*CALL     COMPGFP
*CALL     COMPRJC
*CALL     COMPSAF
*CALL     COMPSCA
          SPACE  4,10
 LOCF     EQU    *+5         OVERLAY ADDRESS FOR ZERO-LEVEL OVERLAYS
 
          ERRNG  EPFW-LOCF-ZAVL  CHECK LENGTH OF *0AV*
          ERRNG  EPFW-LOCF-ZBFL  CHECK LENGTH OF *0BF*
          ERRNG  BFMS-LOCF-ZRFL  CHECK LENGTH OF *0RF*
 
 
*         THE FOLLOWING CODE MAY BE OVERLAID BY ZERO-LEVEL OVERLAYS.
          TITLE  OVERLAYABLE PRESET SUBROUTINES.
 CPN      SPACE  4,10
**        CPN - COMPARE NAMES.
*
*         ENTRY  (CM - CM+3) = NAME FROM COMMON LIBRARIES TABLE.
*                (A) = ADDRESS OF SECOND NAME.
*
*         EXIT   (A) = 0 IF MATCH.
*
*         USES   T7.
 
 
 CPN      SUBR               ENTRY/EXIT
          STD    T7          SAVE ADDRESS
          LDI    T7
          LMD    CM
          NJN    CPNX        IF NO MATCH
          LDM    1,T7
          LMD    CM+1
          NJN    CPNX        IF NO MATCH
          LDM    2,T7
          LMD    CM+2
          NJN    CPNX        IF NO MATCH
          LDM    3,T7
          LMD    CM+3
          SCN    77
          UJN    CPNX        RETURN
 PER      SPACE  4,15
**        PER - PROCESS ERROR REPLY FROM *CPUPFM*.
*
*         ENTRY  (A) = ERROR REPLY FROM *CPUPFM*.
*                (CM - CM+4) = CP WORD *SPCW*.
*                (PWRF) = *PFM* RESTART FLAGS.
*
*         EXIT   (A) = PARAMETER WORD FOR *ERROR* MACRO.
*                (P1) = ERROR CODE.
*                (PWRF) = *RFRR* BIT SET IF REQUEST TO BE RETRIED.
*                TO *3PS* TO REDO *DMP=* CALL IF *CPUPFM* DID NOT
*                COMPLETE.
*
*         USES   T0.
*
*         MACROS EXECUTE.
 
 
 PER      SUBR               ENTRY/EXIT
          STD    T0
          SHN    21-11
          PJN    PER3        IF *CPUPFM* DID NOT COMPLETE
          LDD    T0
          LPC    177
          STD    P1          ERROR CODE
          ZJN    PERX        IF NO ERROR
          LMK    /ERRMSG/RTR
          NJN    PER2        IF NOT *RETRY REQUEST*
          LDM    PWRF        RESTART FLAGS
          LPK    RFRR
          NJN    PER1        IF REQUEST ALREADY RETRIED
          LDK    RFRR        SET *RETRY REQUEST* FLAG
          RAM    PWRF
          UJN    PER2        FORM PARAMETER WORD FOR *ERROR* MACRO
 
 PER1     LDK    /ERRMSG/MSE SET ERROR CODE TO *MASS STORAGE ERROR*
          STD    P1
 PER2     LDD    T0          FORM PARAMETER WORD FOR *ERROR* MACRO
          SHN    1-10
          LPN    2           ERROR IDLE FLAG
          STD    T0
          LDD    P1
          SHN    2           ERROR CODE
          ADD    T0
          UJN    PERX        RETURN
 
*         REDO *DMP=* CALL.
 
 PER3     LDD    CM
          EXECUTE  3PS       REDO *DMP=* CALL
 PFP      SPACE  4,20
**        PFP - PROCESS FET PARAMETERS.
*
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS.
*
*         EXIT   (CN - CN+4) = USER NAME/USER INDEX.
*                (FN - FN+4) = ACCESS WORD (*AACW*).
*                (FERT) = REAL-TIME PROCESSING FLAG.
*                (PFUC) = USER CONTROLS.
*                (FETL) = LENGTH OF PF PARAMETERS IN FET.
*                (PRSA - PRSA+1) = AUXILIARY DEVICE TYPE REQUESTED.
*                (RQDT - RQDT+1) = REQUESTED DEVICE TYPE.
*                PARAMETERS FROM FET SET IN PFM PARAMETER BLOCK AREA.
*
*         USES   T1, CM - CM+4, CN - CN+4, FN - FN+4.
*
*         CALLS  CRS, PSR, PXT, SAP, SFA, VRP.
*
*         MACROS ERROR.
 
 
 PFP      SUBR               ENTRY/EXIT
          RJM    SFA         READ FET+1
          ADN    1
          CRD    CM
          LDD    CM          SET DEVICE TYPE FOR AUX PACK PROCESSING
          STM    PFPB
          LDD    CM+1        SAVE RT STATUS
          SHN    0-7
          LPN    1
          STM    FERT
          LDD    CM+1        SAVE SECURITY PROCESSING BIT
          LPN    10
          STM    PFSP
          LDD    CM+3
          SHN    -6
          ADN    5           COMPUTE FULL LENGTH
          STD    T1
 
*         CHECK RECALL STATUS.
 
          LDM    TCTL,CC
          SHN    21-13
          MJN    PFP1.1      IF REQUEST MAY BE MADE WITHOUT AUTO-RECALL
          RJM    CRS         CHECK RECALL STATUS
          NJN    PFP2        IF CALLED WITH AUTO RECALL
 PFP1     ERROR  PAE,CH,IW   * PFM ARGUMENT ERROR.*
 
 PFP1.1   LDD    CM+1        CHECK ERROR PROCESSING OPTIONS
          SHN    0-10
          LPN    3
          LMN    3
          NJN    PFP1        IF EITHER *EP* OR *UP* NOT SPECIFIED
 
*         SET FET PARAMETERS.
 
 PFP2     LDD    CC
          LMN    CCCT
          NJN    PFP2.1      IF NOT *CATLIST* COMMAND
          LDD    T1
          SBN    CFCN+1
          MJN    PFP1        IF FET NOT LONG ENOUGH
 PFP2.1   LDD    T1          DETERMINE IF FET WILL FIT IN BUFFER AREA
          SBM    FETL
          PJN    PFP3        IF FET LONGER THAN PF PARAMETERS
          RAM    FETL        SET FET LENGTH
 
 PFP3     LDM    FETL        READ FET PARAMETERS
          SBN    CFPN
          STD    T1
          MJN    PFP4        IF NONE TO READ
          ZJN    PFP4        IF NONE TO READ
          RJM    SFA
          ADN    CFPN
          CRM    PFFN,T1
          LDM    EMRA        CHECK ERROR MESSAGE RETURN ADDRESS
          LPN    37
          SHN    14
          ADM    EMRA+1
          ADN    3           CHECK ADDRESS
          SHN    -6
          SBD    FL
          MJN    PFP4        IF ADDRESS IN RANGE
          LDN    0           CLEAR ERROR MESSAGE RETURN ADDRESS
          STM    EMRA
          STM    EMRA+1
          LJM    PFP1        ISSUE ERROR MESSAGE
 
 PFP4     RJM    SAP         SAVE ACCESS PARAMETERS
          RJM    PXT         PROCESS EXPIRATION TERM
          LDD    CP          READ USER CONTROL FROM CONTROL POINT
          ADN    PFCW
          CRD    FS
          ADN    UIDW-PFCW   READ USER INDEX
          CRD    CN
          CRM    PFAC,ON     READ USER NAME
          ADN    AACW-UIDW-1
          CRD    FN          READ USER VALIDATIONS
          LDM    SSJS
          ZJN    PFP4.1      IF NOT *SSJ=*
          LDD    CN+3        CHECK USER INDEX
          LPN    37
          SHN    14
          LMD    CN+4
          LMC    SYUI
          NJN    PFP4.1      IF NOT *SYSTEMX*
          LCN    0           SET UNLIMITED VALIDATIONS
          STD    FS+4
 PFP4.1   LDD    FS+4        SAVE PF USER CONTROL VALIDATIONS
          STM    PFUC
          RJM    PSR         PROCESS SPECIAL REQUEST BLOCK
          NJN    PFP5        IF NOT SPECIAL REQUEST
          LJM    PFPX        RETURN
 
*         DETERMINE AUXILIARY PACKNAME AND DEVICE TYPE.
 
 PFP5     RJM    VRP         VERIFY PARAMETERS
          LDK    PFNL        PRESET SYSTEM DEFAULT PACK TYPE
          CRD    CM
          LDD    CM+1
          SCN    77
          SHN    6
          LMD    CM
          SHN    6
          STM    RQDT+1
          SHN    -14
          STM    RQDT
          LDM    PFPN+4      SAVE UNIT COUNT
          STM    PFPA
          LDD    IA          READ INPUT REGISTER
          CRD    CM
          LDD    CM+2
          SCN    77
          NJN    PFP6        IF *IP* OR *DF* SPECIFIED
          LDM    PFPN
          ZJN    PFP8        IF PACKNAME NOT SPECIFIED IN FET
          LMC    1R0*100
          NJP    PFP9        IF NOT *PN.EQ.0*
 
*         CLEAR PACKNAME.
 
 PFP6     LDN    0           CLEAR PACKNAME
          STM    PFPN
          LDD    CM+2
          SHN    21-11
          PJN    PFP7        IF NOT *DF* (FORCE SYSTEM DEFAULT FAMILY)
          LDM    SSJS
          ZJP    PFP1        IF NOT *SSJ=* PROGRAM
          LDC    PFNL
          CRD    FS
 PFP7     UJN    PFP9.1      SET FAMILY EQUIPMENT
 
*         NO PACKNAME IN FET - SET PACKNAME AND DEVICE TYPE FROM CPA.
 
 PFP8     LDD    CP          SET PACKNAME AND DEVICE TYPE FROM CPA
          ADC    PKNW
          CRM    PFPN,ON
          LDM    PFPN+4
          ZJN    PFP9        IF DEVICE TYPE NOT SPECIFIED IN CPA
          STM    RQDT+1      SET DEVICE TYPE
          LDM    PFPN+3
          LPN    37
          UJN    PFP10.1     SET USER REQUESTED AND FAMILY EQUIPMENT
 
*         SET DEVICE TYPE FROM FET.
 
 PFP9     LDN    CFPK        CHECK FET LENGTH
          SBM    FETL
 PFP9.1   PJN    PFP11       IF FET TOO SHORT FOR UNIT COUNT
          LDC    *
 PFPA     EQU    *-1         (UNIT COUNT SPECIFIED IN FET)
          NJN    PFP10       IF UNIT COUNT SPECIFIED
          LDN    1           SET DEFAULT COUNT
 PFP10    ADN    1R0         CONVERT TO DISPLAY CODE
          STD    T1
          LDC    *
 PFPB     EQU    *-1         (DEVICE TYPE SPECIFIED IN FET)
          ZJN    PFP11       IF NO DEVICE TYPE SPECIFIED
          LPC    3777        SET REQUESTED DEVICE TYPE
          SHN    6
          LMD    T1
          STM    RQDT+1
          SHN    -14
 PFP10.1  LMD    HN          SET *USER REQUESTED DEVICE* FLAG
          STM    RQDT
 
*         SET FAMILY EQUIPMENT.
 
 PFP11    LDD    FS+3
          STM    PFPN+4
          LJM    PFPX        RETURN
 PSR      SPACE  4,15
**        PSR - PROCESS SPECIAL REQUEST BLOCK.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (FS - FS+4) = (PFCW) FROM CONTROL POINT AREA.
*                (PFRB - PFRB+1) = SPECIAL REQUEST BLOCK ADDRESS.
*                (SSJS) .NE. 0 IF CALLED BY *SSJ=* PROGRAM.
*
*         EXIT   (A) = 0 IF SPECIAL REQUEST.
*                (CN+3 - CN+4) = USER INDEX.
*                (PFPN - PFPN+4) = 42/ NAME, 6/, 12/ FAMILY EQ.
*                (PFUC) = USER CONTROLS.
*                (PFSB - PFFN) = SPECIAL REQUEST BLOCK SETUP.
*                *STTA* SET IN *STAT* IF TAPE ALTERNATE STORAGE REQUEST.
*
*         USES   T5, T6, CM - CM+4, CN - CN+4, T0 - T0+4, T7 - T7+4.
*
*         CALLS  VCA.
*
*         MACROS ERROR, SFA.
 
 
 PSR12    LDN    1           INDICATE NO SRB
 
 PSR      SUBR               ENTRY/EXIT
          LDM    TCTL,CC
          SHN    21-12
 PSR1     PJN    PSR12       IF NO SPECIAL REQUEST BLOCK ALLOWED
 
*         READ SPECIAL REQUEST BLOCK (SRB).
 
 PSR2     LDM    PFRB        CHECK LOCATION OF SPECIAL REQUEST BLOCK
          LPN    37
          SHN    14
          ADM    PFRB+1
          NJN    PSR3        IF ADDRESS SPECIFIED
 
*         NO SRB SPECIFIED ON FUNCTION WHICH ALLOWS SRB.  FOR *DROPDS*,
*         *DROPIDS* AND *PURGE* - ALLOW EVEN WITH NO *SSJ=*.
*         FOR *ASSIGNPF*, *UATTACH* AND *UGET* - ALLOW WITH *SSJ=*.
*         FOR ALL OTHER SRB-TYPE FUNCTIONS - DO NOT ALLOW.
 
          LDD    CC
          LMN    CCPG
          ZJN    PSR1        IF *PURGE*
          LMN    CCDD&CCPG
          ZJN    PSR1        IF *DROPDS*
          LMN    CCDI&CCDD
          ZJN    PSR1        IF *DROPIDS*
          LMN    CCUA&CCDI
          ZJN    PSR2.1      IF *UATTACH*
          LMN    CCUG&CCUA
          ZJN    PSR2.1      IF *UGET*
          LMN    CCAN&CCUG
          NJN    PSR4        IF NOT *ASSIGNPF*
 PSR2.1   LDM    SSJS
          NJN    PSR1        IF *SSJ=*
 PSR2.2   ERROR  ILR,CH,IW   * PFM INCORRECT REQUEST.*
 
 PSR3     ADN    SFBL-1
          SHN    -6
          SBD    FL
          MJN    PSR5        IF IN RANGE OF FIELD LENGTH
 PSR4     ERROR  PAE,CH,IW   * PFM ARGUMENT ERROR.*
 
 PSR5     LDM    SSJS        ALWAYS REQUIRE *SSJ=* IF SRB SPECIFIED
          ZJN    PSR2.2      IF NOT *SSJ=*
          LDN    SFBL        READ SPECIAL REQUEST BLOCK
          STD    T1
          LDM    PFRB
          LPN    37
          SHN    6
          ADD    RA
          SHN    6
          ADM    PFRB+1
          CRM    PFSB,T1
          LDM    PFSB+5+1
          SHN    21-6
          PJN    PSR5.1      IF NOT TAPE ALTERNATE STORAGE REQUEST
          LDN    STTA        SET TAPE FLAG
          RAM    STAT
 PSR5.1   LDN    ZERL        INITIALIZE FOR USER INDEX
          CRD    CN
          LDM    PFSU        SET USER INDEX
          LPN    77
          STD    CN+3
          LDM    PFSU+1
          STD    CN+4
 
*         FIND THE FAMILY EST ORDINAL BASED ON THE FAMILY NAME AND
*         DEVICE NUMBER.
 
          LDN    ESTP        READ EST SEARCH POINTERS
          CRD    T0
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    T5
          LDD    T0+3        SAVE LAST MASS STORAGE ORDINAL + 1
          STD    T6
 PSR6     AOD    T5          ADVANCE EST ORDINAL
          LMD    T6
          NJN    PSR7        IF NOT END OF MASS STORAGE DEVICES
          ERROR  IPA,CH,IW   * INCORRECT PFC ADDRESS.*
 
 PSR7     SFA    EST,T5
          ADK    EQDE
          CRD    CM
          LDD    CM          CHECK FOR MASS STORAGE DEVICE
          SHN    -6
          LPN    41
          LMN    40
          NJN    PSR6        IF UNAVAILABLE OR NON-MS DEVICE
          LDD    CM+3        SAVE DEVICE TYPE
          STM    PSRB
          LDD    CM+4        READ MST
          STM    PSRA        SAVE MST ADDRESS
          SHN    3
          ADN    STLL
          CRD    T0
          LDD    T0
          LPC    MLFPR+MLIAL+MLIHD+MLIFD+MLIPF+MLUNL+MLDUL
 PSR7.1   NJN    PSR6        IF INITIALIZE PENDING OR UNLOADED
          LDM    PSRA
          SHN    3
          ADN    PFGL
          CRD    T0
          LDM    PFFM        COMPARE FAMILY NAME
          LMD    T0
 PSR8     NJN    PSR7.1      IF FAMILY NAME DOES NOT MATCH
          LDM    PFFM+1
          LMD    T0+1
          NJN    PSR8        IF FAMILY NAME DOES NOT MATCH
          LDM    PFFM+2
          LMD    T0+2
          NJN    PSR8        IF FAMILY NAME DOES NOT MATCH
          LDM    PFFM+3
          LMD    T0+3
          SCN    77
          NJN    PSR8        IF FAMILY NAME DOES NOT MATCH
          LDD    CC          CHECK COMMAND CODE
          LMN    CCAN
          ZJN    PSR9        IF *ASSIGNPF* COMMAND
          LDM    PFID        COMPARE DEVICE NUMBER
          LMD    T0+3
          LPN    77
          NJN    PSR8        IF DEVICE NUMBER DOES NOT MATCH
 
*         THE EST ORDINAL HAS BEEN IDENTIFIED.
 
          RJM    VCA         VERIFY THE CATALOG ADDRESS *PFID*
 PSR9     LDD    FS+4        SET USER CONTROL BIT
          STM    PFUC
          LDM    PFPN        CHECK FET FIELDS
          ADM    PFOU
          NJP    PSR4        IF *PN* OR *UN* SPECIFIED
          LDC    *           CHECK IF DEVICE IS AUXILIARY PACK
 PSRA     EQU    *-1         (MST ADDRESS/10)
          SHN    3
          ADN    MDGL
          CRD    T0
          ADN    DDLL-MDGL
          CRD    T7
          LDD    T0+0
          SHN    21-12
          MJN    PSR10       IF AUXILIARY PACK
          LDD    T5          SET EST ORDINAL OF SPECIFIED DEVICE
          UJN    PSR11       SET FAMILY EST ORDINAL
 
 PSR10    LDD    MA          SET PACKNAME INTO *PFPN*
          CWM    PFFM,ON
          SBN    1
          CRM    PFPN,ON
          LDD    T7+0        GET UNIT COUNT
          LPN    7
          ADN    1R1
          SHN    14
          LMC    *
 PSRB     EQU    *-1         (DEVICE TYPE)
          SHN    6
          STM    RQDT+1      SET REQUESTED DEVICE TYPE
          SHN    -14
          STM    RQDT
          LDD    FS+3        SET FAMILY EST ORDINAL FROM CPA
 PSR11    STM    PFPN+4      SET FAMILY EST ORDINAL
          LDN    0           INDICATE SPECIAL REQUEST BLOCK PRESENT
          LJM    PSRX        RETURN
 PXT      SPACE  4,20
**        PXT -  PROCESS EXPIRATION TERM.
*
*         CONVERT EXPIRATION TERM INTO PACKED DATE, AND CHECK AGAINST
*         MAXIMUM ALLOWED BY SYSTEM.
*
*         ENTRY  (PFXT - PFXT+1) = USER SPECIFIED EXPIRATION DATE/TERM.
*                (CC) = COMMAND CODE.
*                (SVAL) = SECURITY VALIDATION BITS.
*
*         EXIT   (PXDT - PXDT+1) = VALIDATED EXPIRATION DATE.
*                (PXDT - PXDT+1) = 0 IF NONEXPIRING PASSWORD/PERMIT.
*
*         USES   T1, T2, CM - CM+4, CN - CN+4.
*
*         MACROS ERROR, MONITOR.
 
 
 PXT      SUBR               ENTRY/EXIT
          LDM    TCTL,CC
          SHN    21-10
          PJN    PXTX        IF COMMAND DOES NOT ALLOW *XT*
          LDN    ZERL
          CRD    CM
          LDN    RIDS        SET UP *RDCM* PARAMETERS
          STD    CM+1
          LDM    PFXT        CHECK *XD/XT*
          LPN    77
          STD    T1
          SHN    14
          LMM    PFXT+1
          STD    T2
          NJN    PXT1        IF *XD/XT* SPECIFIED
          LDK    FPXT        USE SYSTEM DEFAULT *XT*
          STD    T2
          LJM    PXT8        SET DEFAULT *XT*
 
 PXT1     LDN    STXD        INDICATE THAT DATE WAS SPECIFIED
          RAM    STAT
          LDM    SVAL        CHECK PASSWORD EXPIRATION VALIDATION
          SHN    21-10
          MJN    PXT2        IF USER VALIDATED TO SET EXPIRATION DATE
          ERROR  NVX,CH,IW   *NOT VALIDATED TO SET XD/XT.*
 
 PXT2     LDD    T1
          ZJP    PXT7        IF *XT* SPECIFIED RATHER THAN *XD*
 
*         VALIDATE SPECIFIED EXPIRATION DATE.
 
 PXT3     LDK    FPXL        READ MAXIMUM *XT* ALLOWED
          LMC    7777
          ZJN    PXT4        IF MAXIMUM IS UNLIMITED
          LDK    FPXL        CONVERT MAXIMUM *XT* TO *XD*
          STD    CM+4
          MONITOR  RDCM
          LDD    MA
          CRD    CN          COMPARE *XD* SPECIFIED WITH MAXIMUM *XD*
          LDD    CN+3
          SBD    T1
          MJN    PXT6        IF DATE BEYOND MAXIMUM
          SHN    14
          ADD    CN+4
          SBD    T2
          MJN    PXT6        IF DATE BEYOND MAXIMUM
 
*         SAVE PASSWORD/PERMIT EXPIRATION DATE.
 
 PXT4     LDD    T1
          SHN    14
          LMD    T2
 PXT5     STM    PXDT+1
          SHN    -14
          STM    PXDT
          LJM    PXTX        RETURN
 
 PXT6     ERROR  DEM,CH,IW   *XD/XT EXCEEDS MAXIMUM.*
 
*         PROCESS EXPIRATION TERM.
 
 PXT7     LDK    FPXL        COMPARE TO MAXIMUM *XT*
          SBD    T2
          MJN    PXT6        IF MAXIMUM *XT* EXCEEDED
 PXT8     LDD    T2
          LMC    7777
          ZJN    PXT5        IF NON-EXPIRING TERM SPECIFIED
          LDD    T2          CONVERT *XT* INTO *XD*
          STD    CM+4
          MONITOR  RDCM
          LDD    MA          READ RESULT
          CRD    CN
          LDD    CN+3
          SHN    14
          LMD    CN+4
          UJN    PXT5        STORE DATE
 SAP      SPACE  4,15
**        SAP - SAVE ACCESS PARAMETERS.
*
*         ENTRY  (CC) = COMMAND CODE.
*
*         EXIT   (PFFC - PFFC+2) = SPECIFIED ACCESS CATEGORY SET.
*                (PFAL) = JOB ACCESS LEVEL.
*                (LFAL) = SPECIFIED ACCESS LEVEL(IF ANY),DEFAULT PFAL.
*                (SVAL) = SECURITY VALIDATION BITS.
*
*         USES   CN - CN+4, CM - CM+4, T0 - T4.
*
*         MACROS ERROR, MONITOR.
 
 
 SAP      SUBR               ENTRY/EXIT
          LDD    CP          GET JOB DEFAULT VALUES AND VALIDATION
          ADK    JSCW
          CRM    SVAL,ON
          LDM    SVAL+1      SAVE JOB ACCESS LEVEL
          SHN    -11
          STM    PFAL
          STM    LFAL
          LDM    SVAL+2      SAVE JOB ACCESS CATEGORY SET
          LPC    377
          STM    PFFC
          ERRNZ  SVAL+2-PFFC CODE DEPENDS ON VALUE
          LDN    ZERL        SET UP FOR *VSAM*
          CRD    CN
          CRD    CM
          LDN    VAJS
          STD    CM+1
          LDD    CC
          LMN    CCAC
          ZJP    SAP4        IF *SETPFAC* REQUEST
          LMN    CCAL&CCAC
          ZJN    SAP2        IF *SETPFAL* REQUEST
 
*         PROCESS ACCESS LEVEL FROM FET FOR *SAVE*, *DEFINE*, AND
*         *ASSIGNPF*, IF *SP* BIT SET.
 
          LMN    CCSV&CCAL
          ZJN    SAP1        IF *SAVE* REQUEST
          LMN    CCDF&CCSV
          ZJN    SAP1        IF *DEFINE* REQUEST
          LMN    CCAN&CCDF
          NJP    SAPX        IF NOT *ASSIGNPF* REQUEST
 SAP1     LDM    PFSP
          ZJP    SAPX        IF SECURITY PROCESSING BIT NOT SET
 
*         VALIDATE SPECIFIED ACCESS LEVEL.
 
 SAP2     RJM    SFA         GET SPECIFIED ACCESS LEVEL
          ADN    CFAL
          CRD    T0
          LDD    T0+1        SAVE ACCESS LEVEL
          LPN    7
          STM    LFAL
          STD    CN+1
          LDN    1           VALIDATE ACCESS LEVEL ONLY
          STD    CM+4
          LDD    MA
          CWD    CN
          MONITOR  VSAM
          LDD    CM+1
          ZJP    SAPX        IF SPECIFIED ACCESSES VALID
          ERROR  LNJ,CH,IW,,SVE  * ACCESS LEVEL NOT VALID FOR JOB.*
 
*         VALIDATE SPECIFIED ACCESS CATEGORY SET.
 
 SAP4     LDN    CFFC
          SBM    FETL
          MJN    SAP5        IF FET LONG ENOUGH FOR FUNCTION
          ERROR  ILR,CH,IW   * PFM INCORRECT REQUEST.*
 
 SAP5     RJM    SFA         GET SPECIFIED ACCESS CATEGORY SET
          ADN    CFFC
          CRD    CN
          LDD    CN+2
          LPC    377
          STD    CN+2
          STM    PFFC        SAVE ACCESS CATEGORY SET
          LDD    CN+3
          STM    PFFC+1
          LDD    CN+4
          STM    PFFC+2
          LDN    2           VALIDATE ACCESS CATEGORY SET ONLY
          STD    CM+4
          LDD    MA
          CWD    CN
          MONITOR  VSAM
          LDD    CM+1
          ZJP    SAPX        IF SPECIFIED ACCESS CATEGORY SET VALID
          ERROR  CNJ,CH,IW,,SVE  * ACCESS CATEGORIES NOT VALID FOR JOB*
 SEP      SPACE  4,10
**        SEP - SET ERROR PROCESSING OPTIONS.
*
*         EXIT   (EPOP) = ERROR PROCESSING OPTIONS.
*
*         USES   CM - CM+4.
*
*         CALLS  SFA.
 
 
 SEP      SUBR               ENTRY/EXIT
          RJM    SFA         READ FET+1
          ADN    1
          CRD    CM
          LDD    CM+1        SAVE ERROR PROCESSING OPTIONS
          SHN    0-6
          LPN    37
          STM    EPOP
          UJN    SEPX        RETURN
 SLT      SPACE  4,20
**        SLT - SEARCH COMMON LIBRARY TABLE FOR ALTERNATE USER NAME.
*
*         ENTRY  (FN - FN+3) = USER NAME FOR ALTERNATE ACCESS.
*
*         EXIT   (A) = -1 IF USER NAME NOT FOUND.
*                (A) =  0 IF MATCH AND USER INDEX AND EQ AVAILABLE.
*                (A) =  1 IF MATCH BUT VALIDATION NEEDED.
*                (CN - CN+3) = FAMILY IF USER NAME FOUND.
*                (T1 - T2) = USER INDEX IF FOUND IN THE TABLE.
*                (POAB) = TABLE OFFSET IF ENTRY FOUND.
*                (PFPN+4) = (T5) = EST ORDINAL IF TAKEN FROM THE TABLE.
*                (PFUC) = PERMANENT FILE VALIDATION.
*
*         USES   T1 - T7, CM - CM+4.
*
*         CALLS  CPN.
*
*         MACROS SFA.
 
 
 SLT6     LCN    1           VALUE
 
 SLT      SUBR               ENTRY/EXIT
          LDC    CLTP        PICK UP COMMON LIBRARIES POINTER
          CRD    T3
          LDD    T5
          ZJN    SLT6        IF NO CLT
          LDN    0           INITIALIZE CLT OFFSET
          STD    T4
 SLT1     AOD    T4          CHECK NEXT CLT ENTRY
          LMD    T5
          ZJN    SLT6        IF END OF CLT
          SFA    CLT,T4
          CRD    CM          READ COMMON LIBRARIES USER NAME
          LDN    FN          PASS ALTERNATE USER NAME ADDRESS
          RJM    CPN         COMPARE USER NAMES
          NJN    SLT1        IF NO MATCH
 SLT2     LDD    T4
          STM    POAB        SAVE TABLE OFFSET FOR ENTRY
          LDD    CM+3        PICK UP USER INDEX
          LPN    37
          STD    T1
          LDD    CM+4
          STD    T2
          SFA    CLT,T4      CHECK FOR EST ORDINAL
          ADN    CLTF-CLTU
          CRD    CN          PICK UP FAMILY NAME AND EST ORDINAL
          LDD    CN+4
          NJN    SLT5        IF EST ORDINAL IN THE TABLE
 SLT3     LDN    1           SET VALIDATION REQUIRED
 SLT4     LJM    SLTX        RETURN
 
 SLT5     STD    T5          SAVE EST ORDINAL
          SFA    EST
          ADK    EQDE
          CRD    CM          READ EST ENTRY
          LDD    CM+4        GET MST ADDRESS
          SHN    3
          ADN    PFGL
          CRD    CM          READ FAMILY OR PACK NAME
          LDN    CN
          RJM    CPN         COMPARE FAMILY NAMES
          NJN    SLT3        IF NO MATCH
          LDD    T5          CHANGE EST ORDINAL
          STM    PFPN+4
          SFA    CLT,T4      GET PF VALIDATION
          ADN    CLTV-CLTU
          CRD    CM
          LDD    CM+4
          STM    PFUC
          LDN    0           USER NAME AND INDEX FOUND
          UJN    SLT4        RETURN
 VCA      SPACE  4,15
**        VCA - VERIFY CATALOG ADDRESS.
*
*         ENTRY  (CM - CM+4) = EST ENTRY OF THE FAMILY AND DEVICE.
*                (T5) = EST ORDINAL FOR THE FAMILY AND DEVICE NUMBER.
*                (PFID - PFID+2) = 4/,2/PEO,6/DN,12/TRACK,12/SECTOR.
*
*         EXIT   THE CATALOG ADDRESS IS VERIFIED TO DEFINE A LEGAL
*                PERMANENT FILE CATALOG ADDRESS.
*
*         USES   CM - CM+4, T0 - T0+4, T6 - T6+4.
*
*         CALLS  CTA.
*
*         MACROS ERROR.
 
 
 VCA      SUBR               ENTRY/EXIT
          LDD    CM+4        DETERMINE MST ADDRESS
          SHN    3
          ADN    ALGL        READ THE DEVICE ALLOCATION WORD
          CRD    T6
          ADN    PUGL-ALGL   READ DEVICE MASK
          CRD    T0
          ADN    TRLL-PUGL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH          BIAS FOR LINK INDICATOR BIT
          STM    VCAA+1
          SHN    -14
          LMC    ADCI
          STM    VCAA
          LDD    T6+1        SET FIRST TRACK IN CATALOG CHAIN (LABEL)
          STD    T6
          LDM    PFSU+1      CHECK USER INDEX AGAINST DEVICE MASK
          LPN    7
          RAM    VCAB
          LDN    1
 VCAB     SHN    **          (LAST DIGIT OF USER INDEX)
          STM    VCAC
          LDD    T0+4
          LPC    377
          LPC    *           (MASK FOR SPECIFIED USER INDEX)
 VCAC     EQU    *-1
          ZJN    VCA2        IF USER INDEX NOT LEGAL FOR DEVICE
 
*         LOOP THROUGH THE CHAIN OF CATALOG TRACKS AND VERIFY THAT
*         THE SPECIFIED TRACK IS IN THE CHAIN.
 
 VCA1     LDD    T6          CHECK TRACK LINKAGE
          SHN    21-13
          PJN    VCA2        IF NOT A VALID LINKAGE
          ZJN    VCA2        IF END OF CHAIN
          SHN    13-21-2     CALCULATE NEXT TRT WORD OFFSET
 VCAA     ADC    TRTS
          CRD    CM          READ THE LINKED TO WORD
          LDD    T6          BIAS INTO THIS TRT WORD
          LPN    3
          STD    CM+4
          LDM    CM,CM+4
          STD    T6          SET THE NEXT TRACK
          LMM    PFID+1
          ZJN    VCA3        IF THE SPECIFIED TRACK IS IN THE CHAIN
          UJN    VCA1        CONTINUE EXAMINING CATALOG TRACKS
 
 VCA2     ERROR  IPA,CH,IW   * INCORRECT PFC ADDRESS.*
 
*         THE TRACK IS A MEMBER OF THE CATALOG CHAIN.
 
 VCA3     SETMS  STATUS      VERIFY THE SECTOR SPECIFIED
          LDM    PFID+2
          SBM    SLM
          PJN    VCA2        IF SECTOR OUT OF RANGE
          LJM    VCAX        RETURN
 VFA      SPACE  4,15
**        VFA - VERIFY FET ADDRESS.
*
*         EXIT   (A) .LT. 0, IF FET NOT WITHIN CALLER-S FIELD LENGTH.
*                (SFAB) = *LDD RA*, IF FET IN RANGE.
*                (SFAA - SFAA+1) = FET ADDRESS, IF IN RANGE.
*
*         USES   T1, CN - CN+4.
*
*         CALLS  SFA.
*
*         MACROS ISTORE.
 
 
 VFA      SUBR               ENTRY/EXIT
          LDD    IR+3
          LPN    77
          SHN    14
          MJN    VFA1        IF ADDRESS OUT OF RANGE
          LMD    IR+4
          ADN    1
          SHN    -6
          SBD    FL
          MJN    VFA2        IF ADDRESS IN RANGE
 VFA1     LCN    0           SET ERROR RETURN
          UJN    VFAX        RETURN
 
 VFA2     LDD    IR+3        SAVE FET ADDRESS
          LPN    37
          LMC    ADCI
          STM    SFAA
          LDD    IR+4
          STM    SFAA+1
          ISTORE SFAB,(LDD RA)  FLAG FET ADDRESS VALID
          RJM    SFA         READ FET LENGTH/RANDOM BIT
          ADN    1
          CRD    CN
          LDD    CN+3        SAVE FET LENGTH
          SHN    -6
          ADN    4
          STD    T1
          LDD    CN+1
          SHN    21-13
          PJN    VFA4        IF NOT RANDOM FET
          LDD    T1
          SBN    CFCN
          PJN    VFA4        IF FET NOT TOO SHORT
 VFA3     UJN    VFA1        SET ERROR RETURN
 
 VFA4     LDD    IR+3        CHECK FET WITHIN FIELD LENGTH
          LPN    77
          SHN    14
          LMD    IR+4
          ADD    T1
          SHN    -6
          SBD    FL
          PJN    VFA3        IF FET OUT OF RANGE
          LDN    0           SET NO ERROR
          UJP    VFAX        RETURN
 VRP      SPACE  4,15
**        VRP - VERIFY PARAMETERS.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (FN - FN+4) = ACCESS WORD.
*                (PFBR) = BACKUP REQUIREMENT VALUE.
*                (PFRS) = PREFERRED RESIDENCE VALUE.
*                (PFSS) = SUBSYSTEM VALUE.
*                (PFAP) = ALTERNATE CATLIST PERMISSION VALUE.
*
*         EXIT   PARAMETERS VERIFIED TO BE IN RANGE.
*                DEFAULT VALUES SET IF NEEDED (FILE CREATION).
*
*         MACROS ERROR.
 
 
 VRP      SUBR               ENTRY/EXIT
          LDD    CC          CHECK FOR *CHANGE* REQUEST
          LMN    CCCG
          ZJN    VRP3        IF *CHANGE* REQUEST
 
 
*         SET DEFAULT VALUES ON FILE CREATION.
 
 
          LDM    PFSS        CLEAR *CHANGE* FLAG ON FILE CREATION
          SCN    40
          STM    PFSS
          LDM    PFBR        INSURE VALID *BR* VALUE
          LPC    0700
          NJN    VRP1        IF *BR* PARAMETER SPECIFIED
          LDC    BRDE*100    SET DEFAULT *BR* VALUE
          RAM    PFBR
 VRP1     LDM    PFRS        INSURE VALID *PR* VALUE
          SHN    0-11
          NJN    VRP2        IF *PR* PARAMETER SPECIFIED
          LDC    RSDE*1000   SET DEFAULT *PR* VALUE
          RAM    PFRS
 VRP2     LDM    PFAP        CHECK FOR NULL *AC* VALUE
          SHN    -12
          NJN    VRP3        IF *AC* PARAMETER SPECIFIED
          LDC    ACDF*2000   SET DEFAULT *AC* VALUE
          RAM    PFAP
 
*         ENSURE VALID PARAMETER VALUES.
 
 VRP3     LDM    PFBR        VERIFY RANGE OF *BR* VALUE
          SHN    0-6
          LPN    7
          SBN    BRMX+1
          PJN    VRP4        IF *BR* NOT IN RANGE
          LDM    PFRS        VERIFY RANGE OF *PR* VALUE
          SHN    0-11
          SBN    RSMX+1
          PJN    VRP4        IF *PR* OUT OF RANGE
          ADN    RSMX+1-RSLK
          NJN    VRP5        IF *DISK LOCKED* NOT REQUESTED
          LDD    FN+2        CHECK FOR *CLTD* VALIDATION
          SHN    21-0
          MJN    VRP5        IF USER VALIDATED TO SPECIFY DISK LOCKED
 VRP4     ERROR  ILR,CH,IW   * PFM INCORRECT REQUEST.*
 
 VRP5     LDM    PFSS        VERIFY SUBSYSTEM VALUE
          LPN    37
          SBN    MSYS+1
          PJN    VRP4        IF *SS* NOT VALID
          LDM    PFAP        VERIFY *AC* PARAMETER
          SHN    -12
          SBN    ACMX+1
          PJN    VRP4        IF *AC* NOT VALID
          LJM    VRPX        RETURN
 VUA      SPACE  4,15
**        VUA - VALIDATE USER ACCESS.
*
*         EXIT   (SSJS) = 1 IF *SSJ=* JOB.
*
*         USES   CM - CM+4.
 
 
 VUA      SUBR               ENTRY/EXIT
          LDD    CP          CHECK FOR SSJ= JOB
          ADC    SEPW
          CRD    CM
          LDD    CM
          SHN    0-2
          LPN    1
          STM    SSJS        SAVE *SSJ=* STATUS
          UJN    VUAX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPCRS
*CALL     COMPVFN
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  PPFW,EPFW  OVERFLOW INTO DISK ERROR PROCESSING AREA
          OVERLAY  (LOCAL FILE PROCESSING.),OVLD
          SPACE  4,15
**        THIS OVERLAY PERFORMS INITIAL LOCAL FILE PROCESSING FOR
*         REQUESTS WHICH ARE SENSITIVE TO THE EXISTENCE OF LOCAL FILES.
 
 
 OVL      BSS    0           ENTRY
*         LJM    PLF         PROCESS LOCAL FILE
 PLF      SPACE  4,15
**        PLF - PROCESS LOCAL FILE.
*
*         ENTRY  (CC) = COMMAND CODE.
*
*         EXIT   (FN - FN+4) = PERMANENT FILE NAME.
 
 
 PLF      BSS    0           ENTRY
          LDM    PLFT,CC
          STM    PLFA
 PLFT     LJM    PLF7        *SAVE*
 PLFA     EQU    *-1         (LOCAL FILE PROCESSOR ADDRESS)
          CON    PLF4        *GET*
          CON    0           *PURGE* (NO LOCAL FILE PROCESSING)
          CON    0           *CATLIST* (NO LOCAL FILE PROCESSING)
          CON    0           *PERMIT* (NO LOCAL FILE PROCESSING)
          CON    PLF7        *REPLACE*
          CON    PLF8        *APPEND*
          CON    PLF1        *DEFINE*
          CON    PLF5        *ATTACH*
          CON    0           *CHANGE* (NO LOCAL FILE PROCESSING)
          CON    PLF11       *UATTACH*
          CON    PLF12       *SETASA*
          CON    0           *SETAF* (NO LOCAL FILE PROCESSING)
          CON    PLF3        *SETDA*
          CON    0           *DROPDS* (NO LOCAL FILE PROCESSING)
          CON    PLF1        *ASSIGNPF*
          CON    PLF4        *OLD*
          CON    0           *SETPFAC* (NO LOCAL FILE PROCESSING)
          CON    0           *SETPFAL* (NO LOCAL FILE PROCESSING)
          CON    PLF4        *UGET*
          CON    PLF7        *UREPLACE*
          CON    0           *DROPIDS* (NO LOCAL FILE PROCESSING)
          CON    PLF13       *DELPFC*
          CON    0           *RPFSTAT* (NO LOCAL FILE PROCESSING)
          CON    0           *STAGEPF* (NO LOCAL FILE PROCESSING)
 
*         *ASSIGNPF*/*DEFINE* PROCESSING.
 
 PLF1     RJM    PEF         PROCESS EXISTING FILE
          LDM    MXNF
          ZJN    PLF2        IF NO FILE LIMIT SPECIFIED
          LDK    STAC        TURN ON STATISTICAL ACCUMULATION
          RAM    STAT
 PLF2     EXECUTE  3PB       FILE RESIDENCE PROCESSOR
 
*         *SETDA* PROCESSING.
 
 PLF3     RJM    SSF         SEARCH FOR SYSTEM FILE
          UJN    PLF2        PROCESS FILE RESIDENCE
 
*         *GET*/*OLD*/*UGET* PROCESSING.
 
 PLF4     RJM    PEF         PROCESS EXISTING FILE
 
*         EXIT TO COMMAND PREPROCESSING OVERLAY.
 
 PLFX     RJM    SPN         SET PERMANENT FILE NAME
          EXECUTE  3PC       EXIT TO COMMAND PROCESSING OVERLAY
 
*         *ATTACH* PROCESSING.
 
 PLF5     RJM    PEF         PROCESS EXISTING FILE
          LDM    MODE        SET UP FNT STATUS MODE EQUIVALENCE
          LPN    37
          STD    T1
          LDM    TFNS,T1
          STM    FNMD
          RJM    CFA         CHECK FAST ATTACH FILE
          PJN    PLF6        IF NOT FAST ATTACH FILE
          RJM    EFN         ESTABLISH *FNT/FST* FOR *FA* FILE
          EXECUTE  3PU       TERMINATE PROGRAM
 
 PLF6     RJM    CAA         CHECK FOR APPLICATION ACCOUNTING
          UJN    PLF10       EXIT
 
*         *SAVE*/*REPLACE*/*APPEND*/*UREPLAC* PROCESSING.
 
 PLF7     LDM    MXNF
          NJN    PLF8        IF FILE LIMIT SPECIFIED
          LDM    MXCS
          NJN    PLF8        IF SIZE LIMIT SPECIFIED
          LDM    MXCS+1
          ZJN    PLF9        IF NO SIZE LIMIT SPECIFIED
 PLF8     LDK    STAC        TURN ON STATISTICAL ACCUMULATION
          RAM    STAT
 PLF9     RJM    SSF         SEARCH FOR SYSTEM FILE
          RJM    CFS         CHECK FILE SIZE
 PLF10    LJM    PLFX        COMPLETE
 
*         *UATTACH* PROCESSING.
 
 PLF11    RJM    PEF
          LDM    MODE        SET UP FNT STATUS MODE EQUIVALENCE
          LPN    37
          STD    T1
          LDM    TFNS,T1
          STM    FNMD
          UJN    PLF10       EXIT
 
*         *SETASA* PROCESSING.
 
 PLF12    LDM    STAT
          LPK    STTA
          NJN    PLF10       IF SETTING TAPE ASA
          LDM    PFAT
          LPN    77
          LMN    ATOD
          ZJN    PLF10       IF SETTING OPTICAL DISK ASA
          RJM    SSF         SEARCH FOR SYSTEM FILE
          UJN    PLF10       EXIT
 
*         *DELPFC* PROCESSING.
 
 PLF13    RJM    PIF         PROCESS INTERLOCK FILES
          UJN    PLF10       EXIT
 TFNS     SPACE  4,15
**        FNT STATUS VALUES FOR SPECIFIED ACCESS MODE.
 
 
 TFNS     BSS    0
          LOC    0
          CON    2           WRITE
          CON    1           READ
          CON    22          APPEND/EXTEND
          CON    5           EXECUTE
          CON    0           NULL
          CON    32          MODIFY
          CON    31          READ AND ALLOW MODIFY
          CON    21          READ AND ALLOW APPEND
          CON    12          UPDATE
          CON    11          READ AND ALLOW UPDATE
          LOC    *O
 TFNSL    EQU    *-TFNS
          TITLE  SUBROUTINES.
 CAA      SPACE  4,15
**        CAA - CHECK FOR APPLICATION ACCOUNTING.
*
*         ENTRY  (FNTA) = *FST* ADDRESS OF FILE.
*
*         EXIT   IF THE FILE IS FROM THE APPLICATION LIBRARY
*                AND THE MODE OF ACCESS IS EXECUTE, THE
*                APPLICATION ACCOUNTING FILE STATUS IS SET.
 
 
 CAA      SUBR               ENTRY/EXIT
          LDD    UI          CHECK FOR APPLICATION LIBRARY
          SHN    14
          ADD    UI+1
          LMC    AAUI
          NJN    CAAX        IF NOT FROM APPLICATION LIBRARY
          LDM    FNMD        CHECK FOR MODE OF ATTACH FUNCTION
          LMN    5
          NJN    CAAX        IF NOT EXECUTE-ONLY FILE
          LDM    SFNB        SET APPLICATION ACCOUNTING FILE STATUS
          SCN    77
          LMN    AAST
          STM    SFNB
          UJN    CAAX        EXIT
 CFA      SPACE  4,25
**        CFA - CHECK FOR FAST ATTACH FILE.
*
*         IF THE *FA* OR *MA* SPECIAL REQUEST WAS SPECIFIED AND THE
*         CALLER IS *SSJ=*, CHECK THE SYSTEM FNT FOR THE SPECIFIED
*         FAST ATTACH FILE, AND ATTACH THE FILE IF IT EXISTS AND IS
*         NOT BUSY.  IF THE FILE DOES NOT EXIST AND THE *FA* (FORCED
*         FAST ATTACH) SPECIAL REQUEST WAS SPECIFIED, RETURN AN
*         ERROR.  IF THE FILE DOES NOT EXIST AND THE *MA* (MIXED
*         FAST ATTACH) SPECIAL REQUEST WAS SPECIFIED, EXIT AND ALLOW
*         NORMAL ATTACH PROCESSING TO PROCEED.
*
*         ENTRY  (PFSR) = SPECIAL REQUEST SUBFUNCTION.
*                (SSJS) = SPECIAL SYSTEM JOB STATUS.
*
*         EXIT   (A) .LT. 0 IF FAST ATTACH FILE FOUND.
*
*         USES   T5, T6, CM - CM+4, CN - CN+4, FN - FN+4, FS - FS+4.
*
*         CALLS  FAT, SFN, SPN.
*
*         MACROS ERROR, MONITOR, SFA.
 
 
 CFA6     LDM    PFSR        CHECK FOR SPECIAL REQUEST
          LPN    77
          LMN    SRMA
          ZJN    CFAX        IF MIXED FAST ATTACH SPECIAL REQUEST
          ERROR  FNF,CH,IW   * (FILE NAME) NOT FOUND.*
 
 CFA7     ERROR  IUA,CH,IW   * USER ACCESS NOT VALID.*
 
 
 CFA      SUBR               ENTRY/EXIT
          LDM    PFSR        CHECK FOR SPECIAL REQUEST
          LPN    77
          LMN    SRFA
          ZJN    CFA0        IF FORCED FAST ATTACH SPECIAL REQUEST
          LMN    SRMA&SRFA
          NJN    CFAX        IF NOT MIXED FAST ATTACH SPECIAL REQUEST
 CFA0     LDM    SSJS
          ZJN    CFA7        IF CALLER IS NOT *SSJ=*
          RJM    SPN         SET FILE NAME
          SFA    EST,PFPN+4  SET FAMILY EST ORDINAL
          ADK    EQDE
          CRD    CN          READ EST ENTRY
          LDD    CN+4
          SHN    3
          ADN    PFGL        READ FAMILY NAME
          CRD    CN
          LDD    MA
          CWD    FN
          CRD    CM          SET FILE NAME
          RJM    FAT         CHECK IF FAST ATTACH
          ZJN    CFA1        IF FAST ATTACH FILE FOUND
          LJM    CFA6        PROCESS FILE NOT FOUND
 
*         FAST ATTACH FILE FOUND.
 
 CFA1     SFA    FNT,T1      READ FNT/FST ENTRY
          CRD    FN
          ADN    FSTL
          CRD    FS
          LDD    FS          SET FILE TRACK AND EST ORDINAL
          STD    T5
          STM    PFEQ
          STM    ERRE        SET EST ORDINAL FOR EVENT
          LDD    FS+1
          STD    T6
          STM    ERRC        SET TRACK FOR EVENT
          STM    PFFT
          LDM    MODE        CHECK FOR LEGAL MODE
          LPN    37
          STD    CM+2        SET MODE IN MONITOR REQUEST
          LDM    TFNS,CM+2
          STM    CFAA
          NJN    CFA2        IF LEGAL MODE
          ERROR  ILR,CH,IW,FS *PFM INCORRECT REQUEST.*
 
 CFA2     LDN    AFAS        SET REQUEST FOR FAFT FILE
          STD    CM+3
          LDD    T1
          STD    CM+4
          LDD    FN+3
          LPN    77
          ZJN    CFA3        IF LOCAL FAST ATTACH FILE
          LDD    T5          SET EST ORDINAL IF GLOBAL FILE
 CFA3     STD    CM+1
          MONITOR  AFAM
          LDD    CM+1        CHECK RETURN STATUS
          ZJN    CFA4        IF NO ERROR
          LDN    FRT         SET TIME FOR EVENT
          STM    ERRD
          ERROR  FBS,CH,IW,FS *(FILE NAME) BUSY.*
 
 CFA4     LDC    *
 CFAA     EQU    *-1         (*TFNS* TABLE ENTRY FOR SPECIFIED MODE)
          SHN    21-4
          MJN    CFA5        IF M, RM, A OR RA MODE
          LDD    T5          REQUEST TRT UPDATE
          STD    CM+1
          LDN    UTRS
          STD    CM+3
          MONITOR  STBM
 CFA5     LDC    PFSN        SET FILE NAME
          RJM    SFN
          LCN    1           SET FAST ATTACH FILE FOUND
          LJM    CFAX        EXIT
 CSA      SPACE  4,10
**        CSA - CHECK SPECIFIED ACCESS LEVEL.
*
*         ENTRY  (FA) = FNT ADDRESS IN NFL.
*                (LFAL) = REQESTED ACCESS LEVEL, IF *PFSP* NONZERO.
*
*         EXIT   ACCESS LEVEL SET IN FNT ENTRY BY *CPUMTR*, IF VALID.
*                *MFFI* ACCOUNT MESSAGE ISSUED.
*
*         CALLS  IAM.
*
*         USES   CM - CM+4.
*
*         MACROS ERROR, MONITOR.
 
 
 CSA      SUBR               ENTRY/EXIT
          LDM    PFSP
          ZJN    CSAX        IF SECURITY PROCESSING BIT NOT SET IN FET
          LDN    VSFS        VALIDATE AND SET ACCESS LEVEL FOR FILE
          STD    CM+1
          LDD    FA
          STD    CM+3
          LDM    LFAL
          STD    CM+4
          MONITOR  VSAM
          LDD    CM+1
          ZJN    CSAX        IF ACCESS LEVEL VALID
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE
          ERROR  LNF,CH,IW,,SVE  * ACCESS LEVEL NOT VALID FOR FILE.*
 CFS      SPACE  4,10
**        CFS - CHECK FILE SIZE FOR THE CATALOG SEARCH.
*
*         ENTRY  (MXFS) = MAXIMUM FILE SIZE ALLOWED FOR INDIRECT
*                         ACCESS FILES/ 10B.
*                (LF - LF+1) = LENGTH OF LOCAL FILE.
*
*         EXIT   (LF - LF+1) CHECKED FOR SIZE LIMITS.
*
*         MACROS ERROR.
 
 
 CFS3     ERROR  EFL,CH,IW   *(FILE NAME) EMPTY.*
 
 CFS      SUBR               ENTRY/EXIT
          LDD    LF
          SHN    -5
          ZJN    CFS2        IF FILE LENGTH .LT. 131072D SECTORS
 CFS1     ERROR  FTL,CH,IW   *FILE TOO LONG.*
 
 CFS2     LDD    LF          CHECK FOR EMPTY FILE
          SHN    14
          ADD    LF+1
          ZJN    CFS3        IF FILE EMPTY
          ADN    2           ADD SYSTEM AND EOI SECTORS
          MJN    CFS1        IF FILE .GT. 131069D SECTORS
          LDM    MXFS
          ZJN    CFSX        IF NO FILE SIZE LIMITS
          LDD    LF
          SHN    -3
          NJN    CFS1        IF FILE SIZE .GT. MAXIMUM FILE SIZE LIMIT
          LDD    LF
          SHN    14
          ADD    LF+1
          ADN    7
          SHN    -3
          SBM    MXFS
          MJN    CFSX        IF LIMIT NOT EXCEEDED
          NJN    CFS1        IF FILE LIMIT EXCEEDED
          UJN    CFSX        RETURN
 EFN      SPACE  4,20
**        EFN - ESTABLISH FNT ENTRY FOR FAST ATTACH FILE.
*
*         ENTRY  (FN - FN+4) = LOCAL FILE NAME.
*                (FNTA) = FNT ADDRESS OF LOCAL FILE.
*                (PFEQ) = EST ORDINAL FOR FILE.
*                (PFFT) = FIRST TRACK FOR FILE.
*                (PFSN) = LOCAL FILE NAME.
*                (FNMD) = FNT STATUS MODE EQUIVALENCE.
*
*         EXIT   FNT ENTRY ESTABLISHED IN CENTRAL MEMORY.
*                (FA) = FNT ADDRESS.
*                (FN - FN+4) = FNT.
*                (FS - FS+4) = FST.
*                PERMANENT FILE USER COUNT INCREMENTED.
*
*         USES   T1, CM - CM+4.
*
*         MACROS MONITOR.
 
 
 EFN      SUBR               ENTRY/EXIT
          LDM    FNTA        SET FNT/FST
          STD    FA
          LDM    PFEQ        SET EST ORDINAL
          STD    FS
          LDM    PFFT        SET FIRST TRACK
          STD    FS+1
          STD    FS+2
          LDN    FSMS        SET SECTOR
          STD    FS+3
          LDC    2004        SET FST STATUS
          STD    FS+4
          LDC    PMFT*100    SET FILE TYPE
          RAD    FN+4
          STM    PFSN+4
          LDM    FNMD        SET FNT STATUS MODE
          SCN    2           CLEAR WRITEABLE MODE BIT
          RAM    PFSN+3
          STD    FN+3
          LDN    ZERL        SET FILE SIZE LIMIT TO INFINITE
          CRD    CM
          LDC    700
          STD    CM+2
          NFA    FA,R        RESTORE FNT ENTRY
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CWD    FS
          ADN    FUTL-FSTL
          CWD    CM
          LDM    PFEQ        INCREMENT PF USER COUNT
          STD    CM+1
          LDN    IUCS
          STD    CM+3
          MONITOR  SMDM
          LJM    EFNX        RETURN
 IAM      SPACE  4,10
**        IAM - ISSUE ACCOUNT FILE MESSAGE.
*
*         ISSUES AN *MFFI* ACCOUNT FILE MESSAGE TO INDICATE THAT THE
*         LOCAL FILE ACCESS LEVEL CHANGE ATTEMPT WAS INVALID.
*
*         ENTRY  (LFAL) = LOCAL FILES NEW ACCESS LEVEL.
*
*         EXIT   ACCOUNT FILE MESSAGE ISSUED.
*
*         USES   T1.
*
*         CALLS  ACS, DFM.
 
 
 IAM      SUBR               ENTRY/EXIT
          LDC    IAMB+3      INITIALIZE POINTER FOR *ACS* CALLS
          STD    T1
          LDN    FN          INSERT FILE NAME IN BUFFER
          RJM    ACS
          LDC    IAMC        APPEND COMMA
          RJM    ACS
          LDM    LFAL        DETERMINE MNEMONIC OF ACCESS LEVEL
          SHN    2
          ADC    TALV        APPEND NEW ACCESS LEVEL
          RJM    ACS
          LDC    IAMD        APPEND TERMINATOR
          RJM    ACS
          LDC    IAMB+ACFN   ISSUE DAYFILE MESSAGE
          RJM    DFM
          UJN    IAMX        RETURN
 
*         ACCOUNT FILE MESSAGE BUFFER.
 
 IAMB     DATA   C*MFFI, *
          BSSZ   12
 IAMC     DATA   2H,         MESSAGE SEPARATOR
          CON    0           END OF STRING
 IAMD     DATA   2H.         MESSAGE TERMINATOR
          CON    0
 PDS      SPACE  4,15
**        PDS - PROCESS DEVICE STATUS.
*
*         ENTRY  (A) = 0 IF DEVICE AVAILABLE.
*                (A) .NE. 0 IF DEVICE INACCESSIBLE.
*                (T5) = EST ORDINAL OF DEVICE.
*                (FERT) = REAL-TIME PROCESSING FLAG.
*                (SSYS) = SUBSYSTEM FLAG.
*
*         EXIT   RETURN IF PROCESSING IS TO CONTINUE.
*
*                TO *ERR* IF DEVICE IS INACCESSIBLE AND CALLER HAS
*                REAL-TIME PROCESSING SET IN FET OR IS NOT A SUBSYSTEM.
*
*         MACROS ERROR.
 
 
 PDS      SUBR               ENTRY/EXIT
          ZJN    PDSX        IF DEVICE AVAILABLE, RETURN
          LDM    SSYS
          ZJN    PDS1        IF NOT A SUBSYSTEM
          LDM    FERT
          ZJN    PDSX        IF NO REAL-TIME PROCESSING, RETURN
 PDS1     ERROR  WID,CH,IW,T5,EC6  * WAITING - INACCESSIBLE DEVICE.*
 PEF      SPACE  4,25
**        PEF - PROCESS EXISTING FILE.
*
*         DETERMINE IF A LOCAL FILE WITH THE SPECIFIED NAME IS ALREADY
*         ASSIGNED TO THE JOB.  FOR ALL REQUESTS EXCEPT *DEFINE*,
*         RETURN THE EXISTING LOCAL FILE.  FOR *DEFINE*, RETURN THE
*         RESERVED FNT ENTRY AND KEEP THE EXISTING LOCAL FILE.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (PFSN) = LOCAL FILE NAME.
*
*         EXIT   (FA) = (FNTA) = FNT ADDRESS OF THE LOCAL FILE.
*                (FA) = 0 IF THE FILE WAS RETURNED OR DID NOT EXIST.
*                (FN - FN+4) = FNT ENTRY FOR FILE (*DEFINE*).
*                (FS - FS+4) = FST ENTRY FOR FILE (ZERO IF NOT FOUND).
*                (ERRB) = NONZERO IF LOCAL FILE EXISTS.
*                (LFAL) = LOCAL FILE ACCESS LEVEL.
*
*         USES   FA, T1, CM - CM+4, FN - FN+4.
*
*         CALLS  CSA, PDS, SAF, SFB, SFN, *0DF*.
*
*         MACROS ERROR, EXECUTE, NFA, SETMS, SFA.
 
 
 PEF10    LDC    **          RESTORE DIRECT CELL
 PEFA     EQU    *-1
          STD    UI+1
 PEF11    LDN    ZERL        CLEAR FS - FS+4
          CRD    FS
 
 PEF      SUBR               ENTRY/EXIT
          LDC    PFSN        SET SYSTEM FILE NAME
          RJM    SFN
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    PEF11       IF FILE NOT FOUND
          RJM    SFB         SET FILE BUSY
          ZJN    PEF1        IF NO REJECT ON FILE INTERLOCK
          ERROR  IOE,CH,IW   *I/O SEQUENCE ERROR.*
 
 PEF1     LDD    CC
          LMN    CCDF
          ZJN    PEF6        IF A *DEFINE* REQUEST
 
*         *UNLOAD* OR *RETURN* THE EXISTING FILE.
 
 PEF2     LDN    1           *UNLOAD* PREVIOUS FILE
 PEF3     STM    LOCF-1
          LDD    UI+1        SAVE DIRECT CELL USED BY *0DQ*
          STM    PEFA
          EXECUTE 0DF,LOCF
          PJP    PEF10       IF FILE PROCESSED
          LDD    FS          SET EST ORDINAL OF INACCESSIBLE DEVICE
          STD    T5
          LDD    FA          SET FNT ADDRESS
          STM    FNTA
          AOM    ERRB        SET FILE NOT CREATED BY *PFM*
          RJM    PDS         PROCESS DEVICE STATUS
          ERROR  PFN,CH,IW   * DEVICE UNAVAILABLE.*
 
*         PROCESS *DEFINE* REQUEST (USE EXISTING FILE IF POSSIBLE).
 
 PEF6     LDD    FS
          ZJN    PEF3        IF EQUIPMENT NOT ASSIGNED
          LDD    FS+1
          ZJN    PEF2        IF FILE EMPTY
 
*         *DEFINE* - RETURN RESERVED FNT ENTRY (NOT NEEDED).
 
          LDM    FNTA        SWITCH FNT ADDRESSES
          STD    T1
          LDD    FA
          STM    FNTA
          LDD    T1
          STD    FA
          LDN    1           *UNLOAD FILE*
          STM    LOCF-1
          EXECUTE  0DF,LOCF
          LDM    FNTA        RESET FNT ADDRESS
          STD    FA
          AOM    ERRB        SET FILE NOT CREATED BY *PFM*
 
*         CHECK IF EXISTING LOCAL FILE CAN BE USED.
 
          RJM    CSA         CHECK SPECIFIED ACCESS LEVEL
          NFA    FA,R
          ADK    FNTL
          CRD    FN
          ADK    FSTL-FNTL
          CRD    FS
          ADK    FUTL-FSTL   GET LOCAL FILE ACCESS LEVEL
          CRD    CM
          LDD    CM+2        SAVE LOCAL FILE ACCESS LEVEL
          LPN    7
          STM    LFAL
          SBM    PFAL
          PJN    PEF7        IF LOCAL FILE HAS VALID ACCESS LEVEL
          LDM    SVAL        CHECK FOR WRITE DOWN VALIDATION
          SHN    21-5
          MJN    PEF7        IF WRITE DOWN ALLOWED
          LDM    SSID        CHECK SUBSYSTEM ID
          SBK    LSSI+1
          PJN    PEF7        IF SUBSYSTEM
          ERROR  WDP,CH,IW,,SVE  * WRITE-DOWN OF DATA PROHIBITED.*
 
 PEF7     LDD    FN+3
          LPN    4
          ZJN    PEF8        IF NOT EXECUTE ONLY FILE
          ERROR  FEO,CH,IW   * FILE IS EXECUTE ONLY.*
 
 PEF8     SFA    EST,FS      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-13
          MJN    PEF9        IF MASS STORAGE EQUIPMENT
          ERROR  NMS,CH,IW   *(FILE NAME) NOT MASS STORAGE.*
 
 PEF9     LDD    FS
          STD    T5
          SETMS  STATUS
          LDM    MSD
          LPC    100
          RJM    PDS         PROCESS DEVICE STATUS
          LJM    PEFX        RETURN
 PIF      SPACE  4,15
**        PIF - PROCESS INTERLOCK FILES.
*
*         EXIT   (FNTA) = 0.
*                (CCIB) UPDATED IF /PFM*ILK/ INTERLOCK BIT WAS SET.
*                (IAIF) = NONZERO IF /PFM*PFN/ INTERLOCK BIT WAS SET.
*                INTERLOCK BITS CLEARED IN /PFM*ILK/ AND /PFM*PFN/.
*                TO *ERR* IF FILES DO NOT MATCH FAMILY/USER INDEX.
*
*         USES   FS+4.
*
*         CALLS  SSF.
*
*         MACROS ERROR.
 
 
 PIF      SUBR               ENTRY/EXIT
 
*         PROCESS CATALOG TRACK INTERLOCK (FILE /PFM*ILK/).
 
          LDC    =C/"ILK"/
          STM    SSFA+1
          RJM    SSF         SEARCH FOR LOCAL FILE /PFM*ILK/
          LDD    FS
          LMD    EQ
          NJN    PIF1        IF INCORRECT EST ORDINAL
          LDD    FS+1
          LMM    CCIA
          ZJN    PIF2        IF CORRECT CATALOG TRACK
 PIF1     ERROR  FNF,CH,IW   * FILE NOT FOUND.*
 
 PIF2     LDD    FS+4        CHECK CATALOG TRACK INTERLOCK BIT
          SHN    21-11
          PJN    PIF2.1      IF INTERLOCK BIT NOT SET
          AOM    CCIB        SET CATALOG TRACK INTERLOCK FLAG
 PIF2.1   LDD    FS+4        CLEAR CATALOG TRACK INTERLOCK BIT
          LPC    6776
          LMN    1           SET COMPLETE BIT
          STD    FS+4
          NFA    FA,R        REWRITE FST
          ADK    FSTL
          CWD    FS
 
*         CHECK FOR ALLOCATION INTERLOCK (FILE /PFM*PFN/).
 
          LDC    =C/"PFN"/
          STM    SSFA+1
          RJM    SSF         SEARCH FOR LOCAL FILE /PFM*PFN/
          LDD    FS
          LMD    EQ
          ZJN    PIF3        IF CORRECT EST ORDINAL
          ERROR  FNF,CH      * FILE NOT FOUND.*
 
 PIF3     LDD    FS+4
          SHN    21-11
          PJN    PIF4        IF ALLOCATION INTERLOCK NOT SET
          AOM    IAIF        SET *INDIRECT ALLOCATION INTERLOCK* FLAG
 PIF4     LDD    FS+4        CLEAR ALLOCATION INTERLOCK BIT
          LPC    6776
          LMN    1           SET COMPLETE BIT
          STD    FS+4
          NFA    FA,R        REWRITE FST
          ADK    FSTL
          CWD    FS
          LDN    0           CLEAR LOCAL FILE FNT ADDRESS
          STM    FNTA
          UJP    PIFX        RETURN
 SSF      SPACE  4,20
**        SSF - SEARCH FOR SYSTEM FILE.
*
*         ENTRY  (PFSN) = LOCAL FILE NAME.
*
*         EXIT   (LF - LF+1) = LENGTH OF LOCAL FILE.
*                (FS - FS+4) = FST ENTRY FOR FILE (REWOUND).
*                (ERRB) = NON ZERO IF FILE PRESENT AND SET BUSY.
*                (FNTA) = FNT ADDRESS OF LOCAL FILE.
*                (FNTB) = FNT ADDRESS OF /PFM*PFN/ FILE (*DELPFC*).
*                (FNTC) = FNT ADDRESS OF /PFM*ILK/ FILE (*DELPFC*).
*                (LFAL) = LOCAL FILE ACCESS LEVEL.
*                FST REWRITTEN.
*
*         USES   FA, T5, T6, CM - CM+4, FN - FN+4, FS - FS+4,
*                LF - LF+1.
*
*         CALLS  CSA, CTA, PDS, SAF, SEI, SFB, SFN.
*
*         MACROS ERROR, NFA, SETMS, SFA.
 
 
 SSF      SUBR               ENTRY/EXIT
 SSFA     LDC    PFSN        SET FILE NAME
*         LDC    =C/"ILK"/   (*DELPFC* REQUEST)
*         LDC    =C/"PFN"/   (*DELPFC* REQUEST)
          RJM    SFN
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    SSF1        IF NOT FOUND
          RJM    SFB         SET FILE BUSY
          ZJN    SSF3        IF NO REJECT ON FILE INTERLOCK
          ERROR  IOE,CH,IW   *I/O SEQUENCE ERROR.*
 
 SSF1     ERROR  FNF,CH,IW   * FILE NOT FOUND.*
 
 SSF2     ERROR  FEO,CH,IW   * FILE IS EXECUTE ONLY.*
 
 SSF2.1   ERROR  IFT,CH,IW   * INCORRECT FILE TYPE.*
 
 SSF3     AOM    ERRB        INDICATE FILE NOT CREATED BY *PFM*
          LDD    FA          SAVE FNT ADDRESS
          STM    FNTA
          LDD    CC
          LMN    CCSV
          NJN    SSF4        IF NOT *SAVE* REQUEST
          RJM    CSA         CHECK SPECIFIED ACCESS LEVEL
 SSF4     NFA    FA,R
          ADK    FNTL
          CRD    FN
          ADN    FSTL-FNTL
          CRD    FS
          ADN    FUTL-FSTL   READ LOCAL FILE ACCESS LEVEL
          CRD    CN
          LDD    CN+2        SAVE LOCAL FILE ACCESS LEVEL
          LPN    7
          STM    LFAL
          LDD    FN+3        CHECK FILE MODE
          LPN    4
          NJP    SSF2        IF EXECUTE ONLY FILE
          LDD    FN+3        CHECK FILE MODE
          LPN    21          EXTEND-ONLY AND WRITE LOCKOUT
          LMN    21
          ZJP    SSF2.1      IF READ/ALLOW MODIFY OR READ/ALLOW APPEND
          LDD    FS          CHECK IF EQUIPMENT IS MASS STORAGE
          ZJN    SSF5        IF NO EQUIPMENT ASSIGNED TO FILE
          STD    T5
          SFA    EST
          ADK    EQDE
          CRD    CM          READ EST ENTRY
          LDD    CM
          SHN    21-13       MASS STORAGE BIT
          MJN    SSF6        IF MASS STORAGE
          ERROR  NMS,CH,IW   *(FILENAME) NOT ON MASS STORAGE.*
 
 SSF5     ERROR  EFL,CH,IW   *(FILE NAME) EMPTY.*
 
 SSF6     LDD    CC
          LMN    CCDP
          ZJP    SSFX        IF *DELPFC* REQUEST
          SETMS  STATUS
          LDM    MSD
          LPC    100
          RJM    PDS         PROCESS DEVICE STATUS
          LDD    CM+4        SET FWA OF TRT - TRACK BIT
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH
          STM    SEIA+1
          SHN    -14
          LMC    ADCI
          STM    SEIA
          LDD    FS+2
          ZJN    SSF7        IF FILE NEVER WRITTEN
          LDD    FS+1        DETERMINE FILE LENGTH
          STD    T6
          RJM    SEI
          LDD    T2
          STD    LF
          LDD    T3
          SBN    1           DISCOUNT EOI
          STD    LF+1
          PJN    SSF8        IF NO 12 BIT OVERFLOW
          AOD    LF+1
          SOD    LF
          UJN    SSF8        UPDATE FST
 
 SSF7     LDN    0           SET FILE LENGTH FOR EMPTY FILE
          STD    LF
          STD    LF+1
          LDD    CC
          LMN    CCSD
          ZJN    SSF9        IF *SETDA*
          LJM    SSF5        * (FILE NAME) EMPTY.*
 
*         UPDATE FST.
 
 SSF8     LDD    FS+1        SET CURRENT TRACK = FIRST TRACK
          STD    FS+2
          LDN    FSMS        SET CURRENT SECTOR = FIRST SECTOR
          STD    FS+3
 SSF9     LDD    FS+4        SET STATUS
          SCN    77
          LMN    4
          STD    FS+4
          NFA    FA,R        UPDATE FST
          ADK    FSTL
          CWD    FS
          LJM    SSFX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPACS
 VAL$     SET    0
*CALL     COMPVLC
*CALL     COMPFAT
          QUAL   GFP
 FNT$     EQU    0           DEFINE *COMPGFP* ACCESS TO FNT
*CALL     COMPGFP
          QUAL   *
 .FNT     EQU    /GFP/.FNT
*CALL     COMPSAF
*CALL     COMPSFB
          SPACE  4,15
 LOCF     EQU    *+5         ZERO LEVEL OVERLAY LOAD ADDRESS
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          ERRNG  BFMS-LOCF-ZDFL  *0DF* OVERFLOW
 
 
          OVERFLOW  OVLD,EPFW  OVERFLOW INTO ERROR PROCESSING AREA
          OVERLAY  (ASSIGNPF/FILE RESIDENCE PROCESSING.),OVLD
 FRP      SPACE  4,30
**        THIS OVERLAY DETERMINES THE PROPER RESIDENCE FOR
*         DIRECT ACCESS FILES, ACCORDING TO THE FOLLOWING RULES -
*
*         LOCAL FILE IN EXISTENCE
*                FILE MADE PERMANENT IF LOCAL FILE ON LEGAL PF DEVICE.
*                ABORTED IF FILE NOT ON PF DEVICE.
*                *DT* IS IGNORED.
*                IF REMOVABLE DEVICE REQUEST FILE MUST RESIDE ON THAT
*                REMOVABLE DEVICE.
*
*         NO LOCAL FILE.
*             *DT* = 0.
*                PLACE FILE ON DEVICE WITH MOST AVAILABLE SPACE, AND
*                SUFFICIENT ACCESS LEVEL.
*             *DT* .NE. 0.
*                FILE IS PLACED ON MATCHING DEVICE TYPE WITH SUFFICIENT
*                ACCESS LEVEL AND MOST AVAILABLE SPACE IN FAMILY,
*                OTHERWISE REQUEST IS ABORTED.
*             *PRU* .NE. 0.
*                PLACE FILE ON DEVICE (TYPE *DT* IF SPECIFIED) WITH
*                MOST AVAILABLE SPACE PROVIDED *PRU* SECTORS
*                ARE AVAILABLE. IF THEY ARE NOT REQUEST IS ABORTED.
*
*         IF THE SPECIAL REQUEST *SRMR* IS SPECIFIED, THE FILE MUST
*         RESIDE ON THE MASTER DEVICE (AS DETERMINED BY THE PRIMARY
*         DEVICE MASK), RATHER THAN ON THE DEVICE(S) SPECIFIED IN THE
*         SECONDARY DEVICE MASK(S).
 
 
 FRP      BSS    0           ENTRY
          LDD    CC
          LMN    CCAN
          ZJN    APF         IF *ASSIGNPF* REQUEST
          LDM    LFAL
          STD    CM+4
          LDD    EQ          CHECK *LFAL* WITH MASTER DEVICE *AL*
          STD    CM+2
          LDN    VAES
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          NJN    FRP2        IF FILE ACCESS NOT VALID FOR DEVICE
 
*         PROCESS *DEFINE*, *SETDA*.
 
          RJM    DFR         DETERMINE FILE RESIDENCE
          RJM    SPN         SET PERMANENT FILE NAME
          EXECUTE  3PC       PROCESS REQUEST
 
 FRP2     ERROR  LNP,CH,IW,,SVE  * ACCESS LEVEL NOT VALID ON PF DEVICE*
 APF      SPACE  4,10
***       PROCESS *ASSIGNPF* REQUEST.
*
*         ASSIGN LOCAL FILE TO PROPER PERMANENT FILE DEVICE.
*
*         IF THE SPECIAL REQUEST *SRSY* IS SPECIFIED, WRITE
*         A SYSTEM SECTOR ON THE FILE.
 
 
 APF      BSS    0           ENTRY
          LDM    PFSR        CHECK SPECIAL REQUEST
          LPN    77
          LMN    SRSY
          ZJN    APF2        IF SYSTEM SECTOR IS TO BE PREWRITTEN
          RJM    DFR         DETERMINE FILE RESIDENCE
          LDN    0           SET UP FST FOR SYSTEM SECTOR ACCESS
          STD    FS+2
          STD    FS+3
          LDC    4004        SET FILE STATUS
          STD    FS+4
          NFA    FA,R
          ADN    FSTL
          CWD    FS
          LJM    APF5        TERMINATE PROGRAM
 
*         CLEAR SYSTEM SECTOR.
 
 APF2     LDC    PMFT*100-LOFT*100  FORCE *PMFT* FILE TYPE
          RAM    SFTA
          RJM    DFR         DETERMINE FILE RESIDENCE
          LDC    77*5-1      SET WORD COUNT TO CLEAR
          STD    T1
 APF3     LDN    0
          STM    BFMS+2,T1   CLEAR NEXT WORD
          SOD    T1
          PJN    APF3        IF MORE TO CLEAR
          LDN    72          CURRENT ACCESS MODE (WRITE MODE/PURGED)
          STM    CASS
 
*         WRITE SYSTEM AND EOI SECTORS.
 
          LDD    FS+1        SET TRACK AND SECTOR
          STD    T6
          STD    FS+2
          LDN    FSMS
          STD    FS+3
          LDN    4           SET FILE STATUS
          STD    FS+4
          NFA    FA,R        PREWRITE FST FOR *COMPWEI*
          ADN    FSTL
          CWD    FS
          SETMS  IO,,BFMS
          RJM    PDV         PROCESS DEVICE STATUS
          RJM    WSS         WRITE SYSTEM SECTOR
          MJN    APF3.1      IF WRITE ERROR
          RJM    WEI         WRITE EOI SECTOR
          PJN    APF4        IF NO MASS STORAGE ERROR
 APF3.1   ERROR  MSE,CH,IW,FS  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
 APF4     ENDMS
          LDD    FS          INCREMENT USER COUNT FOR DEVICE
          STD    CM+1
          LDN    IUCS        INCREMENT USER COUNT
          STD    CM+3
          MONITOR  SMDM
          LDN    FSMS        SET EOI IN TRT
          STD    CM+3
          LDD    T6
          LPC    3777
          STD    CM+2
          LDD    FS
          STD    CM+1
          MONITOR  DTKM
 APF5     EXECUTE  3PU       TERMINATE PROGRAM
          TITLE  SUBROUTINES.
 CDA      SPACE  4,15
**        CDA - CHECK DEVICE ACCESSIBILITY.
*
*         ENTRY  (T2) = EST ORDINAL FOR DEVICE.
*                (T3 - T3+4) = EST ENTRY FOR DEVICE.
*
*         EXIT   (A) = 0 IF DEVICE CAN BE ACCESSED.
*                (A) = 1 IF NEW ACTIVITY RESTRICTED ON DEVICE.
*                (A) = 2 IF PF UTILITY ACTIVE.
*                (A) = 3 IF ACCESS DENIED BY *SETMS*.
*                (A) = 4 IF *ERROR IDLE* SET FOR DEVICE.
*
*         USES   T5, CM - CM+4.
*
*         MACROS SETMS.
 
 
 CDA      SUBR               ENTRY/EXIT
 
*         CHECK IF *ERROR IDLE* SET FOR DEVICE.
 
          LDD    T3+4        MST ADDRESS/10B
          SHN    3
          ADN    ACGL
          CRD    CM
          LDD    CM+4
          LPN    20
          ZJN    CDA2        IF NOT *ERROR IDLE*
          LDM    SSJS
          ZJN    CDA1        IF NOT *SSJ=* JOB
          LDM    PFSR
          LPN    77
          LMN    SRIE
          ZJN    CDA2        IF *IGNORE ERROR IDLE* SPECIAL REQUEST
 CDA1     LDN    4           RETURN WITH (A) = 4
          UJN    CDAX        RETURN
 
*         CHECK *SUSPECT*, *OFF*, AND *DOWN* STATUS.
 
 CDA2     LDD    T2          EST ORDINAL
          STD    T5
          SETMS  STATUS
          LDM    MSD
          SHN    21-6
          PJN    CDA4        IF DEVICE CAN BE ACCESSED
          LDN    3           RETURN WITH (A) = 3
 CDA3     UJN    CDAX        RETURN
 
*         CHECK IF PF UTILITY ACTIVE.
 
 CDA4     LDD    T3+4        MST ADDRESS/10B
          SHN    3
          ADK    TDGL
          CRD    CM
          LDD    CM+1
          SHN    21-6
          PJN    CDA5        IF DEVICE NOT INTERLOCKED
          LDN    2           RETURN WITH (A) = 2
          UJN    CDA3        RETURN
 
*         CHECK NEW ACTIVITY RESTRICTIONS.
 
 CDA5     LDD    T3+4        MST ADDRESS/10B
          SHN    3
          ADN    DALL
          CRD    CM
          LDD    CM
          SHN    21-6
          MJN    CDA6        IF *RESTRICT NEW ACTIVITY* FLAG SET
          SHN    0-10-21+6+22
          LPN    3
          SBN    1
          NJN    CDA7        IF *IDLE* FLAG NOT SET
 CDA6     LDN    1           RETURN WITH (A) = 1
          UJN    CDA3        RETURN
 
 CDA7     LDN    0           RETURN WITH (A) = 0
          UJN    CDA3        RETURN
 CML      SPACE  4,15
**        CML - CHECK MASS STORAGE LIMIT.
*
*         ENTRY  (CMLA - CMLA+1) = VALUE OF DECREMENT.
*
*         EXIT   TO ERR IF ERROR IN PRU LIMITS.
*
*         USES   CM - CM+4.
 
 
 CML      SUBR
          LDD    CP          READ PRU VALUE FOR CONTROL POINT
          ADK    ACLW
          CRD    CM
          LDD    CM+3        CHECK FOR LIMIT EXCEEDED
          LPN    77
          SBM    CMLA
          MJN    CML1        IF LIMIT EXCEEDED
          NJN    CMLX        IF LIMIT NOT EXCEEDED
          LDD    CM+4
          SBM    CMLA+1
          PJN    CMLX        IF LIMIT NOT EXCEEDED
 CML1     ERROR  PRL,CH,IW   *PRU LIMIT.*
 
 CMLA     CON    0,0         VALUE OF PRU DECREMENT
 CPF      SPACE  4,10
**        CPF - CHECK FOR PRESERVED FILE.
*
*         ENTRY  (P3) = MST ADDRESS.
*
*         EXIT   (A) .LT. 0 IF PRESERVED FILE BIT SET.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  CTA.
 
 
 CPF      SUBR               ENTRY/EXIT
          LDD    P3          SET *TRT* ADDRESS
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH
          SHN    2
          ADD    FS+1
          STD    T1          SAVE REMAINDER FOR POSITION IN WORD
          SHN    -2          4 TRACK ASSIGNMENTS FOR EACH WORD
          CRD    CM          READ *TRT* WORD FOR TRACK
          LDD    T1          SET PRESERVED BIT POSITION
          LPN    3
          ADC    SHNI+6
          STM    CPFA        SET SHIFT INSTRUCTION
          LDD    CM+4        CHECK FOR PRESERVED STATUS
 CPFA     SHN    **          (21-13+TRACK INDEX)
          UJN    CPFX        RETURN
 CPR      SPACE  4,20
**        CPR - CHECK PROPER PERMANENT FILE RESIDENCE.
*
*         ENTRY  (T2) = EST ORDINAL FOR DEVICE.
*                (T3 - T7) = EST ENTRY FOR DEVICE.
*                (FN - FN+4) = USERS FAMILY OR PACK NAME.
*                (FRSM) = MASK BITS FOR DIRECT ACCESS FILE.
*                RESIDENCE ALLOWED.
*
*         EXIT   (A) = 0 IF PROPER DEVICE.
*                (A) .GT. 0 IF INCORRECT DEVICE.
*                (A) = -1 IF DEVICE UNAVAILABLE.
*                (A) = -2 IF DEVICE ACCESS ERROR.
*
*         USES   T4, CM - CM+4.
*
*         MACROS MONITOR.
 
 
 CPR9     LDN    1
 
 CPR      SUBR               ENTRY/EXIT
          LDD    T3
          SHN    -6
          LPN    41
          LMN    40
          NJN    CPRX        IF NOT AVAILABLE MASS STORAGE
          LDD    T3+4        READ  *MDGL*
          SHN    3
          ADN    MDGL
          CRD    CM
          LDM    PFPN
          ZJN    CPR1        IF NOT AUXILIARY DEVICE REQUEST
          LDD    CM
          SHN    21-12
          PJN    CPR9        IF NOT AUXILIARY DEVICE
 CPR1     LDD    T3+4        SET MST ADDRESS
          SHN    3
          ADN    STLL
          CRD    CM
          LDD    CM
          LPC    MLFPR+MLIAL+MLIHD+MLIFD+MLIPF
          ZJN    CPR2        IF NO INITIALIZATION PENDING
          LCN    1           FLAG *DEVICE UNAVAILABLE*
          UJP    CPRX        RETURN
 
 CPR2     LDD    T3+4        READ PF DESCRIPTION
          SHN    3
          ADN    PFGL
          CRD    CM
          LDM    RQDT        CHECK FOR USER REQUESTED DEVICE TYPE
          SHN    -6
          ZJN    CPR5        IF NOT USER REQUESTED DEVICE TYPE
          LDM    RQDT+1      CHECK UNIT COUNT
          LPN    77
          SBN    1R0+1       CONVERT FROM DISPLAY CODE
          LMD    CM+4
          LPN    77
          ZJN    CPR5        IF RIGHT UNIT COUNT AND FIRST UNIT
 CPR4     LJM    CPRX        RETURN
 
 CPR5     LDD    CM          COMPARE DEVICE NAMES
          LMD    FN
          NJN    CPR4        IF NO MATCH
          LDD    CM+1
          LMD    FN+1
          NJN    CPR4        IF NO MATCH
          LDD    CM+2
          LMD    FN+2
          NJN    CPR4        IF NO MATCH
          LDD    CM+3
          LMD    FN+3
          SCN    77
          NJN    CPR4        IF NO MATCH
          LDD    T3+4        READ DEVICE MASKS
          SHN    3
          ADN    PUGL
          CRD    CM
          LDM    SSJS
          ZJN    CPR6        IF NOT *SSJ=* JOB
          LDM    PFSR        CHECK SPECIAL REQUEST
          LPN    77
          LMN    SRMR
          NJN    CPR6        IF MASTER DEVICE RESIDENCE NOT REQUIRED
          LDD    CM+4        CHECK PRIMARY MASK
          UJN    CPR7        CHECK MASK
 
 CPR6     LDD    CM+3        CHECK SECONDARY MASK
          SHN    14
          LMD    CM+4
          SHN    -10
 CPR7     STM    CPRB
          LDM    FRSM
          LPC    *           (DEVICE MASK)
 CPRB     EQU    *-1
          LMM    FRSM
          LPC    377
          NJN    CPR8        IF NOT CORRECT DEVICE
          LDM    LFAL        CHECK DEVICE ACCESS LEVEL
          STD    CM+4
          LDD    T2
          STD    CM+2
          LDN    VAES
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          ZJN    CPR8        IF FILE ACCESS VALID FOR DEVICE
          LCN    2
 CPR8     LJM    CPRX        RETURN
 DDN      SPACE  4,10
**        DDN - DETERMINE DEVICE NAME.
*
*         ENTRY  (PFPN - PFPN+3) = PACK NAME.
*                (PFPN+4) = FAMILY EST ORDINAL.
*
*         EXIT   (FN - FN+3) = PACK OR FAMILY NAME FOR REQUEST.
*
*         USES   CM - CM+4, FN - FN+4.
*
*         MACROS SFA.
 
 
 DDN1     LDD    MA          SET PACK NAME
          CWM    PFPN,ON
          SBN    1
          CRD    FN
 
 DDN      SUBR               ENTRY/EXIT
          LDM    PFPN
          NJN    DDN1        IF REMOVABLE DEVICE REQUEST
 
*         SET FAMILY NAME.
 
          SFA    EST,PFPN+4  READ FAMILY EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM+4        READ FAMILY NAME
          SHN    3
          ADN    PFGL
          CRD    FN
          UJN    DDNX        RETURN
 DFR      SPACE  4,20
**        DFR - DETERMINE FILE RESIDENCY.
*
*         ENTRY  (FN - FN+4) = FILE NAME SET AS LOCAL FILE.
*                (FS - FS+4) = FST ENTRY FOR EXISTING FILE.
*
*         EXIT   (FS - FS+4) = FST ENTRY (STATUS SET BUSY).
*                (ERRB) .NE. 0 IF FILE PREVIOUSLY EXISTED.
*                (LFEF) = 0 IF FILE IS NOT EMPTY.
*                (PFDN) = DEVICE NUMBER OF DEVICE LOCAL FILE IS ON.
*                (SDAB) = FIRST TRACK OF FILE.
*                (SDAC) = 4XXX WHERE XXX IS *DT* IF REQUESTED
*                         OTHERWISE XXX = 000.
*
*         USES   LF - LF+1, P0 - P3, SA - SA+1, T1 - T7.
*
*         CALLS  CDA, CML, CPF, CPR, DDN, DSA, PDS, SFA, SFN, SFT.
*
*         MACROS ERROR, SETMS, SFA.
 
 
*         FILE EXISTS OR HAS BEEN CREATED - PROCEED WITH REQUEST.
 
 DFR20    LDC    4000        SET DA FILE INDICATION + *DT* IF REQUESTED
 DFRA     EQU    *-1
          STM    SDAC
          LDD    FS+1        SET FIRST TRACK
          STM    SDAB
          LDD    P3          SAVE FILE MST ADDRESS
          SHN    3           SET DEVICE NUMBER
          ADN    PFGL
          CRD    CM
          LDD    CM+3
          LPN    77
          STM    PFDN
          LDD    FS
          LMM    SDAA
          NJN    DFRX        IF FILE NOT ON MASTER DEVICE
          STM    PFDN        SET DEVICE NUMBER TO ZERO
 
 DFR      SUBR               ENTRY/EXIT
          LDD    FS+1        CHECK TRACK ASSIGNMENT
          NJN    DFR1        IF NOT NULL FILE
          LJM    DFR10       DETERMINE CORRECT DEVICE
 
*         PROCESS EXISTING FILE.
 
 DFR1     LDM    FRSM        CHECK FOR SPECIAL USER INDEX
          SHN    21-13
          PJN    DFR2        IF NOT SPECIAL USER INDEX
          SHN    13+21-20    RESTORE ORIGINAL VALUE
          LPC    -377        CLEAR DEVICE ACCESS MASK
          STM    FRSM
 DFR2     LDD    FS+2
          NJN    DFR3        IF NOT EMPTY FILE
          AOM    LFEF
 DFR3     LDD    FN+4        CHECK FILE TYPE
          SHN    -6
          LMN    PMFT
          STM    DFRB        SAVE *PMFT* TEST
          ZJN    DFR6        IF *PMFT* FILE TYPE
          LMN    LIFT&PMFT
          ZJN    DFR5        IF *LIFT* FILE TYPE
          LMN    LOFT&LIFT
          ZJN    DFR6        IF *LOFT* FILE TYPE
 DFR4     ERROR  IFT,CH,IW   *(FILE NAME) INCORRECT FILE TYPE*
 
 DFR5     LDM    FRSM        CHECK IF *LIFT* FILES LEGAL
          SHN    21-12
          PJN    DFR4        IF *LIFT* FILES INVALID
 DFR6     LDD    FN+3
          LPN    4
          NJN    DFR4        IF EXECUTE ONLY FILE
 
*         DETERMINE IF FILE IS ON PROPER DEVICE.
 
          LDD    FS          READ EST ENTRY
          STD    T2
          SFA    EST
          ADK    EQDE
          CRD    T3
          RJM    DDN         DETERMINE DEVICE NAME
          RJM    CPR         CHECK FOR PROPER RESIDENCE
          NJN    DFR8        IF RESIDENCE CHECK FAILED
          RJM    CDA         CHECK DEVICE ACCESSIBILITY
          RJM    PDS         PROCESS DEVICE STATUS
          LDD    T3+4        SAVE MST ADDRESS
          STD    P3
          LDC    *           CHECK IF *PMFT* FILE
 DFRB     EQU    *-1
          NJN    DFR7        IF NOT *PMFT* FILE
          RJM    CPF         CHECK FOR PRESERVED FILE
          PJN    DFR7        IF FILE NOT PRESERVED
          NFA    FA,R        READ FILE NAME FOR MESSAGE
          ADK    FNTL
          CRD    FN
          LJM    DFR4        RETURN FILE TYPE ERROR
 
 DFR7     LJM    DFR20       COMPLETE PROCESSING
 
 
 DFR8     MJN    DFR8.1      IF NOT DIRECT ACCESS DEVICE ERROR
          ERROR  DAD,CH,IW   * DIRECT ACCESS DEVICE ERROR.*
 
 DFR8.1   ADN    1
          ZJN    DFR9        IF DEVICE UNAVAILABLE
          ERROR  LNP,CH,IW,,SVE  * ACCESS LEVEL NOT VALID ON PF DEVICE*
 
 DFR9     ERROR  PFN,CH,IW   * DEVICE UNAVAILABLE.*
 
*         IF NO ACCESSIBLE DEVICE WITH SUFFICIENT SPACE IS FOUND,
*         *DFRC* WILL BE THE STATUS FOR THE MOST ACCESSIBLE DEVICE
*         WHICH WAS ALMOST (BUT NOT QUITE) SELECTED.
 
 DFR9.1   LDC    77          DEVICE STATUS FOR NO DEVICE FOUND
*         LDC    (STATUS)    (STATUS FOR DEVICE WITH NO SPACE)
 DFRC     EQU    *-1
          SBN    3
          PJN    DFR9        IF DEVICE INACCESSIBLE OR NO DEVICE FOUND
          ERROR  SPN,CH,IW   *REQUESTED SPACE UNAVAILABLE.*
 
*         FILE DOES NOT EXIST - DETERMINE PROPER DEVICE FOR FILE.
 
 DFR10    AOM    LFEF        SET EMPTY FILE
          RJM    SFA
          ADN    1
          CRD    CM
          LDD    CM          SET DEVICE TYPE REQUESTED
          STD    P0
          LPC    3777        SET TYPE REQUESTED IN CATALOG
          RAM    DFRA
          LDM    FETL        CHECK FET LENGTH
          SBN    CFOU+1
          MJN    DFR10.1     IF NOT LONG ENOUGH TO REQUEST SPACE
          RJM    SFA
          ADN    CFOU
          CRD    CM
          LDD    CM+3
          STD    LF
          ADD    CM+4
          ZJN    DFR10.1     IF SPACE NOT SPECIFIED
          AOM    DFRD        SET SPACE REQUIRED CHECK
          LDD    CM+4
          STD    LF+1
 DFR10.1  LDN    0
          STD    SA
          STD    SA+1
          STD    FS
          LDN    77          INITIALIZE DEVICE STATUS
          STD    P2
          RJM    DDN         DETERMINE DEVICE NAME
          LDN    ESTP        READ EST POINTER
          CRD    T1
          LDD    T1+3        SET LAST MASS STORAGE ORDINAL + 1
          STD    T1
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    T2
 
*         CHECK NEXT DEVICE.
 
 DFR11    AOD    T2          ADVANCE EST ORDINAL
          LMD    T1
          NJN    DFR12       IF MORE DEVICES TO CHECK
          LDD    FS
          ZJP    DFR9.1      IF NO DEVICE FOUND
          LDD    P2
          RJM    PDS         PROCESS DEVICE STATUS
          LJM    DFR14       SET UP FNT AND EXIT
 
 DFR12    SFA    EST,T2      READ EST ENTRY
          ADK    EQDE
          CRD    T3
          LDD    P0
          ZJN    DFR13       IF DEVICE TYPE NOT REQUESTED
          LMD    T3+3
          NJN    DFR11       IF NOT PROPER DEVICE TYPE
 DFR13    RJM    CPR         CHECK FOR PROPER RESIDENCE
          NJN    DFR11       IF NOT PROPER DEVICE
          RJM    CDA         CHECK DEVICE ACCESSIBILITY
          STD    P1          SAVE STATUS OF CURRENT DEVICE
 
*         SELECT MOST ACCESSIBLE DEVICE WITH MOST AVAILABLE SPACE.
 
          RJM    DSA         DETERMINE SPACE AVAILABLE
          LDD    P2          COMPARE STATUS OF DEVICES
          SBD    P1
          ZJN    DFR13.2     IF STATUS THE SAME
          PJN    DFR13.3     IF CURRENT DEVICE MORE ACCESSIBLE
 DFR13.1  UJP    DFR11       CHECK NEXT DEVICE
 
 DFR13.2  LDD    CM          COMPARE SECTORS AVAILABLE
          SBD    SA
          MJN    DFR13.1     IF LESS AVAILABLE
          NJN    DFR13.5     IF MORE AVAILABLE
          LDD    SA+1
          SBD    CM+1
          MJN    DFR13.5     IF MORE AVAILABLE
          UJN    DFR13.1     CHECK NEXT DEVICE
 
 DFR13.3  LDN    0           SPACE REQUIRED NOT SPECIFIED
*         LDN    1           (SPACE REQUIRED SPECIFIED)
 DFRD     EQU    *-1
          ZJN    DFR13.5     IF SPACE REQUIRED NOT SPECIFIED
          LDD    P1          COMPARE CURRENT DEVICE STATUS
          SBM    DFRC
          PJN    DFR13.4     IF SAVED STATUS BETTER
          RAM    DFRC
 DFR13.4  LDD    CM
          SBD    LF
          MJN    DFR13.1     IF NOT ENOUGH SPACE
          NJN    DFR13.5     IF ENOUGH SPACE
          LDD    CM+1
          SBD    LF+1
          MJN    DFR13.1     IF NOT ENOUGH SPACE
 DFR13.5  LDD    CM          SELECT THIS DEVICE
          STD    SA
          LDD    CM+1
          STD    SA+1
          LDD    T2          SET EST ORDINAL
          STD    FS
          LDD    P1          SAVE DEVICE STATUS
          STD    P2
          LDD    T3+4        SAVE MST ADDRESS
          STD    P3
          LDM    PFPN
          NJN    DFR14       IF AUXILIARY DEVICE REQUEST
          LJM    DFR11       CHECK FOR MORE DEVICES
 
 DFR14    LDD    FS          SET DRIVER FOR PF EQUIPMENT
          STD    T5
          SETMS  STATUS
 DFR18    LDM    SLM         PRE-CHECK PRU LIMIT
          STM    CMLA+1
          LDN    0           SHOW REQUEST PRESET
          RJM    CML
          LDC    PFSN
          RJM    SFN
          RJM    SFT         SET FNT/FST INFORMATION
          LDD    FS+1
          ZJN    DFR19       IF NO TRACK ASSIGNED
          LDM    SLM         DECREMENT PRU COUNT FOR TRACK ASSIGNED
          STM    AIPR+1
          LJM    DFR20       COMPLETE
 
 DFR19    ERROR  TKL,CH,IW,FS  *EQXXX,DNYY, TRACK LIMIT.*
 DSA      SPACE  4,10
**        DSA - DETERMINE SPACE AVAILABLE ON A DEVICE.
*
*         ENTRY  (T3+4) = MST ADDRESS/10.
*
*         EXIT   (CM - CM+1) = SPACE AVAILABLE.
*
*         USES   CM - CM+4.
 
 
 DSA      SUBR               ENTRY/EXIT
          LDD    T3+4        ADDRESS OF MST
          SHN    3
          ADK    MDGL        GET SECTORS PER TRACK
          CRD    CM
          LDD    CM+4
          STD    T0
          LDD    T3+4        ADDRESS OF MST
          SHN    3
          ADK    TDGL        GET TRACKS AVAILABLE
          CRD    CM
          LDN    0
          STD    CM          CLEAR RESULT
          STD    CM+1
          STD    CM+3        CLEAR UPPER HALF OF MULTIPLIER
 
*         MULTIPLY NUMBER OF TRACKS AVAILABLE BY NUMBER OF SECTORS
*         PER TRACK USING SHIFTS AND ADDS.
 
 DSA1     LDD    T0          CHECK MULTIPLIER (SECTORS PER TRACK)
          ZJN    DSAX        IF DONE
          SHN    21-0        RIGHT SHIFT MULTIPLIER 1 BIT
          STD    T0
          PJN    DSA2        IF NO ADDITION
          LDD    CM+4        ADD SHIFTED NUMBER OF TRACKS TO RESULT
          RAD    CM+1
          SHN    -14
          ADD    CM+3
          RAD    CM
 DSA2     LDD    CM+3        SHIFT NUMBER OF TRACKS TO THE LEFT
          RAD    CM+3
          LDD    CM+4
          RAD    CM+4
          SHN    -14
          RAD    CM+3
          UJN    DSA1        DO NEXT ITERATION OF MULTIPLY
 PDS      SPACE  4,25
**        PDS - PROCESS DEVICE STATUS.
*
*         ENTRY  (A) = 0 IF DEVICE CAN BE ACCESSED.
*                (A) = 1 IF NEW ACTIVITY RESTRICTED ON DEVICE.
*                (A) = 2 IF PF UTILITY ACTIVE.
*                (A) = 3 IF ACCESS DENIED BY *SETMS*.
*                (A) = 4 IF *ERROR IDLE* SET FOR DEVICE.
*                (FS) = EST ORDINAL OF DEVICE.
*                (FERT) = REAL-TIME PROCESSING FLAG.
*                (SSYS) = SUBSYSTEM FLAG.
*
*         EXIT   RETURN IF DEVICE CAN BE ACCESSED.
*
*                TO *ERR* IF PF UTILITY ACTIVE.
*                TO *ERR* IF DEVICE IS INACCESSIBLE.
*                TO *ERR* IF *ERROR IDLE* IS SET.
*
*                THE FOLLOWING LOCATIONS ARE SET FOR ERROR EXITS WHICH
*                MAY CAUSE THE JOB TO BE ROLLED OUT.
*                (ERRC) = ROLLOUT EVENT.
*                (ERRD) = ROLLOUT TIME.
*
*         USES   T0.
*
*         MACROS ERROR.
 
 
 PDS4     LDN    0           RETURN WITH (A) = 0
 
 PDS      SUBR               ENTRY/EXIT
          STD    T0          SAVE DEVICE STATUS
          SBN    2
          MJN    PDS4        IF DEVICE CAN BE ACCESSED, RETURN
          NJN    PDS1        IF PF UTILITY NOT ACTIVE
          LDN    PFUE        SET ROLLOUT EVENT
          STM    ERRC
          LDK    UIRT        SET ROLLOUT TIME
          STM    ERRD
          ERROR  PFA,CH,IW,,EC2  * PF UTILITY ACTIVE.*
 
 PDS1     LDM    FERT
          NJN    PDS2        IF REAL-TIME PROCESSING SET
          LDM    SSYS
          NJN    PDS3        IF A SUBSYSTEM
 
*         SUSPEND THE JOB OR RETURN STATUS INDICATING DELAY TO CALLER.
 
 PDS2     LDD    T0
          SBN    4
          ZJN    PDS3        IF *ERROR IDLE* IS SET
          ERROR  WID,CH,IW,FS,EC6  * WAITING - INACCESSIBLE DEVICE.*
 
*         TERMINATE THE REQUEST.
 
 PDS3     ERROR  PFN,CH,IW   * DEVICE UNAVAILABLE.*
 SFT      SPACE  4,20
**        SFT - SET FNT/FST INFORMATION.
*
*         ENTRY  (FNTA) = FNT ADDRESS IN NFL.
*                (LFAL) = LOCAL FILE ACCESS LEVEL.
*                (FN - FN+4) = LOCAL FILE NAME.
*                (FS) = FILE EST ORDINAL.
*
*         EXIT   (FA) = FNT ADDRESS.
*                (FS - FS+4) = FST ENTRY.
*                (FN - FN+4) = FNT ENTRY.
*                (RTKE) = RESERVED TRACK EST ORDINAL.
*                (RTKT) = RESERVED TRACK.
*                FNT/FST REWRITTEN TO CENTRAL MEMORY.
*
*         USES   FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
*         MACROS MONITOR, NFA.
 
 
 SFT      SUBR               ENTRY/EXIT
          LDC    LOFT*100    SET FILE TYPE
*         LDC    PMFT*100    (*ASSIGNPF* WITH *SRSY* SPECIAL REQUEST)
 SFTA     EQU    *-1
          RAD    FN+4
          LDM    FNTA        SET FST ADDRESS
          STD    FA
          NFA    FA,R        SET FILE ACCESS LEVEL
          ADN    FUTL
          CRD    CM
          LDM    LFAL
          STD    CM+2
          NFA    FA,R        UPDATE FNT INFORMATION
          ADK    FNTL
          CWD    FN
          ADN    FUTL-FNTL
          CWD    CM
          LDN    ZERL        REQUEST TRACK FOR FILE
          CRD    CM
          LDD    FS          SET EST ORDINAL
          STD    CM+1
          STM    RTKE        SET RESERVED TRACK EST ORDINAL
          MONITOR RTCM
          LDD    CM+4        SET FST
          STM    RTKT        SET RESERVED TRACK
          STD    FS+1
          STD    FS+2
          LDN    FSMS
          STD    FS+3
          LDN    4
          STD    FS+4
          NFA    FA,R        REWRITE FNT/FST
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CWD    FS
          LJM    SFTX        RETURN
          SPACE  4,10
 WCS$     EQU    0           SELECT CONSECUTIVE SECTOR WRITE
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPWEI
*CALL     COMPWSS
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLD,EPFW  OVERFLOW INTO ERROR PROCESSING AREA
          OVERLAY  (CATALOG/PERMIT SEARCH AND RESIDENT.),OVLA
          SPACE  4,25
**        THIS OVERLAY CONTAINS PRELIMINARY PROCESSING FOR
*         MOST REQUESTS, INCLUDING CATALOG AND PERMIT SEARCH.
*         IT ALSO CONTAINS RESIDENT SUBROUTINES.
*
*         ENTRY  (CC) = COMMAND CODE.
 
 
 OVL      BSS    0           ENTRY
          LJM    IRP         INITIAL REQUEST PROCESSING
 MSR      SPACE  4,10
**        MSR - *COMPRNS* MASS STORAGE READ ERROR PROCESSOR.
*
*         ENTRY  FROM *RNS*.
*                (MSRA) = ADDRESS OF ERROR PROCESSOR IN CALLER
*                         OF *RNS*.
*
*         CALLS  PCC, PCE, PTE.
 
 
 MSR      SUBR               ENTRY/EXIT
          RJM    PCE         PROCESS CATALOG READ ERROR
*         RJM    PCC         (CATALOG READ ERROR FOR *CHANGE* REQUEST)
*         RJM    PTE         (READ ERROR FOR DEVICE TO DEVICE TRANSFER)
 MSRA     EQU    *-1         ERROR PROCESSOR ADDRESS
          UJN    MSRX        RETURN
          SPACE  4,10
*         RESIDENT COMMON DECKS.
 
 
*CALL     COMPSNT
*CALL     COMPRNS
          SPACE  4,10
 LOCG     EQU    *+5         LOAD ADDRESS FOR DEVICE/DEVICE TRANSFER
          TITLE  RESIDENT SUBROUTINES.
 CAI      SPACE  4,15
**        CAI - CLEAR ALLOCATION INTERLOCK.
*
*         ENTRY  (T5)= PERMANENT FILE EST ORDINAL.
*                (AILK) = TRACK FOR ALLOCATION INTERLOCK.
*
*         EXIT   ALLOCATION INTERLOCK CLEARED.
*
*         USES   T5.
*
*         CALLS  CTI.
 
 
 CAI      SUBR               ENTRY/EXIT
          LDC    4000        SET CHECKPOINT VIA *STBM*
          RAD    T5
          LDM    AILK
          RJM    CTI         CLEAR TRACK INTERLOCK
          LDD    T5          RESTORE EST ORDINAL
          LPC    777
          STD    T5
          LDN    0           CLEAR INTERLOCK FLAG
          STM    AILK
          UJN    CAIX        RETURN
 CSA      SPACE  4,15
**        CSA - COMPUTE SECTOR ADDRESS.
*
*         ENTRY  (RI - RI+1) = RANDOM INDEX OF PERMIT SECTOR.
*                (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
*                PROPER DRIVER LOADED.
*
*         EXIT   (T6) = TRACK OF RANDOM SECTOR.
*                (T7) = SECTOR OF RANDOM SECTOR.
*
*         USES   T6 - T7, RI - RI+1.
*
*         CALLS  CRA.
*
*         MACROS ERROR.
 
 
 CSA      SUBR               ENTRY/EXIT
          LDM    DVLW+2      SET FIRST TRACK
          STD    T6
          RJM    CRA         CONVERT RANDOM ADDRESS
          PJN    CSAX        IF RANDOM ADDRESS OK
          ERROR  RIN,,,EQ    *EQXXX,DNYY, RANDOM INDEX ERROR.*
 DPR      SPACE  4,15
**        DPR - DELAY PRIOR TO RETRY.
*
*         DELAY 100 MILLISECONDS.
*
*         EXIT   TO *ERR* IF *ORET* SET.
*
*         USES   T0.
*
*         MACROS DELAY, ERROR, PAUSE.
 
 
 DPR      SUBR               ENTRY/EXIT
          LDC    1400
          STD    T0
 DPR1     DELAY
          PAUSE
          LDD    CM+1
          LMN    ORET
          ZJN    DPR2        IF *ORET* SET
          SOD    T0
          PJN    DPR1        IF MORE DELAY REQUIRED
          UJN    DPRX        RETURN
 
 DPR2     ERROR  ABT,,,T5    *EQXXX,DNYY, PFM ABORTED.*
 DTK      SPACE  4,15
**        DTK - DROP TRACKS.
*
*         ENTRY  (A) = LAST SECTOR WRITTEN.
*                (T6) = ADDRESS OF LAST TRACK (NOT RELEASED).
*                (T5) = EST ORDINAL.
*
*         EXIT   LAST SECTOR WRITTEN UPDATED IN TRT.
*
*         USES   CM - CM+4.
 
 
 DTK      SUBR               ENTRY/EXIT
          STD    CM+3
          LDD    T6
          LPC    3777
          STD    CM+2
          LDD    T5
          STD    CM+1
          MONITOR DTKM
          UJN    DTKX        RETURN
 ITC      SPACE  4,15
**        ITC - INTERLOCK TRACK CHAIN.
*
*         ENTRY  (A) = TRACK CHAIN TO BE INTERLOCKED.
*                (T5) = EST ORDINAL.
*
*         EXIT   (A) = 0 IF TRACK INTERLOCKED.
*                (A) = 2 IF TRACK NOT RESERVED.
*                (T6) = TRACK.
*
*         CALLS  DPR, STI.
 
 
 ITC2     LMN    1           RETURN STATUS VALUE
 
 ITC      SUBR               ENTRY/EXIT
          STD    T6
 ITC1     RJM    STI         TRY TO INTERLOCK TRACK
          LMN    1
          NJN    ITC2        IF INTERLOCK WORKED OR TRACK NOT RESERVED
          RJM    DPR         DELAY PRIOR TO RETRY
          UJN    ITC1        TRY AGAIN
 RMD      SPACE  4,15
**        RMD - RESET TO MASTER DEVICE.
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*
*         EXIT   (T5) = MASTER DEVICE EST ORDINAL.
*
*         USES   T5.
*
*         CALLS  PDV.
*
*         MACROS SETMS.
 
 
 RMD      SUBR               ENTRY/EXIT
          LDD    EQ
          STD    T5
          SETMS  IO,NS
          RJM    PDV         PROCESS DEVICE STATUS
          UJN    RMDX        RETURN
 UCE      SPACE  4,20
**        UCE - UPDATE CATALOG ENTRY.
*
*         ENTRY  (CB) = POINTER TO BUFFER LOCATION.
*                (CI) = POINTER TO CATALOG ENTRY IN BUFFER.
*                MASTER DEVICE CHANNEL RESERVED.
*                (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
*                (UCEA) SET WITH *STMI+CI* IF FCMD, FCUD
*                       ARE TO BE UPDATED.
*
*         EXIT   (PWRF) = FLAGS SET FOR ACCESS AND PERMIT COUNTS
*                         UPDATED.
*                FCAC, FCAD, FCMD, FCUD UPDATED.
*                CATALOG ENTRY REWRITTEN.
*
*         USES   CM - CM+4.
*
*         CALLS  WBI.
 
 
 UCE      SUBR               ENTRY/EXIT
 
*         UPDATE DATES.
 
          LDN    PDTL        READ PACKED DATE AND TIME
          CRD    CM
          LDN    3
          STD    CM
          RAD    CI
 UCE1     LDM    CM+2-1,CM
 UCEA     UJN    UCE2        READ ACCESS - BYPASS FCMD, FCUD UPDATES
*         UJN    UCE3        (*UATTACH*/M=R - BYPASS DATE/TIME UPDATE)
*         STM    FCUD-1,CI   (UPDATE UTILITY CONTROL DATE/TIME)
          CON    FCUD-1
 UCEB     STM    FCMD-1,CI   UPDATE MODIFICATION DATE
*         UJN    UCE3        (*UATTACH* - BYPASS FCMD, FCAD UPDATE)
 UCE2     STM    FCAD-1,CI   UPDATE ACCESS DATE
 UCE3     SOD    CI
          SOD    CM
          NJN    UCE1        IF UPDATE NOT COMPLETE
 
*         UPDATE ACCESS COUNT.
 
          LDM    PWRF        RESTART FLAGS
          LPK    RFAC
          NJN    UCE4        IF ACCESS COUNT UPDATED
 UCEC     AOM    FCAC+1,CI   ADVANCE ACCESS COUNT
*         UJN    UCE4        (*UATTACH* - BYPASS ACCESS COUNT UPDATE)
          SHN    -14
          RAM    FCAC,CI
 
*         REWRITE CATALOG ENTRY.
 
 UCE4     LDD    CB          REWRITE CATALOG
          RJM    WBI
          LDM    PWRF        RESTART FLAGS
          SCN    RFAC+RFPC
          ADK    RFAC+RFPC   SET ACCESS AND PERMIT COUNTS UPDATED
          STM    PWRF
          UJP    UCEX        RETURN
 
*         CHECK RANGE ON GENERATED JUMPS.
 
          ERRNG  37-UCE3+UCEB
          ERRNG  37-UCE4+UCEC
 WBI      SPACE  4,20
**        WBI - WRITE BUFFER IN PLACE.
*
*         ENTRY  (A) = BUFFER LOCATION.
*                (T5) = MASTER DEVICE EST ORDINAL.
*                (STAT) = *STNS* BIT SET IF NO JOB SUSPENSION ALLOWED.
*                ADDRESS SET IN 2 LOCATIONS PRECEEDING BUFFER.
*                LINKAGE SET IN BUFFER.
*
*         EXIT   SECTOR WRITTEN.
*                TO *ERR* TO PROCESS MASS STORAGE ERROR.
*
*         USES   T3, T6, T7.
*
*         CALLS  PDV, PES, WDS.
*
*         MACROS ERROR, SETMS.
 
 
 WBI      SUBR               ENTRY/EXIT
          STD    T3          SAVE BUFFER ADRRESS
          LDM    -2,T3
          STD    T6
          LDM    -1,T3
          STD    T7
          SETMS  IO,(RW,NS)
          RJM    PDV         PROCESS DEVICE STATUS
          LDD    T3
          LMK    WLSF        WRITE LAST SECTOR
          RJM    WDS
          PJN    WBIX        IF NO ERRORS
          RJM    PES         PROCESS ERROR STATUS
          LDM    STAT
          LPK    STNS
          NJN    WBI1        IF JOB SUSPENSION INHIBITED
          LDM    RDCT        DRIVER STATUS
          SHN    21-13
          PJN    WBI1        IF DATA TRANSFERRED
          ERROR  MSE,CH,,T5  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
*         REQUEST ERROR IDLE BE SET WHEN CATALOG OR PERMIT FILE
*         IS NOT INTACT.
 
 WBI1     ERROR  MSE,CH,,T5,,EI  *EQXXX,DNYY, MASS STORAGE ERROR.*
          SPACE  4,10
*         RESIDENT COMMON DECKS.
 
 
*CALL     COMPCRA
*CALL     COMPCTI
*CALL     COMPIRA
 STI$     SET    0           RETURN CONTROL ON TRACK INTERLOCK REJECT
 TNR$     SET    0           DO NOT HANG ON *TRACK NOT RESERVED*
*CALL     COMPSTI
          SPACE  4,10
 OVLU     EQU    *+5         CATALOG/PERMIT UPDATE OVERLAY LOAD ADDRESS
          SPACE  4,10
*         DEFINE THE MAXIMUM LENGTH OF OVERLAYS *3PD*
*         (CATALOG UPDATE ROUTINES) AND *3PE* (PERMIT
*         UPDATE ROUTINES) IN SECTORS.
 
 
 OVLL     EQU    3*500B      OVERLAY LENGTH IN SECTORS
          SPACE  4,10
*         DEFINE THE LOAD ADDRESS FOR THE COMMAND OVERLAYS.
 
 
 OVLC     EQU    OVLU+OVLL-5 COMMAND CODE LOAD ADDRESS
          TITLE  PERMIT SEARCH ROUTINES.
 CPI      SPACE  4,25
**        CPI - CHECK PERMISSION INFORMATION.
*
*         *BFMS* IS USED TO READ PERMITS.
*
*         ENTRY  (A) = PERMISSION MODE REQUIRED FOR COMMAND.
*                (CI) = INDEX TO CATALOG ENTRY.
*                MASTER DEVICE CHANNEL RESERVED.
*                (PP) = 0.
*                (PB) = 0.
*
*         EXIT   (A) = ACCESS MODE ALLOWED.
*                TO ERR IF NOT PERMITTED ACCESS.
*                BUFFER LOADED WITH PERMITS.
*                (PP) = POINTER TO PERMIT ENTRY.
*                (PP) = 0 IF PERMIT ENTRY NOT AVAILABLE.
*                (PB) = ADDRESS OF PERMIT BUFFER.
*                (PB) = 0 IF NO PERMIT SEARCH POSSIBLE.
*
*         USES   P1, PB, PP, T0, T1, RI - RI+1.
*
*         CALLS  SPI.
*
*         MACROS MONITOR.
 
 
 CPI      SUBR               ENTRY/EXIT
          LPN    37          SET MODE REQUIRED
          STD    T1
          STM    CPIC
          LDC    SHNI+21     SET SHIFT COUNT FOR MODE REQUIRED
          SBD    T1
          STM    CPID
          LDD    PI
          ADD    PI+1
          ZJN    CPIX        IF NOT ALTERNATE CATALOG ACCESS
 
*         READ PERMISSION INFORMATION.
 
          LDC    BFMS        SET PERMIT BUFFER
          STD    PB
          LDM    FCRI,CI     SET PERMIT ADDRESS
          STD    RI
          LDM    FCRI+1,CI
          STD    RI+1
          ADD    RI
          ZJN    CPI1        IF NO PERMISSION INFORMATION AVAILABLE
          LDN    IPPA        PF INCREMENT OF PERMIT FILE ACCESS
          RAM    AIPF+1
          RJM    SPI         SEARCH PERMISSION INFORMATION
 
*         CHECK FILE CATEGORY.
 
 CPI1     LDM    FCAM,CI     SET ACCESS MODE FOR FILE
          LPN    77
          STD    P1
          LDM    FCCT,CI
          SHN    -6
          LMK    FCPR
          NJN    CPI3        IF NOT PRIVATE FILE
 
*         PRIVATE FILE.
 
          LDD    PP
          NJN    CPI5        IF PERMIT FOUND
 CPI2     LDN    PTNU        PROHIBIT ACCESS TO FILE
          STD    P1
          UJN    CPI8        PROCESS PERMIT NOT FOUND
 
*         SEMI-PRIVATE OR PUBLIC FILE.
 
 CPI3     LDM    PFAC
          NJN    CPI4        IF CALLER HAS USER NAME IN CPA
          STD    PB          PREVENT UPDATE OF PERMIT ENTRY
          UJN    CPI6        TREAT AS NONPERMITTED PUBLIC FILE
 
 CPI4     LDC    MJNI+CPI6-CPIB  SET SEMI-PRIVATE OR PUBLIC FILE
          STM    CPIB
          LDD    PP          CHECK PERMIT INDEX
          ZJN    CPI6        IF NO PERMIT FOUND
 
*         CHECK PERMIT TYPE.
 
 CPI5     LDM    FPMD,PP     CHECK PERMIT TYPE
          SHN    21-4
 CPIB     MJN    CPI2        IF ACCOUNTING PERMIT
*         MJN    CPI6        IF ACCOUNTING PERMIT (SEMI-PRIVATE/PUBLIC)
          SHN    -21+4       SET PERMIT MODE
          STD    P1
 
*         CHECK ACCESS MODE.
 
 CPI6     LDD    P1          PERMITTED MODE
          SBN    PTLM
          MJN    CPI8        IF LEGAL MODE
 CPI7     ERROR  FNF         *(FILENAME) NOT FOUND.*
 
*         CHECK FOR MULTI-LEVEL USER NAME ACCESS.
 
 CPI8     LDM    PFPT
          NJN    CPI10       IF NOT MULTI-LEVEL USER
          LDC    *           (REQUESTED MODE)
 CPIC     EQU    *-1
          LMN    PTRD
          ZJN    CPI9        IF READ MODE REQUESTED
          LMN    PTEX&PTRD
          NJN    CPI10       IF MODE OTHER THAN EXECUTE REQUESTED
 CPI9     LDN    PTRD        ALLOW READ MODE ACCESS
          LJM    CPIX        RETURN
 
*         CHECK EXPIRATION DATE.
 
 CPI10    LDD    PP
          ZJN    CPI12       IF NO PERMIT ENTRY
          LDM    FPMD,PP
          SHN    21-5
          PJN    CPI12       IF EXPIRATION DATE NOT PRESENT
          LDM    FPXD,PP
          LPN    77
          STD    CM+3
          SHN    14
          LMM    FPXD+1,PP
          ZJN    CPI12       IF NONEXPIRING PERMIT
          STD    CM+4
          LDN    VEDS        VALIDATE EXPIRATION DATE
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          ZJN    CPI12       IF PERMIT NOT EXPIRED
 CPI11    LJM    CPI7        *(FILENAME) NOT FOUND.*
 
*         CHECK IF ACCESS MODE PERMITTED.
 
 CPI12    LDM    TMPE,P1
 CPID     SHN    **          (21 - REQUESTED MODE)
          PJN    CPI11       IF REQUESTED MODE NOT ALLOWED
          LDD    P1          ALLOW PERMITTED MODE
          LJM    CPIX        RETURN
 
*         TEST RANGE OF GENERATED RELATIVE JUMPS.
 
          ERRNG  37+CPIB-CPI6
 
 
 TMPE     BSS    0           TABLE OF MODE PERMISSION EQUIVALENCES.
          LOC    0
 
          CON    MDWR        WRITE
          CON    MDRD        READ
          CON    MDAP        APPEND
          CON    MDEX        EXECUTE
          CON    MDNU        NEGATE
          CON    MDMD        MODIFY
          CON    MDRM        READ/ALLOW MODIFY
          CON    MDRA        READ/ALLOW EXTEND
          CON    MDUP        UPDATE
          CON    MDRU        READ/ALLOW UPDATE
 
          LOC    *O
 SPI      SPACE  4,25
**        SPI - SEARCH PERMISSION INFORMATION.
*
*         ENTRY  (PB) = BUFFER TO BE SEARCHED.
*                (PP) = 0.
*                (EBTK) = END BUFFER TRACK, IF BUFFER IS IN *BFMS*.
*
*         EXIT   (PP) = INDEX TO PERMIT ENTRY IF FOUND.
*                (PP) = 0 IF PERMIT ENTRY NOT FOUND.
*                (T1) = NEXT AVAILABLE ENTRY IF NOT FOUND AND SHORT PRU.
*                (EXPC) = NUMBER OF EXPLICIT PERMIT ENTRIES (IF PERMIT
*                         NOT FOUND).
*                (RI - RI+1) = RANDOM INDEX OF PERMIT SECTOR.
*                            (ADVANCED IF SECTOR OVERFLOW)
*                (STAT) FLAG SET IF *BFMS* REUSED.
*                BUFFER LOADED WITH PERMITS.
*
*         USES   T1, T2, PI - PI+1, RI - RI+1.
*
*         CALLS  CSA, PDV, PES, RDS.
*
*         MACROS ERROR, SETMS.
 
 
 SPI      SUBR               ENTRY/EXIT
          LDN    STPR        INDICATE THAT PERMITS WERE READ
          RAM    STAT
          LDM    EBTK        CHECK IF END BUFFER IS IN *BFMS*
          ZJN    SPI1        IF *BFMS* IS NOT IN USE
          LDN    STBR        INDICATE THAT *BFMS* HAS BEEN REUSED
          RAM    STAT
 
*         READ NEXT SECTOR OF PERMITS.
 
 SPI1     RJM    CSA         COMPUTE RANDOM ADDRESS
          LDD    T6          SET CURRENT SECTOR POINTERS
          STM    -2,PB
          STM    ERRC
          LDD    T7
          STM    -1,PB
          STM    ERRD
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDD    PB
          RJM    RDS         READ SECTOR
          PJN    SPI2        IF NO READ ERROR
          RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,CH,,EQ  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
 SPI2     LDM    1,PB        WORD COUNT IN PERMIT SECTOR
          SBN    NWPE+NWPH
          MJN    SPI3        IF INCORRECT SECTOR LENGTH
          LPN    NWPE-1
          ZJN    SPI4        IF INTEGRAL NUMBER OF PERMIT ENTRIES
          ERRNZ  NWPH-NWPE   HEADER SIZE MUST EQUAL ENTRY SIZE
 SPI3     ERROR  BCS,,,T5,,EI  *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
 
 SPI4     LDN    NWPH        ADVANCE WORD COUNT PAST HEADER
          STD    T2
          LDD    PB          RESET SEARCH INDEX
          ADN    NWPH*5+2    SKIP HEADER AND CONTROL BYTES
          STD    T1
          UJN    SPI7        CHECK FIRST ENTRY IN SECTOR
 
*         ADVANCE TO NEXT PERMIT ENTRY.
 
 SPI5     LDM    FPMD,T1
          SHN    21-4
          MJN    SPI6        IF ACCOUNTING PERMIT
          AOM    EXPC        ADVANCE EXPLICIT PERMIT COUNT
 SPI6     LDN    NWPE*5      ADVANCE BUFFER INDEX
          RAD    T1
          LDN    NWPE        INCREMENT WORD COUNT
          RAD    T2
          LMM    1,PB
          NJN    SPI7        IF NOT END OF BUFFER
          UJN    SPI10       END OF BUFFER
 
 SPI7     LDM    PFAC
          LMM    FPAN,T1     COMPARE USER NAME
          NJN    SPI5        IF NO MATCH
          LDM    FPAN+1,T1
          LMM    PFAC+1
          NJN    SPI5        IF NO MATCH
          LDM    FPAN+2,T1
          LMM    PFAC+2
 SPI8     NJN    SPI5        IF NO MATCH
          LDM    FPAN+3,T1
          LMM    PFAC+3
          SCN    77
          NJN    SPI8        IF NO MATCH
          LDD    T1          SET POINTER TO ENTRY
          STD    PP
 SPI9     LDD    T1          SET HOLE ADDRESS
          STM    NPHA
          LJM    SPIX        RETURN
 
 SPI10    LDD    T2          CHECK WORD COUNT OF SECTOR
          LMD    HN
          NJN    SPI9        IF END OF PERMITS
          LDM    FPRI,PB     CHECK FOR LINKED PERMIT BUFFERS
          STD    RI
          LDM    FPRI+1,PB
          STD    RI+1
          ADD    RI
          ZJN    SPI9        IF INDEX NOT SET
          LJM    SPI1        READ NEXT SECTOR
          SPACE  4,10
 OVL0     EQU    *+5         ZERO-LEVEL OVERLAY LOAD ADDRESS
          TITLE  CATALOG SEARCH ROUTINES.
 CCD      SPACE  4,25
**        CCD - CHECK CATALOG DATA.
*
*         CHECK IF CATALOG ENTRY IS THAT OF DESIRED FILE.
*         IF PASSWORD PRESENT IN CATALOG ENTRY, VERIFY THAT
*         CORRECT PASSWORD WAS SPECIFIED AND THAT PASSWORD
*         HAD NOT EXPIRED (ALTERNATE USER ONLY).
*         THE ACCESS LEVEL AND ACCESS CATEGORY SET ARE ALSO
*         VALIDATED.  STATISTICS ARE ACCUMULATED FOR USER
*         CONTROL CHECKS.
*
*         ENTRY  (T3) = INDEX TO CATALOG ENTRY.
*                (FN - FN+3) = FILE NAME.
*                (PFPW - PFPW+3) = FILE PASSWORD FROM CALL BLOCK
*                (CCDA) = EXIT JUMP IF NO OPTIONAL USER.
*
*         EXIT   (A) = 0 IF FILE FOUND AND ACCESS ALLOWED.
*                (NF - NF+1) INCREMENTED.
*                (CS - CS+1) ADVANCED IF FILE IS INDIRECT.
*                TO *ERR* IF ACCESS TO FILE NOT ALLOWED.
*
*         USES   T3, FN - FN+3.
*
*         MACROS ERROR, MONITOR.
*
*         NOTES  THE USE OF THE DATA TAGS *CCDD*, *CCDF*, *CCDI*
*                AND *CCDP* SHOULD BE AVOIDED, SINCE THEY CONFLICT
*                WITH GLOBAL SYMBOL DEFINITIONS.
 
 
 CCD      SUBR               ENTRY/EXIT
 CCDB     UJN    CCD1        SET TO *PSN* IF ALLOCATION COMMAND
*                            I.E. SAVE, REPLACE, APPEND, DEFINE.
 
*         ACCUMULATE STATISTICS.
 
          AOD    NF+1        ADVANCE FILE COUNT
          SHN    -14
          RAD    NF
          LDM    FCBS,T3
          SHN    6
          MJN    CCD1        IF DIRECT ACCESS FILE
          LDM    FCLF+1,T3   ADD TO CUMULATIVE SIZE OF INDIRECT FILES
          RAD    CS+1
          SHN    -14
          ADM    FCLF,T3
          RAD    CS
 
*         CHECK FILE FOR SEARCH.
 
 CCD1     LDI    T3          COMPARE FILE NAMES
          LMD    FN
          NJN    CCDX        IF NOT EQUAL
          LDM    FCFN+1,T3   COMPARE BYTE 2
          LMD    FN+1
 CCD2     NJN    CCDX        IF NOT EQUAL
          LDM    FCFN+2,T3   COMPARE BYTE 3
          LMD    FN+2
          NJN    CCDX        IF NOT EQUAL
          LDM    FCFN+3,T3   COMPARE 7TH CHARACTER
          LMD    FN+3
          SHN    -6
          NJN    CCD2        IF LAST CHARACTER NOT EQUAL
 
*         COMPARE FILE PASSWORD.
 
 CCDA     LDM    FCPW,T3     COMPARE FILE PASSWORD
*         UJN    CCD4        (NOT ALTERNATE USER)
*         UJN    CCD4        (*PERMIT* REQUEST)
          LMM    PFPW
          NJN    CCD3        IF NOT EQUAL
          LDM    FCPW+1,T3   COMPARE BYTE 2
          LMM    PFPW+1
          NJN    CCD3        IF NOT EQUAL
          LDM    FCPW+2,T3   COMPARE BYTE 3
          LMM    PFPW+2
          NJN    CCD3        IF NOT EQUAL
          LDM    FCPW+3,T3   COMPARE 7TH CHARACTER
          LMM    PFPW+3
          SHN    -6
 CCD3     NJN    CCD6        IF NOT EQUAL
          UJN    CCD5        CHECK FOR PASSWORD EXPIRATION
 
 CCD4     LDN    0
          UJN    CCD7        VALIDATE ACCESS TO FILE
 
*         CHECK FOR PASSWORD EXPIRATION.
 
 CCD5     LDM    FCPW,T3
          ZJN    CCD7        IF NO PASSWORD
          LDM    FCXD,T3     CHECK EXPIRATION DATE
          LPN    77
          STD    CM+3
          SHN    14
          LMM    FCXD+1,T3
          ZJN    CCD7        IF NON-EXPIRING PASSWORD
          STD    CM+4
          LDN    VEDS        VALIDATE EXPIRATION DATE
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          ZJN    CCD7        IF NOT EXPIRED
 CCD6     ERROR  FNF         *(FILENAME) NOT FOUND.*
 
*         VALIDATE ACCESS TO FILE.
 
 CCD7     STD    CM          VALIDATE ACCESS LEVEL AND CATEGORY SET
          LDM    FCAL,T3     SET ACCESS LEVEL
          LPN    7
          STD    CM+1
          LDM    FCFC,T3     SET ACCESS CATEGORY
          LPC    377
          STD    CM+2
          LDM    FCFC+1,T3
          STD    CM+3
          LDM    FCFC+2,T3
          STD    CM+4
          LDD    MA
          CWD    CM
          LDN    ZERL
          CRD    CM
          LDN    VAJS        CHECK AGAINST CURRENT JOB VALIDATIONS
          STD    CM+1
          ERRNZ  VAJS-3      VALIDATE ACCESS LEVEL AND CATEGORY SET
          STD    CM+4
          MONITOR  VSAM
          LDD    CM+1
 CCDC     NJN    CCD6        IF NOT VALID ACCESS
*         NJN    CCD9        IF NOT VALID ACCESS (NOT ALTERNATE USER)
 CCD8     LJM    CCDX        RETURN
 
*         ALLOW AN *SSJ=* JOB TO PURGE ANY FILE.
 
 CCD9     LDM    SSJS
          ZJN    CCD10       IF NOT *SSJ=*
          LDD    CC
          LMN    CCPG
          ZJN    CCD8        IF *PURGE*
 CCD10    ERROR  JCA,,,,SVE  * JOB CANNOT ACCESS FILE.*
 ICT      SPACE  4,15
**        ICT - INTERLOCK CATALOG TRACK.
*
*         ENTRY  (T6) = CATALOG TRACK TO BE INTERLOCKED.
*                (T5) = EST ORDINAL.
*
*         EXIT   TRACK INTERLOCKED.
*                RECALL *PFM* IF INTERLOCK NOT AVAILABLE
*                  AFTER FOUR TRIES.
*                TO *HNG* IF CATALOG TRACK NOT RESERVED.
*
*         CALLS  DPR, STI.
 
 
 ICT      SUBR               ENTRY/EXIT
          LDN    3           SET RETRY COUNT
          STD    T1
 ICT1     RJM    STI         TRY TO INTERLOCK TRACK
          ZJN    ICTX        IF INTERLOCK SUCCESSFUL
          LMN    2
          ZJN    ICT2        IF TRACK NOT RESERVED
          SOD    T1
          MJN    ICT3        IF RETRY COUNT EXHAUSTED
          RJM    DPR         DELAY PRIOR TO RETRY
          UJN    ICT1        RETRY
 
 ICT2     RJM    HNG         HANG IF CATALOG TRACK NOT RESERVED
 
 ICT3     EXIT   INA,CH,,,EC4  * INTERLOCK NOT AVAILABLE.*
 ISP      SPACE  4,20
**        ISP - INITIALIZE SEARCH OF PERMANENT FILES.
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*                (CCIA) = CATALOG TRACK.
*
*         EXIT   (T4) = MASTER DEVICE CHANNEL.
*                (T5) = MASTER DEVICE EST ORDINAL.
*                (T6) = CATALOG TRACK.
*                (T7) = CATALOG SECTOR.
*                (DPPF) = INCREMENTED FOR CATALOG SEARCH.
*                (P0 - P4) = CATALOG SEARCH POINTERS INITIALIZED.
*                CATALOG TRACK INTERLOCK SET.
*                *SETMS READ* PERFORMED.
*
*         CALLS  ICT, IRA, PDV.
*
*         MACROS ERROR, SETMS.
 
 
 ISP      SUBR               ENTRY/EXIT
          LDD    EQ          SET MASTER DEVICE EST ORDINAL
          STD    T5
          LDM    CCIA        SET CATALOG TRACK
          STD    T6
 ISPB     RJM    ICT         INTERLOCK CATALOG TRACK
*         UJN    ISP1        (*UREPLAC*/*DROPIDS*- ALREADY INTERLOCKED)
          AOM    CCIB        SET CATALOG TRACK INTERLOCK FLAG
 ISP1     LDN    IPCS        PF INCREMENT FOR CATALOG SEARCH
          RAM    AIPF+1
          RJM    IRA         INITIALIZE RANDOM PROCESSORS
 
*         SET SEARCH POINTERS.
 
          LDN    0           SET STARTING CATALOG TRACK SECTOR
          STD    T7
          LDN    ZERL        CONTIGUOUS STORAGE INITIALIZATION
          CRD    P0          TEMPORARY CATALOG SEARCH BUFFER POINTERS
          LDC    BUF1        SET PRIMARY BUFFER POINTER
*         LDC    BFMS        (*UREPLAC*/*DROPIDS*)
 ISPC     EQU    *-1
          STD    P2
          LDC    BUF2        SET SECONDARY BUFFER POINTER
 ISPA     EQU    *-1
*         LDC    BFMS        (*DEFINE* REQUEST)
          STD    P3
          SETMS  READSTR
          RJM    PDV         PROCESS DEVICE STATUS
          UJP    ISPX        RETURN
 PCE      SPACE  4,10
**        PCE - PROCESS CATALOG READ ERROR.
*
*         ENTRY  READ ERROR DETECTED BY *COMPRNS*.
 
 
 PCE      SUBR               ENTRY
          RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,,,T5    *EQXXX,DNYY, MASS STORAGE ERROR.*
 SCH      SPACE  4,50
**        SCH - SEARCH CATALOGS.
*
*         THIS ROUTINE WILL SEARCH FOR A FILE AND FOR A HOLE
*         (IF REQUESTED) BY READING INTO *BUF1* UNTIL A HOLE IS FOUND
*         AND THEN CONTINUING IN *BUF2*.  IF A LARGER HOLE IS
*         FOUND (*BUF2*) THEN READ WILL REVERT BACK TO *BUF1* UNTIL
*         LARGEST HOLE AND FILE ARE IN *BUF1* AND *BUF2*.  *SCH*
*         ALWAYS EXITS WHEN THE FILE IS FOUND.
*
*         ON A *UREPLAC* OR *DROPIDS* REQUEST, *SCH* IS CALLED JUST TO
*         SEARCH FOR A HOLE.  READING WILL START WITH *BFMS* AND WILL
*         SWITCH BACK AND FORTH BETWEEN *BFMS* AND *BUF2* UNTIL THE END
*         OF CATALOGS, OR UNTIL AN EXACT FIT IS FOUND.
*
*         UPON REENTRY (ON A *REPLACE* OR *APPEND* REQUEST IN WHICH
*         NO EXACT FIT HOLE WAS FOUND IN THE FIRST SEARCH) IT IS
*         NECESSARY TO KEEP ONE OF THE TWO BUFFERS (THE ONE WITH THE
*         FILE CATALOG ENTRY IN IT) AND TO CONTINUE TO SEARCH FOR A
*         LARGER HOLE BY READING INTO THE REMAINING BUFFER AND *BFMS*.
*         READING WILL START IN THE REMAINING *BUF1*/*BUF2* BUFFER -
*         RATHER THAN IN *BFMS* - UNLESS THERE IS ALREADY A HOLE IN
*         THE *BUF1*/*BUF2* BUFFER.
*
*         IF NO HOLE SEARCH IS REQUIRED ALL SECTORS ARE READ
*         INTO BUF1 (*GET*, *OLD* AND *ATTACH* REQUESTS).
*
*         SEE *CPI* FOR BUFFERS USED TO READ PERMITS.
*
*         ENTRY  (FN - FN+3) = FILE NAME.
*                (UI - UI+1) = USER INDEX.
*                (LF - LF+1) = LENGTH OF FILE IF HOLE SEARCH DESIRED.
*                (SCHA) INCREMENTED IF REENTRANT CALL.
*                (SCHB) PRESET FOR REENTRY IF CURRENT ENTRY (FILE
*                       FOUND) IS TO BE INCLUDED IN HOLE SEARCH.
*                (SCHF) PRESET IF HOLE SEARCH ENABLED (SEARCH FOR
*                       LARGEST HOLE OR ONE THAT FILE EXACTLY FITS IN).
*                (SCHH) PRESET IF SEARCH FOR DAPF HOLE.
*                (SCHI) PRESET IF SEARCH FOR LARGEST HOLE ENABLED.
*
*         EXIT   (A) = 0 IF FILE FOUND.
*                (CI) = CATALOG POINTER.
*                (CB) = CATALOG BUFFER.
*                (HP) = HOLE POINTER.
*                (HB) = HOLE BUFFER.
*                (EP) = END POINTER.
*                (EB) = END BUFFER.
*                (HL) = SIZE OF HOLE FOUND.
*                (NF - NF+1) = NUMBER OF FILES IN CATALOG.
*                (CS - CS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
*                (DAHP - DAHP+2) = DIRECT ACCESS HOLE POINTERS IF
*                            DA HOLE FOUND AND NOT DAPF SEARCH.
*                (SDAB - SDAC) = ADDRESS OF FILE IF FOUND.
*
*         USES   P0 - P3, T3 - T7.
*
*         CALLS  CCD, ISP, RNS.
*
*         MACROS ERROR.
 
 
*         FILE FOUND.
 
 SCH18    LDD    T3          SET CATALOG ENTRY POINTERS
          STD    CI
          LDM    P2,P1
          STD    CB
          LDM    FCBT,CI     SET ADDRESS OF FILE FOUND
          STM    SDAB
          LDM    FCBS,CI
          STM    SDAC
          LDN    0
 
 SCH      SUBR               ENTRY/EXIT
 SCHA     LDN    0
*         LDN    1           PRESET BY CATALOG SEARCH INITIALIZATION
          NJN    SCH1        IF NOT INITIAL CALL
          AOM    SCHA        CLEAR INITIAL CALL STATUS
          RJM    ISP         INITIALIZE FOR SEARCH
          LJM    SCH7        READ FIRST SECTOR
 
*         SECONDARY CALL TO CONTINUE SEARCH FOR BEST HOLE.
 
 SCH1     LDK    PSNI        USE NEW BUFFER FOR REMAINDER OF SEARCH
          STM    SCHD
          LDD    HP
          ZJN    SCH1.1      IF NO HOLE FOUND YET
          LDD    HB
          LMM    P2,P1
          NJN    SCH1.2      IF HOLE NOT IN CURRENT BUFFER
 SCH1.1   AOM    SCHC        SET BUFFER TOGGLE (DO NOT USE *BFMS* NEXT)
 SCH1.2   LJM    SCH10       CONTINUE SEARCH, BYPASSING CURRENT FILE
*         LJM    SCH11       (INCLUDE CURRENT FILE IN SEARCH)
 SCHB     EQU    *-1
 
*         END OF SECTOR PROCESSING.
 
 SCH2     LDC    *           PARTIAL SECTOR WORD COUNT
 SCHE     EQU    *-1
          LPN    77
          ZJN    SCH4        IF NOT EOR
 
*         END OF RECORD ENCOUNTERED.
 
          LDD    T3          SET END SECTOR POINTERS
          STD    EP
 
*         END OF INFORMATION ENCOUNTERED (NO SHORT SECTOR).
 
 SCH3     LDM    P2,P1       SET END BUFFER
          STD    EB
          LJM    SCHX        RETURN
 
*         SELECT BUFFER FOR NEXT SECTOR.
 
 SCH4     UJN    SCH5        TOGGLE BUFFER IF NECESSARY
*         PSN                (NEW BUFFER REQUIRED)
 SCHD     EQU    *-1
          LDC    BFMS        SET *BFMS* IN PLACE OF CURRENT BUFFER
          STM    P2,P1
          ISTORE SCHD,(UJN SCH5)  RESET TO BYPASS THIS SECTION
 SCH5     LDN    0
*         LDN    1           (BUFFER TOGGLE REQUIRED)
 SCHC     EQU    *-1
          ZJN    SCH7        IF SAME BUFFER TO BE USED
          ISTORE SCHC,(LDN 0)  CLEAR BUFFER TOGGLE
          LDD    P1          TOGGLE BUFFER
          LMN    1
          STD    P1
 
*         READ NEXT SECTOR.
 
 SCH7     LDM    P2,P1       SET BUFFER ADDRESS
          STD    T3
          LDD    T6          SAVE POSITION OF SECTOR
          STM    -2,T3
          STM    ERRC
          LDD    T7
          STM    -1,T3
          STM    ERRD
          LDD    T3          READ SECTOR
          RJM    RNS
          NJN    SCH8        IF NOT EOF/EOI OR ZERO LENGTH RECORD
          LJM    SCH3        PROCESS EOI
 
 SCH8     STD    P0          SAVE WORD COUNT
          STM    SCHE
          LPN    NWCE-1
          ZJN    SCH9        IF INTEGRAL NUMBER OF CATALOG ENTRIES
          ERROR  BCS,,,T5,,EI  *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
 
 SCH9     LDN    2           SKIP CONTROL BYTES
          RAD    T3
          UJN    SCH11       CHECK FIRST CATALOG ENTRY
 
*         ADVANCE TO NEXT CATALOG ENTRY.
 
 SCH10    LDC    NWCE*5      ADVANCE TO NEXT CATALOG ENTRY
          RAD    T3
          LCN    NWCE        ADVANCE SECTOR WORD COUNT
          RAD    P0
          ZJP    SCH2        IF END OF BUFFER
 
*         CHECK NEXT CATALOG ENTRY.
 
 SCH11    LDM    FCUI,T3
          LPN    37
          SHN    14
          LMM    FCUI+1,T3
 SCHF     PSN    0
*         ZJN    SCH12       (HOLE SEARCH ENABLED - IF HOLE)
          ZJN    SCH10       IF EMPTY CATALOG ENTRY
          LMD    UI+1
          SHN    6
          LMD    UI
 SCHG     NJN    SCH10       IF NOT SAME USER INDEX
*         PSN                (PRIVATE DEVICE ACCESS)
*         UJN    SCH10       (*UREPLAC*/*DROPIDS*, HOLE SEARCH ONLY)
          RJM    CCD         CHECK CATALOG DATA
          NJN    SCH10       IF NOT SAME FILE
          LJM    SCH18       TERMINATE SEARCH
 
*         SAVE ADDRESS OF DIRECT ACCESS HOLE FOR POSSIBLE FUTURE USE.
 
 SCH11.1  LDM    DAHP
 SCH11.2  NJN    SCH10       IF DIRECT ACCESS HOLE ALREADY FOUND
          LDM    P2,P1       GET START OF BUFFER
          STD    T0
          LDD    T3          SAVE OFFSET WITHIN BUFFER
          SBD    T0
          STM    DAHP+2
          SOD    T0
          LDI    T0          SAVE DIRECT ACCESS HOLE SECTOR
          STM    DAHP+1
          SOD    T0
          LDI    T0          SAVE DIRECT ACCESS HOLE TRACK
          STM    DAHP
          UJN    SCH11.2     ADVANCE TO NEXT CATALOG ENTRY
 
*         CHECK HOLE FOR POSSIBILITY OF PLUG.
 
 SCH12    LDM    FCBS,T3
          SHN    6
 
 SCHH     MJN    SCH11.1     IF NOT IAPF HOLE
*         UJN    SCH16       (DAPF FILE SEARCH)
          LDM    FCLF+1,T3
          STD    T0
          SBD    LF+1
 SCHI     ZJN    SCH17       IF EXACT FIT
*         UJN    SCH13       (*APPEND* - SEARCH FOR LARGEST HOLE)
          SBK    MNHS
          MJN    SCH15       IF NOT LARGE ENOUGH FOR FILE AND NEW HOLE
 SCH13    LDD    HL
          SBD    T0
          PJN    SCH15       IF NOT LARGER THAN PREVIOUS HOLE
          LDD    T0          SET THIS AS MAXIMUM HOLE
          STD    HL
 
*         SET POINTER TO HOLE.
 
 SCH14    AOM    SCHC        SET TO TOGGLE BUFFER
          LDD    T3          SAVE HOLE ADDRESS
          STD    HP
          LDM    P2,P1       SET HOLE BUFFER ADDRESS
          STD    HB
 SCH15    LJM    SCH10       ADVANCE TO NEXT CATALOG ENTRY
*         LJM    SCHX        (*UREPLAC*/*DROPIDS*, EXACT FIT FOUND)
 SCHJ     EQU    *-1
 
*         CHECK FOR DIRECT ACCESS PURGED ENTRY.
 
 SCH16    PJN    SCH15       IF NOT DIRECT ACCESS FILE
 
*         EXACT FIT.   BYPASS REMAINDER OF HOLES.
 
 SCH17    ISTORE SCHF,(PSN)  BYPASS HOLE SEARCH
          LDD    T0          SET LENGTH OF HOLE
          STD    HL
 SCHK     UJN    SCH14       SET POINTER TO HOLE
*         PSN                (*UREPLAC*/*DROPIDS*)
          LDC    SCHX
          STM    SCHJ        SET HOLE SEARCH ONLY EXIT
          UJN    SCH14       SET POINTER TO HOLE
 SHL      SPACE  4,30
**        SHL - SEARCH CATALOG FOR HOLE.
*
*         THIS SUBROUTINE PRESETS *SCH* TO SEARCH FOR A HOLE ENTRY
*         FOR A *UREPLAC* OR *DROPIDS* REQUEST.
*
*         IT IS POSSIBLE THAT AT THE COMPLETION OF THE SEARCH, THE
*         HOLE ENTRY AND/OR THE END OF CATALOGS WILL BE IN SAME SECTOR
*         AS THE FILE CATALOG ENTRY.  IF THIS SITUATION OCCURS, THE
*         HOLE AND/OR END POINTERS WILL BE ADJUSTED TO POINT TO THE
*         FILE ENTRY-S BUFFER (*BUF1*).
*
*         ENTRY  (CCIA) = CATALOG TRACK ADDRESS.
*                (CB) = CATALOG BUFFER.
*                (CI) = CATALOG POINTER.
*                (LF - LF+1) = LENGTH OF FILE.
*                (SDAA) = MASTER DEVICE EST ORDINAL.
*
*         EXIT   (A)  = 0, IF HOLE NOT FOUND.
*                (EB) = END BUFFER, IF END ENCOUNTERED.
*                (EP) = END POINTER, IF END ENCOUNTERED.
*                (HB) = HOLE BUFFER.
*                (HL) = SIZE OF HOLE FOUND.
*                (HP) = HOLE POINTER.
*
*         CALLS  SCH.
*
*         USES   EB, EP, HB, HP.
*
*         MACROS ISTORE.
 
 
 SHL      SUBR               ENTRY/EXIT
          ISTORE ISPB,(UJN ISP1)   BYPASS CATALOG TRACK INTERLOCK
          ISTORE SCHA,(LDN 0)  FORCE *ISP* CALL
          LDC    BFMS        SET PRIMARY BUFFER POINTER
          STM    ISPC
          ISTORE SCHF,(ZJN SCH12)  ENABLE HOLE SEARCH
          ISTORE SCHG,(UJN SCH10)  SEARCH FOR HOLES ONLY
          ISTORE SCHK,(PSN)        ENABLE EXIT FOR HOLE ONLY SEARCH
          RJM    SCH         SEARCH FOR HOLE
 
*         CHECK IF HOLE IS IN THE SAME TRACK/SECTOR AS FILE ENTRY.
 
          LDD    HP
          ZJN    SHL1        IF HOLE NOT FOUND
          LDM   -1,CB
          LMM   -1,HB
          NJN    SHL1        IF SECTOR NOT THE SAME FOR HOLE AND FILE
          LDM   -2,CB
          LMM   -2,HB
          NJN    SHL1        IF TRACK NOT THE SAME FOR HOLE AND FILE
          LDD    CB          ADJUST HOLE POINTERS TO FILE ENTRY BUFFER
          SBD    HB
          RAD    HP
          LDD    CB
          STD    HB
 
*         CHECK IF END IS IN SAME TRACK/SECTOR AS FILE ENTRY.
 
 SHL1     LDD    EB
          ZJN    SHL3        IF END NOT REACHED (EXACT FIT HOLE FOUND)
          LDM   -1,CB
          LMM   -1,EB
          NJN    SHL3        IF SECTOR NOT THE SAME FOR END AND FILE
          LDM   -2,CB
          LMM   -2,EB
          NJN    SHL3        IF TRACK NOT THE SAME FOR END AND FILE
          LDD    EP          ADJUST END POINTERS
          ZJN    SHL2        IF NO END POINTER (EOI)
          SBD    EB          ADJUST END POINTER TO FILE ENTRY BUFFER
          ADD    CB
          STD    EP
 SHL2     LDD    CB          ADJUST END BUFFER TO FILE ENTRY BUFFER
          STD    EB
 
*         RETURN HOLE POINTER.
 
 SHL3     LDD    HP          HOLE POINTER (IF FOUND)
          LJM    SHLX        RETURN
          TITLE  SPECIAL REQUEST BLOCK CATALOG ACCESS ROUTINES.
 ACE      SPACE  4,30
**        ACE - ACCESS CATALOG ENTRY.
*
*         READ A CATALOG ENTRY AND CHECK THE FOLLOWING INFORMATION -
*            COMPARE THE USER INDEX WITH (PFFM+3 - PFFM+4).
*            COMPARE THE CREATION DATE AND TIME WITH (PFCD - PFCD+2).
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*                (CCIA) = CATALOG TRACK TO INTERLOCK.
*                (CCIB) UPDATED IF CATALOG TRACK INTERLOCK ALREADY SET.
*                (PFAS) = 36/ ALTERNATE STORAGE ADDRESS.
*                (PFCD) = 36/ CREATION DATE AND TIME.
*                (PFFM) = 42/FAMILY,18/USER INDEX.
*                (PFID) = 4/,2/PEO,6/DN,12/TRACK,12/SECTOR.
*
*         EXIT   CATALOG SECTOR READ.
*                CATALOG TRACK INTERLOCKED.
*                (CB) = BUFFER ADDRESS OF CATALOG SECTOR.
*                (CI) = POINTER TO CATALOG ENTRY.
*                (T5) = MASTER DEVICE EST ORDINAL.
*                (T6) = CATALOG TRACK.
*                (T7) = CATALOG SECTOR.
*
*         CALLS  ICT, IRA, PDV, PES, RDS.
*
*         USES   CB, CI, T1, T5, T6, T7.
*
*         MACROS COMPARE, ERROR, EXIT, SETMS.
 
 
 ACE      SUBR               ENTRY/EXIT
          LDC    BUF1        SET CATALOG BUFFER ADDRESS
          STD    CB
          ADN    2           INITIALIZE *PFC* ENTRY POINTER
          STD    CI
          LDD    EQ          SET MASTER DEVICE EST ORDINAL
          STD    T5
          LDM    CCIA        BASE TRACK ADDRESS
          STD    T6
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDM    CCIB        CHECK CATALOG INTERLOCK FLAG
          LPN    77
          NJN    ACE1        IF CATALOG ALREADY INTERLOCKED
          LDD    CC
          LMN    CCSP
          ZJN    ACE1        IF *STAGEPF* REQUEST
          RJM    ICT         INTERLOCK CATALOG TRACK
          AOM    CCIB        SET CATALOG TRACK INTERLOCK FLAG
 ACE1     RJM    IRA         INITIALIZE RANDOM PROCESSORS
          LDM    PFID+1      SET TRACK ADDRESS FOR READ
          STM    -2,CB
          STD    T6
          STM    ERRC
          LDM    PFID+2      SET SECTOR ADDRESS FOR READ
          STM    -1,CB
          STD    T7
          STM    ERRD
          LDD    CB          READ THE CATALOG SECTOR
          RJM    RDS
          PJN    ACE3        IF NO READ ERROR
          RJM    PES         PROCESS ERROR STATUS
 ACE2     ERROR  MSE,,,T5    *EQXXX,DNYY, MASS STORAGE ERROR.*
 
*         SETUP *PFC* ENTRY POINTER BASED ON THE *PEO* VALUE.
 
 ACE3     LDM    1,CB        CHECK SECTOR LENGTH
          LPN    NWCE-1
          ZJN    ACE4        IF LEGAL SECTOR LENGTH
          ERROR  BCS,,,T5,,EI  *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
 
 ACE4     LDM    PFID        ISOLATE *PEO* VALUE
          SHN    -6
          LPN    1S"NWCEM"-1
          SHN    NWCES       FORM *PFC* BIAS
          STD    T1
          SHN    2
          ADD    T1
          RAD    CI
          LDD    T1          CHECK *PEO* OFFSET
          SBM    1,CB
          PJN    ACE5        IF INVALID *PEO* VALUE
 
*         VERIFY *PFC* ENTRY INFORMATION.
 
          LDM    FCUI+1,CI   COMPARE LSB OF USER INDEX
          LMM    PFFM+4
          ZJN    ACE6        IF MATCH
 ACE5     ERROR  PVE         *PFC VERIFICATION ERROR.*
 
 ACE6     LDM    FCUI,CI     COMPARE MSB OF USER INDEX
          LMM    PFFM+3
          LPN    77
          NJN    ACE5        IF USER INDEX DOES NOT MATCH
          COMPARE  PFCD,FCCD CREATION DATE/TIME
          NJN    ACE5        IF CREATION DATE/TIME DOES NOT MATCH
          LJM    ACEX        EXIT
 COF      SPACE  4,15
**        COF - COMPARE FIELD OF 36 BITS.
*
*         ENTRY  (A) = PFC ENTRY OFFSET TO OBJECT FIELD.
*                (CI) = PFC ENTRY ADDRESS.
*                (T1) = SECONDARY FIELD FOR COMPARE.
*
*         EXIT   (A) = 0 IF FIELDS ARE THE SAME.
*
*         USES   T1, T2, T3.
 
 
 COF      SUBR               ENTRY/EXIT
          ADD    CI          SET PRIMARY COMPARE FIELD ADDRESS
          STD    T2
          LDN    3           SET NUMBER OF WORDS TO COMPARE
          STD    T3
 
*         LOOP COMPARING THE TWO FIELDS.
 
 COF1     LDI    T1          SECONDARY FIELD
          LMI    T2          PRIMARY FIELD
          NJN    COFX        IF FIELDS DO NOT MATCH
          AOD    T1          ADVANCE SECONDARY FIELD POINTER
          AOD    T2          ADVANCE PRIMARY FIELD POINTER
          SOD    T3
          ZJN    COFX        IF ALL FIELDS COMPARE
          UJN    COF1        CONTINUE FIELD COMPARE
RSC       SPACE  4,10
**        RSC - READ CATALOG ENTRY, SEARCH CATALOG IF NECESSARY.
*
*         CALLS  ACE, SCH.
*
*         MACROS ERROR.
 
 
 RSC      SUBR               ENTRY/EXIT
          LDM    PFRB
          LPN    37
          ADM    PFRB+1
          NJN    RSC1        IF SPECIAL REQUEST BLOCK SPECIFIED
          RJM    SCH         SEARCH CATALOG
          ZJN    RSCX        IF FILE FOUND
          ERROR  FNF         * (FILENAME) NOT FOUND. *
 
 RSC1     RJM    ACE         ACCESS CATALOG ENTRY
          UJN    RSCX        RETURN
 RVC      SPACE  4,10
**        RVC -  READ AND VERIFY CATALOG ENTRY.
*
*         EXIT   (CB) = CATALOG BUFFER.
*                (CI) = CATALOG POINTER.
*
*         CALLS  ACE.
*
*         MACROS COMPARE, ERROR.
 
 
 RVC      SUBR               ENTRY/EXIT
          RJM    ACE         ACCESS CATALOG ENTRY
          LDM    STAT
          LPK    STTA
          NJN    RVC2        IF TAPE ALTERNATE STORAGE REQUEST
 
*         VERIFY CARTRIDGE ALTERNATE STORAGE ADDRESS.
 
          COMPARE  PFAA,FCAA VERIFY ALTERNATE STORAGE ADDRESS
          NJN    RVC1        IF NO MATCH ON ALTERNATE STORAGE ADDRESS
          LDM    PFAT        VERIFY ALTERNATE STORAGE TYPE
          LMM    FCAT,CI
          LPN    77
          ZJN    RVCX        IF ALTERNATE STORAGE TYPES MATCH
 RVC1     ERROR  PVE         * PFC VERIFICATION ERROR.*
 
*         VERIFY TAPE ALTERNATE STORAGE ADDRESS.
 
 RVC2     COMPARE  PFTS+1,FCTS+1  VERIFY TAPE SEQUENCE NUMBER AND VSN
          NJN    RVC1        IF NO MATCH
          LDM    PFTS        VERIFY TAPE SEQUENCE NUMBER
          LMM    FCTS,CI
          LPN    77
          NJN    RVC1        IF TAPE SEQUENCE NUMBER DOES NOT MATCH
          UJP    RVCX        RETURN
          SPACE  4,10
*         CHECK FOR ZERO-LEVEL OVERLAY OVERFLOW.
 
 
          ERRNG  *-OVL0-ZBFL *0BF* OVERFLOW
          ERRNG  *-OVL0-ZDFL *0DF* OVERFLOW
          TITLE  REQUEST PREPROCESSORS.
 APP      SPACE  4,10
***       APP - *APPEND* REQUEST.
 
 
 APP      BSS    0           ENTRY
 
*         INITIALIZE FOR CATALOG SEARCH.
 
          LDD    LF          CHECK FILE SIZE
          NJN    APP1        IF FILE TOO LARGE FOR HOLE
          ISTORE SCHI,(UJN SCH13)  SET FOR LARGEST HOLE SEARCH
          ISTORE SCHF,(ZJN SCH12)  SET FOR HOLE SEARCH
 APP1     RJM    SCH         SEARCH CATALOG
          ZJN    APP2        IF FILE FOUND
          ERROR  FNF         *(FILE NAME) NOT FOUND.*
 
*         COMPUTE LENGTH OF NEW FILE.
 
 APP2     LDD    LF          SAVE LENGTH OF APPENDAGE
          STM    APLF
          LDD    LF+1
          STM    APLF+1
          LDM    FCLF+1,CI   CALCULATE TOTAL LENGTH OF NEW FILE
          RAD    LF+1
          SHN    -14
          ADM    FCLF,CI
          RAD    LF
          SHN    -5
          NJN    APP3        IF FILE LENGTH .GE. 131072D SECTORS
          LDD    LF          CHECK FOR .GT. 131069D SECTORS
          SHN    14
          ADD    LF+1
          ADN    2           ADD SYSTEM AND EOI SECTORS
          MJN    APP3        IF FILE .GT. 131069D SECTORS
          LDM    MXFS
          ZJN    APP4        IF NO LIMIT ON FILE SIZE
          LDD    LF
          SHN    -3
          NJN    APP3        IF FILE SIZE .GT. MAXIMUM FILE SIZE LIMIT
          LDD    LF
          SHN    14
          ADD    LF+1
          ADN    7
          SHN    -3
          SBM    MXFS
          MJN    APP4        IF FILE NOT TOO LARGE
          ZJN    APP4        IF FILE NOT TOO LARGE
 APP3     LDN    STAB        SET TO ABORT AFTER PERMISSION CHECK
          RAM    STAT
 APP4     LDM    FCBT,CI     SAVE ADDRESS OF OLD FILE
          STM    APTK
          LDM    FCBS,CI
          STM    APSC
          LDD    LF
          ZJN    APP6        IF NEW FILE SHORT ENOUGH TO PLUG HOLE
          ISTORE SCHF,(PSN)  TURN OFF HOLE SEARCH
          UJN    APP7        CLEAR HOLE POINTERS
 
 APP6     LDD    HL          CHECK SIZE OF HOLE FOUND
          ZJN    APP8        IF NO HOLE FOUND
          SBD    LF+1
          ZJN    APP9        IF EXACT FIT, BYPASS HOLE SEARCH
          SBK    MNHS
          PJN    APP8        IF HOLE LONG ENOUGH FOR FILE AND NEW HOLE
 APP7     LDN    0           CLEAR HOLE POINTERS
          STD    HP
          STD    HB
          STD    HL
 APP8     ISTORE SCHI,(ZJN SCH17)  TURN ON SEARCH FOR EXACT FIT
          RJM    SCH         CONTINUE SEARCH FOR BEST HOLE
          NJN    APP9        IF DUPLICATE FILE NOT FOUND
          ERROR  RPE,,,EQ    *EQXXX,DNYY, REPLACE ERROR.*
 
*         SEARCH PERMITS.
 
 APP9     RJM    CCT         CHECK FOR CPU TRANSFER
          RJM    SDB         SWAP DISK BUFFERS (IF NECESSARY)
          RJM    SSP         SET STATISTICAL PARAMETERS
          LDN    0           CLEAR PERMIT POINTERS
          STD    PB
          STD    PP
 
*         READ PERMITS.
 
          LDN    PTAP        CHECK FOR APPEND PERMISSION
          RJM    CPI
          RJM    VFI         VERIFY THAT FILE IS INDIRECT ACCESS
          RJM    DSR         DETERMINE IF FILE STAGING REQUIRED
          LJM    LCO         CALL OVERLAY
 ATT      SPACE  4,10
***       ATT - *ATTACH* REQUEST.
 
 
 ATT      BSS    0           ENTRY
          RJM    SCH         SEARCH CATALOG
          ZJN    ATT2        IF FILE FOUND
          ERROR  FNF         *(FILE NAME) NOT FOUND.*
 
*         VERIFY PERMISSIONS FOR ACCESS.
 
 ATT2     LDM    MODE
          RJM    CPI
          LDM    FCBS,CI     CHECK FILE TYPE
          SHN    21-13
          MJN    ATT3        IF DIRECT ACCESS FILE
          ERROR  FIA         *(FILE NAME) IS INDIRECT ACCESS.*
 
 ATT3     RJM    DSR         DETERMINE IF FILE STAGING IS REQUIRED
          LJM    LCO         CALL OVERLAY
 CHG      SPACE  4,10
***       CHG - *CHANGE* REQUEST.
 
 
 CHG      BSS    0           ENTRY
          LJM    LCO         CALL OVERLAY
 DDS      SPACE  4,10
***       DDS - *DROPDS* REQUEST.
 
 
 DDS      BSS    0           ENTRY
          RJM    RSC         READ CATALOG ENTRY, SEARCH IF NECESSARY
          LDM    FCBT,CI
          NJN    DDS1        IF FILE DISK RESIDENT
          ENDMS
          EXECUTE  3PU       TERMINATE *PFM*
 
 DDS1     LDM    FCBS,CI
          SHN    21-13
          MJN    DDS2        IF DIRECT ACCESS FILE
          LDN    CCDI        PROCESS AS *DROPIDS* REQUEST
          STD    CC
          LDC    PRDI        SET REQUEST PROCESSOR ADDRESS
          STM    LCOA
          LDC    OVDI        SET OVERLAY INTO *EXECUTE* MACRO
          STM    LCOB
          LJM    DIS2        PROCESS AS *DROPIDS* REQUEST
 
 DDS2     LJM    LCO         LOAD OVERLAY
 DIS      SPACE  4,10
***       DIS - *DROPIDS* REQUEST.
 
 
 DIS      BSS    0           ENTRY
          RJM    RSC         READ CATALOG ENTRY, SEARCH IF NECESSARY
          LDM    FCBT,CI
          NJN    DIS1        IF FILE DISK RESIDENT
          ENDMS
          EXECUTE  3PU       TERMINATE *PFM*
 
 DIS1     LDM    FCBS,CI
          SHN    21-13
          PJN    DIS2        IF INDIRECT ACCESS FILE
          LDN    CCDD        PROCESS AS *DROPDS* REQUEST
          STD    CC
          LDC    PRDD        SET REQUEST PROCESSOR ADDRESS
          STM    LCOA
          LDC    OVDD        SET OVERLAY INTO *EXECUTE* MACRO
          STM    LCOB
          UJN    DDS2        PROCESS AS *DROPDS* REQUEST
 
 DIS2     ISTORE SCHH,(UJN SCH16)  SEARCH ONLY DAPF HOLES
          RJM    SHL         SEARCH CATALOG FOR DAPF HOLE
          ZJN    DIS3        IF DELETED DAPF HOLE NOT FOUND
          LDN    0           CLEAR DAPF HOLE INDICATOR
          STM    FCBS,HP
          STM    FCBT,HP     CLEAR TRACK
 DIS3     LJM    LCO         CALL OVERLAY
 DEF      SPACE  4,10
***       DEF - *DEFINE* REQUEST.
 
 
 DEF      BSS    0           ENTRY
          ISTORE SCHF,(ZJN SCH12)  SET TO SEARCH FOR HOLES
          ISTORE SCHH,(UJN SCH16)  SEARCH FOR DIRECT ACCESS HOLES ONLY
          LDC    BFMS        SET ADDRESS OF CATALOG SEARCH BUFFER
          STM    ISPA
 DEF1     LDD    FS          SET EST ORDINAL
          STD    T5
          RJM    IRA         INITIALIZE RANDOM ACCESS PROCESSORS
          LDM    SDAB        SET FIRST SECTOR
          STD    T6
          RJM    SEI         DETERMINE FILE SECTOR SIZE
          LDD    T2          PRESERVE SECTOR SIZE
          STD    LF
          LDD    T3
          STD    LF+1
          LDD    CC
          LMN    CCSD
          ZJN    DEF2        IF *SETDA* REQUEST
          RJM    SCH         SEARCH CATALOG
          NJN    DEF3        IF NO FILE FOUND
          ERROR  FAP         *(FILE NAME) ALREADY PERMANENT.*
 
*         PROCESS *SETDA* REQUEST.
 
 DEF2     RJM    RVC         READ AND VERIFY CATALOG ENTRY
 DEF3     LJM    LCO         CALL OVERLAY
 DPF      SPACE  4,10
***       DPF - *DELPFC* REQUEST.
 
 
 DPF      BSS    0           ENTRY
          LDC    IFUI        SET *IFUI* USER INDEX INTO SRB
          STM    PFFM+4
          LDM    PFFM+3
          SCN    77
          LMN    IFUI/10000B
          STM    PFFM+3
          RJM    ACE         ACCESS CATALOG ENTRY
          LJM    LCO         LOAD COMMAND OVERLAY
 GET      SPACE  4,10
***       GET - *GET* REQUEST.
 
 
 GET      BSS    0           ENTRY
          RJM    SCH         SEARCH CATALOG
          ZJN    GET1        IF FILE FOUND
          ERROR  FNF         *(FILENAME) NOT FOUND.*
 
 GET1     LDM    FCLF,CI     SET FILE LENGTH
          STD    LF
          LDM    FCLF+1,CI
          STD    LF+1
          RJM    CCT         CHECK FOR CPU TRANSFER
          LDN    PTEX        EXECUTE MODE REQUIRED FOR *GET*
          RJM    CPI         CHECK PERMISSION INFORMATION
          STM    ACCM        SAVE ACTUAL ACCESS MODE
          RJM    VFI         VERIFY THAT FILE IS INDIRECT ACCESS
          RJM    DSR         DETERMINE IF FILE STAGING REQUIRED
          LJM    LCO         CALL OVERLAY
 OLD      SPACE  4,10
***       OLD - *OLD* REQUEST.
 
 
 OLD      EQU    GET         USE *GET* PRESET FOR *OLD* REQUEST
 PER      SPACE  4,10
***       PER - *PERMIT* REQUEST.
 
 
 PER      BSS    0           ENTRY
          ISTORE CCDA,(UJN CCD4)  SET BYPASS OF PASSWORD CHECK
          RJM    SCH         SEARCH CATALOG
          ZJN    PER2        IF FILE FOUND
          ERROR  FNF         * (FILENAME) NOT FOUND.*
 
 PER2     LDD    MA          SET USER NAME
          CWM    PFOU,ON
          SBN    1
          CRM    PFAC,ON
          LDN    0           CLEAR PERMIT POINTER
          STD    PP
          LDC    BFMS        SET PERMIT BUFFER ADDRESS
          STD    PB
          LDM    FCRI,CI     SET PERMIT RANDOM INDEX
          STD    RI
          LDM    FCRI+1,CI
          STD    RI+1
          ADD    RI
          ZJN    PER4        IF NO PERMIT DATA AVAILABLE
          RJM    SPI         SEARCH PERMIT INFORMATION
 PER4     LJM    LCO         CALL OVERLAY
 PUR      SPACE  4,10
***       PUR - *PURGE* REQUEST.
 
 
 PUR      BSS    0           ENTRY
          RJM    RSC         READ CATALOG ENTRY, SEARCH IF NECESSARY
          LDM    PFRB
          LPN    37
          ADM    PFRB+1
          NJN    PUR1        IF SPECIAL REQUEST BLOCK SPECIFIED
          LDN    PTWR        WRITE PERMISSON NEEDED FOR PURGE
          RJM    CPI         CHECK PERMISSION INFORMATION
 PUR1     LJM    LCO         CALL OVERLAY
 REP      SPACE  4,10
***       REP - *REPLACE* REQUEST.
 
 
 REP      BSS    0           ENTRY
          LDD    LF
          NJN    REP1        IF FILE LARGER THAN HOLES
          ISTORE SCHF,(ZJN SCH12)  SET TO SEARCH FOR HOLES
 REP1     RJM    SCH         SEARCH FOR CATALOG ENTRY
          ZJP    REP5        IF FILE IS FOUND
          LDD    CP          CHECK USER VALIDATION
          ADK    AACW
          CRD    CM
          LDD    CM+4
          SHN    21-3
          PJN    REP2        IF USER MAY NOT CREATE INDIRECT FILES
          SHN    21-10-21+3+22
          MJN    REP3        IF USER MAY ACCESS AUXILIARY DEVICE
          LDM    PFPN
          ZJN    REP3        IF AUXILIARY DEVICE NOT SPECIFIED
 REP2     ERROR  IUA         *USER ACCESS NOT VALID.*
 
 REP3     LDD    PI          CHECK FOR ALTERNATE CATALOG ACCESS
          ADD    PI+1
          ZJN    REP4        IF NOT ALTERNATE CATALOG ACCESS
          ERROR  FNF         *(FILE NAME) NOT FOUND.*
 
 REP4     LDC    PRSV        PROCESS AS *SAVE* REQUEST
          STM    LCOA        SET PROCESSOR ADDRESS
          LDC    OVSV
          STM    LCOB        SET OVERLAY NAME FOR *SAVE* REQUEST
          LJM    SAV2        PROCESS REQUEST AS *SAVE*
 
 REP5     LDN    0           SET ENTRY AS HOLE
          STM    FCUI,CI
          STM    FCUI+1,CI
          LDM    FCBT,CI     FIRST TRACK OF FILE
          ZJN    REP7        IF FILE NOT DISK RESIDENT
 
*         CHECK SIZE OF HOLE CREATED BY REPLACE.
 
          LDM    FCLF,CI
          SBD    LF
          SHN    14
          ADM    FCLF+1,CI
          SBD    LF+1
          NJN    REP6        IF NOT EXACT FIT
          LDD    CI          SET THIS ENTRY AS HOLE FOUND
          STD    HP
          LDD    CB
          STD    HB
          LDD    LF+1
          STD    HL
          UJN    REP8        BYPASS HOLE SEARCH
 
 REP6     LDM    FCLF,CI     CHECK LENGTH OF FILE BEING REPLACED
          NJN    REP7        IF FILE TOO LONG TO BE USED AS HOLE
          LDC    SCH11       INCLUDE THIS FILE IN HOLE SEARCH
          STM    SCHB
 REP7     RJM    SCH         CONTINUE SEARCH FOR BEST HOLE
          NJN    REP8        IF DUPLICATE FILE NOT FOUND
          ERROR  RPE,,,EQ    *EQXXX,DNYY, REPLACE ERROR.*
 
*         SEARCH PERMITS.
 
 REP8     RJM    CCT         CHECK FOR CPU TRANSFER
          RJM    SDB         SWAP DISK BUFFERS (IF NECESSARY)
          RJM    SSP         SET STATISTICAL PARAMETERS
          LDN    0           CLEAR PERMIT POINTERS
          STD    PB
          STD    PP
          LDN    PTWR        CHECK FOR WRITE PERMISSION
          RJM    CPI         CHECK PERMISSION INFORMATION
          LJM    LCO         CALL OVERLAY
 SAA      SPACE  4,10
***       SAA - *SETASA* REQUEST.
 
 
 SAA      BSS    0           ENTRY
          RJM    ACE         ACCESS CATALOG ENTRY
          LJM    LCO         CALL OVERLAY
 SAC      SPACE  4,10
***       SAC - *SETPFAC* REQUEST.
 
 
 SAC      EQU    CHG         USE *CHANGE* PRESET FOR *SETPFAC* REQUEST
 SAF      SPACE  4,10
***       SAF - *SETAF* REQUEST.
 
 
 SAF      BSS    0           ENTRY
          RJM    RVC         READ AND VERIFY CATALOG ENTRY
          LJM    LCO         CALL OVERLAY
 SAL      SPACE  4,10
***       SAL - *SETPFAL* REQUEST.
 
 
 SAL      EQU    CHG         USE *CHANGE* PRESET FOR *SETPFAL* REQUEST
 SAV      SPACE  4,10
***       SAV - *SAVE* REQUEST.
 
 
 SAV      BSS    0           ENTRY
          LDD    LF
          NJN    SAV1        IF FILE LARGER THAN HOLES
          ISTORE SCHF,(ZJN SCH12)  SET TO SEARCH FOR HOLES
 SAV1     RJM    SCH         SEARCH FOR CATALOG ENTRY
          NJN    SAV2        IF FILE NOT FOUND
          ERROR  FAP         *FILE ALREADY PERMANENT.*
 
 SAV2     AOD    NF+1        ADVANCE FILE COUNT FOR NEW FILE
          SHN    -14
          RAD    NF
          RJM    SSP         SET STATISTICAL PARAMETERS
 SAV3     RJM    CCT         CHECK FOR CPU TRANSFER
          LJM    LCO         CALL OVERLAY
 SDA      SPACE  4,10
***       SDA - *SETDA* REQUEST.
 
 
 SDA      EQU    DEF1        USE *DEFINE* PRESET FOR *SETDA* REQUEST
 SPF      SPACE  4,10
***       SPF - *STAGEPF* REQUEST.
 
 
 SPF      BSS    0           ENTRY
          RJM    ACE         ACCESS CATALOG ENTRY
          LDM    FCBT,CI
          NJN    SPF1        IF FILE ALREADY DISK RESIDENT
          LJM    LCO         LOAD COMMAND OVERLAY
 
 SPF1     ENDMS
          EXECUTE  3PU       TERMINATE *PFM*
 UAT      SPACE  4,10
***       UAT - *UATTACH* REQUEST.
 
 
 UAT      BSS    0           ENTRY
          RJM    RSC         READ CATALOG ENTRY, SEARCH IF NECESSARY
          LDM    FCBS,CI
          SHN    21-13
          MJN    UAT2        IF DIRECT ACCESS FILE
          ERROR  FIA         *FILE IS INDIRECT ACCESS.*
 
 UAT2     LDM    FCBT,CI
          NJP    LCO         IF FILE DISK RESIDENT
          ERROR  FND         *FILE NOT DISK RESIDENT.*
 UGT      SPACE  4,10
***       UGT - *UGET* REQUEST.
 
 
 UGT      BSS    0           ENTRY
          RJM    RSC         READ CATALOG ENTRY, SEARCH IF NECESSARY
          UJN    LCO         CALL OVERLAY
 URE      SPACE  4,10
***       URE - *UREPLAC* REQUEST.
 
 
 URE      BSS    0           ENTRY
          RJM    RVC         READ AND VERIFY CATALOG ENTRY
          LDD    CI          SAVE PFC ADDRESS
          STM    PFCA
          ADN    FCFN        SET FILE NAME TO CURRENT PFN
          RJM    SFN
          RJM    VFI         VERIFY THAT FILE IS INDIRECT ACCESS
          LDM    FCBT,CI
          ZJN    URE2        IF NOT DISK RESIDENT
          ERROR  ICU         * INVALID CATALOG UPDATE.*
 
 URE2     LDD    LF
          NJN    URE3        IF FILE LONGER THAN LARGEST HOLE
          RJM    SHL         SEARCH CATALOG FOR HOLE
          RJM    SDB         SWAP DISK BUFFERS
 URE3     UJN    LCO         CALL OVERLAY
          TITLE  LOAD OVERLAY PROCESSOR.
 LCO      SPACE  4,10
**        LCO - LOAD COMMAND OVERLAY.
*
*         EXIT   TO COMMAND OVERLAY.
*
*         MACROS ENDMS, EXECUTE.
 
 
 LCO      BSS    0           ENTRY
          ENDMS              RELEASE MASTER DEVICE CHANNEL
          LDC    *           SET COMMAND PROCESSING ADDRESS
 LCOA     EQU    *-1         (PROCESSING ADDRESS WITHIN OVERLAY)
          STD    P0
 LCOB     EQU    *+1         (LAST TWO CHARACTERS OF OVERLAY NAME)
          EXECUTE  3PF       *GET*/*OLD*/*UGET*
          EXECUTE  3PG,=     *SAVE*/*REPLACE*/*UREPLAC*
          EXECUTE  3PH,=     *APPEND*
          EXECUTE  3PI,=     *ATTACH*/*UATTACH*
          EXECUTE  3PK,=     *DEFINE*/*SETDA*
          EXECUTE  3PL,=     *DROPDS*/*PURGE*
          EXECUTE  3PM,=     *DELPFC*/*DROPIDS*/*PERMIT*
          EXECUTE  3PN,=     *CHANGE*/*SETPFAC*/*SETPFAL*
          EXECUTE  3PO,=     *SETASA*/*SETAF*
          EXECUTE  3PR,=     STAGE FILE FROM ALTERNATE STORAGE
          TITLE  INITIALIZATION SUBROUTINES.
 CCT      SPACE  4,15
**        CCT - CHECK FOR CPU TRANSFER.
*
*         ENTRY  (LF - LF+1) = FILE LENGTH + 1.
*
*         EXIT   (CPTF) = NONZERO IF CPU SHOULD BE USED FOR TRANSFER.
*                (FA) = FNT ADDRESS FOR LOCAL FILE.
*                (FN - FN+4) = PERMANENT FILE NAME.
*                (FS - FS+4) = FST ENTRY FOR LOCAL FILE.
*
*         USES   FA, CM - CM+4, FS - FS+4.
*
*         CALLS  CLF, RMD, SFN.
*
*         MACROS ENDMS.
 
 
 CCT      SUBR               ENTRY/EXIT
 
*         CHECK IF CALLER IS *DMP=*, SUBSYSTEM OR UCP.
 
          LDD    CP
          ADK    SPCW
          CRD    CM
          LDD    CM+1
          SCN    77
          ADD    CM
          NJN    CCTX        IF *DMP=* PROGRAM IN PROGRESS
          LDD    CP
          ADK    JCIW
          CRD    CM
          LDD    CM+2
          SBK    LSSI
          PJN    CCTX        IF CALLER IS A SUBSYSTEM
          LDD    CP
          ADK    SSCW
          CRD    CM
          LDD    CM
          ADD    CM+1
          ADD    CM+2
          ADD    CM+3
          ADD    CM+4
          NJN    CCTX        IF CALLER IS A UCP
 
*         CHECK IF FILE SIZE .GE. THRESHOLD.
 
          LDK    PFNL        CHECK CPU TRANSFER THRESHOLD
          CRD    CM
          LDD    CM+4
          ZJN    CCTX        IF CPU TRANSFER DISABLED
          SBD    LF+1
          SBN    1
          MJN    CCT1        IF FILE LONG ENOUGH
          LDD    LF
          ZJP    CCTX        IF FILE NOT LONG ENOUGH
 
*         SET UP FOR CPU TRANSFER.
 
 CCT1     ENDMS              RELEASE CHANNEL
          AOM    CPTF        SET *CPU TRANSFER* FLAG
          LDC    CCTA        CREATE LOCAL FILE /PFM*PFN/
          RJM    CLF
          STM    FNTB        SAVE FNT ADDRESS
          LDC    CCTB        CREATE LOCAL FILE /PFM*ILK/
          RJM    CLF
          STM    FNTC        SAVE FNT ADDRESS
          LDD    CC
          LMN    CCAP
          NJN    CCT2        IF NOT *APPEND* REQUEST
          LDC    CCTC        CREATE LOCAL FILE /PFM*APF/
          RJM    CLF
          STM    FNTD        SAVE FNT ADDRESS
 
*         RESET LOCAL FILE PARAMETERS AND MASTER DEVICE DRIVER.
 
 CCT2     LDM    FNTA        RESET FNT ADDRESS
          STD    FA
          NFA    FA,R        REREAD FST
          ADN    FSTL
          CRD    FS
          LDM    PFFN        RESET PERMANENT FILE NAME
          ZJN    CCT3        IF PFN NOT SPECIFIED, USE LFN
          LDN    PFFN-PFSN
 CCT3     ADC    PFSN
          RJM    SFN         SET FILE NAME
          RJM    RMD         RESET TO MASTER DEVICE
          UJP    CCTX        RETURN
 
 
 CCTA     VFD    60/7L"PFN"
 CCTB     VFD    60/7L"ILK"
 CCTC     VFD    60/7L"APF"
 CLF      SPACE  4,20
**        CLF - CREATE LOCAL FILE.
*
*         CREATE AN FNT ENTRY FOR THE SPECIFIED LOCAL FILE,
*         USING ONE OF THE SPECIAL RESERVED FNT ENTRIES.
*         IF THE SPECIFIED LOCAL FILE IS ALREADY ASSIGNED TO
*         THE JOB, RETURN THE FILE AND THEN CREATE A NEW FILE.
*         IF A RESERVED FNT ENTRY WAS NOT FOUND, HANG.
*
*         ENTRY  (A) = ADDRESS OF FILE NAME.
*
*         EXIT   (A) = (FA) = FNT ADDRESS OF FILE.
*                TO *HNG* IF RESERVED FNT ENTRY NOT FOUND.
*
*         USES   FS, FN - FN+4.
*
*         CALLS  *0BF*, *0DF*.
*
*         MACROS EXECUTE, MONITOR.
 
 
 CLF      SUBR               ENTRY/EXIT
          STM    CLFA        SET FILE NAME ADDRESS
 CLF1     LDD    MA
          CWM    *,ON
 CLFA     EQU    *-1
          SBN    1
          CRD    FN          SET FILE NAME
          LDN    45          USE RESERVED FNT, RETURN ON FILE NOT MADE
          STM    OVL0-1
          LDK    NEEQ
          STD    FS
          EXECUTE  0BF,OVL0  CREATE FILE
          UJN    CLF2        IF FILE NOT ALREADY ASSIGNED
 
*         IF FILE ALREADY ASSIGNED, RETURN FILE.
 
          LDN    1           *UNLOAD* EXISTING FILE
          STM    OVL0-1
          EXECUTE  0DF,OVL0
          UJN    CLF1        CREATE NEW FILE
 
*         CHECK FOR SUCCESSFUL FILE CREATION.
 
 CLF2     NJN    CLF3        IF FILE NOT CREATED
          LDD    FA
          LJM    CLFX        RETURN
 
*         HANG IF RESERVED FNT ENTRY NOT FOUND.
 
 CLF3     RJM    HNG         HANG
 DSR      SPACE  4,15
**        DSR -  DETERMINE IF FILE STAGING REQUIRED.
*
*         ENTRY  (CB) = CATALOG BUFFER ADDRESS.
*                (CI) = CATALOG ENTRY POINTER.
*
*         EXIT   (LCOB) = *3PR*, IF STAGING REQUIRED.
*
*         USES   CM - CM+4.
*
*         CALLS  MCB.
*
*         MACROS EXECUTE.
 
 
 DSR      SUBR               ENTRY/EXIT
          LDK    SSTL        GET FILE STAGING DISABLED STATUS
          CRD    CM
          LDD    CM
          SHN    21-3
          MJN    DSR1        IF CARTRIDGE PF STAGING DISABLED
          LDM    FCAF,CI     CHECK PSEUDO RELEASE FLAG
          SHN    21-3
          PJN    DSR1        IF PSEUDO RELEASE NOT SET
          SHN    21-0-21+3
          PJN    DSR2        IF CARTRIDGE COPY NOT OBSOLETE
 DSR1     LDM    FCBT,CI     FIRST TRACK OF FILE
          NJN    DSRX        IF FILE DISK RESIDENT
 DSR2     EXECUTE  3PR,*     STAGE FILE FROM TAPE OR CARTRIDGE
          STM    LCOB
          RJM    MCB         MOVE CATALOG BUFFER (IF NECESSARY)
          UJN    DSRX        RETURN
 MCB      SPACE  4,15
**        MCB - MOVE CATALOG BUFFER.
*
*         MOVE THE CATALOG BUFFER INTO *BUF1*, IF THE CATALOG BUFFER
*         IS CURRENTLY IN *BUF2*.  THIS IS DONE TO ALLOW MORE SPACE
*         FOR OVERLAY *3PR*.  SINCE THE FILE MUST BE STAGED, NO OTHER
*         BUFFERS ARE REQUIRED FOR THE CURRENT INVOCATION OF *PFM*.
*
*         ENTRY  (CB) = CATALOG BUFFER ADDRESS.
*                (CI) = CATALOG ENTRY POINTER.
*
*         EXIT   CATALOG BUFFER COPIED INTO *BUF1*, IF NECESSARY.
*                (CB), (CI) UPDATED.
*
*         USES   CB, CI, T1.
 
 
 MCB      SUBR               ENTRY/EXIT
          LDD    CB          CHECK CATALOG BUFFER ADDRESS
          LMC    BUF2
          NJN    MCBX        IF CATALOG BUFFER IS NOT IN *BUF2*
          LDC    501         SET BYTE COUNT
          STD    T1
 MCB1     LDM    BUF2-2,T1   MOVE NEXT BYTE
          STM    BUF1-2,T1
          SOD    T1
          PJN    MCB1        IF MORE BYTES TO MOVE
          LDC    BUF1-BUF2   ADJUST CATALOG ENTRY POINTER
          RAD    CI
          LDC    BUF1        RESET CATALOG BUFFER POINTER
          STD    CB
          UJN    MCBX        RETURN
 SDB      SPACE  4,20
**        SDB - SWAP DISK BUFFERS.
*
*         SWAP THE *END* BUFFER WITH THE *BFMS* BUFFER, IF THE HOLE
*         BUFFER IS IN *BFMS*.  THIS IS DONE SO THAT *BFMS* CAN BE
*         REUSED FOR PERMITS (IF NECESSARY), AND LATER REREAD IF THE
*         END BUFFER IS NEEDED.  THIS ALSO ALLOWS *REB* TO LATER READ
*         THE DAPF HOLE ENTRY (IF PRESENT) INTO *BFMS*, AND TO THEN
*         DESIGNATE *BFMS* AS THE END BUFFER.  THE VARIOUS POINTERS
*         AND DISK ADDRESSES ASSOCIATED WITH THE BUFFERS ARE ALSO
*         SWAPPED.
*
*         ENTRY  (CB) = ADDRESS OF CATALOG BUFFER.
*                (EB) = ADDRESS OF BUFFER CONTAINING END OF CATALOGS.
*                (EP) = POINTER TO NEXT PFC SLOT AVAILABLE FOR USE.
*                (HB) = ADDRESS OF HOLE BUFFER, IF ANY.
*                (HP) = POINTER TO HOLE ENTRY, IF ANY.
*
*         EXIT   (EBSC) = END BUFFER SECTOR, IF BUFFER IS IN *BFMS*.
*                (EBTK) = END BUFFER TRACK, IF BUFFER IS IN *BFMS*.
*                BUFFERS SWAPPED.
*                BUFFER ADDRESSES AND POINTERS RESET.
*
*         USES   EB, EP, HB, HP, T1, T2, T3.
 
 
 SDB5     LDD    EB
          LMC    BFMS
          NJN    SDBX        IF END BUFFER IS NOT IN *BFMS*
          LDM    BFMS-2      INDICATE THAT END BUFFER IS IN *BFMS*
          STM    EBTK
          LDM    BFMS-1
          STM    EBSC
 
 SDB      SUBR               ENTRY/EXIT
          LDD    HP
          ZJN    SDBX        IF NO HOLE FOUND
          LDD    HB
          LMC    BFMS
          NJN    SDB5        IF HOLE NOT IN *BFMS*
 
*         DETERMINE WHICH BUFFER TO SWAP.
 
          LDD    CB
          LMC    BUF1
          ZJN    SDB1        IF CATALOG IS IN *BUF1*
          LDC    BUF1-BUF2   SWAP *BFMS* WITH *BUF1*
 SDB1     ADC    BUF2        SWAP *BFMS* WITH *BUF2*
          STD    T1          SET BUFFER ADDRESSES
          SBN    2
          STM    SDBA
          STM    SDBB
          LDC    503B        MOVE BUFFER PLUS DISK ADDRESS
          STD    T2
 
*         SWAP BUFFERS.
 
 SDB2     LDM    BFMS-2,T2   SWAP ONE PAIR OF BYTES
          STD    T3
          LDM    *-2,T2
 SDBA     EQU    *-1         (ADDRESS OF BUFFER - 2)
          STM    BFMS-2,T2
          LDD    T3
          STM    *-2,T2
 SDBB     EQU    *-1         (ADDRESS OF BUFFER - 2)
          SOD    T2
          PJN    SDB2        IF MORE BYTES TO SWAP
 
*         RESET POINTERS TO BUFFERS WHICH HAVE BEEN MOVED.
 
          LDD    T1          RESET HOLE POINTERS
          SBD    HB
          RAD    HP
          LDD    T1
          STD    HB
          LDD    EB
          LMD    T1
          NJN    SDB3        IF END OF CATALOGS IS IN HOLE BUFFER
          LDC    BFMS        RESET END POINTERS TO POINT TO *BFMS*
          STD    T1
 SDB3     LDD    EP          RESET END POINTERS
          ZJN    SDB4        IF END SECTOR IS EOI
          SBD    EB
          ADD    T1
          STD    EP
 SDB4     LDD    T1
          STD    EB
          UJP    SDB5        RETURN
 SSP      SPACE  4,10
**        SSP - SET STATISTICAL PARAMETERS.
*
*         ENTRY  (NF - NF+1) = NUMBER OF FILES.
*                (CS - CS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
*
*         EXIT   (ACNF - ACNF+1) SET WITH NUMBER OF FILE.
*                (CIFS - CIFS+1) SET WITH CUMULATIVE SIZE OF FILES.
 
 
 SSP      SUBR               ENTRY/EXIT
          LDD    CS
          STM    CIFS
          LDD    CS+1
          STM    CIFS+1
          LDD    NF
          STM    ACNF
          LDD    NF+1
          STM    ACNF+1
          UJN    SSPX        EXIT
 VFI      SPACE  4,10
**        VFI - VERIFY THAT FILE IS INDIRECT ACCESS.
*
*         EXIT   TO *ERR* IF FILE IS DIRECT ACCESS.
*
*         MACROS ERROR.
 
 
 VFI      SUBR               ENTRY/EXIT
          LDM    FCBS,CI     CHECK FILE TYPE
          SHN    21-13
          PJN    VFIX        IF INDIRECT ACCESS FILE
          ERROR  FDA         *(FILE NAME) IS DIRECT ACCESS.*
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          USE    OVERFLOW
          ERRNG  BUF2-2-*    OVERFLOW INTO CATALOG/PERMIT BUFFER
          TITLE  OVERLAYABLE INITIALIZATION ROUTINES.
 IRP      SPACE  4,25
***       INITIAL REQUEST PROCESSING.
*
*         CALL REQUEST PREPROCESSOR TO PERFORM CATALOG AND
*         PERMIT SEARCH, BEFORE CALLING COMMAND OVERLAY.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
*                (MSTA) = MST ADDRESS/10B.
*                (PFOU) = OPTIONAL USER NAME
*                (PFPN) = OPTIONAL PACK NAME.
*
*         EXIT   TO COMMAND PROCESSOR AS SPECIFIED BY (CC).
*                (CCDA) = CHANGED IF PASSWORD CHECKING IS NOT NEEDED.
*                (CCDB) = *PSN* SET IF ACCUMULATION REQUIRED.
*                (CCDC) = CHANGED IF SECURITY ACCESS VIOLATION.
*                (DVLW) = DEVICE LAYOUT WORD OF MASTER DEVICE FROM MST.
*                (LCOA) = COMMAND OVERLAY PROCESSOR ADDRESS.
*                (LCOB) = COMMAND OVERLAY NAME.
*                (SCHG) = BYPASS SET IF USER INDEX CHECK IS NOT NEEDED.
*                THE FOLLOWING SEARCH POINTERS ARE INITIALIZED.
*                (HL, PB, PP, CS, CS+1, HB, HP, CB, CI, EP)
*
*         USES   T1, CM - CM+4.
*
*         CALLS  RMD.
 
 
 IRP      BSS    0           ENTRY
 
*         INITIALIZE CATALOG SEARCH ROUTINES.
 
          LDM    PFOU
          NJN    IRP1        IF ALTERNATE USER NAME SPECIFIED
          ISTORE CCDA,(UJN CCD4)  SET BYPASS OF PASSWORD CHECK
          ISTORE CCDC,(NJN CCD9)  SET SECURITY VIOLATION PROCESSING
 IRP1     LDM    STAT        CHECK FOR SEARCH STATISTICS REQUIRED
          LPK    STAC
          ZJN    IRP2        IF ACCUMULATION NOT REQUIRED
          ISTORE CCDB,(PSN)  SET ACCUMULATION REQUIRED
 
*         INITIALIZE FOR DEVICE ACCESS.
 
 IRP2     RJM    RMD         SET DRIVER FOR MASTER DEVICE
          LDM    MSTA        READ MST DEVICE LAYOUT WORD
          SHN    3
          ADN    ALGL
          CRM    DVLW,ON
          LDM    STAT        CHECK FOR PRIVATE DEVICE
          LPK    STPD
          ZJN    IRP3        IF NOT PRIVATE DEVICE
          ISTORE SCHG,(PSN)  SET BYPASS OF USER INDEX CHECK
 
*         INITIALIZE SEARCH POINTERS.
 
 IRP3     LDN    0           CLEAR DIRECT CELLS
          STD    HL          LENGTH OF HOLE
          STD    PB          POINTER TO PERMIT BUFFER
          STD    PP          INDEX TO PERMIT BUFFER
          STD    CS          CUMULATIVE SIZE OF FILES IN CATALOG
          STD    CS+1
          LDN    ZERL        CLEAR CONTIGUOUS STORAGE
          CRD    HB
          ERRNZ  HP-HB-1     DIRECT CELLS NOT CONTIGUOUS
          ERRNZ  CB-HP-1     DIRECT CELLS NOT CONTIGUOUS
          ERRNZ  CI-CB-1     DIRECT CELLS NOT CONTIGUOUS
          ERRNZ  EP-CI-1     DIRECT CELLS NOT CONTIGUOUS
 
*         EXIT TO REQUEST PREPROCESSOR.
 
          LDD    CC          INDEX INTO *TCMD* TABLE
          SHN    1
          ADD    CC
          STD    T1
          LDM    TCMD+2,T1   SET OVERLAY NAME INTO *EXECUTE* MACRO
          STM    LCOB
          LDM    TCMD+1,T1   SET REQUEST PROCESSOR ENTRY ADDRESS
          STM    LCOA
          LDM    TCMD,T1     SET REQUEST PREPROCESSOR ADDRESS
          STD    T1
          LJM    0,T1        EXIT TO REQUEST PREPROCESSOR
 CMD      SPACE  4,15
**        CMD - CREATE *TCMD* TABLE ENTRIES.
*
*         *CMD* CREATES THE THREE-WORD *TCMD* ENTRIES AND DEFINES
*         THE SYMBOLS *OVXX* AND *PRXX*, THE OVERLAY SUFFIX AND REQUEST
*         PROCESSOR ENTRY ADDRESS, RESPECTIVELY, FOR FUNCTION XX.
*         *XX* IS THE APPROPRIATE LAST TWO CHARACTERS OF THE COMMAND
*         CODE SYMBOL *CCXX*.
*
* CC      CMD    PPR,PRO
*
*         CC     COMMAND CODE SUFFIX
*         PPR    PREPROCESSOR ADDRESS.  IF OMITTED, A ZERO ENTRY IS
*                CREATED.
*         PRO    REQUEST PROCESSOR ENTRY ADDRESS IN THE FORM /3PX/ADDR.
 
 
          MACRO  CMD,C,PPR,PRO
          ERRNZ  *-3*//CC_C  TABLE ENTRY OUT OF ORDER
 .A       IFC    EQ,$PPR$$
          CON    0,0,0
 .A       ELSE
 .1       MICRO  2,2,PRO//
          CON    PPR,PRO,2R".1"
 OV_C     EQU    2R".1"
 CMD      RMT
 PR_C     EQU    PRO
          RMT
 .A       ENDIF
          ENDM
 TCMD     SPACE  4,10
**        TCMD - TABLE OF COMMAND PROCESSOR ADDRESSES.
*
*         *TCMD* IS CREATED BY THE *CMD* MACRO.
*
*         FIRST BYTE IS PREPROCESSOR ADDRESS IN *3PC*.
*         SECOND BYTE IS PROCESSOR ADDRESS IN COMMAND OVERLAY.
*         THIRD BYTE IS SUFFIX FOR COMMAND OVERLAY NAME.
 
 TCMD     EQU    *-3         COMMAND CODE ADDRESS TABLE
          LOC    3
 
 SV       CMD    SAV,/3PG/SAV  *SAVE*
 GT       CMD    GET,/3PF/GET  *GET*
 PG       CMD    PUR,/3PL/PUR  *PURGE*
 CT       CMD                  *CATLIST*
 PM       CMD    PER,/3PM/PER  *PERMIT*
 RP       CMD    REP,/3PG/REP  *REPLACE*
 AP       CMD    APP,/3PH/APP  *APPEND*
 DF       CMD    DEF,/3PK/DEF  *DEFINE*
 AT       CMD    ATT,/3PI/ATT  *ATTACH*
 CG       CMD    CHG,/3PN/CHG  *CHANGE*
 UA       CMD    UAT,/3PI/UAT  *UATTACH*
 SA       CMD    SAA,/3PO/SAA  *SETASA*
 AF       CMD    SAF,/3PO/SAF  *SETAF*
 SD       CMD    SDA,/3PK/SDA  *SETDA*
 DD       CMD    DDS,/3PL/DDS  *DROPDS*
 AN       CMD                  *ASSIGNPF*
 OD       CMD    OLD,/3PF/OLD  *OLD*
 AC       CMD    SAC,/3PN/CHG  *SETPFAC*
 AL       CMD    SAL,/3PN/CHG  *SETPFAL*
 UG       CMD    UGT,/3PF/UGT  *UGET*
 UR       CMD    URE,/3PG/URE  *UREPLAC*
 DI       CMD    DIS,/3PM/DIS  *DROPIDS*
 DP       CMD    DPF,/3PM/DPF  *DELPFC*
 RS       CMD                  *RPFSTAT*
 SP       CMD    SPF,/3PR/SPF  *STAGEPF*
 
          LOC    *O
 
          OVERFLOW  OVLA,EPFW
          EJECT
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 CAI      EQU    /".O"/CAI
 CSA      EQU    /".O"/CSA
 CTI      EQU    /".O"/CTI
 DPR      EQU    /".O"/DPR
 DTK      EQU    /".O"/DTK
 IRA      EQU    /".O"/IRA
 ITC      EQU    /".O"/ITC
 MSRA     EQU    /".O"/MSRA
 RMD      EQU    /".O"/RMD
 RNS      EQU    /".O"/RNS
 SNT      EQU    /".O"/SNT
 SNTA     EQU    /".O"/SNTA
 STI      EQU    /".O"/STI
 UCE      EQU    /".O"/UCE
 UCE3     EQU    /".O"/UCE3
 UCE4     EQU    /".O"/UCE4
 UCEA     EQU    /".O"/UCEA
 UCEB     EQU    /".O"/UCEB
 UCEC     EQU    /".O"/UCEC
 WBI      EQU    /".O"/WBI
 
 LOCG     EQU    /".O"/LOCG
 OVLC     EQU    /".O"/OVLC
 OVLU     EQU    /".O"/OVLU
          OVERLAY  (CATALOG UPDATE ROUTINES.),OVLU
 OVL      SPACE  4,10
***       THIS OVERLAY CONTAINS SUBROUTINES USED BY THE COMMAND
*         OVERLAYS TO UPDATE THE PERMANENT FILE CATALOG.
 
 
 OVL      BSS    0           ENTRY
          RJM    RMD         RESET TO MASTER DEVICE
          LDM    DVLW+1      PRESET FIRST TRACK FIELD IN EOI BUFFER
          STM    EOIFS+1
          LDN    PDTL        PRESET DATE/TIME FIELD IN EOI BUFFER
          CRM    EOIDT,ON
          LDM    PUCW
          SHN    21-13
          PJN    OVL1        IF NO USER CONTROL WORD SPECIFIED
          LDN    PSNI        FORCE UPDATE OF USER CONTROL WORD
          STM    FCEG
 OVL1     LDM    PFPW
          ZJN    OVL2        IF PASSWORD NOT SPECIFIED
          LDN    PSNI        FORCE UPDATE OF PASSWORD
          STM    FCEH
 OVL2     UJN    ".Q"X       RETURN AFTER LOAD
          TITLE  ALLOCATION ROUTINES.
 ACS      SPACE  4,25
**        ACS - ALLOCATE CATALOG SPACE.
*
*         ENTRY  (T5) = (EQ) = MASTER DEVICE EST ORDINAL.
*                (EB) = POINTER TO END BUFFER.
*                (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
*                (FS) = EST ORDINAL FOR FILE.
*                (FS+1) = FIRST TRACK OF FILE.
*                (SDAC) = FIRST SECTOR OF FILE ,(4XXX) FOR DA FILE.
*
*         EXIT   NEXT SECTOR ALLOCATED FOR CATALOGS.
*                NEW CATALOG BUFFER CLEARED.
*                ADDRESS SET IN 2 LOCATIONS PRECEEDING BUFFER.
*                (EP) = ADDRESS OF NEXT AVAILABLE ENTRY IN BUFFER.
*                LINKAGE SET IN BUFFER.
*                OVERFLOW BIT SET IN MST IF NEW TRACK ALLOCATED.
*                TO *HNG* IF LABEL TRACK NOT RESERVED.
*
*         USES   EP, T1, T5, T6.
*
*         CALLS  CAI, ITC, RTK, SEI.
*
*         MACROS ENDMS, MONITOR.
 
 
 ACS3     LDD    EB          SAVE BUFFER ADDRESS
          ADN    1
          STM    ACSA
          ADN    1           SET POINTER TO NEXT AVAILABLE ENTRY
          STD    EP
          LDC    500
          STD    T1
 ACS4     LDN    0           CLEAR NEW CATALOG SECTOR BUFFER
          STM    *,T1
 ACSA     EQU    *-1         (ADDRESS OF BUFFER + 1)
          SOD    T1
          PJN    ACS4        IF MORE BYTES TO CLEAR
 
 ACS      SUBR               ENTRY/EXIT
          LDM    -2,EB       END BUFFER TRACK
          STD    T6
          LDM    -1,EB
          ADN    1
          STI    EB
          LMM    SLM
          NJN    ACS3        IF NOT AT SECTOR LIMIT
          ENDMS
          LDM    DVLW+1      INTERLOCK CATALOG ALLOCATION
          RJM    ITC
          ZJN    ACS1        IF INTERLOCK SUCCESSFUL
          RJM    HNG         HANG IF LABEL TRACK NOT RESERVED
 
 ACS1     LDD    T6          SET ALLOCATION INTERLOCK FLAG
          STM    AILK
          RJM    SEI         SEARCH FOR END OF CATALOG TRACK
          LDD    T5          SET CATALOG TRACK OVERFLOW
          STD    CM+1
          LDN    SGBS
          STD    CM+3
          LDN    GCTO
          STD    CM+2
          MONITOR  STBM
          LDD    T6
          STI    EB
          RJM    RTK         REQUEST TRACK
          ZJN    ACS2        IF NO TRACK AVAILABLE
          RJM    CAI         CLEAR ALLOCATION INTERLOCK
          LJM    ACS3        EXIT
 
*         TRACK LIMIT ENCOUNTERED.
 
 ACS2     ERROR  TKL,,,T5    *EQXXX,DNYY, TRACK LIMIT.*
 AFS      SPACE  4,20
**        AFS - ALLOCATE FILE SPACE.
*
*         ENTRY  (T5) = MASTER DEVICE EST ORDINAL.
*                (LF - LF+1) = LENGTH OF FILE TO BE ALLOCATED.
*                INDIRECT ALLOCATION INTERLOCK SET.
*
*         EXIT   SPACE ALLOCATED FOR INDIRECT FILE.
*                (SDAB) = TRACK OF NEW FILE.
*                (SDAC) = SECTOR OF NEW FILE.
*
*         USES   T2, T7, CM - CM+4.
*
*         CALLS  DTK, SEI.
*
*         MACROS ENDMS, MONITOR.
 
 
 AFS      SUBR               ENTRY/EXIT
          ENDMS              RELEASE CHANNEL
          LDM    IAIF
          NJN    AFS2        IF ALLOCATION INTERLOCK SET
          RJM    HNG         HANG
 
 AFS2     LDM    DVLW        SKIP TO END OF INDIRECT CHAIN
          STD    T6
          RJM    SEI
          LDD    T5          SET EST ORDINAL AND TRACK
          STD    CM+1
          LDD    T6
          STM    SDAB
          STD    CM+2
          LDD    T7          CALCULATE SECTORS REQUIRED
          ADD    LF+1
 AFSB     ADN    2           ALLOCATE FOR SYSTEM SECTOR AND EOI
*         PSN                (*APPEND* - DO NOT ALLOCATE FOR SS/EOI)
          STD    CM+4
          STD    T2
          SHN    -14
          ADD    LF
          STD    CM+3
          AOD    T7
          LMM    SLM
          NJN    AFS3        IF CURRENT EOI NOT AT END OF TRACK
          STD    T7          RESET FIRST TRACK AND SECTOR OF NEW FILE
          STM    AFSA+PSNI*0
 AFS3     LDD    CM+4        SUBTRACT SECTORS IN CURRENT TRACK
          SBM    SLM
          STD    CM+4
          PJN    AFS6        IF ADDITIONAL TRACKS REQUIRED
          LDD    CM+3
          NJN    AFS5        IF ADDITIONAL TRACKS REQUIRED
          LDD    T2          SET EOI IN TRT
          RJM    DTK
          UJN    AFS8        COMPLETE ALLOCATION
 
 AFS5     AOD    CM+4        ADJUST FOR UNDERFLOW
          SOD    CM+3
 AFS6     AOD    CM+4        ADJUST SECTOR COUNT FOR *RTCM*
          SHN    -14
          RAD    CM+3
          MONITOR  RTCM
*         LDN    0           CLEAR REWRITE ON FILE COPY
          STM    DTMD
          LDD    CM+4
 AFSA     UJN    AFS7        SKIP UPDATE OF FIRST TRACK
*         PSN                (CURRENT EOI AT END OF TRACK)
          STM    SDAB        SET FIRST TRACK OF NEW FILE
 AFS7     ZJN    AFS9        IF NO TRACKS ASSIGNED
 AFS8     LDD    T7          SET FIRST SECTOR OF NEW FILE
          STM    SDAC
          LDC    STXC        SET *EXTENDING INDIRECT CHAIN* FLAG
          RAM    STAT
          LDN    0           CLEAR REWRITE ON FILE COPY
          STM    DTMD
          LJM    AFSX        RETURN
 
 AFS9     ERROR  TKL,,,T5    *EQXXX,DNYY, TRACK LIMIT.*
          TITLE  CATALOG UPDATE ROUTINES.
 CCS      SPACE  4,30
**        CCS - CREATE CATALOG SECTOR.
*
*         ENTRY  (HB) = ADDRESS OF BUFFER CONTAINING HOLE.
*                (HP) = INDEX TO HOLE ENTRY.
*                (EB) = POINTER TO BUFFER CONTAINING END OF CATALOGS.
*                (EP) = INDEX TO FIRST AVAILABLE ENTRY IN END BUFFER.
*                (CC) = COMMAND CODE.
*                (DAHP) .NE. 0 IF DIRECT ACCESS HOLE BEING USED.
*                (CI) = INDEX TO CATALOG ENTRY (APPEND/REPLACE/UREPLACE)
*                (CCSB) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
*                (CCSC) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
*                (CCSF) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
*                (CCSG) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
*                (SDAB) = FIRST TRACK OF FILE.
*                (SDAC) = FIRST SECTOR OF FILE, (4XXX) FOR DA FILE.
*
*         EXIT   CATALOG ENTRY CREATED.
*                CATALOG ENTRY NOT WRITTEN TO DISK IF *DEFINE* REQUEST.
*                SPACE FOR FILE ALLOCATED IF NECESSARY.
*                (EP) = ADDRESS OF NEW CATALOG ENTRY OF FILE (IF DAPF).
*                (EB) = ADDRESS OF BUFFER FOR FILE (IF DAPF).
*                IF (HB) .NE. (EB), END BUFFER REWRITTEN.
*
*         USES   T1 - T7.
*
*         CALLS  ACS, AFS, FCE, FHE, REB, WBI.
*
*         NOTES  THE SYMBOLS *CCSA*, *CCSD* AND *CCSV* SHOULD NOT BE
*                USED AS DATA TAGS IN THIS SUBROUTINE, SINCE THEY
*                CONFLICT WITH GLOBAL SYMBOLS.
 
 
 CCS      SUBR               ENTRY/EXIT
 CCSE     LDD    HP
*         LJM    CCS5.1      (*UREPLACE*)
          NJN    CCS3        IF HOLE AVAILABLE
 
*         CREATE NEW CATALOG ENTRY.
 
          RJM    REB         REREAD END BUFFER (IF NECESSARY)
 CCSB     RJM    AFS         ALLOCATE FILE SPACE
*         PSN                (*DEFINE* OR *DROPIDS*)
          LDD    EP
          NJN    CCS2        IF SPACE AVAILABLE IN LAST SECTOR
          RJM    ACS         ALLOCATE CATALOG SPACE
 
*         FORM CATALOG ENTRY FOR FILE.
 
 CCS2     LDD    EP          SET ADDRESS OF FIRST ENTRY
          RJM    FCE
          LDM    DAHP
          NJN    CCS2.1      IF USING DIRECT ACCESS HOLE
          LDN    NWCE        ADVANCE SECTOR WORD COUNT
          RAM    1,EB
 CCS2.1   LJM    CCS7        WRITE END BUFFER
 
*         USE EXISTING CATALOG ENTRY FOR FILE.
 
 CCS3     UJN    CCS5        PROCESS INDIRECT ACCESS FILE
*         PSN                (*DEFINE*/*DROPIDS* REQUEST)
 CCSC     EQU    *-1
 
*         REUSE DELETED DIRECT ACCESS FILE ENTRY.
 
          LDD    HP          FORM CATALOG ENTRY FOR DIRECT ACCESS FILE
          STD    EP
          RJM    FCE
 
 CCS4     LDD    HB          REWRITE CATALOG SECTOR
          STD    EB
 CCSF     RJM    WBI
*         PSN                (*DEFINE*/*DROPIDS* REQUEST)
          UJP    CCSX        EXIT
 
*         UTILIZE HOLE FOR INDIRECT ACCESS FILE.
 
 CCS5     LDM    FCBT,HP     SET ADDRESS OF HOLE
          STM    SDAB
          LDM    FCBS,HP
          STM    SDAC
          LDD    HP          REFORM CATALOG ENTRY FOR NEW FILE
          RJM    FCE         FORM CATALOG ENTRY
 CCS5.1   LDD    HL          LENGTH OF HOLE
          SBD    LF+1
          ZJN    CCS4        IF EXACT FIT
 
*         CREATE CATALOG ENTRY FOR UNUSED PORTION OF HOLE.
*
*         NOTE - CODE IN *SCH* AND *APP* GUARANTEES THAT A HOLE
*         WILL NOT BE SELECTED UNLESS IT IS LARGE ENOUGH TO
*         ALLOW A NEW MINIMUM-SIZED HOLE TO BE CREATED (EXCEPT
*         FOR EXACT FITS).
 
          SBN    2           SET NEW HOLE LENGTH
          STD    HL
          RJM    REB         REREAD END BUFFER (IF NECESSARY)
          LDD    EP
          NJN    CCS6        IF SPACE AVAILABLE IN LAST SECTOR
          RJM    ACS         ALLOCATE CATALOG SPACE
 CCS6     RJM    FHE         FORM HOLE ENTRY
          LDM    DAHP
          NJN    CCS6.1      IF USING DIRECT ACCESS HOLE
          LDN    NWCE
          RAM    1,EB
 CCS6.1   LDD    HB          REWRITE FILE CATALOG ENTRY
          RJM    WBI
          LDD    HB          CHECK BUFFERS
          LMD    EB
          ZJN    CCS8        IF NEW ENTRY IN SAME BUFFER AS HOLE
 CCS7     LDD    EB          WRITE NEW CATALOG ENTRY
 CCSG     RJM    WBI
*         PSN                (*DEFINE*/*DROPIDS* REQUEST)
 
*         WRITE EOI SECTOR IF NEW SECTOR OF CATALOGS.
 
 CCS8     LDD    EP          CHECK END BUFFER
          SBD    EB
          SBN    2
          ADM    DAHP        NON-ZERO IF USING DIRECT ACCESS HOLE
          NJN    CCS10       IF NOT NEW END BUFFER
          LDI    EB
          SHN    6
          PJN    CCS9        IF NOT NEW TRACK
          SHN    -6
          STD    T6
          LDN    0
 CCS9     SHN    -6
          STD    T7          SET SECTOR NUMBER
          STM    EOIA+1
          STM    EOIFS+3
          LDD    T6          SET TRACK NUMBER
          STM    EOIA
          STM    EOIFS+2
          LDC    EOIB        WRITE EOI
          RJM    WBI
 CCS10    LJM    CCSX
 CDA      SPACE  4,15
**        CDA - COMPARE DISK ADDRESSES.
*
*         IF THE DISK ADDRESS FOR THE BUFFER MATCHES THE DISK ADDRESS
*         FOR THE DIRECT ACCESS HOLE, SET THE END BUFFER POINTERS TO
*         MATCH THE BUFFER POINTERS.
*
*         ENTRY  (A) = BUFFER ADDRESS.
*
*         EXIT   (A) = 0 IF DISK ADDRESS MATCH.
*                (EB) = BUFFER ADDRESS IF DISK ADDRESSES MATCH.
*                (EP) = OFFSET IF DISK ADDRESSES MATCH.
*
*         USES   T3.
 
 
 CDA      SUBR               ENTRY/EXIT
          STD    T3          SAVE BUFFER ADDRESS
          LDM    DAHP
          LMM    -2,T3
          NJN    CDAX        IF NOT THE SAME TRACK
          LDM    DAHP+1
          LMM    -1,T3
          NJN    CDAX        IF NOT THE SAME SECTOR
          LDD    T3          SET END BUFFER ADDRESS
          STD    EB
          ADM    DAHP+2
          STD    EP
          LDN    0           DISK ADDRESS MATCH
          UJN    CDAX        RETURN
 CIA      SPACE  4,30
**        CIA - CLEAR INDIRECT ALLOCATION INTERLOCK.
*
*         THE INTERLOCK IS NOT CLEARED AT THIS TIME WHEN EXTENDING
*         THE INDIRECT CHAIN ON A BUFFERED DEVICE; THE INTERLOCK IS
*         HELD THROUGHOUT THE TRANSFER.  THIS IS DONE FOR THE FOLLOWING
*         REASON:  SINCE ANY REQUEST TO WRITE TO NEWLY ALLOCATED SPACE
*         ON A BUFFERED DEVICE MUST BE DONE BY SEQUENTIAL (NON-REWRITE)
*         REQUESTS, ALL EXTENSIONS OF THE INDIRECT CHAIN ARE PERFORMED
*         WITH SEQUENTIAL WRITES.  HOWEVER, THIS MEANS THAT TWO OR MORE
*         COPIES OF *PFM* CANNOT BE ALLOWED TO PERFORM SUCH EXTENSIONS
*         AT THE SAME TIME, SINCE ONE *PFM* MIGHT THEN DO A
*         SEQUENTIAL WRITE INTO A PHYSICAL SECTOR PREVIOUSLY WRITTEN
*         BY ANOTHER *PFM*, WHICH MAY DESTROY THE DATA WRITTEN BY
*         THAT OTHER *PFM*.  NOTE THAT THE INTERLOCK MUST ALSO BE
*         HELD THROUGHOUT THE TRANSFER FOR *CPUPFM* TRANSFERS, SINCE
*         FOR SEQUENTIAL WRITES *1MS*/*CPUMTR* WILL CHANGE THE VALUE
*         OF THE EOI IN THE TRT DURING THE TRANSFER, AND WILL NOT SET
*         THE FINAL VALUE OF THE EOI UNTIL THE TRANSFER IS COMPLETE.
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*                (DVLW) = FIRST TRACK OF INDIRECT CHAIN.
*
*         EXIT   INDIRECT ALLOCATION INTERLOCK CLEARED.
*                (IAIF) CLEARED.
*
*         USES   T5, T6.
*
*         CALLS  CTI.
*
*         MACROS ENDMS.
 
 
 CIA      SUBR               ENTRY/EXIT
          ENDMS
          LDM    STAT
          LPC    STBD+STXC
          LMC    STBD+STXC
          ZJN    CIAX        IF EXTENDING CHAIN ON BUFFERED DEVICE
          LDD    EQ
          STD    T5
          LDM    STAT
          LPC    STXC
          ZJN    CIA1        IF NOT EXTENDING CHAIN
          RAD    T5          SET CHECKPOINT BIT
          ERRNZ  STXC-4000   CODE DEPENDS ON VALUE
 CIA1     LDM    DVLW        CLEAR INTERLOCK
          STD    T6
          RJM    CTI
          LDD    EQ
          STD    T5
          LDN    0           CLEAR FLAG
          STM    IAIF
          UJN    CIAX        RETURN
 DCE      SPACE  4,30
**        DCE - DELETE CATALOG ENTRY.
*
*         DELETE CATALOG ENTRY FOR INDIRECT ACCESS FILE.
*         DETERMINE IF SPACE CAN BE RELEASED AND RELEASE IF REQUESTED.
*
*         ENTRY  (CB) = BUFFER ADDRESS.
*                (CI) = POINTER TO CATALOG ENTRY.
*                (DCEC) = PRESET TO *PSN* FOR *APPEND* REQUEST.
*                (DCED) = PRESET TO *PSN* FOR *APPEND* REQUEST.
*                INDIRECT ALLOCATION INTERLOCK SET.
*
*         EXIT   ENTRY DELETED IN CATALOG SECTOR.
*                (A) = 0     IF NO DELINK POSSIBLE.
*                (A) = 1     IF DELINK POSSIBLE.
*                            CATALOG BUFFER REWRITTEN IF NOT *APPEND*
*                            REQUEST.
*                (A) = 2     IF FILE AT END OF CHAIN.
*                            CATALOG BUFFER REWRITTEN IF NOT *APPEND*
*                            REQUEST.
*                DELINK REQUEST SAVED AT *APDK* IF DELINK POSSIBLE FOR
*                  AN APPEND OPERATION.
*
*         USES   P0, P1, P2, P3, T1, T2, T3, T4, T6, T7, CM - CM+4.
*
*         CALLS  DTK, SNT, WBI.
*
*         MACROS ENDMS, MONITOR.
 
 
 DCE      SUBR               ENTRY/EXIT
          LDM    IAIF
          NJN    DCE0        IF ALLOCATION INTERLOCK SET
          RJM    HNG         HANG
 
*         SET CATALOG ENTRY AS HOLE.
 
 DCE0     LDM    FCLF+1,CI   SET LENGTH OF HOLE
          ADN    2           ACCOUNT FOR SYSTEM SECTOR AND EOI
          STD    P1
          SHN    -14
          ADM    FCLF,CI
          STD    P0
          LDM    FCBS,CI     SET START OF HOLE
          STD    T7
          LDN    0           CLEAR TRACK COUNT
          STD    T3
          STM    FCUI+1,CI   SET ENTRY AS HOLE
          LDM    FCUI,CI
          SCN    77
          STM    FCUI,CI
          LDD    CI          SET CONTROL MODIFICATION DATE IN HOLE
          RAM    DCEB
          LDN    PDTL
          CRM    FCKD-2,ON
 DCEB     EQU    *-1         (ADDRESS OF DATE WITHIN BUFFER)
          LDM    FCBT,CI
          NJN    DCE1        IF FILE IS DISK RESIDENT
          LDC    4000        SET AS DAPF HOLE
          STM    FCBS,CI
          LJM    DCE15       EXIT
 
*         CHECK FOR POSSIBILITY OF TRACK DELINK.
 
 DCE1     STD    T6          SET CURRENT TRACK
          RJM    SNT         SET NEXT TRACK
          STD    T1
          SHN    6
          PJN    DCE5        IF END OF TRACK CHAIN
          LDM    SLM
          SBD    T7
          STD    T2          SAVE SECTOR COUNT FOR THIS TRACK
          LDD    P1          DECREMENT REMAINING HOLE BY SECTOR COUNT
          SBD    T2
          STD    T0          SAVE RESULT
          PJN    DCE4        IF NOT END OF HOLE
          SOD    P0
          PJN    DCE3        IF NOT END OF HOLE
 DCE2     LJM    DCE10       PROCESS END OF HOLE
 
 DCE3     AOD    T0          RESTORE RESULT
 DCE4     STD    P1
          AOD    T3          ADVANCE TRACK COUNT
          LDN    0           SET FIRST SECTOR
          STD    T7
          LDD    P2          SAVE PREVIOUS TRACK
          STD    P3
          LDD    T6          SAVE LAST TRACK
          STD    P2
          LDD    T1
          UJN    DCE1        LOOP FOR NEXT TRACK
 
*         END OF CHAIN ENCOUNTERED.
 
 DCE5     LDD    P0
          SHN    14
          ADD    P1
          ADD    T7
          SBD    T1
          SBN    1
          NJN    DCE2        IF NOT LAST FILE ON CHAIN
          LDN    2           FLAG END OF CHAIN
          RAM    DCEA
 DCEC     UJN    DCE6        NOT APPEND COMMAND
*         PSN                (*APPEND* REQUEST)
          LJM    DCE15       EXIT BACK TO APPEND PROCESSING
 
 DCE6     LDM    FCBS,CI
          ZJN    DCE7        IF FILE STARTS AT SECTOR 0
          SBN    1
          STD    P1
          LCN    0           SET AS NULL HOLE
          STM    FCBS,CI     SET AS NULL HOLE (DELETED DA FILE)
          UJN    DCE8        REWRITE CATALOG ENTRY
 
 DCE7     STM    FCLF,CI     SET HOLE LENGTH
          LDK    MNHS-2      LEAVE MINIMUM-SIZE HOLE
          STM    FCLF+1,CI
          ADN    1
          STD    P1
 DCE8     LDD    CB          REWRITE CATALOG ENTRY
          RJM    WBI
          ENDMS
          LDM    FCBT,CI     SET FIRST TRACK
          STD    T6
          LDD    P1          LAST SECTOR WRITTEN
          RJM    DTK         DROP TRACK CHAIN
          LJM    DCE15       EXIT
 
 DCE9     SOD    T3          DELINK ONE LESS TRACK
          LDD    P2          SET TRACK TO LINK TO
          STD    T6
          LDD    P3          SET LAST TRACK TO DELINK
          STD    P2
          LDM    SLM         ADJUST REMAINING LENGTH OF HOLE
          RAD    P1
 
*         END OF HOLE ENCOUNTERED.
 
 DCE10    UJN    DCE11       NOT *APPEND*
*         PSN                (*APPEND* REQUEST)
 DCEE     EQU    *-1
          LDM    CPTF
          ZJN    DCE11       IF NOT CPU TRANSFER
          LDC    IFUI        SET INDIRECT FLAW USER INDEX IN OLD PFC
          STM    FCUI+1,CI
          SHN    -14
          RAM    FCUI,CI
 DCE10.1  LJM    DCE15       EXIT
 
 DCE11    LDD    T3          CHECK TRACK COUNT
          SBN    2
          MJN    DCE10.1     IF NO TRACKS TO DELINK
          LDM    FCBT,CI     SET NEW HOLE
          LPC    3777
          STD    CM+2
          LDM    SLM
          SBM    FCBS,CI
          ADD    P1
          SBK    MNHS
          MJP    DCE9        IF NEW HOLE SHORTER THAN MINIMUM LENGTH
          ADK    MNHS-2      SET LENGTH OF NEW HOLE
          STM    FCLF+1,CI
          LDN    0
          STM    FCLF,CI
          AOM    DCEA        SET DELINK POSSIBLE
          LDD    T5          SET CALL TO DELINK
          ADC    4000        SET CHECKPOINT BIT
          STD    CM+1
          LDD    T6          SET NEXT TRACK IN CHAIN
          STD    CM+3
          LDD    P2          SET LAST TRACK TO RELEASE
          STD    CM+4
          LDD    MA
          CWD    CM
          CRM    APDK,ON     SAVE DELINK REQUEST
 DCED     UJN    DCE12       REWRITE CATALOG ENTRY
*         PSN                (*APPEND* REQUEST)
          UJN    DCE15       EXIT
 
 DCE12    LDD    CB          REWRITE CATALOG ENTRY
          RJM    WBI
          ENDMS
          LDD    MA
          CWM    APDK,ON
          SBN    1
          CRD    CM
          MONITOR  DLKM      DELINK TRACKS
 DCE15    LDN    0           SET EXIT CONDITION
*         LDN    1           (DELINK POSSIBLE)
*         LDN    2           (FILE AT END OF CHAIN)
 DCEA     EQU    *-1
          LJM    DCEX        RETURN
 FCE      SPACE  4,15
**        FCE - FORM CATALOG ENTRY.
*
*         ENTRY  (A) = LOCATION OF ENTRY WITHIN BUFFER.
*                (FN - FN+3) = PERMANENT FILE NAME.
*                (LF - LF+1) = LENGTH OF FILE IN SECTORS.
*                (FCEG) = PRESET TO *PSN* FOR USER CONTROL WORD UPDATE.
*                (FCEH) = PRESET TO *PSN* IF PASSWORD SPECIFIED.
*                (SDAB) = STARTING TRACK ADDRESS.
*                (SDAC) = STARTING SECTOR ADDRESS.
*                (CI) = INDEX TO OLD CATALOG ENTRY.
*
*         EXIT   CATALOG ENTRY REFORMED IN BUFFER.
*                WORD COUNT OF SECTOR ADVANCED IF NOT A HOLE PLUG.
*                (PFCA) = ADDRESS OF NEW CATALOG ENTRY.
*
*         USES   EP, P0, CM - CM+4, FN - FN+3, T0 - T3, UI - UI+1,
*                LF - LF+1.
*
*         NOTE   THE SYMBOLS *FCEC*, *FCEF* AND *FCEO* SHOULD NOT BE
*                USED FOR DATA TAGS IN THIS ROUTINE, SINCE THEY
*                CONFLICT WITH THE GLOBAL CATALOG SYMBOL DEFINITIONS.
 
 
 FCE      SUBR               ENTRY/EXIT
          STD    T1          ADDRESS OF CATALOG ENTRY
          STM    PFCA
          STM    FCEA        SET ADDRESS OF FILE NAME
          STD    T2          SET ADDRESS FOR CLEARING OF CATALOG ENTRY
          ADC    FCCW        SET ADDRESS OF USER CONTROL WORD
          STM    FCEB
          STM    FCED
          LDD    T1
          LMD    CI
          ZJN    FCE2        IF REPLACING SAME CATALOG ENTRY
 
*         CLEAR CATALOG ENTRY BUFFER.
 
          LDC    NWCE*5      CLEAR EXISTING CATALOG ENTRY
          STD    T3
 FCE1     LDN    0
          STI    T2
          AOD    T2
          SOD    T3
          NJN    FCE1        IF MORE CATALOG TO CLEAR
 
*         TRANSFER DATA INTO NEW CATALOG ENTRY.
 
 FCE2     LDD    MA          SET NEW FILE NAME
          CWD    FN
          CRM    *,ON
 FCEA     EQU    *-1
          LDM    FCUI,T1     SET USER INDEX IN CATALOG ENTRY
          SCN    77
          ADD    UI          USER INDEX FIRST BYTE
          STM    FCUI,T1
          LDD    UI+1
          STM    FCUI+1,T1
          LDM    SDAB        SET BEGINNING TRACK AND SECTOR
          STM    FCBT,T1
          LDM    SDAC
          STM    FCBS,T1
          LDD    LF          SET LENGTH OF FILE
          STM    FCLF,T1
          LDD    LF+1
          STM    FCLF+1,T1
          LDN    PDTL        READ PACKED DATE AND TIME
          CRD    CM
          LDD    T1          SET TRANSFER OF OLD CATALOG
          ADN    FCRI
          STD    T2
          LDD    CI
          ZJN    FCE5        IF NO PRIOR FILE
          ADN    FCRI
          STD    T3
          LMD    T2
          ZJN    FCE4        IF SAME CATALOG ENTRY
 FCE3     LDI    T3          TRANSFER OLD CATALOG DATA
          STI    T2
          AOD    T3
          AOD    T2
          ADC    -NWCE*5
          LMD    T1
          NJN    FCE3        IF MORE CATALOG TO TRANSFER
 FCE4     LDM    FCEC,T1     CLEAR ERROR CODES FROM OLD FILE
          LPN    77
          STM    FCEC,T1
          LDC    UJNI+FCE7-FCEI  DO NOT UPDATE FCCD OR FCKD
          STM    FCEI
 FCEG     UJN    FCE5        BYPASS USER CONTROL WORD UPDATE
*         PSN                (SET USER CONTROL WORD)
          LDD    MA          TRANSFER CONTROL WORD VIA MESSAGE BUFFER
          CWM    PUCW,ON
          SBN    1
          CRM    *,ON
 FCEB     EQU    *-1
 FCE5     LDN    CM+2        SET TRANSFER ADDRESSES
*         UJN    FCE7.1      (*DROPIDS* - BYPASS DATE CHANGE)
 FCEL     EQU    *-1
          STD    T2
          LDD    T1
          STD    T3
 FCE6     LDI    T2          TRANSFER DATES
 FCEI     STM    FCCD,T3
*         UJN    FCE7        (IF EXISTING CATALOG ENTRY)
          STM    FCKD,T3
 FCE7     STM    FCUD,T3
          STM    FCAD,T3
          STM    FCMD,T3
          AOD    T3
          AOD    T2
          LMN    CM+5
          NJN    FCE6        LOOP TO END OF DATES
          LDD    CI
          ZJN    FCE8        IF NOT PREVIOUS FILE
 FCE7.1   LJM    FCEX        RETURN
 
*         NEW FILE CREATION.
 
 FCE8     LDN    FCPW        SET PASSWORD ADDRESS
          ADD    T1
          STM    FCEJ
          ADN    FCXD-FCPW   SAVE EXPIRATION DATE POINTER
          STD    T3
          ADN    FCCN-FCXD   SET CHARGE/PROJECT ADDRESS
          STM    FCEK
          LDD    MA          TRANSFER USER CONTROL WORD AND PASSWORD
          CWM    PUCW,ON
          CWM    PFPW,ON
          SBN    2
          CRM    *,ON        SET USER CONTROL WORD
 FCED     EQU    *-1
 FCEH     UJN    FCE9        BYPASS PASSWORD UPDATE
*         PSN                (SET PASSWORD)
          CRM    *,ON        SET PASSWORD
 FCEJ     EQU    *-1
          LDI    T3          SET PASSWORD EXPIRATION DATE
          SCN    77
          LMM    PXDT
          STI    T3
          LDM    PXDT+1
          STM    1,T3
 FCE9     LDM    LFAL        SET ACCESS LEVEL AND CATEGORY SET
          STM    FCAL,T1
          ERRNZ  FCAL-FCFC+1 CODE DEPENDS ON VALUE
          LDM    PFFC
          STM    FCFC,T1
          LDM    PFFC+1
          STM    FCFC+1,T1
          LDM    PFFC+2
          STM    FCFC+2,T1
          LDM    MODE        SET CATALOG TYPE AND FILE MODE
          LPC    3737
          STM    FCCT,T1
          LDM    PFSS        SET SS, BR AND PR
          ERRNZ  PFSS-PFBR   *BR* AND *SS* MUST BE TOGETHER
          ERRNZ  PFRS-PFBR   *BR* AND *PR* MUST BE TOGETHER
          STM    FCFS,T1
          LDM    PFAP        SET ALTERNATE CATLIST PERMISSION
          LPC    6000
          STM    FCAP,T1
          LDC    0           SET DEVICE NUMBER
 FCEE     EQU    *-1
          STM    FCDN,T1
          NFA    CHGN        SET EXECUTING CHARGE/PROJECT FROM NFL
          CRM    *,TR
 FCEK     EQU    *-1
          ERRNZ  FCP1-FCCN-5 *FCP1* MUST FOLLOW *FCCN*
          ERRNZ  FCP2-FCCN-12  *FCP2* MUST FOLLOW *FCCN*/*FCP1*
          ERRNZ  PJ1N-CHGN+1 *PJ1N* MUST BE IMMEDIATELY AFTER *CHGN*
          ERRNZ  PJ2N-PJ1N+1 *PJ2N* MUST BE IMMEDIATELY AFTER *PJ1N*
          LJM    FCEX        RETURN
 
*         TEST RANGE OF GENERATED RELATIVE JUMPS.
 
          ERRNG  37+FCEI-FCE7
 FHE      SPACE  4,15
**        FHE - FORM HOLE ENTRY.
*
*         ENTRY  (EP) = POINTER IN END BUFFER FOR NEW HOLE ENTRY.
*                (HL) = SIZE OF NEW HOLE.
*                (LF - LF+1) = SIZE OF NEW FILE.
*                (HP) = POINTER TO NEW FILE - PLACED IN PREVIOUS HOLE.
*                CATALOG ENTRY CONTAINS POINTER TO NEW FILE.
*
*         EXIT   NEW HOLE FORMED IN END BUFFER.
*
*         CALLS  *NONE*
*
*         USES   T1, T2, T3.
 
 
 FHE      SUBR               ENTRY/EXIT
 
*         DETERMINE START OF NEW HOLE.
 
          LDM    FCBS,HP     FIRST SECTOR OF NEW FILE
          ADN    2           ALLOW FOR SYSTEM SECTOR AND EOI
          STD    T7
          LDD    LF+1        LENGTH OF NEW FILE
          STD    T3
          LDM    FCBT,HP
 FHE1     STD    T6
          LDD    T7
          ADD    T3
          SBM    SLM
          MJN    FHE2        IF PAST END OF NEW FILE
          STD    T3          REMAINDER OF NEW FILE
          LDN    0
          STD    T7
          RJM    SNT         SET NEXT TRACK
          UJN    FHE1
 
 FHE2     ADM    SLM         SET ADDRESS OF NEW FILE
          STD    T7
          LDC    NWCE*5      CLEAR NEXT CATALOG ENTRY
          STD    T1
          LDD    EP
          STD    T2
 FHE3     LDN    0
          STI    T2
          AOD    T2
          SOD    T1
          NJN    FHE3        IF MORE CATALOG TO CLEAR
 
*         FORM HOLE ENTRY
 
          LDD    T7
          STM    FCBS,EP
          LDD    T6
          STM    FCBT,EP
          LDD    HL
          STM    FCLF+1,EP
          LDD    EP          SET CONTROL MODIFICATION DATE IN HOLE
          RAM    FHEA
          LDN    PDTL
          CRM    FCKD-2,ON
 FHEA     EQU    *-1         (ADDRESS OF DATE WITHIN BUFFER)
          LJM    FHEX        RETURN
 IIA      SPACE  4,20
**        IIA - INTERLOCK INDIRECT ALLOCATION.
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*                (DVLW) = FIRST TRACK OF INDIRECT CHAIN.
*
*         EXIT   INDIRECT ALLOCATION INTERLOCK SET.
*                (IAIF) NONZERO.
*
*         ERROR  TO *ERR* IF INTERLOCK NOT OBTAINED BY FOURTH TRY.
*                TO *HNG* IF TRACK NOT RESERVED.
*
*         USES   T1, T5, T6.
*
*         CALLS  DPR, STI.
*
*         MACROS ENDMS.
 
 
 IIA4     AOM    IAIF        SET INDIRECT ALLOCATION INTERLOCK FLAG
 
 
 IIA      SUBR               ENTRY/EXIT
          ENDMS
          LDD    EQ
          STD    T5
          LDM    DVLW
          STD    T6
          LDN    4
          STD    T1
 IIA1     RJM    STI
          ZJN    IIA4        IF INTERLOCK OBTAINED
          LMN    2
          ZJN    IIA2        IF TRACK NOT RESERVED
          SOD    T1
          ZJN    IIA3        IF RETRY COUNT EXHAUSTED
          RJM    DPR         DELAY PRIOR TO RETRY
          UJN    IIA1        TRY AGAIN
 
 IIA2     RJM    HNG         HANG IF TRACK NOT RESERVED
 
 IIA3     EXIT   INA,CH,,,EC4   * INTERLOCK NOT AVAILABLE.*
 REB      SPACE  4,15
**        REB - REREAD END BUFFER.
*
*         REREAD THE BUFFER CONTAINING THE END OF THE CATALOGS,
*         IF THAT BUFFER WAS IN *BFMS*, AND IF *BFMS* WAS REUSED.
*         IF (DAHP) IS NONZERO, READ THE SECTOR CONTAINING THE DAPF
*         HOLE INTO *BFMS*, AND RESET (EB) AND (EP) TO POINT TO IT.
*
*         ENTRY  (EBSC) = SECTOR FOR END BUFFER.
*                (EBTK) = TRACK FOR END BUFFER.
*                (DAHP) = DIRECT ACCESS HOLE POINTER.
*
*         EXIT   END BUFFER REREAD.
*
*         USES   T6, T7.
*
*         CALLS  CDA, PDV, PES, RDS.
*
*         MACROS ERROR, SETMS.
 
 
 REB3     LDM    STAT
          LPN    STBR
          ZJN    REBX        IF *BFMS* (END BUFFER) HAS NOT BEEN REUSED
 REB4     LDM    EBTK        RESET TRACK
          STD    T6
          STM    -2,EB
          LDM    EBSC        RESET SECTOR
          STD    T7
          STM    -1,EB
          SETMS  IO,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDD    EB          REREAD END SECTOR
          RJM    RDS
          PJN    REBX        IF NO ERROR
          RJM    PES         PROCESS ERROR STATUS
 
 REB      SUBR               ENTRY/EXIT
          LDM    DAHP
 REB1     ZJP    REB3        IF NO DIRECT ACCESS HOLES FOUND
          LDD    CB
          RJM    CDA         COMPARE DISK ADDRESSES (CATALOG BUFFER)
          ZJN    REBX        IF DIRECT ACCESS HOLE IN CATALOG BUFFER
          LDD    HP
          ZJN    REB2        IF NO HOLE BUFFER
          LDD    HB
          RJM    CDA         COMPARE DISK ADDRESSES (HOLE BUFFER)
          ZJN    REBX        IF DIRECT ACCESS HOLE IN HOLE BUFFER
 REB2     LDD    EB
          RJM    CDA         COMPARE DISK ADDRESSES (END BUFFER)
          ZJN    REB1        IF DIRECT ACCESS HOLE IN END BUFFER
          LDC    BFMS        FORCE END BUFFER TO BFMS
          STD    EB
          LDM    DAHP        FORCE END BUFFER TO DIRECT ACCESS HOLE
          STM    EBTK
          LDM    DAHP+1
          STM    EBSC
          LDM    DAHP+2
          ADD    EB
          STD    EP
          UJP    REB4        READ DIRECT ACCESS HOLE
          ERROR  MSE,CH,,T5  *EQXXX,DNYY,MASS STORAGE ERROR.*
 RTK      SPACE  4,20
**        RTK - REQUEST LINKED TRACK.
*
*         ENTRY  (T6) = ADDRESS OF LAST TRACK IN CHAIN.
*                (T5) = MASTER DEVICE EST ORDINAL.
*
*         EXIT   (A) = 0 IF NO TRACK AVAILABLE.
*                (A) = TRACK IF AVAILABLE.
*                NEW TRACK PREWRITTEN WITH EOI-S.
*
*         USES   T6, T7, CM - CM+4.
*
*         CALLS  PDV, WDS.
*
*         MACROS ENDMS, MONITOR, SETMS.
*
*         NOTES  THE DRIVER AUTOMATICALLY WRITES THE LAST SECTOR
*                OF A TRACK WITH *WLSF*, EVEN IF *WCSF* IS SPECIFIED.
 
 
 RTK      SUBR               ENTRY/EXIT
          LDN    ZERL
          CRD    CM
          LDD    T5          SET EST ORDINAL
          STD    CM+1
          LDD    T6          SET PRESENT LAST TRACK ADDRESS
          STD    CM+2
          MONITOR  RTCM
          LDD    CM+4
          ZJN    RTKX        IF NO TRACK ASSIGNED
          STD    T6          PREWRITE NEW TRACK
          STM    EOIFS+2     SET TRACK NUMBER IN EOI BUFFER
          LDN    0
          STD    T7
          SETMS  IO,NS
          RJM    PDV         PROCESS DEVICE STATUS
 RTK1     LDD    T7          SET SECTOR NUMBER IN EOI BUFFER
          STM    EOIFS+3
          LDC    EOIB+WCSF   WRITE SECTOR
          RJM    WDS
          AOD    T7
          LMM    SLM
          NJN    RTK1        IF NOT LAST SECTOR
          ENDMS
          LDD    T6
          UJP    RTKX        RETURN
 EOI      SPACE  4,10
**        EOI - EOI SECTOR BUFFER.
 
 
 EOIA     CON    0,0         END OF INFORMATION DISK ADDRESS
 EOIB     CON    0,0         END OF INFORMATION CONTROL BYTES
          VFD    60/3LPFM    FNT WORD
 EOIFS    BSSZ   5           FST WORD
 EOIDT    BSSZ   5           DATE/TIME WORD
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLU,OVLC    OVERFLOW INTO COMMAND OVERLAY AREA
          SPACE  4,10
          OVERFLOW  OVLU,BUF2-2  OVERFLOW INTO CATALOG BUFFER
          EJECT
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 AFS      EQU    /".O"/AFS
 AFSB     EQU    /".O"/AFSB
 CCS      EQU    /".O"/CCS
 CCS5.1   EQU    /".O"/CCS5.1
 CCSB     EQU    /".O"/CCSB
 CCSC     EQU    /".O"/CCSC
 CCSE     EQU    /".O"/CCSE
 CCSF     EQU    /".O"/CCSF
 CCSG     EQU    /".O"/CCSG
 CIA      EQU    /".O"/CIA
 DCE      EQU    /".O"/DCE
 DCEC     EQU    /".O"/DCEC
 DCED     EQU    /".O"/DCED
 DCEE     EQU    /".O"/DCEE
 FCE7.1   EQU    /".O"/FCE7.1
 FCEE     EQU    /".O"/FCEE
 FCEL     EQU    /".O"/FCEL
 IIA      EQU    /".O"/IIA
          OVERLAY  (PERMIT UPDATE ROUTINES.),OVLU
 OVL      SPACE  4,10
***       THIS OVERLAY CONTAINS SUBROUTINES USED BY THE COMMAND
*         OVERLAYS TO UPDATE THE PERMIT FILE.
 
 
 OVL      BSS    0           ENTRY
          RJM    RMD         RESET TO MASTER DEVICE
          LDM    DVLW+2      PRESET FIRST TRACK IN EOI BUFFER
          STM    EOIFS+1
          LDN    PDTL        PRESET DATE/TIME IN EOI BUFFER
          CRM    EOIDT,ON
          UJN    ".Q"X       RETURN AFTER LOAD
          TITLE  ALLOCATION ROUTINES.
 APS      SPACE  4,20
**        APS - ALLOCATE PERMIT SPACE.
*
*         ENTRY  (T5) = MASTER DEVICE EST ORDINAL.
*                (PB) = ADDRESS OF PERMIT BUFFER.
*                (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
*
*         EXIT   (RI - RI+1) = RANDOM ADDRESS OF NEW PERMIT SECTOR.
*                (EOIA) SET WITH ADDRESS OF NEW EOI.
*                (WNPB) = LINKAGE TO NEW EOI.
*                PERMIT ALLOCATION INTERLOCK SET.
*                TO *HNG* IF PERMIT CHAIN NOT RESERVED.
*
*         USES   T6, T7, RI - RI+1.
*
*         CALLS  DTK, ITC, RTK, SEI.
*
*         MACROS ENDMS, ERROR, MONITOR.
 
 
 APS4     LDD    T6          SAVE ADDRESS OF NEW EOI
          STM    EOIA
          STM    EOIFS+2
          LDD    T7
          STM    EOIA+1
          STM    EOIFS+3
 
 APS      SUBR               ENTRY/EXIT
          ENDMS              RELEASE CHANNEL
          LDM    DVLW+2      INTERLOCK PERMIT ALLOCATION
          RJM    ITC
          ZJN    APS0        IF INTERLOCK SUCCESSFUL
          RJM    HNG         HANG IF PERMIT CHAIN NOT RESERVED
 
 APS0     LDD    T6          SET ALLOCATION INTERLOCKED FLAG
          STM    AILK
          RJM    SEI         SEARCH FOR END OF PERMIT FILE
          LDD    T2          SAVE RANDOM ADDRESS OF NEW PERMIT SECTOR
          STD    RI
          LDD    T3
          STD    RI+1
          AOD    T7          CHECK FOR END OF TRACK
          LMM    SLM
          ZJN    APS2        IF AT END OF TRACK
          LDD    T7          SAVE LINKAGE TO NEW EOI
          STM    WNPB
          RJM    DTK         SET EOI IN TRT
 APS1     UJP    APS4        SAVE ADDRESS OF NEW EOI
 
 APS2     RJM    RTK         REQUEST NEW TRACK
          ZJN    APS3        IF TRACK LIMIT ON ALLOCATION FILE
          STD    T6          SET ADDRESS OF NEW EOI
          STM    WNPB        SAVE LINKAGE TO NEW EOI
          LDN    0
          STD    T7
          UJN    APS1        SAVE ADDRESS OF NEW EOI
 
 APS3     ERROR  TKL,,,T5    *EQXXX,DNYY, TRACK LIMIT.*
          TITLE  PERMIT UPDATE ROUTINES.
 CPE      SPACE  4,15
**        CPE - CREATE PERMIT ENTRY.
*
*         EXIT   (PWRF) = *RFPC* FLAG SET IF NEW PERMIT ENTRY WRITTEN
*                         TO EXISTING PERMIT SECTOR.
*                NEW PERMIT ENTRY WRITTEN.
*                RANDOM ADDRESS SET IN CATALOG ENTRY IF
*                NEW PERMIT SECTOR CREATED.
*
*         USES   T5, RI - RI+1.
*
*         CALLS  APS, FPE, WBI, WNP.
*
*         MACROS ERROR, SETMS.
 
 
 CPE      SUBR               ENTRY/EXIT
          LDM    SDAA        SET EST ORDINAL
          STD    T5
          SETMS  STATUS,NS
          LDM    FCRI,CI     GET PERMIT RANDOM INDEX
          STD    RI
          LDM    FCRI+1,CI
          STD    RI+1
          ADD    RI
          NJN    CPE2        IF PERMIT DATA AVAILABLE
 
*         ALLOCATE PERMITS FOR FILE WITH NO EXISTING PERMIT DATA.
 
          RJM    APS         ALLOCATE PERMIT SPACE
          LDD    RI          SET RANDOM INDEX INTO CATALOG
          STM    FCRI,CI
          LDD    RI+1
          STM    FCRI+1,CI
          RJM    WNP         WRITE NEW PERMIT BUFFER
 CPE1     UJN    CPEX        RETURN
 
*         PROCESS FILE WITH EXISTING PERMIT DATA.
 
 CPE2     LDM    1,PB        CHECK FOR FULL SECTOR OF PERMITS
          LPN    77
          ZJN    CPE4        IF FULL SECTOR OF PERMITS
          LDM    NPHA        SET HOLE ADDRESS
          RJM    FPE         FORM PERMIT ENTRY
          LDD    PB          REWRITE PERMIT SECTOR
          RJM    WBI
 CPE3     LDK    RFPC        SET PERMIT COUNT UPDATED
          RAM    PWRF
          UJN    CPE1        RETURN
 
*         REWRITE FULL SECTOR OF PERMITS WITH LINK TO NEW SECTOR.
 
 CPE4     RJM    APS         ALLOCATE PERMIT SPACE
          LDD    RI          SET RANDOM ADDRESS OF NEW PERMIT SECTOR
          STM    FPRI,PB
          LDD    RI+1
          STM    FPRI+1,PB
          LDD    PB          REWRITE EXISTING PERMIT SECTOR
          RJM    WBI
          LDK    STNS        SET *NO JOB SUSPENSION* FLAG
          RAM    STAT
          RJM    WNP         WRITE NEW PERMIT SECTOR
          LDK    -STNS       CLEAR *NO JOB SUSPENSION* FLAG
          RAM    STAT
          UJN    CPE3        RETURN
 FPE      SPACE  4,15
**        FPE - FORM PERMIT ENTRY IN BUFFER.
*
*         ENTRY  (A) = BUFFER LOCATION WHERE ENTRY IS TO BE FORMED.
*                (PP) = IF NEW ENTRY TO BE FORMED.
*                (PB) = ADDRESS OF PERMIT BUFFER.
*                (PI - PI+1) =  PERMITTED INDEX.
*                (MODE) = PERMITTED MODE.
*                (PFOU - PFOU+3) = OPTIONAL USER NAME.
*                (PFXT - PFXT+1) = EXPIRATION DATE.
*
*         EXIT   ENTRY FORMED IN PERMIT BUFFER.
*                ACCESS COUNT SET TO 1 IF IMPLICIT PERMIT ENTRY.
*
*         USES   T1, CM - CM+4.
 
 
 FPE      SUBR               ENTRY/EXIT
          STD    T1          SAVE ADDRESS OF BUFFER
          STM    FPEA
          ADN    FPAC        SET ACCESS COUNT WORD ADDRESS
          STM    FPEC
          LDD    MA          SET USER NAME IN PERMIT ENTRY
          CWM    PFOU,ON
          SBN    1
          CRM    *,ON
 FPEA     EQU    *-1
          LDD    PB          SET ADDRESS OF PERMIT HEADER
          ADN    FPUD
          STM    FPEB
          LDN    PDTL
          CRM    *,ON        SET DATE/TIME IN PERMIT ENTRY
 FPEB     EQU    *-1
          SBN    1
          CRM    *,ON        SET DATE/TIME IN PERMIT HEADER
 FPEC     EQU    *-1
          LDM    MODE        SET MODE/ACCESS COUNT
          LPN    17
          LMM    SAPF        SET IMPLICIT PERMIT FLAG, IF APPROPRIATE
          ADM    IACP        INCREMENT ACCESS COUNT, IF APPROPRIATE
          STM    FPAC+1,T1
          LDM    FPXD,T1     SET EXPIRATION DATE
          SCN    77
          LMM    PXDT
          STM    FPXD,T1
          LDM    PXDT+1
          STM    FPXD+1,T1
          LDM    SAPF
          NJN    FPE1        IF ACCOUNTING PERMIT
          LDN    40          INDICATE EXPIRATION DATE IS PRESENT
          RAM    FPAC+1,T1
 FPE1     LDN    NWPE        ADVANCE WORD COUNT
          RAM    1,PB
          LJM    FPEX        EXIT
 RTK      SPACE  4,20
**        RTK - REQUEST LINKED TRACK.
*
*         ENTRY  (T6) = ADDRESS OF LAST TRACK IN CHAIN.
*                (T5) = MASTER DEVICE EST ORDINAL.
*
*         EXIT   (A) = 0 IF NO TRACK AVAILABLE.
*                (A) = TRACK IF AVAILABLE.
*                NEW TRACK PREWRITTEN WITH EOI-S.
*
*         USES   T6, T7, CM - CM+4.
*
*         CALLS  PDV, WDS.
*
*         MACROS ENDMS, MONITOR, SETMS.
*
*         NOTES  THE DRIVER AUTOMATICALLY WRITES THE LAST SECTOR
*                OF A TRACK WITH *WLSF*, EVEN IF *WCSF* IS SPECIFIED.
 
 
 RTK      SUBR               ENTRY/EXIT
          LDN    ZERL
          CRD    CM
          LDD    T5          SET EST ORDINAL
          STD    CM+1
          LDD    T6          SET PRESENT LAST TRACK ADDRESS
          STD    CM+2
          MONITOR  RTCM
          LDD    CM+4
          ZJN    RTKX        IF NO TRACK ASSIGNED
          STD    T6          PREWRITE NEW TRACK
          STM    EOIFS+2     SET TRACK NUMBER IN EOI BUFFER
          LDN    0
          STD    T7
          SETMS  IO,NS
          RJM    PDV         PROCESS DEVICE STATUS
 RTK1     LDD    T7          SET SECTOR NUMBER IN EOI BUFFER
          STM    EOIFS+3
          LDC    EOIB+WCSF   WRITE SECTOR
          RJM    WDS
          AOD    T7
          LMM    SLM
          NJN    RTK1        IF NOT LAST SECTOR
          ENDMS
          LDD    T6
          UJP    RTKX        RETURN
 UPI      SPACE  4,20
**        UPI - UPDATE PERMIT INFORMATION.
*
*         ENTRY  (PP) = POINTER TO PERMIT ENTRY.
*                (PP) = 0 IF NO PERMIT ENTRY PRESENT.
*                (PB) = ADDRESS OF PERMIT BUFFER.
*                (PB) = 0 IF NO PERMISSION UPDATE REQUIRED.
*                (CI) = POINTER TO CATALOG ENTRY.
*                (PWRF) = *PFM* RESTART FLAGS.
*                PERMIT BUFFER LOADED IF PERMIT EXISTS.
*
*         EXIT   (PWRF) = *RFPC* FLAG SET IF PERMIT COUNT UPDATED.
*                PERMIT ENTRY UPDATED.
*                PERMIT ENTRY CREATED IF SEMIPRIVATE ACCESS.
*                (FCKD) UPDATED IF PERMIT DATA CHANGED.
*
*         USES   T5, T6, T7, CM - CM+4.
*
*         CALLS  CPE, PDV, PES, RDS, WBI.
*
*         MACROS ERROR, SETMS.
 
 
 UPI      SUBR               ENTRY/EXIT
          LDD    PB
          ZJN    UPIX        IF NO PERMIT BUFFER
          LDM    STAT
          LPN    STPR
          ZJN    UPI1        IF PERMITS HAVE NOT BEEN READ
 UPIB     LDN    0
*         LDN    1           (*BFMS* REUSED FOR SYSTEM SECTOR ACCESS)
          ZJN    UPI1        IF *BFMS* HAS NOT BEEN REUSED
          LDM    BFMS-2      RESET PERMIT BUFFER TRACK AND SECTOR
          STD    T6
          LDM    BFMS-1
          STD    T7
          SETMS  IO,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BFMS        REREAD PERMIT BUFFER
          RJM    RDS
          PJN    UPI1        IF NO ERROR
          RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,CH,,EQ  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
 UPI1     LDM    FCCT,CI     CHECK FILE TYPE
          SHN    -6
          LMN    FCSP
          ZJN    UPI3        IF SEMI-PRIVATE FILE
          LDD    PP
          NJN    UPI4        IF PERMIT FOUND (PRIVATE OR PUBLIC FILE)
 UPI2     UJP    UPIX        RETURN
 
 UPI3     LDD    PP
          ZJP    UPI5        IF NO PERMIT DATA AND SEMIPRIVATE FILE
 
*         UPDATE EXISTING PERMIT ENTRY.
 
 UPI4     LDN    PDTL        READ PACKED DATE AND TIME
          CRD    CM
          LDM    PWRF
          LPK    RFPC
          NJN    UPI4.1      IF PERMIT COUNT UPDATED
          LDD    HN          INCREMENT ACCESS COUNT
          RAM    FPAC+1,PP
          SHN    -14
          RAM    FPAC,PP
 UPI4.1   LDD    CM+2        UPDATE LAST ACCESS DATE AND TIME
          STM    FPAD,PP
          LDD    CM+3
          STM    FPAD+1,PP
          LDD    CM+4
          STM    FPAD+2,PP
          LDD    PB          REWRITE PERMIT SECTOR
          RJM    WBI
          LDM    PWRF        SET PERMIT COUNT UPDATED FLAG
          SCN    RFPC
          ADK    RFPC
          STM    PWRF
          LJM    UPI7        UPDATE CATALOG ENTRY
 
*         CREATE NEW PERMIT ENTRY FOR SEMI-PRIVATE FILE.
 
 UPI5     LDM    EBTK
          ZJN    UPI6        IF *BFMS* WAS NOT USED FOR *END* BUFFER
          LDM    STAT        INDICATE THAT *BFMS* HAS BEEN REUSED
          SCN    STBR
          LMN    STBR
          STM    STAT
 UPI6     LDD    MA          SET USER NAME
          CWM    PFAC,ON
          SBN    1
          CRM    PFOU,ON
          LDM    MODE        SAVE REQUESTED MODE
          STM    UPIA
          LDM    FCAM,CI     SET FILE MODE FOR PERMIT ENTRY
          LPN    77
          STM    MODE
          LDN    0           CLEAR EXPIRATION DATE
          STM    PXDT
          STM    PXDT+1
          RJM    CPE         CREATE PERMIT ENTRY
          LDC    *           RESET ORIGINAL VALUE OF *MODE*
 UPIA     EQU    *-1
          STM    MODE
 
*         UPDATE CONTROL MODIFICATION DATE IN CATALOG ENTRY.
 
 UPI7     LDN    PDTL
          CRD    CM
          LDD    CM+2
          STM    FCKD,CI
          LDD    CM+3
          STM    FCKD+1,CI
          LDD    CM+4
          STM    FCKD+2,CI
          UJP    UPIX        RETURN
 WNP      SPACE  4,20
**        WNP - WRITE NEW PERMIT BUFFER.
*
*         ENTRY  (PB) = ADDRESS OF PERMIT BUFFER.
*                (RI - RI+1) = RANDOM ADDRESS OF NEW PERMIT SECTOR.
*                (UI - UI+1) = USER INDEX OF PERMITTED FILE.
*                (PI - PI+1) = USER INDEX OF PERMITTED USER.
*                (EIOA) SET WITH ADDRESS OF NEW EOI SECTOR.
*                (WNPB) = LINKAGE TO NEW EOI SECTOR.
*                PERMIT ALLOCATION INTERLOCK SET.
*
*         EXIT   NEW PERMIT SECTOR FORMED AND WRITTEN.
*                NEW EOI WRITTEN.
*                PERMIT ALLOCATION INTERLOCK CLEARED.
*
*         CALLS  CAI, CSA, FPE, WBI.
*
*         MACROS ENDMS.
 
 
 WNP      SUBR               ENTRY/EXIT
          LDD    PB          SET BUFFER ADDRESS
          ADN    1
          STM    WNPA
          LDC    500
          STD    T1
 WNP1     LDN    0           CLEAR PERMIT BUFFER
          STM    *,T1
 WNPA     EQU    *-1         (ADDRESS OF BUFFER + 1)
          SOD    T1
          PJN    WNP1        IF MORE BYTES TO CLEAR
          LDC    *           SET LINKAGE TO EOI
 WNPB     EQU    *-1
          STI    PB
          LDN    NWPH        SET WORD COUNT FOR HEADER
          STM    1,PB
          RJM    CSA         COMPUTE ADDRESS OF NEW PERMIT SECTOR
          LDD    T6          SET CURRENT TRACK AND SECTOR
          STM    -2,PB
          LDD    T7
          STM    -1,PB
          LDD    UI          SET USER INDEX
          STM    FPUI,PB
          LDD    UI+1
          STM    FPUI+1,PB
          LDD    PB          SET INDEX FOR FIRST PERMIT ENTRY
          ADN    NWPH*5+2    SKIP HEADER AND CONTROL BYTES
          RJM    FPE         FORM PERMIT ENTRY
          LDD    PB          WRITE NEW PERMIT SECTOR
          RJM    WBI
          LDC    EOIB        WRITE NEW EOI
          RJM    WBI
          ENDMS
          RJM    CAI         CLEAR ALLOCATION INTERLOCK
          LJM    WNPX        RETURN
 EOI      SPACE  4,10
**        EOI - EOI SECTOR BUFFER.
 
 
 EOIA     CON    0,0         END OF INFORMATION DISK ADDRESS
 EOIB     CON    0,0         END OF INFORMATION CONTROL BYTES
          VFD    60/3LPFM    FNT WORD
 EOIFS    BSSZ   5           FST WORD
 EOIDT    BSSZ   5           DATE/TIME WORD
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLU,OVLC    OVERFLOW INTO COMMAND OVERLAY AREA
          SPACE  4,10
          OVERFLOW  OVLU,BUF2-2  OVERFLOW INTO CATALOG BUFFER
          EJECT
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 CPE      EQU    /".O"/CPE
 UPI      EQU    /".O"/UPI
 UPIB     EQU    /".O"/UPIB
          OVERLAY  (GET/OLD/UGET PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES *GET*, *OLD*, AND *UGET* REQUESTS.
*
*         ENTRY  (P0) = PROCESSING ADDRESS.
 
 
 OVL      BSS    0           ENTRY
          LDD    EQ          RESET MASTER DEVICE EST ORDINAL
          STD    T5
          LJM    0,P0        PROCESS REQUEST
          TITLE  COMMAND PROCESSING.
 GET      SPACE  4,10
***       PROCESS *GET* REQUEST.
*
*         GENERATE WORKING COPY OF INDIRECT ACCESS FILE *PF NAME*.
*         THIS COPY WILL NOT BE PERMANENT UNTIL *SAVE* *REPLACE*
*         OR *DEFINE* REQUEST FOR LOCAL FILE IS ISSUED.
 
 
 GET      BSS    0           ENTRY
          LDN    0           CLEAR REWRITE ON FILE COPY
          STM    DTMD
          LDM    ACCM        ACTUAL ACCESS MODE
          LMN    PTEX
          NJN    GET1        IF MORE THAN EXECUTE PERMISSION
          LDN    4           RESTRICT LOCAL FILE TO EXECUTE-ONLY
          RAM    GETG
 GET1     LDM    FCEC,CI     CHECK CATALOG ERROR STATUS
          SHN    -4
          LPN    34
          ZJN    GET3        IF NO ERRORS
          SBN    4
          RAM    GETL        MODIFY ERROR CODE
 GETL     EQU    *+2
          ERROR  EDA         * ERROR IN FILE DATA.*
*         ERROR  EPT         * ERROR IN PERMIT DATA.*
*         ERROR  EDP         * DATA/PERMIT ERRORS.*
 
          ERRNZ  /ERRMSG/EPT-/ERRMSG/EDA-1  ERRORS MUST BE CONTIGUOUS
          ERRNZ  /ERRMSG/EDP-/ERRMSG/EPT-1  ERRORS MUST BE CONTIGUOUS
 
 GET3     RJM    CML         CHECK MASS STORAGE LIMITS
          LDD    PB
          ZJN    GET3.1      IF NO PERMIT BUFFER
          EXECUTE  3PE       LOAD PERMIT UPDATE ROUTINES
          RJM    UPI         UPDATE PERMISION INFORMATION
 GET3.1   RJM    UCE         UPDATE CATALOG ENTRY
          ENDMS
          LDD    CI          SET CONTROL WORD POINTER FOR CATALOG
          RAM    GETE
          LDM    FCFS,CI     PROCESS SUBSYSTEM INDEX
          LPN    77
          STM    PFSS
          ZJN    GET4        IF NO SUBSYSTEM INDEX
          LDD    CC
          LMN    CCOD
          NJN    GET4        IF NOT *OLD* REQUEST
          LDM    PFSS
          RJM    SSF         SET SUBSYSTEM FLAG IN CP AREA
 
*         RETURN FIELDS TO FET.
*         ENTER HERE FOR *UGET* REQUEST.
 
 GET4     LDK    STNS        INHIBIT JOB SUSPENSION AFTER THIS POINT
          RAM    STAT
          LDM    PFSP        CHECK FOR SECURITY PROCESSING BIT
          ZJN    GET5        IF SECURITY PROCESSING BIT NOT SPECIFIED
          RJM    SFA         RETURN ACCESS LEVEL TO FET
          ADN    CFAL
          CRD    CM
          LDD    CM+1
          SCN    7
          LMM    FCAL,CI
          STD    CM+1
          RJM    SFA
          ADN    CFAL
          CWD    CM
 GET5     LDM    MODE        RETURN ACCESS MODE TO FET
          SCN    77
          LMM    ACCM        ACTUAL MODE FILE ACCESSED IN
          STM    MODE
          LDN    CFMD
          SBM    FETL
          PJN    GET6        IF FET NOT LONG ENOUGH FOR MODE
          RJM    SFA         RETURN ACCESS MODE TO FET
          ADN    CFMD
          CWM    MODE-4,ON
          LDN    CFUC
          SBM    FETL
          PJN    GET6        IF FET NOT LONG ENOUGH FOR UCW
          RJM    SFA         RETURN USER CONTROL WORD TO FET
          ADN    CFUC
          CWM    FCCW,ON
 GETE     EQU    *-1         (ADDRESS OF *UCW* FROM *PFC*)
          LDN    CFSS
          SBM    FETL
          PJN    GET6        IF FET NOT LONG ENOUGH FOR SUBSYSTEM
          RJM    SFA         RETURN SUBSYSTEM TO FET
          ADN    CFSS
          CWM    PFSS,ON
 
*         UPDATE FNT/FST.
 
 GET6     LDC    PFSN        SET SYSTEM FILE NAME
          RJM    SFN
 GETG     LDN    0           SET FILE ACCESS INFORMATION
*         LDN    4           (EXECUTE-ONLY FILE)
          RAD    FN+3
 GETH     LDN    LOFT        SET FILE TYPE
*         LDN    PTFT        (*OLD* PROCESSING)
          SHN    6
          RAD    FN+4
          LDM    FNTA        SET FST INFORMATION
          STD    FA
          NFA    FA,R
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CRD    FS
 
*         ALLOCATE MASS STORAGE SPACE ON LOCAL FILE DEVICE.
 
          LDN    0
          STD    CM+1
          LDD    LF+1        ADJUST LENGTH FOR SYSTEM SECTOR AND EOI
          ADN    2
          STD    CM+4
          SHN    -14
          ADD    LF
          STD    CM+3
          LDM    FCAL,CI     SET ACCESS LEVEL IN REQUEST
          ADN    40          SELECT ON ACCESS LEVEL
          SHN    6
          RAD    CM+3
 GETI     LDN    0           SET TYPE OF FILE SPACE NEEDED
*         LDN    PRIS        (*OLD* - REQUEST PRIMARY FILE SPACE)
          STD    CM+2
          MONITOR  RTCM      ASSIGN MASS STORAGE SPACE
          LDN    ZERL
          CRD    FS
          LDD    CM+1        SET EST ORDINAL
          STM    RTKE
          STD    FS
          LDD    CM+4
          NJN    GET8        IF TRACKS ASSIGNED
          LDD    CM+3
          SBN    2
          ZJN    GET7        IF NO TEMP DEVICE VALID FOR ACCESS LEVEL
          ERROR  TKL,CH,,FS  *EQXXX,DNYY, TRACK LIMIT.*
 
 GET7     ERROR  NTD,CH      *(FILE NAME) - NO TEMP DEVICE FOUND.*
 
 GET8     STM    RTKT        SET FIRST TRACK
          STD    FS+1
          LDM    CPTF
          NJN    GET9        IF FILE TO BE TRANSFERRED VIA CPU
          LDD    FS+1
          STD    FS+2
          LDN    FSMS
          STD    FS+3
 GET9     LDN    4           SET STATUS
          STD    FS+4
          NFA    FA,R        WRITE FST
          ADN    FSTL
          CWD    FS
          ADN    FUTL-FSTL
          CRD    CM
          LDM    FCAL,CI     SET ACCESS LEVEL IN FNT
          LMD    CM+2
          LPN    7
          LMD    CM+2
          STD    CM+2
          NFA    FA,R
          ADN    FUTL
          CWD    CM
          RJM    SFA         SET FNT POINTER IN FET
          ADN    4
          CRD    CM
          LDD    FA
          STD    CM
          RJM    SFA
          ADN    4
          CWD    CM
 
*         UPDATE PRIMARY FILE FST POINTER IN CONTROL POINT AREA.
 
          LDD    CC
          LMN    CCOD
          NJN    GET10       IF NOT *OLD* REQUEST
          RJM    POF         PROCESS OLD PRIMARY FILE
          LDD    CP          SET NEW PRIMARY FILE FST POINTER
          ADN    TFSW
          CRD    CM
          LDM    FNTA        RESTORE FST AND FST ADDRESS
          STD    FA
          STD    CM+1
          NFA    FA,R
          ADN    FSTL
          CRD    FS
          LDD    CP
          ADN    TFSW
          CWD    CM
 
*         UPDATE PRIMARY FILE POINTERS IN EJT ENTRY.
 
          EXECUTE 0PT,OVL0   CALL *0PT* TO UPDATE EJT POINTERS
 
 GET10    LDD    FS          RESTORE EST ORDINAL
          STD    T5
          SETMS  STATUS,NS
          LDD    CM+4        SET TRT ADDRESS
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH
          STM    SNTA+1
          STM    SEIA+1
          SHN    -14
          LMC    ADCI
          STM    SNTA
          STM    SEIA
          LDM    SLM         INCREMENT PRU COUNT FOR FIRST TRACK
          RAM    AIPR+1
          SHN    -14
          RAM    AIPR
 
*         DETERMINE WHETHER TO USE CPU TO TRANSFER FILE.
 
          LDM    CPTF
          ZJN    GET11       IF FILE NOT TO BE TRANSFERRED VIA CPU
          LDD    EQ          SET SYSTEM SECTOR EST/TRACK/SECTOR
          STD    T5
          LDM    SDAB
          STD    T6
          LDM    SDAC
          STD    T7
          RJM    VSS         VERIFY SYSTEM SECTOR
          ENDMS
 GETA     BSS    0           (OVERFLOW POINT FOR *3PS* LOAD)
          EXECUTE  3PS       TRANSFER FILE VIA CPU
 
*         SET UP SYSTEM SECTOR.
 
          ERRNG  *-BUF-502   SYSTEM SECTOR BUFFER OVERFLOWS CODE
 
 GET11    EXECUTE  3PP       LOAD DEVICE TO DEVICE TRANSFER OVERLAY
          AOD    LF+1        ADJUST LENGTH FOR SYSTEM SECTOR
          SHN    -14
          RAD    LF
          AOM    /3PP/SNSA   TURN ON PRU ACCUMULATION
          LDC    3777        SET SYSTEM SECTOR CONTROL BYTE
          STM    BUF
          LDN    77          SET WORD COUNT BYTE
          STM    BUF+1
          LDD    FA
          STM    FASS+BUF-BFMS
          NFA    FA,R        READ FILE NAME
          ADK    FNTL
          CRM    BUF+FNSS-BFMS,ON
          LDC    LOFT*100    SET LOCAL FILE TYPE IN SYSTEM SECTOR
          STM    FNSS+4+BUF-BFMS
          STM    PFSN+4
          LDD    FS          SET EST ORDINAL
          STM    EQSS+BUF-BFMS
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STM    FTSS+BUF-BFMS
          STD    T6
          LDN    PDTL        ENTER PACKED DATE
          CRM    DTSS+BUF-BFMS,ON
          AOM    DTSS+BUF-BFMS  SET ENHANCED EOI FLAG
          LDN    0           SET SECTOR
          STD    T7
          RJM    SDP         SWAP DISK PARAMETERS
          RJM    IBA         INCREMENT BUFFER ADDRESS
          RJM    VSS         VERIFY SYSTEM SECTOR
          LJM    DTD         ENTER DEVICE TO DEVICE TRANSFER LOOP
          TITLE  SUBROUTINES.
 VSS      SPACE  4,10
**        VSS - VERIFY SYSTEM SECTOR.
*
*         ENTRY  (T5 - T7) = SYSTEM SECTOR DISK ADDRESS.
*
*         EXIT   SYSTEM SECTOR READ.
*                TO *ERR* IF BAD SYSTEM SECTOR OR READ ERROR.
*                ERROR IDLE SET IF BAD SYSTEM SECTOR.
*
*         CALLS  PDV, PES, RSS.
*
*         MACROS ERROR, SETMS.
 
 
 VSS      SUBR               ENTRY/EXIT
          SETMS  READSTR,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDN    0           DO NOT VALIDATE FILE NAME
          RJM    RSS         READ SYSTEM SECTOR
          MJN    VSS1        IF READ ERROR
          ZJN    VSSX        IF VALID SYSTEM SECTOR
          ERROR  SSE,CH,,T5,,EI  *EQXXX,DNYY, SYSTEM SECTOR ERROR.*
 
 VSS1     RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,CH,,T5  *EQXXX,DNYY, MASS STORAGE ERROR.*
          SPACE  4,10
*         COMMON DECKS.
 
 RIS$     SET    1           READ IAPF SYSTEM SECTOR
*CALL     COMPRSS
          SPACE  4,10
          USE    OVERLAY
 OVL0     EQU    *+1         LOAD ADDRESS FOR *0PT*
          ERRNG  BUF1-OVL0-ZPTL  *0PT* OVERFLOW INTO *BUF1*
          TITLE  COMMAND PROCESSING (OVERLAYABLE).
 OLD      SPACE  4,10
***       PROCESS *OLD* REQUEST.
*
*         GENERATE PRIMARY-TERMINAL FILE (*PTFT*) COPY OF INDIRECT
*         ACCESS FILE *PF NAME*.  THIS COPY WILL NOT BE PERMANENT
*         UNTIL *SAVE* OR *REPLACE* REQUEST FOR LOCAL FILE
*         IS ISSUED.
 
 
 OLD      BSS    0           ENTRY
          LCN    -PTFT+LOFT  FORCE PRIMARY-FILE PROCESSING
          RAM    GETH
          LDN    PRIS
          RAM    GETI
          LJM    GET         PROCESS REQUEST
 UGT      SPACE  4,15
***       PROCESS *UGET* REQUEST.
*
*         THE *UGET* REQUEST OBTAINS A LOCAL FILE COPY OF AN INDIRECT
*         ACCESS FILE WITHOUT CHANGING ANY DATES IN THE CATALOG ENTRY.
*         A COPY OF THE CATALOG ENTRY IS RETURNED TO *FIRST*.  THE
*         *AFLOK* FLAG IS SET IN THE CATALOG ENTRY TO INDICATE THAT
*         THE FILE IS ABOUT TO BE DESTAGED (ANY SUBSEQUENT *REPLACE*
*         OR *APPEND* WILL CLEAR THIS FLAG, WHICH WILL THEN INDICATE
*         THAT ANOTHER *UGET* MUST BE PERFORMED IF THE FILE IS STILL
*         TO BE DESTAGED).
 
 
 UGT      BSS    0           ENTRY
          LDN    0           CLEAR REWRITE ON FILE COPY
          STM    DTMD
 
*         CHECK THE FILE RESIDENCE.
 
          LDM    FCBS,CI
          STM    SDAC        SET SECTOR ADDRESS
          SHN    21-13
          PJN    UGT1        IF INDIRECT ACCESS FILE
          ERROR  FDA         *FILE IS DIRECT ACCESS.*
 
 UGT1     LDM    FCBT,CI
          STM    SDAB        SET TRACK ADDRESS OF FILE
          NJN    UGT2        IF FILE DISK RESIDENT
          ERROR  FND         *FILE NOT DISK RESIDENT.*
 
 UGT2     LDM    FCLF,CI     SET FILE LENGTH
          STD    LF
          LDM    FCLF+1,CI
          STD    LF+1
 
*         UPDATE CATALOG ENTRY.
 
          LDM    FCAF,CI     SET *AFLOK* FLAG
          LPC    -AFLOKM
          LMC    AFLOKM
          STM    FCAF,CI
          LDD    CB          REWRITE CATALOG ENTRY
          RJM    WBI
          ENDMS
 
*         RETURN COPY OF THE *PFC* ENTRY TO THE BUFFER.
 
          RJM    SFA         READ *FIRST* POINTER
          ADN    1
          CRD    CM
          LDD    CM+3        VERIFY *FIRST* POINTER
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          ADN    NWCE
          SBN    1
          SHN    -6
          SBD    RA
          SBD    FL
          MJN    UGT3        IF BUFFER WITHIN JOB FL
          ERROR  ILR,CH,,,EC3  * PFM INCORRECT REQUEST.*
 
 UGT3     LDD    CI          COPY CATALOG ENTRY TO BUFFER
          STM    UGTA
          RAM    GETE        SET CONTROL WORD POINTER FOR CATALOG
          LDN    NWCE        NUMBER OF PFC WORDS
          STD    T1
          LDD    CM+3        FORM *CM* ADDRESS
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          CWM    **,T1
 UGTA     EQU    *-1         (CATALOG ENTRY ADDRESS)
          LJM    GET4        PROCESS FILE TRANSFER
          TITLE  SUBROUTINES (OVERLAYABLE).
 CML      SPACE  4,15
**        CML - CHECK MASS STORAGE LIMIT.
*
*         ENTRY  (LF - LF+1) = VALUE OF DECREMENT.
*                (CMLA) = UPPER 6 (OF 18 BITS) MASS STORAGE LIMIT.
*                (CMLB) = LOWER 12 BITS OF MASS STORAGE LIMIT.
*
*         EXIT   TO *ERR* IF ERROR IN PRU LIMITS.
*
*         USES   T0, CM - CM+4.
 
 
 CML      SUBR
          LDD    CP          READ MASS STORAGE LIMIT
          ADK    ACLW
          CRD    CM
          LDD    LF
          LPN    77
          STD    T0
          LDD    CM+3
          LPN    77
          SBD    T0
          MJN    CML1        IF LIMIT EXCEEDED
          NJN    CMLX        IF LIMIT NOT EXCEEDED
          LDD    CM+4
          SBD    LF+1
          PJN    CMLX        IF LIMIT NOT EXCEEDED
 CML1     ERROR  PRL         *PRU LIMIT.*
 POF      SPACE  4,15
**        POF - PROCESS OLD PRIMARY FILE.
*
*         ENTRY  FNT ADDRESS OF CURRENT PRIMARY FILE IN *TFSW*.
*
*         EXIT   OLD PRIMARY FILE CHANGED TO *LOFT*.
*
*         USES   FA, CM - CM+4, FS - FS+4.
*
*         CALLS  SFB.
*
*         MACROS ERROR.
 
 
 POF      SUBR               ENTRY/EXIT
          LDD    CP          GET FNT ADDRESS OF OLD PRIMARY FILE
          ADK    TFSW
          CRD    CM
          LDD    CM+1
          ZJN    POFX        IF NO OLD PRIMARY FILE
 
*         CHANGE OLD PRIMARY FILE TO TYPE *LOFT*.
 
          STD    FA          SET FILE BUSY
          NFA    FA,R
          ADK    FNTL
          CRD    FS
          RJM    SFB
          NJN    POF1        IF FILE NOT INTERLOCKED
          LDC    LOFT*100-PTFT*100  CHANGE FILE TYPE
          RAD    CM+4
          AOD    FS+4        SET FST COMPLETE
          NFA    FA,R
          ADK    FNTL
          CWD    CM
          ADN    FSTL-FNTL
          CWD    FS
          UJN    POFX        RETURN
 
*         PROCESS *I/O SEQUENCE ERROR* ON OLD PRIMARY FILE.  CHANGE THE
*         NEW LOCAL FILE FROM *PTFT* TO *LOFT*, SO THAT *0DF* WILL NOT
*         CLEAR THE PRIMARY FILE POINTER IN THE CPA AND THE EJT WHEN
*         THE NEW LOCAL FILE IS RETURNED.
 
 POF1     LDM    FNTA        RESET FST AND FST POINTER
          STD    FA
          NFA    FA,R
          ADK    FNTL
          CRD    FN
          LDD    FN+4
          LPN    77
          LMC    LOFT*100
          STD    FN+4
          NFA    FA,R
          ADK    FNTL
          CWD    FN
          ERROR  IOE         * I/O SEQUENCE ERROR.*
          SPACE  4,10
*         OVERLAYABLE COMMON DECKS.
 
*CALL     COMPSFB
*CALL     COMPSSF
          SPACE  4,10
          OVERFLOW  OVLC,BUF1-2  OVERFLOW INTO CATALOG BUFFER
          SPACE  4,10
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 GETA     EQU    /".O"/GETA
          OVERLAY  (SAVE/REPLACE/UREPLAC PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES *SAVE*/*REPLACE*/*UREPLAC* REQUESTS.
*
*         ENTRY  (P0) = PROCESSING ADDRESS.
 
 
 OVL      BSS    0           ENTRY
          LJM    0,P0        PROCESS REQUEST
          TITLE  COMMAND PROCESSING.
 REP      SPACE  4,10
***       PROCESS *REPLACE* REQUEST.
*
*         PURGE EXISTING PERMANENT FILE *PF NAME* AND GENERATE COPY
*         OF FILE *FILE NAME* AS INDIRECT ACCESS FILE *PF NAME*.
 
 
 REP      BSS    0           ENTRY
          LDM    FCBS,CI
          SHN    21-13
          PJN    REP1        IF NOT DIRECT ACCESS FILE
          ERROR  FDA         * FILE IS DIRECT ACCESS.*
 
*         CHECK LOCAL FILE ACCESS LEVEL AGAINST *PFC*.
 
 REP1     LDM    SSOM        CHECK SYSTEM SECURITY MODE
          ZJN    REP2        IF SYSTEM OPERATING IN UNSECURED MODE
          LDM    FCAL,CI     ALLOW SAVING DATA AT HIGHER LEVEL
          SBM    LFAL
          PJN    REP2        IF ACCESS LEVEL OKAY
          LDM    SVAL
          LPN    40
          NJN    REP2        IF WRITE-DOWN PERMITTED
          LDM    SSID        CHECK SUBSYSTEM ID
          SBK    LSSI+1
          PJN    REP2        IF SUBSYSTEM
          ERROR  WDP,,,,SVE  * WRITE-DOWN OF DATA PROHIBITED.*
 
*         UPDATE PERMITS.
 
 REP2     RJM    CUC         CHECK USER CONTROLS
          LDD    PB
          ZJN    REP2.1      IF NO PERMIT BUFFER
          EXECUTE  3PE       LOAD PERMIT UPDATE ROUTINES
          RJM    UPI         UPDATE PERMISSION INFORMATION
          ENDMS
 
*         UPDATE CATALOG.
 
 REP2.1   LDD    CI          CLEAR ALTERNATE STORAGE INFORMATION IN PFC
          RAM    REPA+1
          LDN    ZERL
 REPA     CRM    FCAF,ON
          LDD    CI          CLEAR TAPE ALTERNATE STORAGE INFORMATION
          RAM    REPC+1
          LDN    ZERL
 REPC     CRM    FCTF,ON
 REP3     AOM    FCAC+1,CI   INCREMENT ACCESS COUNT
          SHN    -14
          RAM    FCAC,CI
          EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          RJM    IIA         INTERLOCK INDIRECT ALLOCATION
          LDK    STNS        SET *NO JOB SUSPENSION* AFTER THIS POINT
          RAM    STAT
          RJM    CCS         CREATE NEW CATALOG SECTOR
          LDD    HP
          LMD    CI
          ZJN    REP4        IF HOLE IS FILE BEING REPLACED
          RJM    DCE         DELETE CATALOG ENTRY
          ZJN    REP4        IF FILE WITHIN CHAIN AND NO DELINK
          RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          UJN    REP6        TRANSFER FILE
 
*         REWRITE OLD FILE-S CATALOG ENTRY.
*         ENTER HERE ON *UREPLAC* REQUEST.
 
 REP4     RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          LDD    CB          REWRITE CATALOG ENTRY
          RJM    WBI
          ENDMS
 REP6     LJM    SAV2        TRANSFER FILE
 SAV      SPACE  4,10
***       PROCESS *SAVE* REQUEST.
*
*         GENERATE COPY OF FILE *FILE NAME* AS INDIRECT ACCESS FILE
*         *PF NAME*.  IF *PF NAME* EXISTS REQUEST IS ABORTED.
 
 
 SAV      BSS    0           ENTRY
          LDM    LFAL
          STD    CM+4
          LDD    EQ          CHECK MASTER DEVICE ACCESS LEVEL
          STD    CM+2
          LDN    VAES
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          ZJN    SAV1        IF FILE ACCESS VALID FOR DEVICE
          ERROR  LNP,,,,SVE  * ACCESS LEVEL NOT VALID ON PF DEVICE.*
 
 SAV1     RJM    CUC         CHECK USER CONTROLS
          EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          RJM    IIA         INTERLOCK INDIRECT ALLOCATION
          LDK    STNS        SET *NO JOB SUSPENSION* AFTER THIS POINT
          RAM    STAT
          RJM    CCS         CREATE CATALOG SECTOR
          RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
 
*         ENTER HERE ON *REPLACE* OR *UREPLAC* REQUEST.
 
 SAV2     LDM    CPTF
          ZJN    SAV3        IF FILE NOT TO BE TRANSFERRED VIA CPU
 SAVA     BSS    0           (OVERFLOW POINT FOR *3PS* LOAD)
          EXECUTE  3PS       TRANSFER FILE VIA CPU
 
 SAV3     EXECUTE  3PP       LOAD DEVICE TO DEVICE TRANSFER OVERLAY
 
          LDD    FS          SET EST ORDINAL
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDN    FSMS        SET FIRST SECTOR
          STD    T7
          SETMS  READSTR,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BUF         SET STARTING BUFFER ADDRESS
          STD    BB
          AOD    LF+1        ADJUST FILE LENGTH FOR SYSTEM SECTOR
          SHN    -14
          RAD    LF
 
          ERRNG  *-BUF-502   SYSTEM SECTOR BUFFER OVERFLOWS CODE
 
          RJM    CSS         CREATE SYSTEM SECTOR IN BUFFER
          RJM    IBA         INCREMENT BUFFER ADDRESS
          LJM    DTD         ENTER DEVICE TO DEVICE TRANSFER LOOP
 URE      SPACE  4,20
***       PROCESS *UREPLAC* REQUEST.
*
*         MAKE ALTERNATE STORAGE RESIDENT FILE DISK RESIDENT
*         BY CREATING A PERMANENT COPY OF THE DATA TO BE
*         ASSOCIATED WITH THE EXISTING PFC ENTRY.
*
*         THE DATA WILL EITHER BE PLACED IN A PREVIOUSLY
*         EXISTING IAPF HOLE OR SPACE WILL BE ALLOCATED
*         AT THE END OF THE INDIRECT CHAIN.  IF A HOLE IS
*         FOUND THE TRACK AND SECTOR FROM THE HOLE WILL BE
*         PLACED IN THE EXISTING PFC AND THE HOLE WILL BE
*         CONVERTED TO A DAPF HOLE.  THIS IS DONE SO THAT
*         THE POSITION OF THE ORIGINAL PFC DOES NOT CHANGE,
*         SINCE THE RESCAN CODE IN *PFDUMP* REQUIRES THAT
*         THE POSITION OF THE PFC REMAIN CONSTANT.
 
 
 URE      BSS    0           ENTRY
          EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          LDC    LJMI        BYPASS HOLE CHECK IN *CCS*
          STM    CCSE
          LDC    CCS5.1
          STM    CCSE+1
          RJM    IIA         INTERLOCK INDIRECT ALLOCATION
          LDK    STNS        SET *NO JOB SUSPENSION* AFTER THIS POINT
          RAM    STAT
          LDD    HP          HOLE POINTER
          NJN    URE1        IF HOLE AVAILABLE
          RJM    AFS         ALLOCATE FILE SPACE
          LDD    LF+1
          STD    HL          SIMULATE EXACT FIT HOLE (FOR *CCS*)
          LDD    CB
          STD    HB
          UJN    URE2        SET DISK ADDRESS IN ORIGINAL PFC
 
*         PROCESS HOLE ENTRY.
 
 URE1     LDM    FCBT,HP     SAVE FIRST TRACK FROM HOLE ENTRY
          STM    SDAB
          LDM    FCBS,HP     SAVE FIRST SECTOR FROM HOLE ENTRY
          STM    SDAC
          LDC    4000        MARK HOLE AS DAPF HOLE
          STM    FCBS,HP
          LDN    0
          STM    FCBT,HP     CLEAR TRACK IN HOLE ENTRY
          STM    FCLF,HP     CLEAR HOLE ENTRY LENGTH
          STM    FCLF+1,HP
          LDD    CI          SET HOLE POINTER TO POINT TO PFC FOR *FHE*
          STD    HP
 
*         SET NEW VALUES IN ORIGINAL PFC ENTRY.
 
 URE2     LDM    SDAB
          STM    FCBT,CI     FIRST TRACK
          LDM    SDAC
          STM    FCBS,CI     FIRST SECTOR
          LDD    LF          SET NEW FILE LENGTH
          STM    FCLF,CI
          LDD    LF+1
          STM    FCLF+1,CI
          LDM    STAT
          LPK    STTA
          NJN    URE3        IF TAPE ALTERNATE STORAGE REQUEST
          LDM    FCAF,CI     CLEAR *AFVER*, *AFPDR* AND *AFTMP* FLAGS
          SCN    AFPDRM+AFTMPM+AFVERM
          STM    FCAF,CI
          UJN    URE4        UPDATE CATALOG ENTRY
 
 URE3     LDM    FCTF,CI     CLEAR *TFVER* FLAG
          SCN    TFVERM
          STM    FCTF,CI
 URE4     RJM    CCS         CREATE CATALOG SECTOR
          LJM    REP4        PROCESS FILE TRANSFER
 RSS      SPACE  4,10
          TITLE  SUBROUTINES.
 CSS      SPACE  4,10
**        CSS - CREATE SYSTEM SECTOR IN BUFFER.
*
*         ENTRY  (FA) = FNT OFFSET FOR LOCAL FILE.
*                (PFCA) = ADDRESS OF NEW CATALOG ENTRY.
*
*         EXIT   (BUF - BUF+502) = INITIALIZED SYSTEM SECTOR.
*
*         USES   T1, T2, T3.
 
 
 CSS      SUBR               ENTRY/EXIT
          LDC    77*5-1      CLEAR SYSTEM SECTOR
          STD    T1
 CSS1     LDN    0
          STM    BUF+2,T1
          SOD    T1
          PJN    CSS1        IF NOT END OF SECTOR
          LDC    3777        SET CONTROL BYTES
          STM    BUF
          LDN    77
          STM    BUF+1
          NFA    FA,R        COPY FNT TO BUFFER
          ADK    FNTL
          CRM    FNSS+BUF-BFMS,ON
          LDM    FNSS+3+BUF-BFMS
          SCN    77
          STM    FNSS+3+BUF-BFMS
          LDC    PMFT*100    SET FILE TYPE
          STM    FNSS+4+BUF-BFMS
          LDM    SDAA        SET EST ORDINAL
          STM    EQSS+BUF-BFMS
          LDM    SDAA+1      SET FIRST TRACK
          STM    FTSS+BUF-BFMS
          LDN    PDTL        ENTER PACKED DATE
          CRM    DTSS+BUF-BFMS,ON
 
*         COPY CATALOG ENTRY INTO SYSTEM SECTOR.
 
          LDM    PFCA        ADDRESS OF CATALOG ENTRY
          STD    T1
          LDC    CTSS+BUF-BFMS  ADDRESS IN SYSTEM SECTOR
          STD    T2
          ADC    NWCE*5      NUMBER OF BYTES TO COPY
          STD    T3
 CSS2     LDI    T1          TRANSFER ENTRY
          STI    T2
          AOD    T1
          AOD    T2
          LMD    T3
          NJN    CSS2        IF MORE BYTES TO TRANSFER
          LJM    CSSX        RETURN
 CUC      SPACE  4,20
**        CUC - CHECK USER CONTROLS.
*
*         CHECK NUMBER OF FILES.
*         CHECK CUMULATIVE SIZE OF INDIRECT ACCESS FILES.
*
*         ENTRY  (ACNF - ACFN+1) = NUMBER OF FILES IN CATALOG.
*                (CIFS - CIFS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
*                (MXCS - MXCS+1) = CUMULATIVE SIZE OF INDIRECTS ALLOWED.
*                (MXNF) = MAXIMUM NUMBER OF FILES.
*                (LF - LF+1) = LENGTH OF NEW FILE.
*                (CI) = INDEX TO EXISTING CATALOG ENTRY OF FILE REPLACED
*
*         USES   CM - CM+4.
*
*         MACROS ERROR.
 
 
 CUC      SUBR               ENTRY/EXIT
          LDD    MA          SET CUMULATED TOTALS
          CWM    ACNF,ON
          SBN    1
          CRD    CM
 
*         CHECK  NUMBER OF FILES ALLOWED.
 
          LDM    MXNF
          ZJN    CUC1        IF NO LIMIT ON  NUMBER OF FILES
          LDD    CM
          SHN    14
          ADD    CM+1
          ADN    7           ROUND UP
          SHN    -3
          SBM    MXNF
          MJN    CUC1        IF NUMBER OF FILES ALLOWED NOT EXCEEDED
          ZJN    CUC1        IF NUMBER OF FILES ALLOWED NOT EXCEEDED
          ERROR  COF         * TOO MANY PERMANENT FILES.*
 
*         CHECK CUMULATIVE SIZE OF INDIRECT FILES.
 
 CUC1     LDM    MXCS
          NJN    CUC2        IF SIZE CONTROL SET
          LDM    MXCS+1
          ZJN    CUCX        IF NO SIZE CONTROL SET
 
*         DECREMENT ACCUMULATED SIZE BY SIZE OF FILE REPLACED.
 
 CUC2     LDD    CI
          ZJN    CUC4        IF NO PREVIOUS FILE
          LDD    CM+3
          SBM    FCLF+1,CI
          STD    CM+3
          PJN    CUC3        IF NO 12 BIT OVERFLOW
          AOD    CM+3
          SOD    CM+2
 CUC3     LDD    CM+2
          SBM    FCLF,CI
          STD    CM+2
 
*         INCREMENT CUMULATIVE SIZE FOR NEW FILE.
 
 CUC4     LDD    LF+1
          RAD    CM+3
          SHN    -14
          ADD    LF
          RAD    CM+2
          SHN    -14
          ZJN    CUC6        IF NO OVERFLOW
 CUC5     ERROR  COS         * TOO MUCH INDIRECT ACCESS FILE SPACE.*
 
 CUC6     LDD    CM+2        CHECK SIZE AGAINST THAT ALLOWED
          SBM    MXCS
          MJN    CUC7        IF NO OVERFLOW
          NJN    CUC5        IF OVERFLOW
          LDD    CM+3
          SBM    MXCS+1
          MJN    CUC7        IF NO OVERFLOW
          NJN    CUC5        IF OVERFLOW
 CUC7     LJM    CUCX
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF2-2  OVERFLOW INTO CATALOG BUFFER
          SPACE  4,10
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 SAVA     EQU    /".O"/SAVA
          OVERLAY  (APPEND PROCESSING.)
 APP      SPACE  4,10
**        THIS OVERLAY PROCESSES THE INDIRECT ACCESS FILE
*         COMMAND *APPEND*.
 
 
 OVL      BSS    0           ENTRY
*         LJM    0,P0        PROCESS REQUEST
          TITLE  COMMAND PROCESSING.
          SPACE  4,10
***       PROCESS *APPEND* REQUEST.
*
*         APPEND LOCAL FILE *FILE NAME* AT EOI OF INDIRECT ACCESS
*         PERMANENT FILE *PF NAME*.
 
 
 APP      BSS    0           ENTRY
          LDD    CI          CLEAR ALTERNATE STORAGE INFORMATION IN PFC
          RAM    APPA+1
          LDN    ZERL
 APPA     CRM    FCAF,ON
          LDD    CI          CLEAR TAPE ALTERNATE STORAGE INFORMATION
          RAM    APPI+1
          LDN    ZERL
 APPI     CRM    FCTF,ON
 
*         CHECK LOCAL FILE ACCESS LEVEL AGAINST *PFC*.
 
          LDM    SSOM        CHECK SYSTEM SECURITY MODE
          ZJN    APP1        IF SYSTEM OPERATING IN UNSECURED MODE
          LDM    FCAL,CI
          SBM    LFAL
          PJN    APP1        IF ACCESS LEVEL ACCEPTABLE
          LDM    SVAL
          LPN    40
          NJN    APP1        IF WRITE-DOWN ALLOWED
          LDM    SSID        CHECK SUBSYSTEM ID
          SBK    LSSI+1
          PJN    APP1        IF SUBSYSTEM
          ERROR  WDP,,,,SVE  * WRITE-DOWN OF DATA PROHIBITED.*
 
 APP1     LDM    FCEC,CI     CHECK CATALOG ERROR STATUS
          SHN    -4
          LPN    34
          ZJN    APP3        IF NO ERRORS
          SBN    4
          RAM    APPH        MODIFY ERROR CODE
 APPH     EQU    *+2
          ERROR  EDA         * ERROR IN FILE DATA.*
*         ERROR  EPT         * ERROR IN PERMIT DATA.*
*         ERROR  EDP         * DATA/PERMIT ERRORS.*
 
          ERRNZ  /ERRMSG/EPT-/ERRMSG/EDA-1  ERRORS MUST BE CONTIGUOUS
          ERRNZ  /ERRMSG/EDP-/ERRMSG/EPT-1  ERRORS MUST BE CONTIGUOUS
 
 APP3     LDM    STAT        CHECK FOR PREVIOUS ERROR
          LPN    STAB
          ZJN    APP4        IF NO PREVIOUS ERROR
          ERROR  FTL         *FILE TOO LONG.*
 
*         UPDATE PERMITS.
 
 APP4     RJM    CUC         CHECK USER CONTROLS
          LDD    PB
          ZJN    APP4.1      IF NO PERMIT BUFFER
          EXECUTE  3PE       LOAD PERMIT UPDATE ROUTINES
          RJM    UPI         UPDATE PERMISSION INFORMATION
          ENDMS
 
*         UPDATE CATALOG.
 
 APP4.1   EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          LDD    CI          SAVE CURRENT VALUE OF (FCKD)
          RAM    APPG
          LDD    MA
          CWM    FCKD,ON
 APPG     EQU    *-1
          SBN    1
          CRM    APPF,ON
          LDN    PSNI        FORCE SPECIAL *APPEND* PROCESSING IN *DCE*
          STM    DCEC
          STM    DCED
          STM    DCEE
          RJM    IIA         INTERLOCK INDIRECT ALLOCATION
          LDK    STNS        SET *NO JOB SUSPENSION* AFTER THIS POINT
          RAM    STAT
          RJM    DCE         DELETE CATALOG ENTRY
          LMN    2
          ZJP    APP9        IF FILE AT END OF CHAIN
 
*         PROCESS FILE WITHIN CHAIN.
 
          AOM    FCAC+1,CI   INCREMENT ACCESS COUNT
          SHN    -14
          RAM    FCAC,CI
          RJM    CCS         CREATE CATALOG SECTOR
          LDM    APDK+1
          NJN    APP4.2      IF DELAYED DELINK PENDING
          RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
 
*         REWRITE OLD FILE-S CATALOG ENTRY.
 
 APP4.2   LDD    CB          REWRITE OLD FILE-S CATALOG SECTOR
          RJM    WBI
          ENDMS
          LDM    CPTF
          ZJN    APP7        IF FILE NOT TO BE TRANSFERRED VIA CPU
          RJM    VSS         VERIFY SYSTEM SECTOR
          ENDMS
 APPB     BSS    0           (OVERFLOW POINT FOR *3PS* LOAD)
          EXECUTE  3PS       TRANSFER FILE VIA CPU
 
          ERRNG  *-BUFA-502  SYSTEM SECTOR BUFFER OVERFLOWS CODE
 
 APP7     EXECUTE  3PP       LOAD DEVICE TO DEVICE TRANSFER OVERLAY
          EXECUTE  3PQ       LOAD TRANSFER ORIGINAL FILE OVERLAY
          AOM    DPCA        DISABLE SRU ACCUMULATION
          LDC    BUFA        SET BUFFER ADDRESS
          STD    BB
          STM    SDPA
          RJM    CSS         CREATE SYSTEM SECTOR IN *BUFA*
          RJM    IBA         INCREMENT BUFFER ADDRESS
          AOD    LF+1        ADJUST LENGTH TO ACCOUNT FOR SYSTEM SECTOR
          SHN    -14
          RAD    LF
          RJM    VSS         VERIFY SYSTEM SECTOR
          LJM    ADT         TRANSFER ORIGINAL FILE AND LOCAL FILE
 
*         PROCESS APPEND TO FILE AT END OF DATA CHAIN AS A *SAVE*
*         OF THE APPENDAGE.
 
 APP9     LDC    STEC        SET *APPEND TO END OF CHAIN* FLAG
          RAM    STAT
          LDD    CI          SAVE CATALOG ADDRESS
          STM    PFCA
          LDD    T6          SAVE CURRENT EOI OF DATA CHAIN (TRACK)
          STM    APPD
          LDM    FCBT,CI
          STD    T6
          LDD    T1          SAVE CURRENT EOI SECTOR
          STM    APPE
          LDD    LF          SET LENGTH OF NEW FILE IN CATALOG
          STM    FCLF,CI
          LDD    LF+1
          STM    FCLF+1,CI
          LDM    APLF        SET LENGTH OF APPENDAGE
          STD    LF
          LDM    APLF+1
          STD    LF+1
          ISTORE AFSB,(PSN)  DO NOT ALLOCATE FOR SYSTEM SECTOR OR EOI
          RJM    AFS         ALLOCATE SPACE FOR APPENDAGE
          RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          LDD    UI          RESET USER INDEX IN DELETED PFC
          RAM    FCUI,CI
          LDD    UI+1
          STM    FCUI+1,CI
          LDD    CI          RESTORE PREVIOUS VALUE OF *FCKD*
          RAM    APPC
          LDD    MA
          CWM    APPF,ON
          SBN    1
          CRM    FCKD,ON
 APPC     EQU    *-1
          LDC    STMI+CI     FORCE UPDATE OF FCUD/FCMD IN *UCE*
          STM    UCEA
          RJM    UCE         UPDATE CATALOG ENTRY
          LDC    **          SET FIRST TRACK TO PLACE APPENDAGE
 APPD     EQU    *-1
          STM    SDAB
          LDC    **
 APPE     EQU    *-1
          STM    SDAC
          ENDMS
          LDM    CPTF
          ZJN    APP10       IF FILE NOT TO BE TRANSFERRED VIA CPU
          EXECUTE  3PS       TRANSFER FILE VIA CPU
 
 APP10    EXECUTE  3PP       LOAD DEVICE TO DEVICE TRANSFER OVERLAY
 
          LDD    FS          SET LOCAL FILE EST ORDINAL
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDN    FSMS        SET FIRST SECTOR
          STD    T7
          SETMS  READSTR,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BUF         SET STARTING BUFFER ADDRESS
          STD    BB
          LJM    DTD         ENTER DEVICE TO DEVICE TRANSFER LOOP
 
 APPF     BSS    5           BUFFER TO SAVE (FCKD)
          TITLE  SUBROUTINES.
 CSS      SPACE  4,10
**        CSS - CREATE SYSTEM SECTOR IN BUFFER.
*
*         ENTRY  (PFCA) = ADDRESS OF NEW CATALOG ENTRY.
*
*         EXIT   (BUFA - BUFA+502) = INITIALIZED SYSTEM SECTOR.
*
*         USES   T1, T2, T3.
 
 
 CSS      SUBR               ENTRY/EXIT
          LDC    77*5-1      CLEAR SYSTEM SECTOR
          STD    T1
 CSS1     LDN    0
          STM    BUFA+2,T1
          SOD    T1
          PJN    CSS1        IF NOT END OF SECTOR
          LDC    3777        SET CONTROL BYTES
          STM    BUFA
          LDN    77
          STM    BUFA+1
          LDD    CI+FCFN*    SET PERMANENT FILE NAME
          STM    CSSA
          LDD    MA          COPY FILE NAME TO BUFFER
          CWM    *,ON
 CSSA     EQU    *-1
          SBN    1
          CRM    FNSS+BUFA-BFMS,ON
          LDM    FNSS+3+BUFA-BFMS
          SCN    77
          STM    FNSS+3+BUFA-BFMS
          LDC    PMFT*100    SET FILE TYPE
          STM    FNSS+4+BUFA-BFMS
          LDM    SDAA        SET EST ORDINAL
          STM    EQSS+BUFA-BFMS
          LDM    SDAA+1      SET FIRST TRACK
          STM    FTSS+BUFA-BFMS
          LDN    PDTL        ENTER PACKED DATE
          CRM    DTSS+BUFA-BFMS,ON
 
*         COPY CATALOG ENTRY INTO SYSTEM SECTOR.
 
          LDM    PFCA        ADDRESS OF CATALOG ENTRY
          STD    T1
          LDC    CTSS+BUFA-BFMS  ADDRESS IN SYSTEM SECTOR
          STD    T2
          ADC    NWCE*5      NUMBER OF BYTES TO COPY
          STD    T3
 CSS2     LDI    T1          TRANSFER ENTRY
          STI    T2
          AOD    T1
          AOD    T2
          LMD    T3
          NJN    CSS2        IF MORE BYTES TO TRANSFER
          LJM    CSSX        RETURN
 CUC      SPACE  4,21
**        CUC - CHECK USER CONTROLS.
*
*         CHECK NUMBER OF FILES.
*         CHECK CUMULATIVE SIZE OF INDIRECT ACCESS FILES.
*
*         ENTRY  (ACNF - ACFN+1) = NUMBER OF FILES IN CATALOG.
*                (MXNF) = MAXIMUM NUMBER OF FILES.
*                (CIFS - CIFS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
*                (MXCS - MXCS+1) = CUMULATIVE SIZE OF INDIRECTS ALLOWED.
*                (LF - LF+1) = LENGTH OF NEW FILE.
*                (CI) = INDEX TO EXISTING CATALOG ENTRY
*                            OF FILE REPLACED.
*
*         USES   CM - CM+4.
*
*         MACROS ERROR.
 
 
 CUC      SUBR               ENTRY/EXIT
          LDD    MA          SET CUMULATED TOTALS
          CWM    ACNF,ON
          SBN    1
          CRD    CM
 
*         CHECK  NUMBER OF FILES ALLOWED.
 
          LDM    MXNF
          ZJN    CUC1        IF NO LIMIT ON  NUMBER OF FILES
          LDD    CM
          SHN    14
          ADD    CM+1
          ADN    7           ROUND UP
          SHN    -3
          SBM    MXNF
          MJN    CUC1        IF NUMBER OF FILES ALLOWED NOT EXCEEDED
          ZJN    CUC1        IF NUMBER OF FILES ALLOWED NOT EXCEEDED
          ERROR  COF         * TOO MANY PERMANENT FILES.*
 
*         CHECK CUMULATIVE SIZE OF INDIRECT FILES.
 
 CUC1     LDM    MXCS
          NJN    CUC2        IF SIZE CONTROL SET
          LDM    MXCS+1
          ZJN    CUCX        IF NO SIZE CONTROL SET
 
*         DECREMENT ACCUMULATED SIZE BY SIZE OF FILE REPLACED.
 
 CUC2     LDD    CI
          ZJN    CUC4        IF NO PREVIOUS FILE
          LDD    CM+3
          SBM    FCLF+1,CI
          STD    CM+3
          PJN    CUC3        IF NO 12 BIT OVERFLOW
          AOD    CM+3
          SOD    CM+2
 CUC3     LDD    CM+2
          SBM    FCLF,CI
          STD    CM+2
 
*         INCREMENT CUMULATIVE SIZE FOR NEW FILE.
 
 CUC4     LDD    LF+1
          RAD    CM+3
          SHN    -14
          ADD    LF
          RAD    CM+2
          SHN    -14
          ZJN    CUC6        IF NO OVERFLOW
 CUC5     ERROR  COS         * TOO MUCH INDIRECT ACCESS FILE SPACE.*
 
 CUC6     LDD    CM+2        CHECK SIZE AGAINST THAT ALLOWED
          SBM    MXCS
          MJN    CUC7        IF NO OVERFLOW
          NJN    CUC5        IF OVERFLOW
          LDD    CM+3
          SBM    MXCS+1
          MJN    CUC7        IF NO OVERFLOW
          NJN    CUC5        IF OVERFLOW
 CUC7     LJM    CUCX        EXIT
 VSS      SPACE  4,10
**        VSS - VERIFY SYSTEM SECTOR.
*
*         ENTRY  (APTK - APSC) = SYSTEM SECTOR DISK ADDRESS.
*
*         EXIT   SYSTEM SECTOR READ.
*                TO *ERR* IF BAD SYSTEM SECTOR OR READ ERROR.
*                ERROR IDLE SET IF BAD SYSTEM SECTOR OR READ ERROR.
*
*         CALLS  PDV, PES, RSS.
*
*         MACROS ERROR.
 
 
 VSS      SUBR               ENTRY/EXIT
          LDD    EQ          SET EST ORDINAL
          STD    T5
          LDM    APTK        SET BEGINNING TRACK
          STD    T6
          LDM    APSC        SET BEGINNING SECTOR
          STD    T7
          SETMS  READSTR,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDN    0           DO NOT VALIDATE FILE NAME
          RJM    RSS         READ SYSTEM SECTOR
          MJN    VSS1        IF READ ERROR
          ZJN    VSSX        IF VALID SYSTEM SECTOR
          ERROR  SSE,CH,,T5,,EI  *EQXXX,DNYY, SYSTEM SECTOR ERROR.*
 
 VSS1     RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,CH,,T5,,EI  *EQXXX,DNYY, MASS STORAGE ERROR.*
          SPACE  4,10
*         COMMON DECKS.
 
 
 RIS$     SET    1           READ INDIRECT-ACCESS FILE SYSTEM SECTOR
*CALL     COMPRSS
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF2-2  OVERFLOW INTO CATALOG BUFFER
          SPACE  4,10
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 APPB     EQU    /".O"/APPB
          OVERLAY  (ATTACH/UATTACH PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES THE DIRECT ACCESS FILE
*         COMMANDS *ATTACH* AND *UATTACH*.
 
 
 OVL      BSS    0           ENTRY
          LDD    EQ          RESET MASTER DEVICE EST ORDINAL
          STD    T5
          LJM    0,P0        CALL FUNCTION PROCESSOR
          TITLE  COMMAND PROCESSING.
 UAT      SPACE  4,10
***       PROCESS *UATTACH* REQUEST.
*
*         ATTACH DIRECT ACCESS FILE SPECIFIED BY *PFID* TO JOB,
*         WITH LOCAL FILE NAME *FILE NAME*.  DO NOT UPDATE ANY
*         ACCESS COUNTS OR DATES, SINCE THIS IS NOT A USER ACCESS.
 
 
 UAT      BSS    0
          LDM    FNMD
          SHN    21-1
          MJN    ATT         IF WRITEABLE MODE ACCESS
          ISTORE  UCEA,(UJN UCE3)  FORCE BYPASS OF DATE/TIME UPDATES
*         UJN    ATT         ATTACH FILE
 ATT      SPACE  4,10
***       PROCESS *ATTACH* REQUEST.
*
*         ATTACH DIRECT ACCESS FILE *PF NAME* TO JOB, WITH LOCAL
*         FILE NAME *FILE NAME*.
 
 
 ATT      BSS    0           ENTRY
          LDM    FCDN,CI     CHECK DEVICE NUMBER
          LPN    77
          ZJN    ATT3        IF FILE ON MASTER DEVICE
 
*         PROCESS ALTERNATE DEVICE ACCESS.
 
          STD    CM
          LDM    PFPN+4      SET FAMILY EST ORDINAL
          RJM    SDN         SEARCH FOR DEVICE NUMBER
          PJN    ATT2        IF DEVICE FOUND
          ADN    1
          RJM    PDA         PROCESS DEVICE AVAILABILITY
 ATT1     ERROR  DAD,CH      * DIRECT ACCESS DEVICE ERROR.*
 
 ATT2     RJM    IRA         PRESET COMMON DECKS FOR FILE DEVICE
          LDD    CC
          LMN    CCUA
 ATT3     ZJN    ATT5        IF *UATTACH* REQUEST
          SFA    EST,T5      CHECK ERROR IDLE
          ADK    EQDE
          CRD    CM
          LDD    CM+4
          SHN    3
          ADN    ACGL
          CRD    CM
          LDD    CM+4
          LPN    20
          ZJN    ATT5        IF NO ERROR IDLE ON EQUIPMENT
          LDM    SSJS
          ZJN    ATT4        IF NOT *SSJ=* JOB
          LDM    PFSR
          LPN    77
          LMN    SRIE
          ZJN    ATT5        IF *IGNORE ERROR IDLE* SPECIAL REQUEST
 ATT4     ERROR  PFN,CH      * DEVICE UNAVAILABLE.*
 
 ATT4.1   ERROR  TNR,CH,,T5  * EQXXX,DNYY,TRACK NOT RESERVED.*
 
*         INITIALIZE FOR SYSTEM SECTOR PROCESSING.
 
 ATT5     LDM    FCBT,CI     SET FILE FIRST TRACK
          STD    P2
          STD    T6
          STM    PFFT
          RJM    ITC         INTERLOCK TRACK CHAIN FOR FILE
          NJN    ATT4.1      IF TRACK NOT RESERVED
          LDD    T5          SAVE THE FILES EST ORDINAL
          STD    FS
          STM    PFEQ
          AOM    DAIF        SET INTERLOCK FLAG
          RJM    CSL         CHECK SIZE LIMITS
          LDD    P2          RESET FIRST TRACK
          STD    T6
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDN    0           DONT VERIFY FILE NAME IN SYSTEM SECTOR
          RJM    RSS         READ SYSTEM SECTOR
          ZJN    ATT8        IF LEGAL SYSTEM SECTOR
          MJN    ATT7        IF READ ERROR
          LDC    /ERRMSG/DAF*4  *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
          UJN    ATT9        PROCESS FILE ERROR
 
 ATT7     RJM    PES         PROCESS ERROR STATUS
          LDC    /ERRMSG/MSE*4  *EQXXX,DNYY, MASS STORAGE ERROR.*
          UJN    ATT9        PROCESS FILE ERROR
 
*         CHECK FOR AN EXISTING UTILITY ACTIVE FILE CONDITION.
 
 ATT8     LDM    CASS        CHECK CURRENT ACCESS MODE
          SHN    21-6
          PJN    ATT11       IF UTILITY MODE NOT SET
          LDD    CC          CHECK FOR ANOTHER UTILITY ATTACH REQUEST
          LMN    CCUA
          NJN    ATT11       IF NOT UTILITY ATTACH
          LDN    /ERRMSG/FBS*4  * FILE BUSY.*
 ATT9     LJM    PFE         PROCESS FILE ERROR
 
 ATT10    LDC    /ERRMSG/FSE*4  * FILE BOI/EOI/UI MISMATCH.*
          UJN    ATT9        PROCESS FILE ERROR
 
*         PROCESS USER INDEX/CREATION DATE VALIDATION.
 
 ATT11    LDM    FCUI,CI     COMPARE USER INDEX FIELDS
          LMM    CTSS+FCUI
          LPN    77
          NJN    ATT10       IF MISMATCH ON USER INDEX
          LDM    FCUI+1,CI
          LMM    CTSS+FCUI+1
          NJN    ATT10       IF MISMATCH ON USER INDEX
          LDN    2           SET UP CHECK ON CREATION DATE
          STD    P0
 ATT12    LDM    FCCD+2,CI
 ATTA     EQU    *-1
          LMM    CTSS+FCCD,P0
          NJN    ATT10       IF NO MATCH ON CREATION DATE
          SOM    ATTA
          SOD    P0
          PJN    ATT12       IF MORE DATA TO CHECK
 
*         PROCESS ERROR STATUS FIELDS.
 
          LDM    FCEC,CI     GET ERROR STATUS FROM PFC
          SHN    -6
          STD    T1
          RAM    ATTC
          LDM    CTSS+FCEC   GET ERROR STATUS FROM SYSTEM SECTOR
          SHN    -6
          STD    P0
          NJN    ATT12.1     IF ERROR STATUS SET IN SYSTEM SECTOR
          LDD    T1
          NJN    ATT13       IF ERROR STATUS SET IN PFC
          UJN    ATT14       CHECK FILE MODE
 
 ATT12.1  SCN    **          COMBINE BOTH ERROR STATUS FIELDS
*         SCN    (T1)
 ATTC     EQU    *-1
          LMD    T1
          SHN    6
          STD    P0
          LDM    FCEC,CI
          LPN    77
          STM    CTSS+FCEC   CLEAR CODE IN SYSTEM SECTOR
          LMD    P0
          STM    FCEC,CI     SET ERROR CODE IN CATALOG
          ENDMS
          LDD    EQ          SET MASTER DEVICE EST ORDINAL
          STD    T5
          LDD    CB          REWRITE CATALOG ENTRY
          RJM    WBI
          ENDMS
          LDD    FS          RESET FILE EST ORDINAL
          STD    T5
          LDD    P2
          STD    T6
 ATT13    LJM    ATT15       REWRITE SYSTEM SECTOR
 
*         CHECK FILE MODE AND UPDATE FIELDS IN SYSTEM SECTOR.
 
 ATT14    RJM    CFM         CHECK FILE MODE
 
*         SAVE JSN, MAINFRAME ID, AND DATE/TIME FOR WRITEABLE ACCESS.
 
          LDM    FNMD        CHECK MODE REQUESTED
          SHN    21-1
          PJN    ATT14.1     IF NOT WRITEABLE MODE ACCESS
          LDN    PDTL        SET CURRENT DATE AND TIME
          CRM    WDSS,ON
          LDK    MMFL        GET MAINFRAME ID
          CRD    CM
          LDD    CM          SET MAINFRAME ID
          STM    WDSS
          LDD    CP          GET EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      SET *JSNE* WORD OF EJT
          ADK    JSNE
          CRM    WJSS,ON
 
*         CHECK FOR BOI/EOI MISMATCH.  THIS IS DONE AFTER THE CALL TO
*         *CFM*, TO AVOID THE CHECK IF THE FILE IS CURRENTLY ATTACHED
*         IN WRITE MODE.  THE EOI MAY NOT BE VALID IN THAT CASE.
 
*         ROUTINES RESIDENT IN *BUF2* MAY NOT BE USED AFTER THIS POINT.
 
 ATT14.1  LDN    SSTL        CHECK BOI/EOI VALIDATION ENABLED
          CRD    CM
          LDD    CM
          SHN    21-4
          MJN    ATT15       IF VALIDATION NOT ENABLED
          LDD    P2          SET FIRST TRACK
          STD    T6
          RJM    SEI         SKIP TO END OF INFORMATION
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BUF2        PERFORM BOI/EOI VALIDATION
          RJM    RDS         READ EOI SECTOR
          MJP    ATT7        IF READ ERROR
          LDM    BUF2+FTEI   CHECK FIRST TRACK POINTER
          LMD    P2
          ADM    BUF2        CHECK LINKAGE BYTES
          ADM    BUF2+1
          NJP    ATT10       IF BOI/EOI MISMATCH
 
*         REWRITE SYSTEM SECTOR.
 
 ATT15    LDD    MA          SET PROPER FILE TYPE IN SYSTEM SECTOR
          CWD    FN
          CRM    FNSS,ON
          LDC    PMFT*100
          STM    FNSS+4
          LDD    P2          RESET FIRST TRACK
          STD    T6
          SETMS  IO,RW
          RJM    PDV         PROCESS DEVICE STATUS
          RJM    WSS         UPDATE SYSTEM SECTOR
          PJN    ATT15.1     IF NO ERROR
          RJM    PES         PROCESS ERROR STATUS
          LDC    /ERRMSG/MSE*4  *EQXXX,DNYY, MASS STORAGE ERROR.*
          LJM    PFE         PROCESS FILE ERROR
 
 ATT15.1  ENDMS
          LDD    T6          RELEASE FILE INTERLOCK
          RJM    CTI
          LDN    0           CLEAR INTERLOCK FLAG
          STM    DAIF
 
*         PROCESS CATALOG ERROR STATUS.
 
          LDM    FCEC,CI     CHECK CATALOG ERROR STATUS
          SHN    0-4         FORM ERROR CODE
          LPN    34
          ZJN    ATT16       IF NO ERROR
          SBN    4
          RAM    ATTD        SET ERROR CODE FOR MESSAGE
 ATTD     EQU    *+2
          ERROR  EDA         * ERROR IN FILE DATA.*
*         ERROR  EPT         * ERROR IN PERMIT DATA.*
*         ERROR  EDP         * DATA/PERMIT ERRORS.*
*         ERROR  FLC         * EOI CHANGED BY RECOVERY.*
 
          ERRNZ  /ERRMSG/EPT-/ERRMSG/EDA-1  ERRORS MUST BE CONTIGUOUS
          ERRNZ  /ERRMSG/EDP-/ERRMSG/EPT-1  ERRORS MUST BE CONTIGUOUS
          ERRNZ  /ERRMSG/FLC-/ERRMSG/EDP-1  ERRORS MUST BE CONTIGUOUS
 
*         CREATE FNT/FST FOR FILE ATTACHED.
 
 ATT16    RJM    CFE         CREATE FNT/FST ENTRY
 
*         RESET TO MASTER DEVICE.
 
          LDD    T5          CHECK FILE EST ORDINAL
          LMD    EQ
          ZJN    ATT17       IF FILE RESIDES ON MASTER DEVICE
          LDD    EQ          RESET EST ORDINAL
          STD    T5
          RJM    IRA         PRESET COMMON DECKS FOR MASTER DEVICE
 
*         UPDATE PERMITS AND CATALOG ENTRY.
 
 ATT17    LDD    CC          CHECK COMMAND CODE
          LMN    CCUA
          ZJN    ATT18       IF *UATTACH* REQUEST
          LDD    PB
          ZJN    ATT19       IF NO PERMIT BUFFER
          EXECUTE  3PE       LOAD PERMIT UPDATE ROUTINES
          AOM    UPIB        INDICATE THAT *BFMS* WAS USED
          RJM    UPI         UPDATE PERMISSION INFORMATION
          UJN    ATT19       CHECK ACCESS MODE
 
 ATT18    ISTORE UCEB,(UJN UCE3)  FORCE BYPASS OF FCMD, FCAD UPDATE
          ISTORE UCEC,(UJN UCE4)  FORCE BYPASS OF FCAC UPDATE
 ATT19    LDM    FNMD        CHECK MODE REQUESTED
          SHN    21-1
          PJN    ATT20       IF NOT WRITEABLE MODE ACCESS
          LDC    STMI+CI     FORCE FCUD UPDATE (ALSO FCMD ON *ATTACH*)
          STM    UCEA
          LDN    0           CLEAR FILE LENGTH
          STM    FCLF,CI
          STM    FCLF+1,CI
          LDD    CI          CLEAR ALTERNATE STORAGE INFORMATION IN PFC
          RAM    ATTH+1
          LDN    ZERL
 ATTH     CRM    FCAF,ON
          LDD    CI          CLEAR TAPE ALTERNATE STORAGE INFORMATION
          RAM    ATTI+1
          LDN    ZERL
 ATTI     CRM    FCTF,ON
          UJN    ATT21       UPDATE CATALOG ENTRY
 
 ATT20    LDM    MODE
          LPN    37
          LMN    PTRD
          NJN    ATT21       IF NOT READ MODE ACCESS
          LDD    LF          UPDATE FILE LENGTH IN CATALOG
          STM    FCLF,CI
          LDD    LF+1
          STM    FCLF+1,CI
 ATT21    RJM    UCE         UPDATE CATALOG ENTRY
          ENDMS
          RJM    CCI         CLEAR CATALOG INTERLOCK
 
*         UPDATE FET WITH PARAMETERS FROM CATALOG.
 
          LDC    PFSN        SET FILE NAME
          RJM    SFN
          LDM    PFSP
          ZJN    ATT22       IF SECURITY PROCESSING BIT NOT SET
          RJM    SFA         RETURN ACCESS LEVEL TO FET
          ADN    CFAL
          CRD    CM
          LDM    FCAL,CI
          LMD    CM+1
          LPN    7
          LMD    CM+1
          STD    CM+1
          RJM    SFA
          ADN    CFAL
          CWD    CM
 ATT22    LDD    CI          SET USER CONTROL WORD ADDRESS
          RAM    ATTE
          LDN    CFUC
          SBM    FETL
          PJN    ATT23       IF FET TOO SHORT
          RJM    SFA
          ADN    CFUC
          CWM    FCCW,ON     RETURN USER CONTROL WORD TO FET
 ATTE     EQU    *-1
 
*         IF *UATTACH* REQUEST, WRITE COPY OF THE *PFC* ENTRY.
 
 ATT23    LDD    CC          CHECK COMMAND CODE
          LMN    CCUA
          ZJN    ATT24       IF *UATTACH* COMMAND
          LJM    ATT26       TERMINATE PROGRAM
 
 ATT24    RJM    SFA         READ FET *FIRST* POINTER
          ADN    1
          CRD    CM
          LDD    CM+3        VERIFY *FIRST* POINTER
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          ADN    NWCE
          SBN    1
          SHN    -6
          SBD    RA
          SBD    FL
          MJN    ATT25       IF BUFFER WITHIN JOB FL
          ERROR  ILR,CH,IW,,EC3  * PFM INCORRECT REQUEST.*
 
 ATT25    LDD    CI          COPY CATALOG ENTRY TO BUFFER
          STM    ATTF
          LDN    NWCE        NUMBER OF PFC WORDS
          STD    T1
          LDD    CM+3        FORM *CM* ADDRESS
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          CWM    **,T1
 ATTF     EQU    *-1         (CATALOG ENTRY ADDRESS)
 ATT26    EXECUTE  3PU       TERMINATE PROGRAM
          TITLE  SUBROUTINES.
 CFE      SPACE  4,20
**        CFE - CREATE FNT/FST ENTRY FOR ATTACHED FILE.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (CI) = POINTER TO CATALOG ENTRY FOR FILE.
*                (FNMD) = FNT STATUS MODE.
*                (FNTA) = FNT ADDRESS IN NFL.
*                (PFEQ) = EST ORDINAL FOR FILE.
*                (PFSN) = SYSTEM FILE NAME.
*                (PFUC) = USER CONTROLS.
*
*         EXIT   FNT/FST WRITTEN TO CENTRAL MEMORY.
*                PERMANENT FILE USER COUNT INCREMENTED.
*
*         USES   FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
*         CALLS  SFN.
*
*         MACROS MONITOR, NFA.
 
 
 CFE      SUBR               ENTRY/EXIT
          LDC    PFSN        SET FILE NAME
          RJM    SFN
          LDC    PMFT*100    SET FILE TYPE
          RAD    FN+4
          LDM    FNTA        SET FNT ADDRESS
          STD    FA
          LDM    PFEQ        SET EST ORDINAL FOR FILE
          STD    FS
          LDM    FCBT,CI     SET FIRST TRACK FOR FILE
          STD    FS+1
          STD    FS+2
          LDD    CC          CHECK COMMAND CODE
          LMN    CCUA
          ZJN    CFE1        IF *UATTACH* COMMAND
          LDN    FSMS        SET SECTOR
          STD    FS+3
          LDN    4           SET OPERATION COMPLETE
          STD    FS+4
          LDM    FNMD
          LPN    35
          UJN    CFE2        SET STATUS MODE
 
 CFE1     LDN    0           SET SECTOR
          STD    FS+3
          LDC    4004        SET OPERATION COMPLETE
          STD    FS+4
          LDM    FNMD
          LPN    35
          LMN    2
 CFE2     ADM    PFSN+3      SET STATUS MODE
          STD    FN+3
          LDN    ZERL        SET FILE SIZE CONTROL
          CRD    CM
          LDM    PFUC        SET *FS* INDEX IN *FUTL* WORD
          SHN    -11
          SHN    6
          STD    CM+2
          LDM    FCAL,CI     SET ACCESS LEVEL IN FNT
          RAD    CM+2
          NFA    FA,R        RESTORE FNT ENTRY
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CWD    FS
          ADN    FUTL-FSTL
          CWD    CM
          RJM    SFA         SET FNT POINTER IN FET
          ADN    4
          CRD    CM
          LDD    FA
          STD    CM
          RJM    SFA
          ADN    4
          CWD    CM
          LDM    PFEQ        INCREMENT PERMANENT FILE USER COUNT
          STD    CM+1
          LDN    IUCS
          STD    CM+3
          MONITOR  SMDM
          UJP    CFEX        RETURN
 PFE      SPACE  4,15
**        PFE - PROCESS FILE ERROR CONDITION.
*
*         ENTRY  (A) = ERROR CODE AND EXIT CASE.
*                (PFEQ) = EST ORDINAL FOR FILE.
*                (PFFT) = FIRST TRACK FOR FILE.
*
*         EXIT   *TERW* UPDATED WITH TIMED/EVENT DATA.
*
*         USES   CM - CM+4.
*
*
*         MACROS ENDMS, ERROR.
 
 
 PFE      BSS    0           ENTRY
          STM    PFEA        SET ERROR CODE AND EXIT CASE
          ENDMS
          LDM    PFEQ        SET EVENT EST ORDINAL
          STM    ERRE
          LDM    PFFT        SET EVENT TRACK
          STM    ERRC
          LDC    ART         SET EVENT TIME
          STM    ERRD
 PFEA     EQU    *+3
          ERROR  FBS,,,FS    *(FILE NAME) BUSY.*
*         ERROR  FSE,,,FS    * FILE BOI/EOI/UI MISMATCH.*
*         ERROR  ILR,,,FS    * PFM INCORRECT REQUEST.*
*         ERROR  FIN,,,FS,EC2  *(FILE NAME) INTERLOCKED.*
*         ERROR  DAF,,,FS    *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
*         ERROR  MSE,,,FS    *EQXXX,DNYY, MASS STORAGE ERROR.*
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPWSS
          TITLE  OVERLAYABLE SUBROUTINES.
*         THE FOLLOWING ROUTINES MAY BE OVERLAID BY *BUF2*.
 
          ERRNG  BUF2-*      OVERFLOW INTO EOI SECTOR BUFFER
 CFM      SPACE  4,30
**        CFM - CHECK FILE MODE.
*
*         ENTRY  (CASS) = CURRENT ACCESS MODE.
*                (FISS) = FAST ATTACH FILE INDEX.
*                (CC) = COMMAND CODE.
*                (MODE) = DESIRED ACCESS MODE.
*                (UCSS+1) - (UCSS+4) = USER COUNTS.
*                (FS) = EST ORDINAL OF FILE.
*                (T6) = FIRST TRACK OF FILE.
*
*         EXIT   SYSTEM SECTOR UPDATED FOR NEW ACCESS MODE.
*                (T1) = REQUESTED MODE.
*                TO *PFE* FOR ERROR PROCESSING IF ACCESS NOT ALLOWED.
*
*         CALLS  DLT.
*
*         USES   P0, P1, T1, T3.
*
*         DEFINE (P1) = CURRENT ACCESS MODE FLAGS.
*                (T3) = ADDRESS OF GLOBAL USER COUNTS.
*                (T7) = ADDRESS OF LOCAL USER COUNTS.
*
*         NOTES  IF A WRITEABLE MODE *ATTACH* IS ATTEMPTED ON A
*                FILE THAT IS ALREADY UTILITY ATTACHED, A *FILE
*                INTERLOCKED* STATUS WILL BE RETURNED.
 
 
 CFM      SUBR               ENTRY/EXIT
          LDC    UCSS+1      ADDRESS OF GLOBAL USER COUNTS
          STD    T3
          LDM    CASS        SET CURRENT ACCESS MODE
          LPC    132
          STD    P1
          LDM    MODE
          LPN    37
          STD    T1          DESIRED ACCESS MODE
          LDM    FISS
          NJN    CFM4        IF FAST ATTACH FILE
          RJM    DLT         DETERMINE LOCAL USER TABLE ADDRESS
          LDD    CC          CHECK FOR *UATTACH* REQUEST
          LMN    CCUA
          NJN    CFM1        IF NOT *UATTACH* REQUEST
          LDD    HN          SET UTILITY MODE
          RAM    CASS
          LDN    2           SET LOCAL *UATTACH* FLAG
          RAM    -1,T7
 CFM1     LDM    CFMT,T1     SET PROCESSOR ADDRESS
          STD    P0
          ZJN    CFM2        IF INCORRECT MODE
          LDD    P1
          LJM    0,P0
 
 CFM2     LDN    /ERRMSG/ILR*4  * PFM INCORRECT REQUEST.*
          LJM    PFE         PROCESS FILE ACCESS ERROR
 
*         WRITE ACCESS REQUESTED.
 
 CFM3     ADI    T3          CHECK IF ANY ACTIVE USERS ON FILE
          ADM    1,T3
          ADM    2,T3
          ADM    3,T3
 CFM4     NJN    CFM9        IF ACCESS NOT ALLOWED
          LDN    32          SET WRITE USER
 
*         SET NEW FILE MODE.
 
 CFM5     RAM    CASS        SET NEW FILE MODE
          AOM    -1,T7       SET LOCAL WRITE FLAG
          LJM    CFMX        RETURN
 
*         MODIFY ACCESS REQUESTED.
 
 CFM6     ADI    T3          CHECK FOR W, M, A, U, R/A, R/U OR R USERS
          ADM    1,T3
          ADM    2,T3
          NJN    CFM9        IF ACCESS NOT ALLOWED
          LDN    12          SET MODIFY USER
          UJN    CFM5        SET NEW FILE MODE
 
*         APPEND ACCESS REQUESTED.
 
 CFM7     ADI    T3          CHECK FOR W, M, A, U, R/U OR R USERS
          ADM    1,T3
          NJN    CFM9        IF ACCESS NOT ALLOWED
          LDN    2           SET APPEND USER
          UJN    CFM5        SET NEW FILE MODE
 
*         UPDATE ACCESS REQUESTED.
 
 CFM8     ADI    T3          CHECK FOR W, M, A, U, R/A OR R USERS
          ADM    2,T3
          NJN    CFM9        IF ACCESS NOT ALLOWED
          LDN    10          SET UPDATE USER
          UJN    CFM5        SET NEW FILE MODE
 
*         ACCESS NOT ALLOWED.
 
 CFM9     LDD    P1          CHECK FOR UTILITY ATTACH MODE
          SHN    21-6
          PJN    CFM10       IF FILE NOT CURRENTLY UTILITY ATTACHED
          LDC    EC2*1000+/ERRMSG/FIN*4  *(FILE NAME) INTERLOCKED.*
          UJN    CFM11       PROCESS FILE INTERLOCKED CONDITION
 
 CFM10    LDN    /ERRMSG/FBS*4  *(FILE NAME) BUSY.*
 CFM11    LJM    PFE         PROCESS FILE BUSY EXIT
 
*         READ OR EXECUTE ACCESS REQUESTED.
 
 CFM12    LPN    32          DO NOT ALLOW W, M, A OR U USERS
 CFM13    NJN    CFM9        IF ACCESS NOT ALLOWED
*         LDN    0
 
*         INCREMENT USER COUNTS.
 
 CFM14    STM    CFMA+1
          STM    CFMB+1
          STM    CFMC+1
 CFMA     LDM    *,T3        CHECK GLOBAL USER COUNT
*         LDM    0,T3        (READ MODE)
*         LDM    1,T3        (READ/ALLOW UPDATE MODE)
*         LDM    2,T3        (READ/ALLOW APPEND MODE)
*         LDM    3,T3        (READ/ALLOW MODIFY MODE)
          LMC    7777
          ZJN    CFM10       IF USER COUNT OVERFLOW
 CFMB     AOM    *,T3        INCREMENT GLOBAL USER COUNT
*         AOM    0,T3        (READ MODE)
*         AOM    1,T3        (READ/ALLOW UPDATE MODE)
*         AOM    2,T3        (READ/ALLOW APPEND MODE)
*         AOM    3,T3        (READ/ALLOW MODIFY MODE)
 CFMC     AOM    *,T7        INCREMENT LOCAL USER COUNT
*         AOM    0,T7        (READ MODE)
*         AOM    1,T7        (READ/ALLOW UPDATE MODE)
*         AOM    2,T7        (READ/ALLOW APPEND MODE)
*         AOM    3,T7        (READ/ALLOW MODIFY MODE)
          LJM    CFMX        RETURN
 
*         READ / ALLOW MODIFY ACCESS REQUESTED.
 
 CFM15    LPN    20          DO NOT ALLOW W USERS
          NJN    CFM13       IF ACCESS NOT ALLOWED
          LDN    3
          UJN    CFM14       INCREMENT USER COUNTS
 
*         READ / ALLOW APPEND ACCESS REQUESTED.
 
 CFM16    LPN    30          DO NOT ALLOW W, M OR U USERS
          NJN    CFM13       IF ACCESS NOT ALLOWED
          LDN    2
          UJN    CFM14       INCREMENT USER COUNTS
 
*         READ / ALLOW UPDATE ACCESS REQUESTED.
 
 CFM17    LPN    22          DO NOT ALLOW W, M OR A USERS
          NJN    CFM13       IF ACCESS NOT ALLOWED
          LDN    1
          UJN    CFM14       INCREMENT USER COUNTS
 CFMT     SPACE  4,15
 CFMT     BSS    0           FILE MODE PROCESSORS
          LOC    0
          CON    CFM3        WRITE
          CON    CFM12       READ
          CON    CFM7        APPEND
          CON    CFM12       EXECUTE
          CON    0           NULL
          CON    CFM6        MODIFY
          CON    CFM15       READ / ALLOW MODIFY
          CON    CFM16       READ / ALLOW APPEND
          CON    CFM8        UPDATE
          CON    CFM17       READ / ALLOW UPDATE
          LOC    *O
          ERRNZ  *-CFMT-PTLM
 CSL      SPACE  4,20
**        CSL - CHECK SIZE LIMITS.
*
*         ENTRY  (T5) = EST ORDINAL OF FILE.
*                (T6) = FIRST TRACK OF FILE.
*                (P2) = FIRST TRACK OF FILE.
*                (MXDS - MXDS+1) = MAXIMUM SIZE FOR DIRECT ACCESS FILE.
*                (FNMD) = FNT STATUS EQUIVALENCED MODE.
*
*         EXIT   TO ERR IF SIZE LIMIT EXCEDED.
*                (LF - LF+1) = FILE LENGTH FOR *PFC* ENTRY.
*                (T6) = TRACK FOR EOI.
*                (T7) = SECTOR FOR EOI.
*
*         USES   T2, T3.
*
*         CALLS  SEI.
*
*         MACROS ERROR.
 
 
 CSL      SUBR               ENTRY/EXIT
          LDM    FNMD
          LPN    2
          ZJN    CSL1        IF NOT WRITE FUNCTION
          AOM    CSLA        SET WRITEABLE MODE
          LDN    0           CLEAR FILE LENGTH FOR WRITE MODE
          STD    LF
          STD    LF+1
 CSL1     LDM    FCLF,CI     CHECK FILE LENGTH IN *PFC*
          STD    T2
          LDM    FCLF+1,CI
          STD    T3
          ADD    T2
          NJN    CSL2        IF FILE LENGTH DEFINED IN *PFC*
          RJM    SEI         SKIP TO END OF INFORMATION
 CSL2     LDN    0           TEST ACCESS MODE
*         LDN    1           (SET IF WRITEABLE MODE)
 CSLA     EQU    *-1
          NJN    CSL4        IF WRITEABLE MODE
          LDD    T2          SET FILE LENGTH
          STD    LF
          LDD    T3
          STD    LF+1
 CSL3     UJN    CSLX        RETURN
 
 CSL4     LDM    MXDS        CHECK FILE LENGTH
          ADM    MXDS+1
          ZJN    CSL3        IF UNLIMITED ACCESS
          LDM    MXDS
          SBD    T2
          MJN    CSL5        IF LENGTH LIMIT EXCEEDED
          NJN    CSL3        IF LIMIT NOT EXCEEDED
          LDM    MXDS+1
          SBD    T3
          PJN    CSL3        IF LIMIT NOT EXCEEDED
 CSL5     ERROR  FTL,CH      * FILE TOO LONG.*
 DLT      SPACE  4,10
**        DLT - DETERMINE LOCAL USER TABLE TO UPDATE.
*
*         ENTRY  (BFMS - BFMS+500) - SYSTEM SECTOR.
*                (T5) = EST ORDINAL.
*
*         EXIT   (T7) - ADDRESS OF LOCAL USER COUNTS.
*
*         USES   T7.
*
*         CALLS  SMI.
 
 
 DLT      SUBR               ENTRY/EXIT
          RJM    SMI         COMPUTE LOCAL USER COUNT BASE ADDRESS
          STD    T0
          SHN    2
          ADD    T0
          ADC    UCSS+1
          STD    T7
          UJN    DLTX
          SPACE  4,10
*         OVERLAYABLE COMMON DECKS.
 
 
 EJT$     SET    0           DEFINE EJT ACCESS
*CALL     COMPGFP
*CALL     COMPRSS
*CALL     COMPSDN
*CALL     COMPSMI
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF1-2  OVERFLOW INTO CATALOG BUFFER
          OVERLAY  (CATLIST PROCESSING.),OVLA
          SPACE  4,10
**        THIS OVERLAY READS PERMANENT FILE CATALOG ENTRIES
*         OR PERMIT ENTRIES FOR A CENTRAL PROCESSOR PROGRAM.
 
 
 OVL      BSS    0           ENTRY
*         LJM    CAT         PROCESS REQUEST
          SPACE  4,10
***       PROCESS *CATLIST* REQUEST.
*
*         CALL.
*
*T        18/PFM,6/P,12/CCCT,24/FET
*
*T  FET   42/ *FILENAME*,18/ STATUS
*T,       60/ FIRST
*T,       60/ IN
*T,       60/ OUT
*T,       60/ LIMIT
*T,       60/
*T,       60/ RESERVED
*T,       60/
*T,       42/ *PF NAME*, 6/ SR, 12/ MODE
*T,       42/ OUAN, 6/ DN, 12/
*
*         STATUS RETURNED,
*                33          BUFFER FULL.
*              1033          REQUEST COMPLETED.
*              BUFFER IS FILLED FROM IN TO LIMIT - 1.
*
*         FET+6 RESERVED FOR RECALL INFORMATION TO *PFM*.
*
*         PF NAME = PERMANENT FILE NAME.
*
*         SR = SPECIAL REQUEST.
*              IF SR = SRDN, LIST ONLY FILES ON SPECIFIED DEVICE.
*
*         MODE = 0           SEARCH FOR CATALOG ENTRIES.
*         MODE = 1           SEARCH FOR PERMIT ENTRIES.
*         MODE = 2           SEARCH FOR CATALOG ENTRIES/*PFID* ACCESS.
*
*         OUAN = ALTERNATE CATALOG SEARCHED.
*
          SPACE  4,10
***       EXIT.
*
*         PF CATALOG ENTRIES WRITTEN TO CM.
*
*                FOR NORMAL CATALOG SEARCH FULL CATALOG ENTRY
*                WRITTEN TO CM (SEE COMSPFM)
*
*                FOR ALTERNATE CATALOG SEARCH ENTIRE CATALOG IS
*                RETURNED WITH THE FOLLOWING FIELDS CLEARED-
*                     USER INDEX.
*                     PASSWORD AND PASSWORD EXPIRATION DATE.
*                     ACCESS LEVEL AND ACCESS CATEGORY SET.
*
*                FOR *PFID* ACCESS CATALOG SEARCH, THE FULL CATALOG
*                ENTRY IS WRITTEN TO CM, WITH A WORD PRECEDING
*                EACH ENTRY CONTAINING THE *PFID* (DISK ADDRESS)
*                FOR THAT ENTRY.
*
*                IN ALL OF THE ABOVE CASES, IF THE FILE ACCESS
*                LEVEL IS ABOVE THE JOB ACCESS LEVEL, THE FOLLOWING
*                FIELDS ARE ALSO CLEARED -
*                     PASSWORD (REPLACED BY ASTERISKS).
*                     PASSWORD EXPIRATION DATE.
*                     ACCESS CATEGORY SET.
*                     USER CONTROL WORD.
*
*                FOR A PERMIT DATA REQUEST, THE FULL PERMIT ENTRY IS
*                WRITTEN TO CM.  THIS TYPE OF REQUEST IS NOT ALLOWED
*                ON A FILE WITH AN ACCESS LEVEL HIGHER THAN THAT OF THE
*                CALLING JOB, UNLESS THE JOB IS A SUBSYSTEM.
          SPACE  4,10
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 CF       EQU    P0          CONTINUATION FLAG
 DN       EQU    35          DEVICE NUMBER FOR CATALOG LIST
 ST       EQU    45          CATALOG SEARCH TRACK
 SS       EQU    46          CATALOG SEARCH SECTOR
 SI       EQU    47          CATALOG SEARCH INDEX
 EQ       EQU    60          MASTER DEVICE EST ORDINAL
 RI       EQU    61 - 62     RANDOM INDEX
 WC       EQU    63          WORD COUNT
 IN       EQU    64 - 65     FET POINTER
 LM       EQU    66 - 67     FET LIMIT POINTER
****
          TITLE  COMMAND PROCESSING.
 CAT      SPACE  4,10
**        CAT - CATALOG MAIN PROGRAM.
*
*         ENTRY  (PFUI - PFUI+1) = USER INDEX.
*                (UI - UI+1) = USER INDEX OF CALLING USER
*                (PI - PI+1) = USER INDEX OF ALTERNATE CATALOG.
*                (PFFN - PFFN+3) = FILE NAME FOR SELECTED FILE CATALOG.
*                (PFOU - PFOU+3) = CALL BLOCK USER NAME.
*                (PFFN+4) = MODE OF CALL.
*
*         USES   T1.
*
*         CALLS  SBS.
*
*         MACROS ENDMS, ERROR.
 
 
 CAT      LDM    PFFN+4      SET FUNCTION TYPE
          SBN    CTMX
          MJN    CAT1        IF VALID MODE
          ERROR  ILR,CH,IW   * PFM INCORRECT REQUEST.*
 
 CAT1     ADN    CTMX
          NJN    CAT2        IF NOT ALTERNATE USER
          LDD    PI          CHECK FOR ALTERNATE USER
          ADD    PI+1
          ZJN    CAT2        IF NORMAL CATALOG SEARCH
          LDN    CTCA        ALTERNATE CATALOG SEARCH
 CAT2     STD    T1
          STM    CATA        SET ACCESS MODE
 
*         PROCESS REQUEST.
 
          LDM    CATC,T1
          STM    CATC
          LJM    NCS         NORMAL CATALOG SEARCH
 CATC     EQU    *-1
          CON    PDS         PERMIT DATA SEARCH
          CON    PAS         *PFID* ACCESS SEARCH
          CON    ACS         ALTERNATE CATALOG SEARCH
 
**        CATX - TERMINATE PROGRAM.
 
 CATX     ENDMS
          LDC    1031        SET BUFFER STATUS TO EOI
          RJM    SBS
          UJN    DPP         DROP PP
 
 CATA     CON    0           FUNCTION
 CATB     CON    0           MASTER DEVICE NUMBER
 DPP      SPACE  4,10
**        DPP - DROP PP.
 
 
 DPP      BSS    0           ENTRY
          LDK    STDP        SET *DROP PP* STATUS BIT
          RAM    STAU
          EXECUTE  3PU       DROP PP
 PAS      SPACE  4,15
**        PAS - *PFID* ACCESS SEARCH.
 
 
 PAS      BSS    0           ENTRY
          LDC    LDNI+NWCE+1 SET FOR SIZE OF OUTPUT
          STM    SHBC
*         UJN    NCS         (PERFORM NORMAL CATALOG SEARCH)
 NCS      SPACE  4,10
**        NCS - NORMAL CATALOG SEARCH.
 
 
 NCS      RJM    ISP         INITIALIZE FOR CATALOG SEARCH
 NCS1     RJM    RBS         READ BUFFER FOR CATALOG SEARCH
          RJM    SHB         SEARCH CATALOG BUFFER
          ZJN    NCS1        LOOP FOR NEXT SECTOR OF CATALOGS
          UJN    CATX        EXIT
 ACS      SPACE  4,10
**        ACS - ALTERNATE CATALOG SEARCH.
 
 
 ACS      RJM    CSU         CHECK FOR SPECIAL USER ACCESS
          LDD    UI          SWAP USER INDEXES
          STD    T1
          LDD    PI
          STD    UI
          LDD    T1
          STD    PI
          LDD    UI+1
          STD    T1
          LDD    PI+1
          STD    UI+1
          LDD    T1
          STD    PI+1
          RJM    ISP         INITIALIZE FOR CATALOG SEARCH
 ACS1     RJM    RBS         READ BUFFER FOR SEARCH
          RJM    SHB         SEARCH CATALOG BUFFER
          ZJN    ACS1        LOOP FOR NEXT SECTOR
          LJM    CATX        EXIT
 PDS      SPACE  4,10
**        PDS - PERMIT DATA SEARCH.
 
 
 PDS      LDM    PFFN        ENTRY
          NJN    PDS1        IF PERMANENT FILE NAME SPECIFIED
          ERROR  ILR,CH,IW   * PFM INCORRECT REQUEST.*
 
 PDS1     RJM    ISP         INITIALIZE FOR CATALOG SEARCH
          LDD    CF          CHECK CONTINUATION FLAG
          ZJN    PDS2        IF INITIAL CALL
          LJM    PDS5        CONTINUE READ
 
 PDS2     RJM    RBS         READ BUFFER FOR SEARCH
          RJM    SHB         SEARCH CATALOG BUFFER
          ZJN    PDS2        IF FILE NOT FOUND
 
*         A PERMIT DATA CATLIST IS NOT ALLOWED ON A FILE WITH AN
*         ACCESS LEVEL ABOVE THAT OF THE JOB UNLESS THE CALLER IS
*         A SUBSYSTEM.
 
          LDM    SSOM
          ZJN    PDS2.1      IF UNSECURED SYSTEM
          LDM    FCAL,P2     GET FILE ACCESS LEVEL
          LPN    7
          STD    T1
          LDM    PFAL        GET JOB ACCESS LEVEL
          SBD    T1
          PJN    PDS2.1      IF FILE ACCESS LEVEL NOT ABOVE JOB LEVEL
          LDM    SSID
          SBK    LSSI+1
          PJN    PDS2.1      IF SUBSYSTEM
          ERROR  IUA,,IW     * USER ACCESS NOT VALID.*
 
 PDS2.1   LDM    FCRI,P2     SET PERMIT RANDOM INDEX
          STD    RI
          LDM    FCRI+1,P2
          STD    RI+1
          ADD    RI
          NJN    PDS4        IF PERMITS AVAILABLE
 
*         NO PERMITS AVALABLE - SET MESSAGE.
 
 PDS3     LDM    PFOU
          ZJP    CATX        IF NOT SPECIFIC USER REQUEST
          LDD    MA          SET OPTIONAL USER IN FILE NAME
          CWM    PFOU,ON
          SBN    1
          CRD    FN
          ERROR  FNF,,IW     *(USER NAME) NOT FOUND.*
 
 PDS4     LDN    NWPH        SET SECTOR WORD INDEX
          STD    SI
          LDN    0
          RJM    CSA         COMPUTE SECTOR ADDRESS
          MJN    PDS3        IF ERROR ON POSITION TO PERMIT SECTOR
 
 PDS5     LDC    BUFB        READ SECTOR
          RJM    RDS
          MJN    PDS3        IF ERROR TREAT AS EOI
          LDM    BUFB
          ZJN    PDS3        IF EOF/EOI
          LDM    BUFB+1
          SBN    NWPH+NWPE
          MJN    PDS6.1      IF INCORRECT SECTOR LENGTH
          LPN    NWPE-1
          ERRNZ  NWPH-NWPE   HEADER SIZE MUST EQUAL ENTRY SIZE
          NJN    PDS6.1      IF NOT INTEGRAL NUMBER OF PERMIT ENTRIES
          LDC    BUFB        CHECK USER INDEX
          STD    T1
          LDD    UI
          LMM    FPUI,T1
          NJN    PDS6        IF INCORRECT UI
          LDD    UI+1
          LMM    FPUI+1,T1
          ZJN    PDS7        IF CORRECT UI
 PDS6     LDD    CF
          ZJN    PDS6.0      IF NOT CONTINUATION CALL
 PDSA     LDC    0
*         LDC    (NONZERO)   (NOT FIRST SECTOR)
          ZJN    PDS6.2      IF FIRST SECTOR
 PDS6.0   ERROR  RIN,,IW,T5  *EQXXX,DNYY,RANDOM INDEX ERROR.*
 
 PDS6.1   ERROR  BCS,,IW,T5,,EI  *EQXXX,DNYY,BAD CATALOG/PERMIT SECTOR*
 
 PDS6.2   ERROR  ECD,,IW     * ERROR IN CATLIST CONTINUATION DATA.*
 
 PDS7     LDM    PFOU
          NJN    PDS8        IF SPECIFIC USER REQUEST
          LJM    PDS12       CONTINUE SEARCH OF PERMITS
 
*         PROCESS SPECIFIC USER PERMIT REQUEST.
 
 PDS8     LDD    MA          SET USER NAME FOR SEARCH
          CWM    PFOU,ON
          SBN    1
          CRD    CM
          RJM    SPB         SEARCH PERMIT BUFFER
          ZJN    PDS10       IF ENTRY NOT FOUND
          LDN    NWPE        WRITE ENTRY TO CM
          STD    T1
          LDM    FPMD,T2
          SHN    21-5
          MJN    PDS9        IF EXPIRATION DATE PRESENT
          LDM    FPXD,T2     CLEAR EXPIRATION DATE FIELD
          SCN    77
          STM    FPXD,T2
          LDN    0
          STM    FPXD+1,T2
 PDS9     LDD    T2          WRITE ENTRY TO CM
          RJM    WDB
          LJM    CATX        EXIT
 
 PDS10    LDM    BUFB+FPRI   SET ADDRESS OF NEXT BUFFER
          STD    RI
          LDM    BUFB+FPRI+1
          STD    RI+1
          ADD    RI
          ZJN    PDS11       IF NO MORE PERMITS
          AOM    PDSA+1      INDICATE NOT FIRST SECTOR
          LJM    PDS4        LOOP TO READ NEXT SECTOR
 
 PDS11    LJM    PDS3        EXIT
 
 PDS12    LDN    NWPE        SET WORD COUNT
          STD    T1
 PDS13    LDD    SI
          SHN    2
          ADD    SI
          ADC    BUFB+2
          STD    T2          SAVE BASE ADDRESS
          LDM    FPMD,T2
          SHN    21-5
          MJN    PDS14       IF EXPIRATION DATE PRESENT
          LDM    FPXD,T2     CLEAR EXPIRATION DATE FIELD
          SCN    77
          STM    FPXD,T2
          LDN    0
          STM    FPXD+1,T2
 PDS14    LDD    T2          WRITE ENTRY TO CM
          RJM    WDB
          LDN    NWPE        ADVANCE WORD INDEX
          RAD    SI
          LMM    BUFB+1
          NJN    PDS13       IF MORE ENTRIES
          LJM    PDS10       LOOP FOR NEXT SECTOR
          TITLE  SUBROUTINES.
 SBS      SPACE  4,15
**        SBS - SET STATUS OF BUFFER.
*
*         ENTRY  (A) = STATUS TO BE SET.
*                (IN - IN+1) = CURRENT ADDRESS IN FET.
*
*         EXIT   FET STATUS SET.
*                (IN) UPDATED IN FET.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  SFA.
 
 
 SBS      SUBR               ENTRY/EXIT
          STD    T1          SAVE STATUS TO BE SET
          RJM    SFA         SET FET ADDRESS
          CRD    CM
          LDD    CM+4        SET STATUS
          LPN    2
          LMD    T1
          STD    CM+4
          LDD    CM+3        CLEAR UPPER BITS OF STATUS FIELD
          SCN    77
          STD    CM+3
          RJM    SFA
          CWD    CM          WRITE FET STATUS
          LDN    ZERL        UPDATE FET IN POINTER
          CRD    CM
          LDD    IN
          STD    CM+3
          LDD    IN+1
          STD    CM+4
          RJM    SFA
          ADN    2
          CWD    CM
          UJN    SBSX        RETURN
 RBS      SPACE  4,15
**        RBS - READ BUFFER FOR SEARCH.
*
*         ENTRY  (T6) = TRACK.
*                (T7) = SECTOR.
*                DEVICE POSITIONED AND CHANNEL RESERVED.
*                AT RBS1 IF SEARCH TERMINATION DESIRED.
*
*         EXIT   (A) = WORD COUNT OF SECTOR READ.
*                (T6) = NEXT TRACK.
*                (T7) = NEXT SECTOR.
*                (WBDB - WDBC) SET TO CURRENT POSITION
*
*         CALLS  DPP, RNS, SBS.
*
*         MACROS ENDMS, ERROR.
 
 
 RBS      SUBR               ENTRY/EXIT
          LDC    **          COUNT OF DA FILES FOUND IN BUFFER
 RBSA     EQU    *-1
          ZJN    RBS1        IF NO DA FILES FOUND IN LAST PRU
          LDN    0           CLEAR PRU COUNT
          STM    RBSA
 
 RBS1     LDD    T6          SET CURRENT POSITION FOR RECALL
          STM    WDBB
          STM    ERRC
          LDD    T7
          STM    WDBC
          STM    ERRD
          LDC    BUFA        SET BUFFER FOR READ
          RJM    RNS         READ SECTOR
          ZJN    RBS2        EOF/EOI SECTOR
          LPN    NWCE-1
          NJN    RBS4        IF NOT INTEGRAL NUMBER OF CATALOG ENTRIES
          LDD    T1
          UJN    RBSX        RETURN
 
 RBS2     LDD    FN
          ZJN    RBS3        IF NOT FILE NAME SEARCH
          ERROR  FNF,,IW     *(FILE NAME) NOT FOUND.*
 
 RBS3     LDC    1031        SET EOI BUFFER STATUS
          RJM    SBS
          ENDMS
          LJM    DPP         TERMINATE PROGRAM
 
 RBS4     ERROR  BCS,,IW,T5,,EI  *EQXXX,DNYY,BAD CATALOG/PERMIT SECTOR*
 MSR      SPACE  4,10
**        MSR - MASS STORAGE READ ERROR PROCESSOR.
 
 
 MSR      SUBR               ENTRY/EXIT
          RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,CH,IW,T5  *EQXXX,DNYY, MASS STORAGE ERROR.*
 SHB      SPACE  4,15
**        SHB - SEARCH CATALOG BUFFER.
*
*         ENTRY  (A) = NUMBER OF WORDS IN BUFFER.
*                (SI) = SEARCH INDEX.
*                (FN - FN+3) = SELECTED FILE NAME FOR SEARCH
*                (UI - UI+1) = USER INDEX OF CATALOG TO SEARCH.
*
*         EXIT   (A) " 0 IF SPECIFIC ENTRY FOUND
*                (P2) = FWA OF CATALOG ENTRY
*
*         USES   T1, P1, P2, RI - RI+1.
*
*         CALLS  WDB, CIP.
 
 
 SHB      SUBR               ENTRY/EXIT
          STD    P1          SAVE WORD COUNT
          LDM    CATA        SET CONTROL FOR SEARCH MODE
          STD    T1
          LDM    SHBF,T1
          STM    SHBB
          LDC    BUFA+2      SET BUFFER DATA BASE
          STD    P2
          LDD    SI          SET SEARCH INDEX
          SHN    2           MULTIPLY BY FIVE
          ADD    SI
          RAD    P2          SET DATA ADDRESS TO NEXT CATALOG ENTRY
 SHB1     LDM    FCUI,P2     CHECK USER INDEX
          LPN    37
          SHN    14
          LMM    FCUI+1,P2
          ZJN    SHB2        IF EMPTY CATALOG ENTRY
 SHBA     PSN
*         UJN    SHB4        (SET IF PRIVATE DEVICE)
          LMD    UI+1
          SHN    6
          LMD    UI
          ZJN    SHB4        USER INDEX MATCH
 
*         INCREMENT FOR NEXT ENTRY.
 
 SHB2     LDC    NWCE*5      ADVANCE ENTRY INDEX
          RAD    P2
          LDN    NWCE        INCREMENT WORD COUNT
          RAD    SI          ADVANCE SEARCH INDEX
          ADN    NWCE-1      CHECK FOR ANOTHER CATALOG ENTRY
          SBD    P1
          MJN    SHB1        IF NOT END OF BUFFER
          LDN    0
          STD    SI          CLEAR SEARCH INDEX
 SHB3     LJM    SHBX        RETURN
 
 SHB4     LDD    FN          CHECK AGAINST SELECTED FILE NAME
          ZJN    SHB6        IF NO SELECTED FILE REQUESTED
          LMI    P2
          NJN    SHB2        NO MATCH
          LDM    1,P2
          LMD    FN+1
          NJN    SHB2        NO MATCH
          LDM    2,P2
          LMD    FN+2
          NJN    SHB2        NO MATCH
          LDM    3,P2
          LMD    FN+3
          SCN    77
 SHB5     NJN    SHB2        IF NOT MATCH
 SHB6     BSS    0
 SHBE     UJN    SHB7
*         PSN                IF CATLIST OF DEVICE NUMBER SPECIFIED.
 
          LDM    FCDN,P2     CHECK DEVICE NUMBER
          LPN    77
          SBD    DN
          NJN    SHB5        IF NO MATCH
 SHB7     LDN    1           SET FOR *CTPM* EXIT CASE
          UJN    *           PERFORM SEARCH DEPENDING ON MODE
 SHBB     EQU    *-1
*         UJN    SHB9        (IF NORMAL CATALOG SEARCH, *CTNC*)
*         UJN    SHB3        (IF PERMIT DATA SEARCH, *CTPM*)
*         UJN    SHB9        (IF *PFID* ACCESS SEARCH, *CTID*)
*         UJN    SHB8        (IF ALTERNATE CATALOG SEARCH, *CTCA*)
 
*         VALIDATE ACCESS AND PREPARE THE *PFC* ENTRY FOR OUTPUT.
 
 SHB8     RJM    CCP         CHECK CATALOG PERMISSION
          ZJP    SHB11       IF NOT PERMITTED
 SHB9     LDM    SSOM
          ZJN    SHB9.1      IF UNSECURED SYSTEM
          LDM    SSJS
          NJN    SHB9.1      IF *SSJ=* CALLER
          LDM    FCAL,P2     GET FILE ACCESS LEVEL
          LPN    7
          STD    T1
          LDM    PFAL        GET JOB ACCESS LEVEL
          SBD    T1
          MJN    SHB9.2      IF FILE ACCESS LEVEL ABOVE JOB
 SHB9.1   LJM    SHB9.4      WRITE CATALOG TO CM
 
*         IF THE FILE ACCESS LEVEL IS HIGHER THAN THE JOB ACCESS LEVEL,
*         CLEAR THE FOLLOWING PFC FIELDS (UNLESS CALLER IS *SSJ=*).
*                1. PASSWORD (REPLACE WITH ASTERISKS).
*                2. PASSWORD EXPIRATION DATE.
*                3. ACCESS CATEGORY SET.
*                4. USER CONTROL WORD.
 
 SHB9.2   LDK    FCCW        SET ADDRESS OF USER CONTROL WORD
          ADD    P2
          STM    SHBG
          LDM    FCPW,P2
          ZJN    SHB9.3      IF NO PASSWORD DEFINED
          LDC    2R**        REPLACE PASSWORD WITH ASTERISKS
          STM    FCPW,P2
          STM    FCPW+1,P2
          STM    FCPW+2,P2
          SCN    77          CLEAR PASSWORD EXPIRATION DATE
          STM    FCPW+3,P2
*         STM    FCXD,P2
          LDN    0
          STM    FCXD+1,P2
 SHB9.3   STM    FCFC+1,P2   CLEAR ACCESS CATEGORY SET
          STM    FCFC+2,P2
          LDM    FCFC,P2
          LPC    7400
          STM    FCFC,P2
          LDN    ZERL        CLEAR USER CONTROL WORD
          CRM    *,ON
 SHBG     EQU    *-1         (ADDRESS OF USER CONTROL WORD)
 
*         WRITE CATALOG TO CM.
 
 SHB9.4   LDM    FCBS,P2
          SHN    6
          PJN    SHB10       IF NOT DIRECT ACCESS FILE
          RJM    DFS         DETERMINE FILE SIZE
 SHB10    LDN    NWCE        WRITE CATALOG TO CM
 SHBC     EQU    *-1
*         LDN    NWCE+1      (IF *PFID* ACCESS SEARCH, *CTID*)
          STD    T1
          LDD    P2
          RJM    WDB
          LDD    FN
          ZJN    SHB11       IF NOT SELECTED FILE SEARCH
          LJM    SHBX        RETURN FILE FOUND
 
 SHB11    STM    RBSA        CLEAR DA FILE COUNT
 SHB13    LJM    SHB2        LOOP FOR NEXT CATALOG ENTRY
 
 
 SHBF     BSS    0           BRANCH TABLE
          LOC    SHBB
          UJN    SHB9        *CTNC* MODE OF SEARCH
          LOC    SHBB
          UJN    SHB3        *CTPM* MODE OF SEARCH
          LOC    SHBB
          UJN    SHB9        *CTID* MODE OF SEARCH
          LOC    SHBB
          UJN    SHB8        *CTCA* MODE OF SEARCH
          LOC    *O
 WDB      SPACE  4,20
**        WDB - WRITE BUFFER TO CENTRAL.
*
*         ENTRY  (A) = CATALOG ENTRY ADDRESS.
*                (T1) = WORD COUNT OF ENTRY TO WRITE
*                (IN - IN+1) = CURRENT POSITION IN FET.
*                (LM - LM+1) = FET LIMIT.
*                (SI) = CURRENT SECTOR WORD INDEX.
*                (T6 - T7) CURRENT PERMIT BUFFER ADDRESS IF PERMIT LIST.
*                (WDBB - WDBC) SET TO CURRENT CATALOG SEARCH POS.
*
*         EXIT   CATALOG ENTRY WRITTEN TO BUFFER.
*                (IN - IN+1) ADVANCED
*                TO DPP IF BUFFER FULL (EOF STATUS SET IN FET)
*
*         USES   T2, CM - CM+4.
*
*         CALLS  PCA, SBS, SFA, SRA.
*
*         MACROS ENDMS, ERROR.
 
 
 WDB      SUBR               ENTRY/EXIT
          STD    T2          SET ADDRESS FOR WRITE
          STM    WDBA
          LDD    IN          CHECK FOR ROOM IN BUFFER FOR NEXT ENTRY
          SHN    14
          ADD    IN+1
          ADD    T1
          STD    CM+4
          SHN    -14
          STD    CM+3
          SBD    LM
          SHN    14
          ADD    CM+4
          SBD    LM+1
          PJN    WDB1        IF BUFFER FULL
          RJM    PCA         PROCESS CATALOG ADDRESS ACCESS MODE
          LDD    IN          WRITE ENTRY TO BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    IN+1
          CWM    *,T1
 WDBA     EQU    *-1
          LDD    CM+3        ADVANCE IN POINTER
          STD    IN
          LDD    CM+4
          STD    IN+1
          LDN    IPCE        PF INCREMENT FOR CATALOG ENTRY RETURNED
          RAM    AIPF+1
          LJM    WDBX        EXIT
 
*         BUFFER FULL.
 
 WDB1     ENDMS
          LDM    CATA
          LMN    CTPM
          ZJN    WDB2        IF PERMIT FILE POSITION TO BE SAVED
          LDC    *           SET CURRENT POSITION
 WDBB     EQU    *-1
          STD    T6
          LDC    *
 WDBC     EQU    *-1
          STD    T7
          LDM    DVLW+1      SET ALLOCATOR TRACK
          UJN    WDB3
 WDB2     LDM    DVLW+2      SET PERMIT FILE
 WDB3     RJM    SRA         SET RANDOM ADDRESS
          ZJN    WDB4        IF NO ERROR
          ERROR  RIN,CH,IW,EQ  *EQXXX,DNYY, RANDOM INDEX ERROR.*
 
 WDB4     LDN    ZERL        CLEAR ASSEMBLY AREA
          CRD    CM
          LDD    RI+1        REPOSITION RANDOM ADDRESS
          SHN    6
          STD    CM+2
          LPC    770000
          ADD    RI
          SHN    6
          STD    CM+1
          LPC    770000
          ADD    SI
          SHN    6
          STD    CM
          RJM    SFA         SET FET ADDRESS
          ADN    CFCN
          CWD    CM          WRITE ADDRESS TO FET
          LDN    31          SET END OF FILE STATUS
          RJM    SBS         SET STATUS OF BUFFER
          LJM    DPP         TERMINATE PROGRAM
 
 CCP      SPACE  4,20
**        CCP - CHECK CATALOG PERMISSION.
*
*         CATALOG ENTRY RETURNED IF ALTERNATE CATLIST PERMISSION HAS
*         BEEN GRANTED AND USER IS VALID TO ACCESS FILE.
*
*         ENTRY  (P2) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   (A) = 0 IF USER NOT PERMITTED TO FILE.
*                CATALOG ENTRY ADJUSTED IF USER PERMITTED.
*
*         USES   T1, T2, T6, T7, P3, ST, SS.
*
*         CALLS  CSA, MSR, PDV, RDS, SPB.
*
*         MACROS MONITOR, SETMS.
 
 
 CCP10    LDN    0           DENY ACCESS TO USER
 CCP11    ZJP    CCPX        IF USER NOT PERMITTED
 CCP12    LDM    FCAM,P2     CHECK PERMISSION MODE
          LPN    77
          LMN    PTNU
          ZJN    CCP11       IF *NULL* PERMISSION
 
*         CHECK FOR EXPIRED PERMIT.
 
          LDD    P3
          ZJN    CCP13       IF NO PERMIT ENTRY FOUND
          LDM    FPMD,T2     CHECK FOR EXPIRED PERMIT
          SHN    21-5
          PJN    CCP13       IF NO EXPIRATION DATE PRESENT
          LDM    FPXD,T2
          LPN    77
          STD    CM+3
          SHN    14
          LMM    FPXD+1,T2
          ZJN    CCP13       IF NON-EXPIRING PERMIT
          STD    CM+4
          LDN    VEDS        VALIDATE EXPIRATION DATE
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          NJN    CCP10       IF EXPIRED
 
*         VALIDATE ACCESS LEVEL/CATEGORY SET OF USER.
 
 CCP13    LDN    ZERL
          CRD    CM
          LDM    FCAL,P2     SET ACCESS LEVEL
          LPN    7
          STD    CM+1
          LDM    FCFC,P2     SET ACCESS CATEGORY
          LPC    377
          STD    CM+2
          LDM    FCFC+1,P2
          STD    CM+3
          LDM    FCFC+2,P2
          STD    CM+4
          LDD    MA
          CWD    CM
          LDN    ZERL
          CRD    CM
          LDN    3           CHECK ACCESS LEVEL/ACCESS CATEGORY SET
          STD    CM+4
          LDN    VAJS        CHECK AGAINST USER-S VALIDATION
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          NJP    CCP10       IF NOT VALID ACCESS
 
*         CLEAR FIELDS IN CATALOG ENTRY.
 
          LDN    FCPW        SET FWA OF PASSWORD
          ADD    P2
          STM    CCPC
          ADN    FCAL-1-FCPW SET FWA OF ACCESS LEVEL AND CATEGORY SET
          STM    CCPD
          ADN    FCCN-FCAL   SET FWA OF CHARGE NUMBER
          STM    CCDF
          ADK    FCP1-FCCN   SET FWA OF PROJECT NUMBER
          STM    CCDG
          ADK    FCP2-FCP1   SET FWA OF WORD 2 OF PROJECT NUMBER
          STM    CCDH
          LDN    ZERL        CLEAR PASSWORD AND EXPIRATION DATE
          CRM    *,ON
 CCPC     EQU    *-1         (FWA OF PASSWORD)
          LDN    ZERL        CLEAR ACCESS LEVEL AND CATEGORIES
          CRM    *,ON
 CCPD     EQU    *-1
          LDN    0
          STM    FCUI+1,P2   CLEAR USER INDEX
          LDM    FCUI,P2
          SCN    77
          STM    FCUI,P2
          LDM    SSJS
          NJN    CCP14       IF CALLER IS *SSJ=* PROGRAM
          LDN    ZERL        CLEAR CHARGE/PROJECT FIELDS
          CRM    *,ON
 CCDF     EQU    *-1
          LDN    ZERL
          CRM    *,ON
 CCDG     EQU    *-1
          LDN    ZERL
          CRM    *,ON
 CCDH     EQU    *-1
 CCP14    LDN    1           RETURN PERMISSION FLAG
 
 CCP      SUBR               ENTRY/EXIT
          LDM    FCAP,P2     CHECK ALTERNATE CATLIST PERMISSION
          SHN    0-12
          NJN    CCP1        IF ALTERNATE CATLIST PERMISSION PRESENT
          LDN    ACEX        USE DEFAULT PERMISSION FOR EXISTING FILES
 CCP1     LMN    ACNO
          ZJN    CCPX        IF ALTERNATE CATLIST NOT PERMITTED
          LDN    0           CLEAR PERMIT SEARCH STATUS
          STD    P3
 
*         SEARCH FOR PERMIT ENTRY.
 
          LDM    FCRI,P2     SET PERMIT INDEX
          STD    RI
          LDM    FCRI+1,P2
          STD    RI+1
          ADD    RI
          NJN    CCP4        IF PERMIT INDEX PRESENT
          LDM    FCCT,P2     CHECK FILE CATEGORY
          SHN    -6
          LMN    FCPR
          ZJN    CCPX        IF PRIVATE FILE
          LJM    CCP12       CHECK PERMISSION MODE IN PFC
 
 CCP4     LDN    IPPA        PF INCREMENT FOR PERMIT FILE ACCESS
          RAM    AIPF+1
          LDD    T6          SAVE POSITION OF CATALOGS
          STD    ST
          LDD    T7
          STD    SS
          LDD    P2
 CCP5     RJM    CSA         COMPUTE SECTOR ADDRESS
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BUFB        READ PERMIT BUFFER
          RJM    RDS
          PJN    CCP6        IF NO ERROR
          RJM    MSR         PROCESS READ ERROR
 
 CCP6     LDM    BUFB        CHECK CONTROL BYTES
          ZJN    CCP8        IF TERMINATING SEARCH
          LDM    BUFB+1
          SBN    NWPH+NWPE
          MJN    CCP6.0      IF INCORRECT SECTOR LENGTH
          LPN    NWPE-1
          ERRNZ  NWPH-NWPE   HEADER SIZE MUST EQUAL ENTRY SIZE
          ZJN    CCP6.1      IF INTEGRAL NUMBER OF PERMIT ENTRIES
 CCP6.0   ERROR  BCS,,IW,T5,,EI  *EQXXX,DNYY,BAD CATALOG/PERMIT SECTOR*
 
 CCP6.1   LDD    CP          SET USER NAME FOR SEARCH
          ADN    UIDW
          CRD    CM
          RJM    SPB         SEARCH PERMIT BUFFER
          NJN    CCP8        IF PERMIT FOUND
 CCP7     LDM    BUFB+FPRI   CHECK FOR PERMIT LINK
          STD    RI
          LDM    BUFB+FPRI+1
          STD    RI+1
          ADD    RI
          NJP    CCP5        IF MORE PERMITS TO CHECK
 CCP8     STD    P3          SAVE SEARCH STATUS
          ZJN    CCP9        IF TERMINATING PERMIT SEARCH
          LDM    FPMD,T2     CHECK PERMIT TYPE
          SHN    21-4
          MJN    CCP7        IF ACCOUNTING PERMIT
          SHN    4-4-21+4    SET PERMIT MODE
          LPN    17
          STD    T1
          LDM    FCAM,P2
          SCN    77
          ADD    T1
          STM    FCAM,P2
 CCP9     LDD    ST          RESET SEARCH ADDRESS
          STD    T6
          LDD    SS
          STD    T7
          SETMS  READSTR
          RJM    PDV         PROCESS DEVICE STATUS
          LDD    P3
          NJN    CCP9.1      IF PERMIT ENTRY FOUND
          LDM    FCCT,P2     CHECK FILE CATEGORY
          SHN    -6
          LMN    FCPR
          ZJP    CCPX        IF PRIVATE FILE
 CCP9.1   LJM    CCP12       CHECK PERMISSION MODE IN PERMIT OR PFC
 DFS      SPACE  4,15
**        DFS - DETERMINE FILE SIZE.
*
*         ENTRY  (P2) = ADDRESS OF CATALOG ENTRY.
*                (EQ) = MASTER DEVICE EST ORDINAL.
*
*         EXIT   LENGTH OF FILE SET IN CATALOG ENTRY.
*
*         USES   P3, SS, ST, CM - CM+4, T1 - T7.
*
*         CALLS  CTA, PDV, SDN, SEI.
*
*         MACROS ENDMS, SETMS.
 
 
 DFS2     ADD    T2
          ZJN    DFS3        IF ZERO LENGTH
 DFS2.1   SOM    FCLF+1,P2   DISCOUNT EOI
          PJN    DFS3        IF NO OVERFLOW
          AOM    FCLF+1,P2
          SOM    FCLF,P2
 DFS3     LDD    ST          RESTORE CATALOG TRACK/SECTOR/EQ
          STD    T6
          LDD    SS
          STD    T7
          LDD    T5
          LMD    EQ
          ZJN    DFSX        IF SAME DEVICE
          LDD    EQ          RESET MASTER DEVICE DRIVER
          STD    T5
          SETMS  READSTR
          RJM    PDV         PROCESS DEVICE STATUS
 
 DFS      SUBR               ENTRY/EXIT
          LDD    T6          SAVE CATALOG TRACK
          STD    ST
          LDD    T7          SAVE CATALOG SECTOR
          STD    SS
          LDM    FCLF,P2     CHECK LENGTH IN CATALOG
          ADM    FCLF+1,P2
          NJP    DFS2.1      IF FILE LENGTH ALREADY AVAILABLE
          ENDMS
          LDM    FCDN,P2     GET DEVICE NUMBER
          LPN    77
          STD    P3
          ZJN    DFS1        IF DA FILE ON MASTER DEVICE
          STD    CM
          LDM    PFPN+4
          RJM    SDN         SEARCH FOR DEVICE NUMBER
          PJN    DFS1        IF DEVICE FOUND
          LJM    DFS3        RETURN LENGTH OF ZERO
 
 DFS1     AOM    RBSA        ADVANCE DA FILE COUNT
          SETMS  STATUS
          LDD    CM+4        SET TRT ADDRESS
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH
          STM    SEIA+1
          SHN    -14
          LMC    ADCI
          STM    SEIA
          LDM    FCBT,P2     SET FIRST TRACK OF FILE
          STD    T6
          LDM    DFSA,P3     REQUEST TRT UPDATE IF FIRST FILE ON DEVICE
          RJM    SEI         GET FILE LENGTH
          AOM    DFSA,P3     PREVENT TRT UPDATE ON SUBSEQUENT FILES
          LDD    T2
          STM    FCLF,P2
          LDD    T3
          STM    FCLF+1,P2
          LJM    DFS2        DISCOUNT EOI
 
 
 DFSA     BSSZ   100B        TRT UPDATE FLAGS FOR EACH DEVICE IN FAMILY
 SPB      SPACE  4,10
**        SPB - SEARCH PERMIT BUFFER.
*
*         ENTRY  PERMIT BUFFER LOADED TO *BUFB*
*                (CM - CM+3) = USER NAME FOR SEARCH.
*
*         EXIT   (A) = 0 IF PERMIT NOT FOUND.
*                (T2) = INDEX TO PERMIT ENTRY, IF FOUND.
*
*         USES   T1, T2.
 
 
 SPB      SUBR               ENTRY/EXIT
 SPB1     LDN    NWPH        ADVANCE WORD COUNT PAST HEADER
          STD    T1
          LDC    BUFB+2      SET DATA ADDRESS
          ADN    NWPH*5
          STD    T2
 SPB2     LDD    CM
          ZJN    SPBX        IF NO USER NAME
          LMM    FPAN,T2     COMPARE USER NAME
          NJN    SPB3        IF NO MATCH
          LDM    FPAN+1,T2
          LMD    CM+1
          NJN    SPB3        IF NO MATCH
          LDM    FPAN+2,T2
          LMD    CM+2
          NJN    SPB3        IF NO MATCH
          LDM    FPAN+3,T2
          LMD    CM+3
          SCN    77
          ZJN    SPB5        IF USER FOUND
 SPB3     LDN    NWPE*5      ADVANCE TO NEXT ENTRY
          RAD    T2
          LDN    NWPE
          RAD    T1
          LMM    BUFB+1
          NJN    SPB2        IF NOT END OF BUFFER
          UJN    SPB6        EXIT
 
 SPB5     LCN    1           SET ENTRY FOUND EXIT
 SPB6     LJM    SPBX        RETURN
 CSA      SPACE  4,15
**        CSA - COMPUTE SECTOR ADDRESS.
*
*         ENTRY  (RI - RI+1) = RANDOM INDEX OF PERMIT SECTOR.
*                (DVLW - DVLW+4) = DEVICE LAYOUT WORD.
*                (A) = ADDRESS OF FILE NAME IF NAME NOT
*                IN FN - FN+3 OTHERWISE (A) = 0.
*
*         EXIT   (T6) = TRACK OF RANDOM SECTOR
*                (T7) = SECTOR OF RANDOM SECTOR.
*
*         USES   T6, T7, RI - RI+1.
*
*         CALLS  CRA, PDV.
*
*         MACROS ENDMS, ERROR, SETMS.
 
 
 CSA2     SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
 
 CSA      SUBR               ENTRY/EXIT
          STM    CSAA
          STM    CSAB
          LDM    DVLW+2      SET FIRST TRACK IN PERMIT CHAIN
          STD    T6
          ENDMS
          LDN    0           SET TRT UPDATE REQUESTED
          RJM    CRA         COVERT RANDOM ADDRESS
          PJN    CSA2        IF NO ERROR
 
*         PROCESS ERROR IN RANDOM INDEX.
 
          LDC    **
 CSAA     EQU    *-1
          ZJN    CSA1        IF NO NAME TO COPY
          LDD    MA          COPY FILE NAME
          CWM    *,ON
 CSAB     EQU    *-1
          SBN    1
          CRD    FN
 CSA1     ERROR  RIN,,IW,EQ  *EQXXX,DNYY, RANDOM INDEX ERROR.*
 PCA      SPACE  4,15
**        PCA - PROCESS CATALOG ADDRESS ACCESS MODE.
*
*         ENTRY  (IN - IN+1) = CURRENT POSITION IN FET.
*                (T1) = OUTPUT ENTRY LENGTH FOR CATALOG AND *PFID*.
*                (T2) = *PFC* ENTRY POINTER.
*                (CATA) = SEARCH MODE.
*                (CATB) = MASTER DEVICE NUMBER.
*                (WDBB) = CURRENT CATALOG TRACK.
*                (WDBC) = CURRENT CATALOG SECTOR.
*                BUFA+2 = BEGINNING OF CATALOG SECTOR BUFFER.
*
*         EXIT   (T1) = DECREMENTED BY ONE FOR *PFID*.
*                *PFID* WRITTEN TO CENTRAL USER BUFFER.
 
 
 PCA      SUBR               ENTRY/EXIT
          LDM    CATA        CHECK SEARCH MODE
          LMN    CTID
          NJN    PCAX        IF NOT *PFID* ACCESS
 
*         SETUP *PFID* FOR OUTPUT.
 
          LDM    WDBC        SET CATALOG SECTOR ADDRESS
          STM    PCAA+4
          LDM    WDBB        SET CATALOG TRACK ADDRESS
          STM    PCAA+3
          LDD    T2          SET *PEO* VALUE
          ADC    -BUFA-2
          SHN    -NWCES      CALCULATE *PEO* VALUE
          LPN    1S"NWCEM"-1
          SHN    6
          LMM    CATB        SET MASTER DEVICE NUMBER
          STM    PCAA+2
 
*         WRITE *PFID* TO CENTRAL BUFFER.
 
          LDD    IN          FORM DESTINATION ADDRESS
          SHN    6
          ADD    RA
          SHN    6
          ADD    IN+1
          ADN    NWCE        OFFSET FOR *PFC* ENTRY
          CWM    PCAA,ON     WRITE *PFID*
          SOD    T1          ADJUST OUTPUT LENGTH
          LJM    PCAX        RETURN
 
 PCAA     CON    0,0,0,0,0   *PFID* BUFFER
          SPACE  4,10
*         COMMON DECKS.
 
 
 CRA$     SET    0           FORCE TRT UPDATE ON *CRA* CALLS
*CALL     COMPCRA
*CALL     COMPSRA
 SEI$     SET    0           FORCE TRT UPDATE ON *SEI* CALLS
*CALL     COMPSEI
*CALL     COMPRNS
*CALL     COMPSDN
          SPACE  4,10
*         BUFFERS
 
 
 BUFA     EQU    *           CATALOG BUFFER
 BUFB     EQU    BUFA+502    PERMIT BUFFER
          ERRNG  EPFW-BUFB-502  BUFFER OVERFLOW
          TITLE  OVERLAYABLE SUBROUTINES.
 CSU      SPACE  4,10
**        CSU - CHECK FOR SPECIAL USER.
*
*         ENTRY  USER NAME WORD (UIDW) SET.
*                (PFOU - PFOU+3) = USER NAME FROM CALL BLOCK.
*
*         EXIT   (UI - UI+1) CLEARED IF SPECIAL USER.
*
*         USES   T1, T2, CM - CM+4.
 
 
 CSU      SUBR               ENTRY/EXIT
          LDD    CP          GET USER USER NAME
          ADN    UIDW
          CRD    CM
          LDD    CM+3        CLEAR LOWER USER NAME
          SCN    77
          STD    CM+3
          LDN    0           INITIALIZE COUNT
          STD    T1
 CSU1     AOD    T1          ADVANCE BYTE
          LMN    5
          ZJN    CSU3        IF END OF USER NAME
          LDM    CM-1,T1     USER NAME BYTE
          STD    T2
          LMC    2R**
          ZJN    CSU1        IF ** SKIP COMPARE OF CHARACTERS
          SCN    77
          ZJN    CSU2        IF UPPER CHARACTER *
          LDD    T2          COMPARE UPPER CHARACTER
          LMM    PFOU-1,T1
          SCN    77
          NJN    CSUX        IF USER NAME DO NOT MATCH
          LDD    T2          CHECK LOWER CHARACTER
          LMN    1R*
          LPN    77
          ZJN    CSU1        IF LOWER CHARACTER = *
 CSU2     LDD    T2          COMPARE LOWER CHARACTER
          LMM    PFOU-1,T1
          LPN    77
          ZJN    CSU1        IF LOWER CHARACTER COMPARE
          UJN    CSU4        USER NAMES DO NOT MATCH
 
 CSU3     STD    UI          CLEAR USER INDEX
          STD    UI+1
          LDN    CTNC        SET MODE TO NORMAL CATALOG SEARCH
          STM    CATA
 CSU4     LJM    CSUX        EXIT
 ISP      SPACE  4,20
**        ISP - INITIALIZE SEARCH OF PERMANENT FILES.
*
*         ENTRY  (SFAA - SFAA+1) = CALL BLOCK ADDRESS.
*                (UI - UI+1) = USER INDEX.
*
*         EXIT   (T5) = (EQ) = MASTER DEVICE EST ORDINAL.
*                (T6) = CATALOG TRACK.
*                (T7) = CATALOG SECTOR.
*                (SI) = SEARCH INDEX.
*                (CF) = CONTINUATION FLAG.
*                (DVLW - DVLW+4) = DEVICE LAYOUT WORD.
*                (CATB) = MASTER DEVICE NUMBER.
*                *SETMS IO* PERFORMED.
*
*         USES   T4 - T7, RI - RI+1, CM - CM+4.
*
*         CALLS  CRA, CTA, PDV, SCA, SFA.
*
*         MACROS ERROR, SETMS.
 
 
 ISP      SUBR               ENTRY/EXIT
 
*         INITIALIZE CATALOG SEARCH.
 
          LDN    0           SELECT NO INTERLOCK OF CATALOG TRACK
          STD    T1
          LDC    PFPN        SET CATALOG ADDRESS
          RJM    SCA
          PJN    ISP1        IF DEVICE AVAILABLE
          ERROR  PFN,CH,IW   *PERMANENT FILES NOT AVAILABLE.*
 
 ISP1     SHN    3           READ DEVICE LAYOUT WORD
          ADN    ALGL
          CRM    DVLW,ON
          ADN    PUGL-ALGL-1 READ USER NAME
          CRD    CM
          SBN    PUGL-PFGL   GET DEVICE NUMBER FOR MASTER DEVICE
          CRD    FN
          LDD    FN+3        PRESERVE DEVICE NUMBER
          LPN    77
          STM    CATB
          LDM    PFSR
          LPN    77
          ZJN    ISP3        IF NO SPECIAL REQUESTS
          SBN    SRDN
          NJN    ISP3        IF NOT DEVICE NUMBER LIST
          LDD    FN+3        CHECK DEVICE NUMBER
          LMM    CTDN
          LPN    77
          ZJN    ISP2        IF MASTER DEVICE
          LDM    CTDN
          LPN    77
          ZJN    ISP3        IF DEVICE NUMBER NOT SPECIFIED
 ISP2     STD    DN
          LDN    PSNI        ENABLE DEVICE NUMBER SEARCH
          STM    SHBE
 ISP3     LDM    PFPN
          ZJN    ISP4        IF NOT AUXILIARY DEVICE
          LDD    CM
          ZJN    ISP4        IF NOT PRIVATE DEVICE
          LDC    UJNI+SHB4-SHBA SET TO BYPASS USER INDEX CHECK
          STM    SHBA
 
 ISP4     LDN    IPCS        PF INCREMENT OF CATALOG SEARCH
          RAM    AIPF+1
          LDD    T5          SET MASTER DEVICE EST ORDINAL
          STD    EQ
          SETMS  READSTR
          RJM    PDV         PROCESS DEVICE STATUS
          LDN    0           SET SECTOR
          STD    T7
          STD    SI          CLEAR SEARCH INDEX
          LDD    CM+4        SET FWA OF TRT
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH          SET *ADC  TRTS-(4000/2)*
          STM    CRAA+1      COMMON DECK -COMPCRA-
          STM    SRAA+1      COMMON DECK -COMPSRA-
          SHN    -14
          LMC    ADCI
          STM    CRAA        COMMON DECK -COMPCRA-
          STM    SRAA        COMMON DECK -COMPSRA-
          LDD    MA          SET FILE NAME IF SPECIFIED
          CWM    PFFN,ON
          SBN    1
          CRD    FN
          RJM    SFA         SET FET ADDRESS
          ADN    CFCN        CONTINUATION CATALOG DATA ADDRESS
          CRD    CM
          LDD    CM+2
          SCN    77
          ADD    CM
          ADD    CM+1
          STD    CF          SET CONTINUATION FLAG
          NJN    ISP5        IF CONTINUATION
          LJM    ISP10       CHECK FET REQUEST POINTERS
 
 ISP5     LDD    CM          RESTORE SEARCH INDEX
          SHN    14
          STD    SI
          SCN    77
          ADD    CM+1        SET UPPER 12 BITS OF RANDOM INDEX
          SHN    14
          STD    RI
          LMD    RI
          ADD    CM+2
          SHN    -6
          STD    RI+1
          LDM    CATA        CHECK REQUEST TYPE
          LMN    CTPM
          NJN    ISP6        IF NOT PERMIT REQUEST
          LDN    NWPE-1      SET MASK FOR SEARCH INDEX
          STM    ISPB
          AOM    ISPC        SET PERMIT SEARCH STATUS
          AOM    ISPD
          AOM    ISPE
 ISP6     LDD    SI          VALIDATE SEARCH INDEX
          LPC    NWCE-1
*         LPC    NWPE-1      (PERMIT SEARCH)
 ISPB     EQU    *-1
          NJN    ISP7        IF INCORRECT SEARCH INDEX
          LDM    DVLW+1      SET LABEL TRACK
*         LDM    DVLW+2      (SET PERMIT TRACK)
 ISPC     EQU    *-1
          STD    T6
          LDN    0           REQUEST TRT UPDATE
          RJM    CRA         CALCULATE RANDOM ADDRESS
          MJN    ISP7        IF ERROR IN CONVERSION
          LDD    T6          CHECK FOR INDEX INTO LABEL/PERMITS TRACK
          LMM    DVLW+1
*         LMM    DVLW+2      (PERMIT SEARCH)
 ISPD     EQU    *-1
          NJN    ISP10       IF LEGAL RANDOM INDEX
 ISPE     LDN    0
*         LDN    1           (PERMIT SEARCH)
          NJN    ISP9        IF PERMIT SEARCH
 ISP7     ERROR  ECD,CH,IW   * ERROR IN CATLIST CONTINUATION DATA.*
 
 ISP9     LDD    T7
          SBN    1
          MJN    ISP7        IF INCORRECT INDEX ON PERMIT SEARCH
 ISP10    RJM    SFA         CHECK FET POINTERS
          ADN    4           READ LIMIT
          CRD    LM-3
          SBN    2           READ IN
          CRD    IN-3
          LDD    IN
          LPN    77
          STD    IN
          LDD    LM          CHECK BUFFER LENGTH
          LPN    77
          STD    LM
          SBD    IN
          MJN    ISP11       IF IN GREATER THAN LIMIT
          SHN    14
          ADD    LM+1
          SBD    IN+1
          SBN    1           MUST HAVE ROOM FOR 1 ENTRY
          MJN    ISP11       IF NOT LARGE ENOUGH FOR 1 ENTRY
          LDD    LM          CHECK POINTERS WITHIN FL
          SHN    14
          ADD    LM+1
          SBN    1
          SHN    -6
          SBD    FL
          PJN    ISP11       IF LIMIT PAST FL
          LJM    ISPX        RETURN
 
 ISP11    ERROR  ILR,CH,IW   * PFM INCORRECT REQUEST.*
 
 ISPA     DATA   C*CATALOG*
          SPACE  4,10
*CALL     COMPSCA
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLA,EPFW  OVERFLOW INTO ERROR PROCESSING AREA
          OVERLAY  (DEFINE/SETDA PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES THE DIRECT ACCESS FILE COMMANDS
*         *DEFINE* AND *SETDA*.  THE DEVICE OF RESIDENCE HAS
*         ALREADY BEEN DETERMINED/VALIDATED BY OVERLAY *3PB*.
 
 
 OVL      BSS    0           ENTRY
          LJM    0,P0        PROCESS COMMAND
          TITLE  COMMAND PROCESSING.
 SDA      SPACE  4,10
***       PROCESS *SETDA* REQUEST.
*
*         SET THE DISK ADDRESS OF *FILE NAME* INTO THE CATALOG
*         ENTRY OF THE FILE SPECIFIED BY *PFID*.
 
 
 SDA      BSS    0           ENTRY
          LDM    FCBS,CI
          SHN    21-13
          PJN    SDA1        IF NOT DIRECT ACCESS FILE
          LDM    FCBT,CI
          ZJN    SDA2        IF NO CURRENT DISK ADDRESS IN CATALOG
 SDA1     ERROR  ICU         *INCORRECT CATALOG UPDATE.*
 
 SDA2     LDM    PFDN        SET DEVICE NUMBER
          STM    FCDN,CI
          LDD    FS+1        SET FIRST TRACK
          STM    FCBT,CI
          LDD    LF          SET FILE LENGTH
          STM    FCLF,CI
          LDD    LF+1
          STM    FCLF+1,CI
          LDM    STAT
          LPK    STTA
          NJN    SDA3        IF TAPE ALTERNATE STORAGE REQUEST
          LDM    FCAF,CI     CLEAR *AFPDR*, *AFTMP* AND *AFVER* FLAGS
          SCN    AFPDRM+AFTMPM+AFVERM
          STM    FCAF,CI
          UJN    SDA4        UPDATE SYSTEM SECTOR
 
 SDA3     LDM    FCTF,CI     CLEAR *TFVER* FLAG
          SCN    TFVERM
          STM    FCTF,CI
 
*         ENTER *DEFINE* PROCESSING TO UPDATE SYSTEM SECTOR.
 
 SDA4     LCN    EP-CI       SET ADDRESS OF CATALOG ENTRY POINTER
          RAM    DEFA
          LDC    MMPF*5+2*5-1  CLEAR ONLY PART OF SYSTEM SECTOR
          STM    DEFB
          LDC    CASS
          STM    DEFC
          LJM    DEF2        PROCESS SYSTEM SECTOR
 DEF      SPACE  4,10
***       PROCESS *DEFINE* REQUEST.
*
*         MAKE THE FILE *FILE NAME* A DIRECT ACCESS PERMANENT FILE
*         WITH NAME *PF NAME*.
 
 
 DEF      BSS    0           ENTRY
          EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          LDN    PSNI        BYPASS ALLOCATION OF IDLE SPACE
          STM    CCSB
          STM    CCSB+1
          STM    CCSC        FORCE CATALOG ENTRY FORMATION
          STM    CCSF        BYPASS WRITING CATALOG ENTRY TO DISK
          STM    CCSF+1
          STM    CCSG        BYPASS WRITING CATALOG ENTRY TO DISK
          STM    CCSG+1
          RJM    CUC         CHECK USER CONTROLS
          LDM    PFDN        SET DEVICE NUMBER IN CATALOG ENTRY
          STM    FCEE
          LDN    0           CLEAR FILE LENGTH
          STD    LF
          STD    LF+1
          RJM    CCS         CREATE CATALOG SECTOR
          ENDMS
 
*         PROCESS SYSTEM SECTOR.
 
 DEF2     LDD    FS
          STD    T5
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDD    CM+4        PRESET *COMPSEI*
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH
          STM    SEIA+1
          SHN    -14
          LMC    ADCI
          STM    SEIA
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDM    LFEF
          ZJN    DEF3        IF NOT EMPTY FILE
          LJM    DEF7        PROCESS EMPTY FILE
 
*         CHECK ENHANCED EOI DATA.
 
 DEF3     LDN    SSTL        CHECK FILE VALIDATION ENABLED
          CRD    CM
          LDD    CM
          SHN    21-4
          MJN    DEF4        IF VALIDATION NOT ENABLED
          RJM    SEI         READ EOI SECTOR
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BFMS
          RJM    RDS
          MJN    DEF5        IF READ ERROR
          LDD    FS+1        RESET FIRST TRACK
          STD    T6
          LMM    BFMS+FTEI   CHECK FIRST TRACK POINTER
          ADM    BFMS        CHECK LINKAGE BYTES
          ADM    BFMS+1
          ZJN    DEF4        IF EOI SECTOR AND IF BOI POINTER MATCHES
          ERROR  FSE,,,FS    *EQXXX,DNYY, FILE BOI/EOI/UI MISMATCH.*
 
 DEF4     LDN    0           IGNORE FILE NAME
          RJM    RSS         READ SYSTEM SECTOR
          ZJN    DEF7        IF LEGAL SYSTEM SECTOR
          MJN    DEF5        IF READ ERROR
          ERROR  DAF,,,FS    *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
 
 DEF5     RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,CH,,FS  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
*         CLEAR SYSTEM SECTOR BUFFER.
 
 DEF7     ENDMS
          LDC    77*5-1      CLEAR ENTIRE SYSTEM SECTOR
*         LDC    MMPF*5+2*5-1  (*SETDA* - CLEAR ONLY PART OF SECTOR)
 DEFB     EQU    *-1
          STD    T1
 DEF8     LDN    0
          STM    BFMS+2,T1
*         STM    CASS,T1     (*SETDA*)
 DEFC     EQU    *-1
          SOD    T1
          PJN    DEF8        IF NOT END OF BUFFER
 
*         ENTER CATALOG ENTRY INTO SYSTEM SECTOR.
 
 DEFA     LDD    EP          ADDRESS OF CATALOG ENTRY
*         LDD    CI          (IF *SETDA* REQUEST)
          STD    T1
          LDC    CTSS        ADDRESS IN SYSTEM SECTOR
          STD    T2
          LDC    NWCE*5
          STD    T3
 DEF9     LDI    T1          TRANSFER ENTRY
          STI    T2
          AOD    T1
          AOD    T2
          SOD    T3          DECREMENT BYTE COUNT
          NJN    DEF9        IF MORE STATUS IN SYSTEM SECTOR
 
*         INITIALIZE SYSTEM SECTOR FIELDS.
 
          LDN    32          SET CURRENT ACCESS TO WRITE
          STM    CASS
          RJM    SUC         SET USER COUNTS IN SYSTEM SECTOR
          ENDMS
          LDN    PDTL        SET CURRENT DATE AND TIME
          CRM    WDSS,ON
          LDK    MMFL        GET MAINFRAME ID
          CRD    CM
          LDD    CM          SET MAINFRAME ID
          STM    WDSS
          LDD    CP          GET EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      SET *JSNE* WORD OF EJT
          ADK    JSNE
          CRM    WJSS,ON
          LDD    FA          SET FNT ENTRY IN SYSTEM SECTOR
          STM    DEFD
          NFA    FA,R
          ADK    FNTL
          CRM    FNSS,ON
          LDN    0           CLEAR FST POINTER
          STD    FA
          LDM    FNSS+4      CHECK FILE TYPE
          SHN    -6
          LMN    PMFT
          ZJN    DEF10       IF FILE CREATED BY *ASSIGNPF*
          LDC    PMFT*100    SET PMFT
          STM    FNSS+4
          AOM    DEFE        FORCE INCREMENT OF FILE COUNT
 
*         WRITE SYSTEM SECTOR.
 
 DEF10    SETMS  IO,RW,BFMS
          RJM    PDV         PROCESS DEVICE STATUS
          LDM    LFEF
          ZJN    DEF11       IF NOT EMPTY FILE
          SETMS  IO,,BFMS
          RJM    PDV         PROCESS DEVICE STATUS
          LDN    WCSF/10000&WLSF/10000  WRITE CONSECUTIVE SECTORS
 DEF11    LMC    LDCI+WLSF/10000
          STM    WSSA
          RJM    WSS         WRITE SYSTEM SECTOR
          MJN    DEF11.1     IF WRITE ERROR
          LDM    LFEF
          ZJN    DEF13       IF NOT EMPTY FILE
          RJM    WEI         WRITE EOI SECTOR
          PJN    DEF12       IF NO MASS STORAGE ERRORS
 DEF11.1  LJM    WSE         PROCESS WRITE ERROR
 
 DEF12    ENDMS
          LDD    FS+1        SET FILE STATUS REWOUND
          STD    FS+2
          LDN    FSMS
          STD    FS+3
          LDN    4           SET OPERATION COMPLETE - FILE BUSY
          STD    FS+4
          LDN    FSMS        SET LAST SECTOR WRITTEN
          RJM    DTK
 DEF13    ENDMS
          LDN    SPFS        SET PRESERVED STATUS FOR DA FILE
          STD    CM+3
          LDD    T5
          LMC    4000        SET CHECKPOINT
          STD    CM+1
          LDD    T6
          STD    CM+2
          MONITOR STBM
          LDD    FS+1        SAVE PRESERVED TRACK
          STM    PTKT
 
*         WRITE CATALOG ENTRY TO DISK.
 
          LDD    EQ          SET MASTER EST ORDINAL
          STD    T5
          LDD    CC
          LMN    CCDF
          ZJN    DEF14       IF *DEFINE* REQUEST
          LDD    CB
          UJN    DEF15       WRITE CATALOG ENTRY TO DISK
 
 DEF14    LDD    EB
 DEF15    RJM    WBI         WRITE CATALOG ENTRY TO DISK
          ENDMS
*         LDN    0           CLEAR PRESERVED TRACK
          STM    PTKT
          RJM    CCI         CLEAR CATALOG INTERLOCK
 
*         UPDATE FNT ENTRY.
 
          LDC    *           READ FNT
 DEFD     EQU    *-1
          STD    FA
          NFA    FA,R
          ADK    FNTL
          CRD    FN
          ADN    FUTL-FNTL
          CRD    CM
          LDD    FN+4        SET *PMFT* FILE TYPE
          LPN    77
          ADC    PMFT*100
          STD    FN+4
          LDD    FN+3        CLEAR MODE BITS
          SCN    77
          STD    FN+3
          LDM    PFUC        SET *FS* INDEX IN *FUTL* WORD
          SHN    -11
          SHN    6
          ADM    LFAL        SET FILE ACCESS LEVEL
          STD    CM+2
          NFA    FA,R
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CWD    FS
          ADN    FUTL-FSTL
          CWD    CM
 
*         INCREMENT FILE COUNT (IF REQUIRED).
 
 DEFE     LDN    0
*         LDN    1           (FILE COUNT INCREMENT REQUIRED)
          ZJN    DEF16       IF FILE COUNT ALREADY INCREMENTED
          LDD    FS          INCREMENT FILE COUNT
          STD    CM+1
          LDN    IUCS
          STD    CM+3
          MONITOR  SMDM
 DEF16    LDD    CC
          LMN    CCDF
          ZJN    DEF17       IF *DEFINE* REQUEST
 
*         RETURN LOCAL FILE (*SETDA*).
 
          LDN    0           RETURN FILE
          STM    LOCF-1
          EXECUTE  0DF,LOCF
 DEF17    EXECUTE  3PU       TERMINATE PROGRAM
 LOCF     SPACE  4,10
 LOCF     EQU    *+5         *0DF* LOAD ADDRESS
          ERRNG  BFMS-LOCF-ZDFL        CHECK LENGTH OF *0DF*
          TITLE  SUBROUTINES.
 CUC      SPACE  4,15
**        CUC - CHECK USER CONTROLS.
*
*         ENTRY  (MXNF) = NUMBER OF FILES ALLOWED.
*                (ACNF - ACNF+1) NUMBER OF FILES ACCUMULATED.
*                (MXDS - MXDS+1) MAXIMUM DIRECT ACCESS FILE SIZE.
*
*         MACROS ERROR.
 
 
 CUC      SUBR               ENTRY/EXIT
          LDM    MXDS        CHECK FILE SIZE LIMIT
          ADM    MXDS+1
          ZJN    CUC2        IF UNLIMITED ACCESS
          LDM    MXDS        CHECK SIZE LIMITS
          SBD    LF
          MJN    CUC1        IF LIMIT EXCEEDED
          NJN    CUC2        IF LIMIT NOT EXCEEDED
          LDM    MXDS+1
          SBD    LF+1
          PJN    CUC2        IF LIMIT NOT EXCEEDED
 CUC1     ERROR  FTL         * FILE TOO LONG.*
 
 CUC2     LDM    MXNF        CHECK FILE NUMBER LIMIT
          ZJN    CUCX        IF NO LIMIT SET
          LDD    NF
          SHN    14
          ADD    NF+1
          ADN    10          ROUND UP
          SHN    -3
          SBM    MXNF
          MJN    CUCX        IF LIMIT NOT EXCEEDED
          ZJN    CUCX        IF LIMIT NOT EXCEEDED
          ERROR  COF         * TOO MANY PERMANENT FILES.*
 SUC      SPACE  4,10
**        SUC - SET USER COUNTS IN SYSTEM SECTOR.
*
*         ENTRY  (BFMS - BFMS+500) - SYSTEM SECTOR.
*                (T5) = EST ORDINAL.
*
*         EXIT   LOCAL WRITE FLAG SET.
*
*         USES   T7.
*
*         CALLS  SMI.
 
 
 SUC      SUBR               ENTRY/EXIT
          RJM    SMI         COMPUTE LOCAL USER COUNT BASE ADDRESS
          STD    T0
          SHN    2
          ADD    T0
          ADC    UCSS
          STD    T7
          AOI    T7
          UJN    SUCX        RETURN
 WSE      SPACE  4,20
**        WSE - WRITE MASS STORAGE ERROR PROCESSOR.
*
*         ENTRY  (FS - FS+4) = LOCAL FILE FST.
*                (LFEF) = 0 IF LOCAL FILE WRITTEN PREVIOUSLY.
*                (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
*                (RDCT) = DRIVER STATUS.
*
*         EXIT   (PWRF) = *RFRR* FLAG SET IF REQUEST TO BE RETRIED
*                         DUE TO UNRECOVERABLE WRITE ERROR.
*                (RTKT) = RESERVED TRACK TO BE RELEASED IF REQUEST
*                         TO BE RETRIED.
*                TO *ERR* TO RETRY REQUEST OR ISSUE ERROR MESSAGE.
*
*         CALLS  PES.
*
*         MACROS ERROR.
 
 
 WSE      BSS    0           ENTRY
          LDM    LFEF
          ZJN    WSE2        IF FILE WRITTEN PREVIOUSLY
          LDM    RDCT        DRIVER STATUS
          SHN    21-12
          PJN    WSE1        IF RECOVERABLE ERROR
          LDM    PWRF        CHECK RESTART FLAGS
          LPK    RFRR
          NJN    WSE3        IF REQUEST ALREADY RETRIED
          LDK    RFRR        SET RETRY REQUEST FLAG
          RAM    PWRF
 WSE1     LDD    FS+1        SET RESERVED TRACK TO BE RELEASED
          STM    RTKT
          ERROR  RTR,CH      RETRY REQUEST
 
 WSE2     RJM    PES         PROCESS ERROR STATUS
 WSE3     ERROR  MSE,CH,,FS  *EQXXX,DNYY, MASS STORAGE ERROR.*
          SPACE  4,10
*         COMMON DECKS.
 
 
 EJT$     SET    0           DEFINE EJT ACCESS
*CALL     COMPGFP
*CALL     COMPRSS
*CALL     COMPSMI
*CALL     COMPWEI
*CALL     COMPWSS
          SPACE  4,10
*         CHECK OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF1-2  OVERFLOW INTO CATALOG BUFFER
          OVERLAY  (DROPDS/PURGE PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES THE COMMANDS *DROPDS* AND *PURGE*.
 
 
 OVL      BSS    0           ENTRY
          LDD    EQ          RESET MASTER DEVICE EST ORDINAL
          STD    T5
          LJM    0,P0        PROCESS COMMAND
          TITLE  COMMAND PROCESSING.
 DDS      SPACE  4,10
***       PROCESS *DROPDS* REQUEST.
*
*         DROP DISK SPACE FOR DIRECT ACCESS FILE.
 
 
 DDS      BSS    0           ENTRY
 
*         CHECK FOR CARTRIDGE ALTERNATE STORAGE COPY OF FILE.
 
          LDM    FCAA,CI
          ADM    FCAA+1,CI
          ADM    FCAA+2,CI
          ZJN    DDS1        IF NO CARTRIDGE ALTERNATE STORAGE COPY
          LDM    FCAF,CI
          LPN    AFOBSM
          NJN    DDS1        IF COPY OBSOLETE
          LDM    FCAF,CI
          LPN    AFPDEM+AFPSEM
          ZJN    DDS2        IF NO ERROR FLAGS SET
          AOM    DDSA        SET *ERROR FLAG DETECTED* FLAG
 
*         CHECK FOR TAPE ALTERNATE STORAGE COPY OF FILE.
 
 DDS1     LDM    FCTV,CI
          ADM    FCTV+1,CI
          ZJN    DDS1.2      IF NO TAPE ALTERNATE STORAGE COPY OF FILE
          LDM    FCTF,CI     CHECK FOR ERRORS ON PRIMARY VSN
          LPK    TFPVNM+TFEPVM
          ZJN    DDS2        IF NO ERRORS ON PRIMARY VSN
          AOM    DDSA        SET *ERROR FLAG DETECTED* FLAG
          LDM    FCTF,CI
          LPK    TFSVSM
          ZJN    DDS1.2      IF NO SECONDARY VSN COPY OF FILE
          LDM    FCTF,CI
          LPK    TFSVNM+TFESVM
          ZJN    DDS2        IF NO ERRORS ON SECONDARY VSN
 
 DDS1.1   ERROR  ASE         * ALTERNATE STORAGE ERROR.*
 
 DDS1.2   LDN    0           CHECK FOR ERRORS
*         LDN    1           (ALTERNATE STORAGE ERROR DETECTED)
 DDSA     EQU    *-1
          NJN    DDS1.1      IF ALTERNATE STORAGE ERRORS DETECTED
          ERROR  AIO         * NO ALTERNATE STORAGE COPY OF FILE.*
 
*         RELEASE DISK SPACE FOR FILE.
 
 DDS2     RJM    SCP         SAVE CATALOG PARAMETERS
          LDN    0           CLEAR DISK ADDRESS
          STM    FCBT,CI
          LDM    FCDN,CI     SAVE DEVICE NUMBER
          STM    SDDA+1
          LDC    LDCI
          STM    SDDA
          LDN    0           CLEAR DN AND DISK-RELATED ERRORS
          STM    FCEC,CI
          ERRNZ  FCDN-FCEC   CODE DEPENDS ON VALUE
          LDM    FCLF,CI     CHECK IF LENGTH IS SET IN PFC
          ADM    FCLF+1,CI
          NJN    DDS3        IF LENGTH PRESENT
          AOM    DDFA        FORCE LENGTH CALCULATION
          AOM    DDFD
 DDS3     RJM    DDF         DELETE DIRECT ACCESS FILE
          LJM    TRP         TERMINATE PROGRAM
 PUR      SPACE  4,10
***       PROCESS *PURGE* REQUEST.
*
*         REMOVE PERMANENT FILE *PF NAME* FROM PERMANENT FILE SYSTEM.
*
*         AN INDIRECT ACCESS FILE WHICH DOES NOT HAVE A DISK RESIDENT
*         COPY IS TREATED THE SAME AS A DIRECT ACCESS FILE WHICH
*         DOES NOT HAVE A DISK IMAGE.
 
 
 PUR      BSS    0           ENTRY
          LDM    FCBS,CI
          SHN    6
          MJP    PUR2        IF DIRECT ACCESS FILE
          LDM    FCBT,CI     CHECK IF DISK RESIDENT
          NJN    PUR1        IF DISK RESIDENT INDIRECT ACCESS FILE
          LDC    4000        MARK ENTRY AS DAPF HOLE
          STM    FCBS,CI
          UJN    PUR2        PROCESS AS IF DIRECT ACCESS FILE
 
 PUR1     EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          RJM    IIA         INTERLOCK INDIRECT ALLOCATION
          LDK    STNS        SET *NO JOB SUSPENSION* AFTER THIS POINT
          RAM    STAT
          RJM    DCE         RELEASE IAPF FILE SPACE
          ZJN    PUR1.1      IF FILE WITHIN CHAIN AND NO DELINK
          RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          UJN    TRP         TERMINATE PROGRAM
 
 PUR1.1   RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          LDD    CB          REWRITE CATALOG ENTRY
          RJM    WBI
          ENDMS
          UJN    TRP         TERMINATE PROGRAM
 
 PUR2     RJM    SCP         SAVE CATALOG PARAMETERS
          LDN    0           CLEAR FILE LENGTH
          STM    FCLF,CI
          STM    FCLF+1,CI
          STM    FCUI+1,CI   CLEAR USER INDEX
          LDM    FCUI,CI
          SCN    77
          STM    FCUI,CI
          RJM    DDF         DELETE DIRECT ACCESS FILE
          UJN    TRP         TERMINATE PROGRAM
          SPACE  4,10
**        TRP - TERMINATE PROGRAM.
 
 
 TRP      EXECUTE  3PU       TERMINATE PROGRAM
          TITLE  SUBROUTINES.
 DDF      SPACE  4,10
**        DDF - DELETE DIRECT ACCESS FILE.
*
*         READ SYSTEM SECTOR AND EITHER PURGE FILE OR SET PURGE
*         STATUS IN SYSTEM SECTOR (IF FILE CURRENTLY ACTIVE).
*         RELEASE THE CATALOG ENTRY FOR THE FILE.
*
*         CALLS  CTA, CTI, ITC, PDV, RDS, RSS, SDD, SEI, WCB, WSS.
*
*         MACROS ENDMS, ERROR, SETMS, SFA.
 
 
 DDF      SUBR               ENTRY/EXIT
          RJM    SDD         SEARCH FOR DIRECT ACCESS DEVICE
          ZJN    DDF1        IF DEVICE FOUND
          RJM    WCB         REWRITE CATALOG BUFFER
          ERROR  DAD,CH,IW   * DIRECT ACCESS DEVICE ERROR.*
 
*         PERFORM BOI/EOI VALIDATION.
 
 DDF1     LDM    PFFT        FIRST TRACK
          NJN    DDF2        IF FILE DISK RESIDENT
          RJM    WCB         REWRITE CATALOG BUFFER
          UJN    DDFX        RETURN
 
 DDF2     RJM    ITC         INTERLOCK TRACK CHAIN FOR FILE
          ZJN    DDF3        IF INTERLOCK SUCCESSFUL
          RJM    WCB         REWRITE CATALOG BUFFER
          EXIT   TNR,CH,IW,T5,EC7  *EQXXX,DNYY, TRACK NOT RESERVED.*
 
 DDF3     AOM    DAIF        SET INTERLOCK FLAG
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDN    SSTL        CHECK FILE VALIDATION ENABLED
          CRD    CM
          LDD    CM
          LPN    20
          LMN    20
          STM    DDFE+1      SAVE VALIDATION VALUE
          NJN    DDF3.1      IF VALIDATION ENABLED
 DDFA     LDN    0
*         LDN    1           (LENGTH UPDATE REQUIRED)
          NJN    DDF3.1      IF LENGTH UPDATE REQUIRED
          LJM    DDF4        SKIP VALIDATION
 
 DDF3.1   SFA    EST,T5      GET EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM+4        SETUP *COMPSEI*
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH
          STM    SEIA+1
          SHN    -14
          LMC    ADCI
          STM    SEIA
          RJM    SEI         POSITION TO EOI SECTOR
 DDFD     LDN    0
*         LDN    1           (LENGTH UPDATE REQUIRED)
          ZJN    DDF3.2      IF LENGTH UPDATE NOT REQUIRED
          LDD    T2          SET LENGTH IN PFC
          STM    FCLF,CI
          LDD    T3
          STM    FCLF+1,CI
 DDFE     LDC    0
*         LDC    20          (VALIDATION REQUIRED)
          ZJN    DDF4        IF VALIDATION NOT REQUIRED
 
 DDF3.2   SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BFMS
          RJM    RDS
          MJN    DDF6        IF READ ERROR
          LDM    PFFT        RESET FIRST TRACK
          STD    T6
          LMM    BFMS+FTEI   CHECK FIRST TRACK POINTER
          ADM    BFMS        CHECK LINKAGE BYTES
          ADM    BFMS+1
 DDF4     ZJN    DDF5        IF EOI SECTOR AND IF BOI POINTER MATCHES
          LJM    DDF10       PROCESS BOI/EOI ERROR
 
*         READ SYSTEM SECTOR.
 
 DDF5     LDN    0           IGNORE FILE NAME
          RJM    RSS
          ZJN    DDF8        IF LEGAL SYSTEM SECTOR
          MJN    DDF6        IF READ ERROR
          RJM    WCB         REWRITE CATALOG BUFFER
          EXIT   DAF,CH,IW,T5,EC7  *EQXXX,DNYY,DIRECT ACCESS FILE ERROR*
 
 DDF6     RJM    PES         PROCESS ERROR STATUS
          RJM    WCB         REWRITE CATALOG BUFFER
          EXIT   MSE,CH,IW,T5,EC7  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
*         VALIDATE SYSTEM SECTOR.
 
 DDF8     LDM    CTSS+FCUI   COMPARE USER INDEX IN SYSTEM SECTOR
          LPN    77
          SHN    14
          LMM    CTSS+FCUI+1
 DDFB     LMC    *
*         LMC    UI          (USER INDEX FROM CATALOG)
          NJN    DDF10       IF USER INDEX MISMATCH
          LDN    2
          STD    P0
 DDF9     LDM    FCCD+2,CI   CHECK CREATION DATE
 DDFC     EQU    *-1
          LMM    CTSS+FCCD,P0
          NJN    DDF10       IF MISMATCH ON CREATION DATE
          SOM    DDFC
          SOD    P0
          PJN    DDF9        IF NOT END OF DATE
          UJN    DDF11       CHECK FOR ACTIVE USERS
 
*         PROCESS BOI/EOI/UI MISMATCH.
 
 DDF10    RJM    WCB         REWRITE CATALOG BUFFER
          EXIT   FSE,CH,IW,T5,EC7  *EQXXX,DNYY,FILE BOI/EOI/UI MISMATCH*
 
*         CHECK FOR ACTIVE USERS.
 
 DDF11    LDM    CASS        CHECK FOR ACTIVE USERS PRESENT
          LPN    32
          ADM    UCSS+1
          ADM    UCSS+2
          ADM    UCSS+3
          ADM    UCSS+4
          ADM    FISS        CHECK FOR FAST ATTACH FILE
          STD    P0
          ZJN    DDF11.1     IF NO ACTIVE USERS
          LDM    PFSR
          LPN    77
          LMN    SRNB
          NJN    DDF11.1     IF TO PURGE FILE WHEN BUSY
          ERROR  FBS         *(FILE NAME) BUSY.*
 
*         RELEASE THE CATALOG ENTRY FOR THE FILE.  NO JOB SUSPENSION
*         IS PERFORMED IF THE DIRECT ACCESS DEVICE BECOMES INACCESSIBLE
*         AFTER THIS POINT.
*
*         THE CATALOG ENTRY IS RELEASED BEFORE SETTING PURGE STATUS
*         IN THE SYSTEM SECTOR OF THE FILE BECAUSE THE CATALOG AND
*         DIRECT ACCESS FILES MAY RESIDE ON DIFFERENT DEVICES.  THIS
*         ORDER ENSURES THAT THE CATALOG DOES NOT POINT TO AN OBSOLETE
*         FILE IF THE CATALOG DEVICE BECOMES INACCESSIBLE BEFORE THE
*         ENTRY IS RELEASED.
 
 DDF11.1  RJM    WCB         REWRITE CATALOG BUFFER
          LDM    PFFT        RESET FIRST TRACK OF FILE
          STD    T6
 
*         REWRITE SYSTEM SECTOR (FOR FILE WITH ACTIVE USERS).
 
          LDD    P0
          ZJP    DDF14       IF NO ACTIVE USERS
          LDM    CASS        SET PURGE BIT
          LMN    40
          STM    CASS
          SETMS  IO,RW
          NJN    DDF13       IF DEVICE INACCESSIBLE
          RJM    WSS         WRITE SYSTEM SECTOR
          PJN    DDF12       IF NO ERROR
          LDM    RDCT        DEVICE STATUS
          SHN    21-12
          PJN    DDF13       IF DEVICE INACCESSIBLE
          EXIT   MSE,CH,IW,T5,EC7  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
 DDF12    ENDMS
 DDF13    LDD    T6          CLEAR TRACK INTERLOCK
          RJM    CTI
          LDN    0           CLEAR INTERLOCK FLAG
          STM    DAIF
          UJN    DDF15       COMPLETE
 
*         RELEASE FILE SPACE (FOR FILE WITH NO ACTIVE USERS).
 
 DDF14    LDD    T5          SET EST ORDINAL
          LMC    4000        SET CHECKPOINT BIT
          STD    CM+1
          LDD    T6
          STD    CM+2
          MONITOR DTKM
*         LDN    0           CLEAR TRACK INTERLOCK FLAG
          STM    DAIF
 
*         INCREMENT PRU LIMIT FIELD IN CONTROL POINT AREA.
*         NUMBER OF SECTORS RETURNED BY *DTKM* IS IN (CM+3 - CM+4).
 
          LDN    CICS        INCREMENT CP AREA FIELD FUNCTION CODE
          STD    CM
          LDK    ACLW        ADDRESS OF MASS STORAGE PRU LIMIT
          STD    CM+1
          LDN    0D*100+18D  POSITION AND WIDTH OF LIMIT FIELD
          STD    CM+2
          LDD    MA          WRITE *UADM* PARAMETERS TO MESSAGE BUFFER
          CWD    CM
          LDN    1
          STD    CM+1        REQUEST COUNT
          STD    CM+2        DO NOT DROP PP
          MONITOR  UADM
 DDF15    LJM    DDFX        RETURN
 SCP      SPACE  4,10
**        SCP - SAVE CATALOG PARAMETERS.
*
*         SAVES PARAMETERS FROM THE CATALOG ENTRY FOR LATER USE.
*
*         EXIT   (DDFB, DDFB+1) = USER INDEX.
*                (PFFT) = FIRST TRACK.
 
 
 SCP      SUBR               ENTRY/EXIT
          LDM    FCUI,CI     SAVE USER INDEX
          LPN    77
          RAM    DDFB
          LDM    FCUI+1,CI
          STM    DDFB+1
          LDM    FCBT,CI     SAVE FIRST TRACK
          STM    PFFT
          UJN    SCPX        RETURN
 SDD      SPACE  4,15
**        SDD - SEARCH FOR DIRECT ACCESS DEVICE.
*
*         ENTRY  (CI) = ADDRESS OF CATALOG ENTRY.
*                (EQ) = MASTER DEVICE EST ORDINAL.
*                (PFPN - PFPN+4) = PERMANENT FILE DEVICE DESCRIPTION.
*                (SDDA) PRESET WITH DEVICE NUMBER IF *SETDA* REQUEST.
*
*         EXIT   (A) = 0 IF DEVICE FOUND.
*                (A) .GT. 0 IF DEVICE NOT FOUND OR INACCESSIBLE.
*                (T5) = (PFEQ) = DIRECT ACCESS DEVICE EST ORDINAL.
*
*         USES   CM, T5.
*
*         CALLS  PDA, SDN.
 
 
 SDD2     LDD    T5          SET DIRECT ACCESS DEVICE EST ORDINAL
          STM    PFEQ
          LDN    0           RETURN WITH (A) = 0
 
 SDD      SUBR               ENTRY/EXIT
          LDD    EQ          SET DIRECT ACCESS DEVICE EST ORDINAL
          STD    T5
          STM    PFEQ
 SDDA     LDM    FCDN,CI     GET DIRECT ACCESS DEVICE NUMBER
*         LDC    (FCDN)      (*DROPDS*)
          LPN    77
          ZJN    SDDX        IF MASTER DEVICE, RETURN
          STD    CM
          LDM    PFPN+4      FAMILY EST ORDINAL
          RJM    SDN         SEARCH FOR DEVICE NUMBER
          PJN    SDD2        IF DEVICE FOUND
          ADN    1
          RJM    PDA         PROCESS DEVICE AVAILABILITY
 SDD1     LDN    1           RETURN WITH (A) .GT. 0
          UJN    SDDX        RETURN
 WCB      SPACE  4,20
**        WCB - REWRITE CATALOG BUFFER.
*
*         ENTRY  (T5) = DIRECT ACCESS DEVICE EST ORDINAL.
*                (CB) = ADDRESS OF CATALOG BUFFER.
*                (CC) = COMMAND CODE.
*                (EQ) = MASTER DEVICE EST ORDINAL.
*                (PFEQ) = DIRECT ACCESS DEVICE EST ORDINAL.
*
*         EXIT   (T5) = DIRECT ACCESS DEVICE EST ORDINAL.
*                CATALOG BUFFER REWRITTEN.
*                CATALOG INTERLOCK RELEASED.
*                *ENDMS* PERFORMED.
*
*         USES   T5.
*
*         CALLS  CCI, WBI, WCE.
*
*         MACROS ENDMS.
 
 
 WCB      SUBR               ENTRY/EXIT
          LDD    EQ
          LMD    T5
          ZJN    WCB0        IF ALREADY ON MASTER DEVICE
          ENDMS
          LDD    EQ          SET MASTER DEVICE EST ORDINAL
          STD    T5
 WCB0     LDD    CC          CHECK COMMAND CODE
          LMN    CCDD
          ZJN    WCB1        IF *DROPDS* REQUEST
          RJM    WCE         UPDATE AND REWRITE CATALOG BUFFER
          UJN    WCB2        CLEAR CATALOG INTERLOCK
 
 WCB1     LDD    CB          REWRITE CATALOG BUFFER
          RJM    WBI
          ENDMS
 WCB2     RJM    CCI         CLEAR CATALOG INTERLOCK
          LDM    PFEQ        RESET DIRECT ACCESS DEVICE EST ORDINAL
          STD    T5
          UJN    WCBX        RETURN
 WCE      SPACE  4,15
**        WCE - REWRITE CATALOG ENTRY.
*
*         ENTRY  (CI) = ADDRESS OF CATALOG ENTRY.
*                (CB) = ADDRESS OF CATALOG BUFFER.
*
*         EXIT   (FCKD) UPDATED AND CATALOG SECTOR REWRITTEN.
*
*         USES   CM - CM+4.
*
*         CALLS  WBI.
*
*         MACROS ENDMS.
 
 
 WCE      SUBR               ENTRY/EXIT
          LDN    PDTL        UPDATE CONTROL MODIFICATION DATE
          CRD    CM
          LDD    CM+2
          STM    FCKD,CI
          LDD    CM+3
          STM    FCKD+1,CI
          LDD    CM+4
          STM    FCKD+2,CI
          LDD    CB          REWRITE CATALOG BUFFER
          RJM    WBI
          ENDMS
          UJN    WCEX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPRSS
*CALL     COMPSDN
*CALL     COMPWSS
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF2-2  OVERFLOW INTO HOLE BUFFER
          OVERLAY  (DELPFC/DROPIDS/PERMIT PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES THE COMMANDS *DELPFC*, *DROPIDS*
*         AND *PERMIT*.
 
 
 OVL      BSS    0           ENTRY
          LDD    EQ          RESET MASTER DEVICE EST ORDINAL
          STD    T5
          LJM    0,P0        PROCESS COMMAND
          TITLE  COMMAND PROCESSING.
 DIS      SPACE  4,10
***       PROCESS *DROPIDS* REQUEST.
*
*         DROP INDIRECT ACCESS FILE DISK SPACE.
*
*         THE TRACK AND SECTOR POINTERS IN THE EXISTING PFC WILL BE
*         CLEARED, AND A HOLE WILL BE CREATED TO POINT TO THE DISK
*         SPACE.  THIS HOLE WILL EITHER BE PLACED IN A PREVIOUSLY
*         EXISTING DAPF HOLE OR A NEW HOLE WILL BE ALLOCATED AT THE
*         END OF THE CATALOG TRACK.  THIS IS DONE SO THAT THE
*         POSITION OF THE ORIGINAL PFC DOES NOT CHANGE; BOTH THE
*         DESTAGE DUMP CODE AND THE PURGE AFTER DUMP CODE IN *PFDUMP*
*         REQUIRE THAT THE POSITION OF THE PFC REMAIN CONSTANT.
 
 
 DIS      BSS    0           ENTRY
          LDD    CI          SET CURRENT PFN FOR NEW PFC ENTRY
          ADN    FCFN
          RJM    SFN
 
*         CHECK FOR CARTRIDGE ALTERNATE STORAGE COPY OF FILE.
 
          LDM    FCAA,CI
          ADM    FCAA+1,CI
          ADM    FCAA+2,CI
          ZJN    DIS1        IF NO CARTRIDGE ALTERNATE STORAGE COPY
          LDM    FCAF,CI
          LPN    AFPDEM+AFPSEM
          ZJN    DIS4        IF NO ERROR FLAGS SET
          AOM    DISA        SET *ERROR FLAG DETECTED* FLAG
 
*         CHECK FOR TAPE ALTERNATE STORAGE COPY OF FILE.
 
 DIS1     LDM    FCTV,CI
          ADM    FCTV+1,CI
          ZJN    DIS2        IF NO TAPE ALTERNATE STORAGE COPY OF FILE
          LDM    FCTF,CI     CHECK FOR ERRORS ON PRIMARY VSN
          LPK    TFPVNM+TFEPVM
          ZJN    DIS4        IF NO ERRORS ON PRIMARY VSN
          AOM    DISA        SET *ERROR FLAG DETECTED* FLAG
          LDM    FCTF,CI
          LPK    TFSVSM
          ZJN    DIS2        IF NO SECONDARY VSN COPY OF FILE
          LDM    FCTF,CI
          LPK    TFSVNM+TFESVM
          NJN    DIS3        IF ERRORS ON SECONDARY VSN
          UJN    DIS4        CONTINUE
 
 DIS2     LDN    0           CHECK IF ERROR FLAG DETECTED
*         LDN    1           (ALTERNATE STORAGE ERROR FLAG DETECTED)
 DISA     EQU    *-1
          NJN    DIS3        IF ALTERNATE STORAGE ERROR FLAG DETECTED
          ERROR  AIO         * NO ALTERNATE STORAGE COPY OF FILE.*
 
 DIS3     ERROR  ASE         * ALTERNATE STORAGE ERROR.*
 
*         SET UP HOLE TO POINT TO DATA.
 
 DIS4     LDM    FCBT,CI     SET DISK ADDRESS
          STM    SDAB
          LDM    FCBS,CI
          STM    SDAC
          LDM    FCLF,CI     SET FILE LENGTH IN (LF - LF+1)
          STD    LF
          LDM    FCLF+1,CI
          STD    LF+1
          STD    HL          SIMULATE EXACT FIT HOLE, IF HOLE FOUND
          EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          LDN    PSNI        BYPASS SPACE ALLOCATION IN *CCS*
          STM    CCSB
          STM    CCSB+1
          STM    CCSC        BYPASS *WBI* CALLS IN *CCS*
          STM    CCSF
          STM    CCSF+1
          STM    CCSG
          STM    CCSG+1
          ISTORE FCEL,(UJN FCE7.1)  BYPASS DATE/TIME UPDATES IN *FCE*
          RJM    IIA         INTERLOCK INDIRECT ALLOCATION
          LDK    STNS        SET *NO JOB SUSPENSION* AFTER THIS POINT
          RAM    STAT
          RJM    CCS         CREATE NEW CATALOG ENTRY FOR HOLE
 
*         UPDATE EXISTING PFC AND RELEASE FILE SPACE.
 
          LDN    0           CLEAR DISK ADDRESS IN EXISTING PFC
          STM    FCBT,CI
          STM    FCBS,CI
          LDD    CB          REWRITE EXISTING PFC
          RJM    WBI
          LDD    EB          SET POINTERS TO PFC TO BE DELETED
          STD    CB
          LDD    EP
          STD    CI
          RJM    DCE         RELEASE IAPF FILE SPACE
          ZJN    DIS5        IF FILE WITHIN CHAIN AND NO DELINK
          RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          UJN    DIS6        TERMINATE PROGRAM
 
 DIS5     RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          LDD    CB
          RJM    WBI         WRITE CATALOG ENTRY
          ENDMS
 DIS6     EXECUTE  3PU       TERMINATE PROGRAM
 DPF      SPACE  4,10
***       PROCESS *DELPFC* REQUEST.
*
*         DELETE INDIRECT ACCESS FILE PFC ENTRY, AND DROP ASSOCIATED
*         DISK SPACE.  THIS REQUEST IS MADE ONLY TO DELETE THE ORIGINAL
*         PFC LEFT OVER FROM AN *APPEND*, AFTER A CPU TRANSFER HAS BEEN
*         PERFORMED ON THAT MACHINE.
 
 
 DPF      BSS    0           ENTRY
          EXECUTE  3PD       LOAD CATALOG UPDATE ROUTINES
          RJM    IIA         INTERLOCK INDIRECT ALLOCATION
          LDK    STNS        SET *NO JOB SUSPENSION* AFTER THIS POINT
          RAM    STAT
          RJM    DCE         DELETE CATALOG ENTRY
          ZJN    DPF1        IF FILE WITHIN CHAIN AND NO DELINK
          RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          UJN    DPF2        TERMINATE PROGRAM
 
 DPF1     RJM    CIA         CLEAR INDIRECT ALLOCATION INTERLOCK
          LDD    CB          REWRITE CATALOG BUFFER
          RJM    WBI
          ENDMS
 DPF2     EXECUTE  3PU       TERMINATE PROGRAM
 PER      SPACE  4,10
***       PROCESS *PERMIT* REQUEST.
*
*         CREATE PERMISSION *M* FOR USER *OUAN* TO ACCESS FILE
*         *PF NAME*.
 
 
 PER      BSS    0           ENTRY
 
*         *PERMIT* IS NOT ALLOWED ON A FILE WITH AN ACCESS LEVEL
*         LOWER THAN THAT OF THE JOB UNLESS THE CALLER IS VALIDATED
*         FOR WRITE-DOWN PRIVILEGES OR IS A SUBSYSTEM.
 
          LDM    SSOM
          ZJN    PER0        IF UNSECURED SYSTEM
          LDM    FCAL,CI
          LPN    7
          SBM    PFAL
          PJN    PER0        IF FILE NOT LOWER THAN JOB
          LDM    SVAL
          LPN    40
          NJN    PER0        IF USER VALIDATED FOR WRITE-DOWN
          LDM    SSID
          SBK    LSSI+1
          PJN    PER0        IF SUBSYSTEM
          ERROR  WDP,,,,SVE  * WRITE-DOWN OF DATA PROHIBITED.*
 
 PER0     LDD    RI
          ADD    RI+1
          ZJN    PER1        IF NO PERMIT RANDOM INDEX
          LDD    PP
          ZJN    PER1        IF PERMIT NOT FOUND
          RJM    UEP         UPDATE EXISTING PERMIT
          UJN    PER2        UPDATE CATALOG ENTRY
 
*         CREATE PERMIT ENTRY.
 
 PER1     LDM    EXPC        GET EXPLICIT PERMIT COUNT
          SBK    PMLM
          PJP    PER3        IF PERMIT LIMIT EXCEEDED
          LDN    0           SET EXPLICIT PERMIT OPTION
          STM    SAPF
          STM    IACP
          EXECUTE  3PE       LOAD PERMIT UPDATE ROUTINES
          RJM    CPE         CREATE PERMIT ENTRY
 
*         UPDATE CATALOG ENTRY.
 
 PER2     LDN    PDTL        UPDATE CONTROL MODIFICATION DATE
          CRD    CM
          LDD    CM+2
          STM    FCKD,CI
          LDD    CM+3
          STM    FCKD+1,CI
          LDD    CM+4
          STM    FCKD+2,CI
          LDD    CB          REWRITE CATALOG BUFFER
          RJM    WBI
          ENDMS
          EXECUTE  3PU       TERMINATE PROGRAM
 
*         PROCESS PERMIT LIMIT.
 
 PER3     ERROR  PLE         * PERMIT LIMIT EXCEEDED.*
          TITLE  SUBROUTINES.
 UEP      SPACE  4,10
**        UEP - UPDATE EXISTING PERMIT ENTRY.
*
*         ENTRY  (PP) = ADDRESS OF PERMIT ENTRY TO UPDATE.
*                (MODE) = MODE TO BE PERMITTED.
*                (PXDT - PXDT+1) = PERMIT EXPIRATION DATE.
*
*         EXIT   PERMIT ENTRY UPDATED.
*
*         USES   CM - CM+4, T0.
*
*         CALLS  WBI.
 
 
 UEP      SUBR               ENTRY/EXIT
          LDD    PP          SET PERMIT ENTRY ADDRESS
          ADN    FPAC
          STM    UEPA
          LDN    PDTL        SET TIME/DATE IN ENTRY
          CRD    CM
          LDM    MODE        SET PERMIT MODE
          LPN    17
          ADN    40          SET *EXPIRATION DATE PRESENT* BIT
          STD    T0
          LDM    FPAC+1,PP   UPDATE MODE/ACCESS COUNT
          SCN    77
          ADD    T0
          STD    CM+1
          LDM    FPAC,PP
          STD    CM
          LDD    MA          SET UPDATED WORD IN ENTRY
          CWD    CM
          CRM    *,ON
 UEPA     EQU    *-1
          LDM    PXDT+1      SET PERMIT EXPIRATION DATE
          STM    FPXD+1,PP
          LDM    FPXD,PP
          SCN    77
          LMM    PXDT
          STM    FPXD,PP
          LDD    PB          REWRITE PERMIT SECTOR
          RJM    WBI
          LJM    UEPX        EXIT
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF2-2  OVERFLOW INTO HOLE BUFFER
          OVERLAY (CHANGE/SETPFAC/SETPFAL PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES THE PERMANENT FILE COMMANDS
*         *CHANGE*, *SETPFAC* AND *SETPFAL*.  THESE COMMANDS
*         CHANGE FIELDS IN THE CATALOG ENTRY FOR A FILE.
*         *SETPFAC* AND *SETPFAL* WILL NOT BE PERFORMED IF THE
*         FILE IS CURRENTLY ATTACHED.
 
 
 OVL      BSS    0           ENTRY
*         LJM    CHG         PROCESS REQUEST
          TITLE  COMMAND PROCESSING.
***       PROCESS CHANGE REQUEST.
*
*         CHANGE CATALOG ENTRY FOR PERMANENT FILE.
*
*         THE PASSWORD SPECIFIED IN THE *FET* WILL BE USED UNLESS
*         IT HAS THE VALUE 7777 7777 7777 77B.  THE *MODE*, *CT*,
*         AND *SS* FIELDS SPECIFIED IN THE *FET* WILL ONLY BE
*         USED IF THEY HAVE THE 40B-BIT SET.
*
*         *CHANGE* AND *SETPFAC* ARE NOT ALLOWED IF THE ACCESS LEVEL
*         OF THE FILE IS LOWER THAN THAT OF THE JOB UNLESS THE CALLER
*         IS VALIDATED FOR WRITE-DOWN PRIVILEGES OR IS A SUBSYETM.
 
 
 CHG      BSS    0           ENTRY
          LDM    STAT        CHECK FOR PRIVATE DEVICE
          LPK    STPD
          ZJN    CHG1        IF NOT PRIVATE DEVICE
          LDN    PSNI        SET BYPASS OF USER INDEX CHECK
          STM    SCTB
 CHG1     RJM    SFL         SET PERMANENT FILE NAMES
          RJM    SCT         SEARCH CATALOG
          ZJN    CHG2        IF FILE NOT FOUND
          RJM    CCE         CHANGE CATALOG ENTRY
          LDN    PDTL        UPDATE CONTROL MODIFICATION DATE
          CRD    CM
          LDD    CM+2
          STM    FCKD,CI
          LDD    CM+3
          STM    FCKD+1,CI
          LDD    CM+4
          STM    FCKD+2,CI
          LDD    CB          REWRITE CATALOG ENTRY
          RJM    WBI
          ENDMS
          EXECUTE  3PU       TERMINATE PROGRAM
 
 CHG2     ERROR  FNF         (*FILENAME) NOT FOUND.*
          TITLE  SUBROUTINES.
 CAL      SPACE  4,10
**        CAL - CHECK ACCESS LEVEL.
*
*         ENTRY  (CI) = INDEX TO ENTRY.
*                (EQ) = FAMILY EST ORDINAL.
*                (CALA) = ALTERNATE DEVICE EST ORDINAL.
*                (LFAL) = NEW ACCESS LEVEL.
*                (SVAL) = USER-S JOB SECURITY VALIDATIONS.
*
*         USES   CM - CM+4.
*
*         MACROS ERROR, MONITOR.
 
 
 CAL3     LDM    FCAL,CI     CHECK FOR DOWNGRADE
          LPN    7
          STD    CM
          LDM    LFAL
          SBD    CM
          PJN    CALX        IF NOT DOWNGRADE
          LDM    SVAL        CHECK FOR PF DOWNGRADE VALIDATON
          SHN    21-6
          MJN    CALX        IF USER HAS DOWNGRADE VALIDATION
          LDM    SSID        CHECK SUBSYSTEM ID
          SBK    LSSI+1
          PJN    CALX        IF SUBSYSTEM
          ERROR  NVD,,,,SVE  * NOT VALID TO DOWNGRADE DATA.*
 
 CAL      SUBR               ENTRY/EXIT
          LDM    SSOM
          ZJN    CALX        IF UNSECURED SYSTEM
          LDD    EQ          CHECK IF *LFAL* VALID FOR MASTER DEVICE
          STD    CM+2
          LDN    VAES
          STD    CM+1
          LDM    LFAL
          STD    CM+4
          MONITOR  VSAM
          LDD    CM+1
          NJN    CAL2        IF FILE ACCESS NOT VALID FOR DEVICE
          LDM    FCBS,CI
          SHN    21-13
 CAL1     PJP    CAL3        IF NOT DIRECT ACCESS FILE
          LDC    **
 CALA     EQU    *-1
          ZJN    CAL1        IF FILE ON MASTER DEVICE
          STD    CM+2        CHECK IF ACCESS IS VALID FOR FILE DEVICE
          LDN    VAES
          STD    CM+1
          LDM    LFAL
          STD    CM+4
          MONITOR  VSAM
          LDD    CM+1
          ZJN    CAL1        IF FILE ACCESS VALID FOR DEVICE
 CAL2     ERROR  LNP,,,,SVE  * ACCESS LEVEL NOT VALID ON PF DEVICE.*
 CCE      SPACE  4,20
**        CCE - CHANGE CATALOG ENTRY.
*
*         ENTRY  (CI) = INDEX TO ENTRY.
*                (PI) = FILE CATEGORY.
*                (PI+1) = FILE MODE.
*                (FS - FS+3) = NEW FILE NAME.
*                (PFPW) = PASSWORD.
*                (PFCW) = USER CONTROL WORD.
*                (PXDT - PXDT+1) = PASSWORD EXPIRATION DATE.
*                (STAT) BIT 0=1 IF PASSWORD EXPIRATION DATE SPECIFIED.
*                (PFAL) = FILE ACCESS LEVEL (*SETPFAL*).
*                (PFFC - PFFC+2) = FILE CATEGORY SET (*SETPFAC*).
*
*         EXIT   CATALOG ENTRY CHANGED.
*
*         USES   CM - CM+4.
*
*         CALLS  CAL, CFB.
*
*         MACROS ERROR, NFA.
 
 
 CCE14    RJM    CFB         CHECK FOR FILE BUSY
          RJM    CAL         CHECK ACCESS LEVEL
          LDM    LFAL        *SETPFAL* CHANGE ACCESS LEVEL
          STM    FCAL,CI
          UJN    CCEX        RETURN
 
 CCE15    RJM    CFB         CHECK FOR FILE BUSY
          LDM    PFFC        *SETPFAC* CHANGE ACCESS CATEGORY SET
          STM    FCFC,CI
          LDM    PFFC+1
          STM    FCFC+1,CI
          LDM    PFFC+2
          STM    FCFC+2,CI
 
 CCE      SUBR               ENTRY/EXIT
          LDD    CC
          LMN    CCAL
          ZJN    CCE14       IF *SETPFAL* REQUEST
          LDM    SSOM
          ZJN    CCE0        IF UNSECURED SYSTEM
          LDM    FCAL,CI
          LPN    7
          SBM    PFAL
          PJN    CCE0        IF FILE NOT LOWER THAN JOB
          LDM    SVAL
          LPN    40
          NJN    CCE0        IF USER VALIDATED FOR WRITE-DOWN
          LDM    SSID
          SBK    LSSI+1
          PJN    CCE0        IF SUBSYSTEM
          ERROR  WDP,,,,SVE  * WRITE-DOWN OF DATA PROHIBITED.*
 
 CCE0     LDD    CC
          LMN    CCAC
          ZJP    CCE15       IF *SETPFAC* REQUEST
 
*         SET NEW FILE NAME.
 
          LDD    FS
          ZJN    CCE1        IF NO NEW NAME
          STM    FCFN,CI     ENTER NEW FILE NAME
          LDD    FS+1
          STM    FCFN+1,CI
          LDD    FS+2
          STM    FCFN+2,CI
          LDD    FS+3
          SCN    77
          LMD    UI
          STM    FCFN+3,CI
 
*         SET NEW CHARGE AND PROJECT NUMBERS INTO PFC.
 
 CCE1     LDM    PFSR        GET SPECIAL REQUEST FUNCTION
          LPN    77
          LMN    SRCP
          NJN    CCE2        IF *CP* PARAMETER NOT SPECIFIED
          LDD    CI
          RAM    CCEC
          NFA    CHGN        SET EXECUTING CHARGE/PROJECT FROM NFL
          CRM    FCCN,TR
 CCEC     EQU    *-1
          ERRNZ  FCP1-FCCN-5 *FCP1* MUST FOLLOW *FCCN*
          ERRNZ  FCP2-FCCN-12  *FCP2* MUST FOLLOW *FCCN*/*FCP1*
          ERRNZ  PJ1N-CHGN+1 *PJ1N* MUST BE IMMEDIATELY AFTER *CHGN*
          ERRNZ  PJ2N-PJ1N+1 *PJ2N* MUST BE IMMEDIATELY AFTER *PJ1N*
 
*         SET USER CONTROL WORD.
 
 CCE2     LDM    PUCW
          SHN    6
          PJN    CCE3        IF NOT SPECIFIED
          LDD    CI
          ADC    FCCW
          STM    CCEA        SET ADDRESS TO WRITE CONTROL WORD
          LDD    MA
          CWM    PUCW,ON
          SBN    1
          CRM    *,ON
 CCEA     EQU    *-1
 
*         SET PASSWORD.
 
 CCE3     LDN    CFPW
          SBM    FETL
          PJP    CCE6        IF FET NOT LONG ENOUGH FOR PASSWORD
          LDM    PFPW
          LMC    7777
          ZJN    CCE4        IF PASSWORD NOT SPECIFIED
          LDD    CI
          ADN    FCPW
          STM    CCEB        SET ADDRESS TO WRITE PASSWORD
          LDD    MA
          CWM    PFPW,ON
          SBN    1
          CRM    *,ON
 CCEB     EQU    *-1
          UJN    CCE5        SET PASSWORD EXPIRATION DATE
 
*         SET PASSWORD EXPIRATION DATE.
 
 CCE4     LDM    STAT        CHECK EXPIRATION DATE STATUS
          LPN    STXD
          ZJN    CCE6        IF EXPIRATION DATE NOT SPECIFIED
          LDM    FCPW,CI
          NJN    CCE5        IF PASSWORD EXISTS
          ERROR  PAE         * PFM ARGUMENT ERROR.*
 
 CCE5     LDM    FCXD,CI     SET EXPIRATION DATE
          SCN    77
          LMM    PXDT
          STM    FCXD,CI
          LDM    PXDT+1
          STM    FCXD+1,CI
 
*         SET CATEGORY.
 
 CCE6     LDD    PI
          SHN    21-13
          PJN    CCE7        IF NOT SPECIFIED
          LDM    FCCT,CI
          LPN    37
          ADD    PI
          LPC    3777
          STM    FCCT,CI
 
*         SET FILE MODE.
 
 CCE7     LDD    PI+1
          SHN    21-5
          PJN    CCE8        IF NOT SPECIFIED
          LDM    FCAM,CI
          SCN    37
          ADD    PI+1
          SCN    40
          STM    FCAM,CI
 
*         SET FILE SUBSYSTEM.
 
 CCE8     LDM    PFSS
          SHN    21-5
          PJN    CCE9        IF SUBSYSTEM NOT SPECIFIED
          SHN    -21+5+22
          LMM    FCFS,CI     SAVE SUBSYSTEM IN CATALOG ENTRY
          SCN    77
          LMM    PFSS
          LMN    40
          STM    FCFS,CI
 
*         CLEAR ERROR STATUS.
 
 CCE9     LDM    PFSR
          LPN    77
          LMN    SRCE
          NJN    CCE10       IF NOT CLEAR ERROR STATUS REQUEST
          LDM    FCEC,CI     CLEAR ERROR STATUS
          LPC    7077
          STM    FCEC,CI
          LDM    JORG
          LMK    SYOT
          NJN    CCE10       IF NOT SYSTEM ORIGIN
          LDM    FCAF,CI     CLEAR MSS RELATED ERROR FLAGS
          SCN    AFPSEM+AFPDEM+AFTMPM
          STM    FCAF,CI
 
*         SET BACKUP REQUIREMENT.
 
 CCE10    LDM    PFBR        CHECK FOR BR PARAMETER CHANGE REQUEST
          LPC    700
          ZJN    CCE11       IF *BR* NOT SPECIFIED
          STD    CM
          LDM    FCBR,CI
          LPC    7077
          LMD    CM
          STM    FCBR,CI
 
*         SET PREFERRED RESIDENCE.
 
 CCE11    LDM    PFRS        CHECK FOR PR PARAMETER CHANGE REQUEST
          LPC    7000
          ZJN    CCE12       IF *PR* NOT SPECIFIED
          STD    CM
          LDM    FCRS,CI
          LPC    0777
          LMD    CM
          STM    FCRS,CI
 
*         SET ALTERNATE CATLIST PERMISSION.
 
 CCE12    LDM    PFAP
          LPC    6000
          ZJN    CCE13       IF *AC* NOT SPECIFIED
          STM    FCAP,CI
 CCE13    LJM    CCEX        RETURN
 CFB      SPACE  4,10
**        CFB - CHECK FOR FILE BUSY.
*
*         ENTRY  (CI) = INDEX TO ENTRY.
*                (EQ) = FAMILY EST ORDINAL.
*
*         USES   CM, T5, T6.
*
*         CALLS  CTI, ITC, PDA, PDV, RMD, RSS, SDN.
*
*         MACROS ENDMS, ERROR, SETMS.
 
 
 CFB      SUBR               ENTRY/EXIT
          LDM    FCBS,CI
          SHN    21-13
          PJN    CFBX        IF NOT DIRECT ACCESS FILE
          ENDMS
          LDD    EQ          SET DIRECT ACCESS DEVICE EST ORDINAL
          STM    PFEQ
          LDM    FCDN,CI     DETERMINE EST ORDINAL OF DEVICE
          LPN    77
          ZJN    CFB4        IF FILE ON MASTER DEVICE
          STD    CM
          LDD    EQ
          RJM    SDN         SEARCH FOR DEVICE NUMBER
          PJN    CFB3        IF DEVICE FOUND
          ADN    1
          RJM    PDA         PROCESS DEVICE AVAILABILITY
 CFB1     ERROR  DAD,CH      * DIRECT ACCESS DEVICE ERROR.*
 
 CFB2     ERROR  TNR,CH,,T5  *EQXXX,DNYY, TRACK NOT RESERVED.*
 
 CFB3     LDD    T5          SAVE ALTERNATE DEVICE EST ORDINAL
          STM    CALA
          STM    PFEQ
 CFB4     LDM    FCBT,CI
          ZJP    CFB8        IF FILE NOT DISK RESIDENT
          STM    PFFT        FIRST TRACK
          RJM    ITC         INTERLOCK TRACK CHAIN FOR FILE
          NJN    CFB2        IF TRACK NOT RESERVED
          AOM    DAIF        SET INTERLOCK FLAG
          SETMS  IO
          RJM    PDV         PROCESS DEVICE STATUS
          LDN    0           DONT VERIFY FILE NAME IN SYSTEM SECTOR
          RJM    RSS         READ SYSTEM SECTOR
          ZJN    CFB6        IF LEGAL SYSTEM SECTOR
          MJN    CFB5        IF READ ERROR
          ERROR  DAF,,,T5    *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
 
 CFB5     RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,CH,,T5  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
 CFB6     ENDMS
          LDM    CASS        CHECK IF FILE BUSY
          ADM    FISS
          ADM    UCSS+1
          ADM    UCSS+2
          ADM    UCSS+3
          ADM    UCSS+4
          ZJN    CFB7        IF FILE NOT BUSY
          ERROR  FBS,CH      * FILE BUSY*
 
 CFB7     LDD    T6
          RJM    CTI         RELEASE FILE INTERLOCK
          LDN    0           CLEAR INTERLOCK FLAG
          STM    DAIF
 CFB8     RJM    RMD         RESET TO MASTER DEVICE
          LJM    CFBX        RETURN
 CFN      SPACE  4,10
**        CFN - CHECK FILE NAMES.
*
*         ENTRY  (FN - FN+3) = OLD FILE NAME.
*                (FS - FS+3) = NEW FILE NAME.
*                (P1) = 1 IF OLD ALREADY FOUND.
*                (T3) = INDEX TO CATALOG ENTRY.
*
*         EXIT   (A) = 0 IF OLD NOT FOUND.
 
 
 CFN      SUBR               ENTRY/EXIT
 
*         CHECK OLD FILE NAME.
 
 CFNA     LDN    0
*         LDN    1           (OLD FILE NAME ALREADY FOUND)
          NJN    CFN1        IF OLD FILE NAME ALREADY FOUND
          LDI    T3
          LMD    FN
          NJN    CFN1        IF NOT EQUAL
          LDM    FCFN+1,T3
          LMD    FN+1
          NJN    CFN1        IF NOT EQUAL
          LDM    FCFN+2,T3
          LMD    FN+2
          NJN    CFN1        IF NOT EQUAL
          LDM    FCFN+3,T3
          LMD    FN+3
          SHN    -6
 CFN1     NJP    CFN3        IF NOT OLD FILE
          LDN    ZERL        CHECK IF JOB CAN ACCESS FILE
          CRD    CM
          LDM    FCAL,T3     SET ACCESS LEVEL
          LPN    7
          STD    CM+1
          LDM    FCFC,T3     SET ACCESS CATEGORY
          LPC    377
          STD    CM+2
          LDM    FCFC+1,T3
          STD    CM+3
          LDM    FCFC+2,T3
          STD    CM+4
          LDD    MA
          CWD    CM
          LDN    ZERL
          CRD    CM
          LDN    VAJS        CHECK ACCESS LEVEL AND CATEGORY SET
          STD    CM+1
          ERRNZ  VAJS-3      CODE DEPENDS ON VALUE
          STD    CM+4
          MONITOR  VSAM
          LDD    CM+1
          NJN    CFN2        IF NOT VALID ACCESS
          AOM    CFNA        SET TO BYPASS COMPARE OF OLD FILENAME
          LJM    CFNX        RETURN
 
 CFN2     ERROR  JCA,,,,SVE  * JOB CANNOT ACCESS FILE.*
 
*         CHECK NEW FILE NAME.
 
 CFN3     LDN    0
*         LDN    1           (NO NEW FILE NAME)
 CFNC     EQU    *-1
          NJN    CFN4        IF NO NEW FILENAME SPECIFIED
          LDI    T3
          LMD    FS
          NJN    CFN4        IF NOT EQUAL
          LDM    FCFN+1,T3
          LMD    FS+1
          NJN    CFN4        IF NOT EQUAL
          LDM    FCFN+2,T3
          LMD    FS+2
          NJN    CFN4        IF NOT EQUAL
          LDM    FCFN+3,T3
          LMD    FS+3
          SHN    -6
          NJN    CFN4        IF NOT EQUAL
          LDD    MA
          CWD    FS
          CRD    FN
          ERROR  FAP         *(FILENAME) ALREADY PERMANENT.*
 
 CFN4     LDN    0
          LJM    CFNX        EXIT
 ICT      SPACE  4,15
**        ICT - INTERLOCK CATALOG TRACK.
*
*         ENTRY  (T6) = CATALOG TRACK TO BE INTERLOCKED.
*                (T5) = EST ORDINAL.
*
*         EXIT   TRACK INTERLOCKED.
*                RECALL *PFM* IF INTERLOCK NOT AVAILABLE
*                  AFTER FOUR TRIES.
*                TO *HNG* IF CATALOG TRACK NOT RESERVED.
*
*         CALLS  DPR, STI.
 
 
 ICT      SUBR               ENTRY/EXIT
          LDN    3           SET RETRY COUNT
          STD    T1
 ICT1     RJM    STI         TRY TO INTERLOCK TRACK
          ZJN    ICTX        IF INTERLOCK SUCCESSFUL
          LMN    2
          ZJN    ICT2        IF TRACK NOT RESERVED
          SOD    T1
          MJN    ICT3        IF RETRY COUNT EXHAUSTED
          RJM    DPR         DELAY PRIOR TO RETRY
          UJN    ICT1        RETRY
 
 ICT2     RJM    HNG         HANG IF CATALOG TRACK NOT RESERVED
 
 ICT3     EXIT   INA,CH,,,EC4  * INTERLOCK NOT AVAILABLE.*
 ISP      SPACE  4,20
**        ISP - INITIALIZE SEARCH OF PERMANENT FILES.
*
*         ENTRY  (SDAA) = MASTER DEVICE EST ORDINAL.
*                (CCIA) = CATALOG TRACK.
*
*         EXIT   (T4) = MASTER DEVICE CHANNEL.
*                (T5) = MASTER DEVICE EST ORDINAL.
*                (T6) = CATALOG TRACK.
*                (T7) = CATALOG SECTOR.
*                (DPPF) = INCREMENTED FOR CATALOG SEARCH.
*                (MSRA) = ERROR PROCESSOR ADDRESS FOR *RNS*.
*                (P0 - P4) = INITIALIZED CATALOG SEARCH POINTERS.
*                CATALOG TRACK INTERLOCK SET.
*                *SETMS READ* PERFORMED.
*
*         CALLS  ICT, IRA, PDV.
*
*         MACROS ERROR, SETMS.
 
 
 ISP      SUBR               ENTRY/EXIT
          LDM    SDAA        SET MASTER DEVICE EST ORDINAL
          STD    T5
          LDM    CCIA        SET CATALOG TRACK
          STD    T6
          RJM    ICT         INTERLOCK CATALOG TRACK
          AOM    CCIB        SET CATALOG TRACK INTERLOCK FLAG
 ISP1     LDN    IPCS        PF INCREMENT FOR CATALOG SEARCH
          RAM    AIPF+1
          RJM    IRA         INITIALIZE RANDOM PROCESSORS
          LDK    PCC         SET ERROR PROCESSOR ADDRESS FOR *RNS*
          STM    MSRA
 
*         SET SEARCH POINTERS.
 
          LDN    0           SET STARTING CATALOG TRACK SECTOR
          STD    T7
          LDN    ZERL        CONTIGUOUS STORAGE INITIALIZATION
          CRD    P0          TEMPORARY CATALOG SEARCH BUFFER POINTERS
          LDC    BUF1        SET PRIMARY BUFFER POINTER
          STD    P2
          LDC    BUF2        SET SECONDARY BUFFER POINTER
          STD    P3
          SETMS  READSTR
          RJM    PDV         PROCESS DEVICE STATUS
          UJP    ISPX        RETURN
 PCC      SPACE  4,10
**        PCC - PROCESS CATALOG READ ERROR FOR *CHANGE*.
*
*         ENTRY  READ ERROR DETECTED BY *COMPRNS*.
 
 
 PCC      SUBR               ENTRY
          RJM    PES         PROCESS ERROR STATUS
          ERROR  MSE,,,EQ    *EQXXX,DNYY, MASS STORAGE ERROR.*
 SCT      SPACE  4,10
**        SCT - SEARCH CATALOG.
*
*         ENTRY  (FN - FN+3) = PF NAME.
*                (FS - FS+3) = NEW FILE NAME.
*                (UI - UI+1) = USER INDEX.
*
*         EXIT   (CB) = CATALOG BUFFER.
*                (CI) = CATALOG POINTER.
*                (A)  = 0 IF FILE NOT FOUND.
*
*         USES   CB, CI, P0, P1, T3.
*
*         CALLS  RNS, CFN.
 
 
 SCT6     LDD    P1
 
 SCT      SUBR               ENTRY/EXIT
          LDN    IPCS        PF INCREMENT FOR CATALOG SEARCH
          RAM    AIPF+1
          UJN    SCT2        READ FIRST SECTOR FOR SEARCH
 
*         END OF SECTOR.
 
 SCT1     LDC    *           SECTOR WORD COUNT
 SCTA     EQU    *-1
          LPN    77
          NJN    SCT6        IF EOR
 
*         READ NEXT SECTOR FOR SEARCH.
 
 SCT2     LDM    P2,P1       SET BUFFER ADDRESS
          STD    T3
          LDD    T6          SAVE POSITION OF SECTOR
          STM    -2,T3
          STM    ERRC
          LDD    T7
          STM    -1,T3
          STM    ERRD
          LDD    T3
          RJM    RNS         READ SECTOR
          ZJN    SCT6        IF EOI
          STD    P0          SAVE WORD COUNT
          STM    SCTA
          LPN    NWCE-1
          ZJN    SCT3        IF INTEGRAL NUMBER OF CATALOG ENTRIES
          ERROR  BCS,,,T5,,EI  *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
 
 SCT3     LDN    2
          RAD    T3          SKIP CONTROL BYTES
          UJN    SCT5        CHECK CATALOG ENTRY
 
*         ADVANCE TO NEXT ENTRY.
 
 SCT4     LDC    NWCE*5      ADVANCE POINTER
          RAD    T3
          LCN    NWCE        DECREMENT WORD COUNT
          RAD    P0
          NJN    SCT5        IF NOT END OF BUFFER
          LJM    SCT1        PROCESS END OF BUFFER
 
*         CHECK CATALOG ENTRY.
 
 SCT5     LDM    FCUI,T3
          LPN    37
          SHN    14
          LMM    FCUI+1,T3
          ZJN    SCT4        IF HOLE
          LMD    UI+1
          SHN    6
          LMD    UI
          NJN    SCT4        IF NOT CORRECT USER INDEX
 SCTB     EQU    *-1         PRESET TO *PSN* IF PRIVATE DEVICE
          RJM    CFN         CHECK FILE NAME
          ZJN    SCT4        IF OLD NOT FOUND
 
*         OLD FILE FOUND.
 
          AOD    P1          SET NEW BUFFER
          LDD    T3          SET CATALOG ENTRY POINTERS
          STD    CI
          LDD    P2
          STD    CB
 SCTC     LDN    0
*         LDN    1           (NO NEW FILE NAME)
          ZJN    SCT4        IF NEW FILENAME SPECIFIED, CONTINUE SEARCH
          LJM    SCTX        RETURN
 SFL      SPACE  4,15
**        SFL - SET FILE NAMES.
*
*         EXIT   (FN - FN+3) = PERMANENT FILE NAME.
*                (FS - FS+3) = NEW FILE NAME.
*                (PI) = CATEGORY.
*                (PI+1) = MODE.
*
*         USES   FN - FN+4, FS - FS+4, PI - PI+1.
*
*         CALLS  ISP.
 
 
 SFL      SUBR               ENTRY/EXIT
          LDD    MA          SET NEW FILE NAME
          CWM    PFNF,ON
          SBN    1
          CRD    FS          SET NEW FILE NAME
          LDD    FS
          NJN    SFL1        IF NEW FILE NAME
          AOM    CFNC        SET TO BYPASS CHECK FOR NEW NAME
          AOM    SCTC        SET TO BYPASS SEARCH FOR NEW NAME
 SFL1     LDM    MODE
          SCN    77
          STD    PI          SET CATEGORY
          LDM    MODE
          LPN    77
          STD    PI+1        SET MODE
          RJM    ISP         INITIALIZE FOR SEARCH OF CATALOG
          UJN    SFLX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPSDN
*CALL     COMPRSS
          SPACE  4,10
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 PCC      EQU    /".O"/PCC
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          ERRNG  BUF1-2-*    OVERFLOW INTO CATALOG SEARCH BUFFER
 
 
          OVERFLOW  OVLC,EPFW  OVERFLOW INTO ERROR PROCESSING AREA
          OVERLAY  (SETASA/SETAF PROCESSING.)
          SPACE  4,10
**        THIS OVERLAY PROCESSES THE COMMANDS *SETASA* AND *SETAF*.
 
 
 OVL      BSS    0           ENTRY
          RJM    RMD         RESET TO MASTER DEVICE
          LJM    0,P0        PROCESS COMMAND
          TITLE  COMMAND PROCESSING.
 SAA      SPACE  4,10
***       PROCESS *SETASA* REQUEST.
*
*         SET ALTERNATE STORAGE ADDRESS IN CATALOG ENTRY.
 
 
 SAA      BSS    0           ENTRY
          LDM    STAT
          LPK    STTA
          NJP    SAA3        IF TAPE ALTERNATE STORAGE REQUEST
 
*         SET CARTRIDGE ALTERNATE STORAGE ADDRESS.
 
          LDM    PFAT        GET ALTERNATE STORAGE TYPE
          LPN    77
          LMN    ATOD
          ZJN    SAA0        IF OPTICAL DISK STORAGE
          LDM    FCBS,CI
          SHN    21-13
          MJN    SAA1        IF DIRECT ACCESS FILE
 SAA0     LDM    FCAF,CI
          LPC    AFLOKM
          NJN    SAA2        IF *AFLOK* STILL SET
          ERROR  AIO         * NO ALTERNATE STORAGE COPY OF FILE.*
 
 SAA1     RJM    CDA         COMPARE DISK ADDRESS FOR DIRECT ACCESS
 SAA2     NFA    FA,R        SET FST COMPLETE
          ADN    FSTL
          CWD    FS
          LDN    0           CLEAR ALTERNATE STORAGE FLAGS
          STM    FCAF,CI
          LDM    PFAT        SET ALTERNATE STORAGE TYPE
          LMM    FCAT,CI
          SCN    77
          LMM    PFAT
          STM    FCAT,CI
          LDM    PFAA        SET ALTERNATE STORAGE ADDRESS
          STM    FCAA,CI
          LDM    PFAA+1
          STM    FCAA+1,CI
          LDM    PFAA+2
          STM    FCAA+2,CI
          LDM    PFAT
          LPN    77
          LMN    ATOD
          NJN    SAA2.1      IF NOT OPTICAL DISK STORAGE
          LDM    PFOA        SET OPTICAL DISK ADDRESS
          STM    FCOA,CI
          LDM    PFOA+1
          STM    FCOA+1,CI
          RJM    UFL         UPDATE FILE LENGTH
 SAA2.1   LJM    WCE         REWRITE CATALOG ENTRY AND EXIT
 
*         SET TAPE ALTERNATE STORAGE ADDRESS.
 
 SAA3     LDM    FCTF,CI
          LPC    TFLOKM
          NJN    SAA4        IF *TFLOK* STILL SET
          ERROR  AIO         * NO ALTERNATE STORAGE COPY OF FILE.*
 
 SAA4     LDM    PFTS        SET TAPE SEQUENCE NUMBER
          LMM    FCTS,CI
          SCN    77
          LMM    PFTS
          STM    FCTS,CI
          LDM    PFTS+1
          STM    FCTS+1,CI
          LDM    PFTV        SET TAPE VSN
          STM    FCTV,CI
          LDM    PFTV+1
          STM    FCTV+1,CI
          LDM    PFES        CHECK TAPE FLAGS
          LPC    -777
          NJN    SAA6        IF UNDEFINED BITS SPECIFIED
          LDM    PFES        SET TAPE ALTERNATE STORAGE FLAGS
          STM    FCTF,CI
          RJM    UFL         UPDATE FILE LENGTH
 SAA5     LJM    WCE         REWRITE CATALOG ENTRY AND EXIT
 
 SAA6     ERROR  ICU         * INVALID CATALOG UPDATE.*
 SAF      SPACE  4,10
***       PROCESS *SETAF* REQUEST.
*
*         SET/CLEAR ALTERNATE STORAGE FLAGS IN CATALOG ENTRY.
 
 
 SAF      BSS    0           ENTRY
          LDM    STAT
          LPK    STTA
          NJN    SAF1        IF TAPE ALTERNATE STORAGE REQUEST
          RJM    UAF         UPDATE CARTRIDGE ALTERNATE STORAGE FLAGS
          UJN    SAF2        CONTINUE
 
 SAF1     RJM    UTF         UPDATE TAPE ALTERNATE STORAGE FLAGS
 SAF2     LJM    WCE         REWRITE CATALOG ENTRY AND EXIT
          TITLE  SUBROUTINES.
 CDA      SPACE  4,15
**        CDA - COMPARE DISK ADDRESSES.
*
*         ENTRY  (FS - FS+4) = FST FOR LOCAL FILE.
*                (CI) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   TO *ERR* IF DISK ADDRESSES DO NOT MATCH.
*
*         CALLS  PDA, RMD, SDN.
*
*         MACROS ERROR.
 
 
 CDA      SUBR               ENTRY/EXIT
          LDM    FCDN,CI     CHECK DEVICE NUMBER
          LPN    77
          ZJN    CDA1        IF FILE ON MASTER DEVICE
          STD    CM
          LDM    PFPN+4      SET FAMILY EST ORDINAL
          RJM    SDN         SEARCH FOR DEVICE NUMBER
          PJN    CDA1        IF DEVICE FOUND
          ADN    1
          RJM    PDA         PROCESS DEVICE AVAILABILITY
 CDA0.1   ERROR  DAD,CH      * DIRECT ACCESS DEVICE ERROR.*
 
 CDA1     LDD    T5          CHECK FILE EST ORDINAL
          LMD    FS
          ZJN    CDA3        IF FILE ON RIGHT EQUIPMENT
 CDA2     ERROR  PVE,CH      *PFC VERIFICATION ERROR.*
 
 CDA3     LDM    FCBT,CI     CHECK FIRST TRACK
          LMD    FS+1
          NJN    CDA2        IF FILE ON WRONG TRACK
          RJM    RMD         RESET TO MASTER DEVICE
          UJP    CDAX        RETURN
 UAF      SPACE  4,10
**        UAF - UPDATE CARTRIDGE ALTERNATE STORAGE FLAGS.
*
*         ENTRY  (CI) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   (FCAF) UPDATED.
*                (FCAF/FCAT/FCAA) CLEARED IF SET REQUEST FOR *AFOBS*,
*                OR IF SET REQUEST FOR *AFFRE* ON A DISK-RESIDENT FILE.
*
*         USES   T1, T2.
 
 
 UAF      SUBR               ENTRY/EXIT
          LDM    PFES        SAVE SET/CLEAR FLAG
          SCN    77
          STD    T2
          LDM    PFES        GET PROCESSOR ADDRESS
          LPN    77
          STD    T1
          SBN    AFMAX+1
          PJN    UAF1        IF INVALID FLAG NUMBER
          LDM    UAFA,T1
          STD    T1
          LJM    0,T1        PROCESS FLAG
 
 UAFA     BSS    0           TABLE OF ERROR FLAG PROCESSORS
          LOC    0
          CON    UAF2        *AFOBS* PROCESSOR
          CON    UAF3        *AFPSE* PROCESSOR
          CON    UAF5        *AFPDE* PROCESSOR
          CON    UAF6        *AFPDR* PROCESSOR
          CON    UAF1        *AFVER* PROCESSOR
          CON    UAF8        *AFTMP* PROCESSOR
          CON    UAF10       *AFFRE* PROCESSOR
          LOC    *O
 
 UAF1     ERROR  ICU         *INVALID CATALOG UPDATE.*
 
*         PROCESS *ALTERNATE STORAGE COPY OBSOLETE* FLAG.
 
 UAF2     LDD    T2          PROCESS *AFOBS*
          ZJN    UAF1        IF *CLEAR* REQUEST
          LDM    FCBT,CI
          ZJN    UAF1        IF NO DISK ADDRESS
          LDM    FCAF,CI
          LPN    AFPDRM
          NJN    UAF1        IF *PSEUDO-RELEASE* SET
 UAF2.1   LDN    FCAF        CLEAR *AF*, *AT*, AND *ASA* INFO
          ADD    CI
          STM    UAFD
          LDN    ZERL
          CRM    *,ON
 UAFD     EQU    *-1
          LJM    UAFX        RETURN
 
*         PROCESS *ALTERNATE STORAGE COPY PERMANENT STATUS ERROR* FLAG
 
 UAF3     LDD    T2          PROCESS *AFPSE*
          ZJN    UAF1        IF *CLEAR* REQUEST
          LDM    FCAF,CI     SET *AFPSE* FLAG
          SCN    AFPSEM
          LMN    AFPSEM
 UAF4     STM    FCAF,CI     UPDATE FLAGS IN CATALOG
          LJM    UAFX        RETURN
 
*         PROCESS *ALTERNATE STORAGE COPY PERMANENT DATA ERROR* FLAG.
 
 UAF5     LDD    T2          PROCESS *AFPDE*
          ZJP    UAF1        IF CLEAR REQUEST
          LDM    FCAF,CI     SET *AFPDE* FLAG
          SCN    AFPDEM
          LMN    AFPDEM
          UJN    UAF4        RETURN
 
*         PROCESS *ALTERNATE STORAGE COPY PSEUDO-RELEASED* FLAG.
 
 UAF6     LDD    T2          PROCESS *AFPDR*
          NJN    UAF7        IF *SET* REQUEST
          STM    UAFB
 UAF7     LDM    FCAF,CI     SET/CLEAR *AFPDR* FLAG
          SCN    AFPDRM
 UAFB     LMN    AFPDRM
*         PSN                (*CLEAR* REQUEST)
          UJN    UAF4        RETURN
 
*         PROCESS *TEMPORARY ERROR* FLAG.
 
 UAF8     LDD    T2
          NJN    UAF9        IF *SET* REQUEST
          STM    UAFC
 UAF9     LDM    FCAF,CI     SET/CLEAR *AFTMP* FLAG
          SCN    AFTMPM
 UAFC     LMN    AFTMPM
*         PSN                (*CLEAR* REQUEST)
          UJN    UAF4        RETURN
 
*         PROCESS *FREE CARTRIDGE* FLAG.
 
 UAF10    LDD    T2          PROCESS *AFFRE* FLAG
          ZJN    UAF11       IF *CLEAR* REQUEST
          LDM    FCBT,CI
          NJP    UAF2.1      IF FILE CURRENTLY DISK RESIDENT
          LDN    PSNI        ENABLE SET OF FLAG
          STM    UAFE
 UAF11    LDM    FCAF,CI     ALTERNATE STORAGE FLAGS
          LPC    -AFFREM     CLEAR *AFFRE* FLAG
 UAFE     UJN    UAF12       DO NOT RESET FLAG
*         PSN                (*SET* REQUEST)
          LMC    AFFREM      SET *AFFRE* FLAG
 UAF12    LJM    UAF4        STORE ALTERNATE STORAGE FLAGS
 UFL      SPACE  4,20
**        UFL - UPDATE FILE LENGTH.
*
*         ENTRY  (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
*
*         EXIT   FILE LENGTH UPDATED IN PFC.
*
*         USES   CM, T6.
*
*         CALLS  CTA, PDA, RMD, SDN, SEI.
*
*         MACROS ERROR, SETMS.
*
*         NOTES  THIS SUBROUTINE ASSUMES THAT THE FILE IS NOT
*                CURRENTLY ATTACHED IN A WRITEABLE MODE; THE
*                CORRECTNESS OF THAT ASSUMPTION DEPENDS ON LOGIC IN
*                *PFDUMP* AND *PFU*.  THIS SUBROUTINE WILL ONLY BE
*                CALLED IF *TFLOK* IS STILL SET, AND *PFDUMP* DOES
*                NOT SET *TFLOK* UNTIL AFTER *PFU* HAS DETERMINED
*                THAT THE FILE IS NOT BUSY.
 
 
 UFL      SUBR               ENTRY/EXIT
          LDM    FCBS,CI
          SHN    21-13
          PJN    UFLX        IF INDIRECT ACCESS FILE
          LDM    FCLF,CI
          ADM    FCLF+1,CI
          NJN    UFLX        IF FILE LENGTH NONZERO
          LDM    FCDN,CI     CHECK DEVICE NUMBER
          LPN    77
          ZJN    UFL2        IF FILE ON MASTER DEVICE
 
*         PROCESS ALTERNATE DEVICE ACCESS.
 
          STD    CM
          LDM    PFPN+4      SET FAMILY EST ORDINAL
          RJM    SDN         SEARCH FOR DEVICE NUMBER
          PJN    UFL2        IF DEVICE FOUND
          ADN    1
          RJM    PDA         PROCESS DEVICE AVAILABILITY
 UFL1     ERROR  DAD,CH      * DIRECT ACCESS DEVICE ERROR.*
 
*         DETERMINE FILE LENGTH.
 
 UFL2     LDM    FCBT,CI     SET FILE FIRST TRACK
          STD    T6
          SETMS  STATUS
          LDD    CM+4        SET TRT ADDRESS FOR *SEI*
          SHN    3
          ADN    TRLL
          RJM    CTA         CALCULATE FWA OF TRT
          SBD    TH
          STM    SEIA+1
          SHN    -14
          LMC    ADCI
          STM    SEIA
          LDN    0           FORCE CURRENT TRT
          RJM    SEI         SKIP TO EOI
          LDD    T2          SET FILE LENGTH
          STM    FCLF,CI
          LDD    T3
          STM    FCLF+1,CI
          RJM    RMD         RESET TO MASTER DEVICE
          UJP    UFLX        RETURN
 UTF      SPACE  4,20
**        UTF - UPDATE TAPE ALTERNATE STORAGE FLAGS.
*
*         ENTRY  (CI) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   (FCTF) UPDATED.
*
*         USES   T1, T2.
*
*         NOTE - CODE TO SET AND CLEAR SOME OF THESE FLAGS ARE INCLUDED
*                IN THIS FUNCTION ONLY FOR TESTING PURPOSES.  DURING
*                NORMAL SYSTEM OPERATION, THE FLAGS ARE SET BY OTHER
*                MEANS.  FOR EXAMPLE, *PFDUMP* SETS THE FLAG *TFLOK*
*                BY CALLING THE *PFU* FUNCTION *CTSL*, AND SETS THE
*                FLAGS *TFSVS*, *TFLIF*, *TFCTS* AND *TFACS* BY
*                SPECIFYING THESE BITS ON THE CALL TO *SETASA*.
 
 
 UTF      SUBR               ENTRY/EXIT
          LDM    PFES        SAVE SET/CLEAR FLAG
          SCN    77
          STD    T2
          LDM    PFES        GET PROCESSOR ADDRESS
          LPN    77
          STD    T1
          SBN    TFMAX+1
          PJN    UTF1        IF INVALID FLAG NUMBER
          LDM    UTFA,T1
          STD    T1
          LJM    0,T1        PROCESS FLAG
 
 UTFA     BSS    0           TABLE OF ERROR FLAG PROCESSORS
          LOC    0
          CON    UTF1        *TFVER* PROCESSOR
          CON    UTF2        *TFSVS* PROCESSOR
          CON    UTF5        *TFPVN* PROCESSOR
          CON    UTF7        *TFSVN* PROCESSOR
          CON    UTF9        *TFEPV* PROCESSOR
          CON    UTF11       *TFESV* PROCESSOR
          CON    UTF13       *TFLIF* PROCESSOR
          CON    UTF15       *TFCTS* PROCESSOR
          CON    UTF17       *TFACS* PROCESSOR
          CON    UTF1        RESERVED
          CON    UTF1        RESERVED
          CON    UTF19       *TFLOK* PROCESSOR
          LOC    *O
 
 UTF1     ERROR  ICU         * INVALID CATALOG UPDATE.*
 
*         PROCESS *SECONDARY VSN EXISTS* FLAG.
 
 UTF2     LDD    T2          PROCESS *TFSVS*
          NJN    UTF3        IF *SET* REQUEST
          STM    UTFB
 UTF3     LDM    FCTF,CI     SET/CLEAR *TFSVS* FLAG
          SCN    TFSVSM
 UTFB     LMN    TFSVSM
*         PSN                (*CLEAR* REQUEST)
 UTF4     STM    FCTF,CI     UPDATE FLAG FIELD IN CATALOG
          UJP    UTFX        RETURN
 
*         PROCESS *PRIMARY VSN NOT AVAILABLE* FLAG.
 
 UTF5     LDD    T2          PROCESS *TFPVN*
          NJN    UTF6        IF *SET* REQUEST
          STM    UTFC
 UTF6     LDM    FCTF,CI     SET/CLEAR *TFPVN* FLAG
          SCN    TFPVNM
 UTFC     LMN    TFPVNM
*         PSN                (*CLEAR* REQUEST)
          UJN    UTF4        RETURN
 
*         PROCESS *SECONDARY VSN NOT AVAILABLE* FLAG.
 
 UTF7     LDM    FCTF,CI     CHECK IF SECONDARY VSN EXISTS
          LPK    TFSVSM
          ZJP    UTF1        IF SECONDARY VSN NOT DEFINED
          LDD    T2
          NJN    UTF8        IF *SET* REQUEST
          STM    UTFD
 UTF8     LDM    FCTF,CI     SET/CLEAR *TFSVN* FLAG
          SCN    TFSVNM
 UTFD     LMN    TFSVNM
*         PSN                (*CLEAR* REQUEST)
          UJN    UTF4        RETURN
 
*         PROCESS *DATA ERROR ON PRIMARY VSN* FLAG.
 
 UTF9     LDD    T2
          NJN    UTF10       IF *SET* REQUEST
          STM    UTFE
 UTF10    LDM    FCTF,CI     SET/CLEAR *TFEPV* FLAG
          SCN    TFEPVM
 UTFE     LMN    TFEPVM
*         PSN                (*CLEAR* REQUEST)
          UJP    UTF4        RETURN
 
*         PROCESS *DATA ERROR ON SECONDARY VSN* FLAG.
 
 UTF11    LDM    FCTF,CI     CHECK IF SECONDARY VSN EXISTS
          LPK    TFSVSM
          ZJP    UTF1        IF SECONDARY VSN NOT DEFINED
          LDD    T2
          NJN    UTF12       IF *SET* REQUEST
          STM    UTFF
 UTF12    LDM    FCTF,CI     SET/CLEAR *TFESV* FLAG
          SCN    TFESVM
 UTFF     LMN    TFESVM
*         PSN                (*CLEAR* REQUEST)
          UJP    UTF4        RETURN
 
*         PROCESS *FILE ON LI FORMAT TAPE* FLAG.
 
 UTF13    LDD    T2          PROCESS *TFLIF*
          NJN    UTF14       IF *SET* REQUEST
          STM    UTFG
          STM    UTFG+1
 UTF14    LDM    FCTF,CI     SET/CLEAR *TFLIF* FLAG
          LPC    -TFLIFM
 UTFG     LMC    TFLIFM
*         PSN                (*CLEAR* REQUEST)
          UJP    UTF4        RETURN
 
*         PROCESS *FILE ON CARTRIDGE (CT/AT) TAPE* FLAG.
 
 UTF15    LDD    T2          PROCESS *TFCTS*
          NJN    UTF15       IF *SET* REQUEST
          STM    UTFH
          STM    UTFH+1
 UTF16    LDM    FCTF,CI     SET/CLEAR *TFCTS* FLAG
          LPC    -TFCTSM
 UTFH     LMC    TFCTSM
*         PSN                (*CLEAR* REQUEST)
          UJP    UTF4        RETURN
 
*         PROCESS *FILE ON ACS CARTRIDGE (AT) TAPE* FLAG.
 
 UTF17    LDD    T2          PROCESS *TFACS*
          NJN    UTF18       IF *SET* REQUEST
          STM    UTFI
          STM    UTFI+1
 UTF18    LDM    FCTF,CI     SET/CLEAR *TFACS* FLAG
          LPC    -TFACSM
 UTFI     LMC    TFACSM
*         PSN                (*CLEAR* REQUEST)
          UJP    UTF4        RETURN
 
*         PROCESS *TFLOK* FLAG.
 
 UTF19    LDD    T2
          ZJP    UTF1        IF *CLEAR* REQUEST
          LDM    FCTF,CI     SET *TFLOK* FLAG
          LPC    -TFLOKM
          LMC    TFLOKM
          UJP    UTF4        RETURN
 WCE      SPACE  4,15
**        WCE - REWRITE CATALOG ENTRY.
*
*         ENTRY  (CI) = ADDRESS OF CATALOG ENTRY.
*                (CB) = ADDRESS OF CATALOG BUFFER.
*
*         EXIT   TO *3PU*.
*                (FCKD) UPDATED AND CATALOG SECTOR REWRITTEN.
*
*         USES   CM - CM+4.
*
*         CALLS  WBI.
*
*         MACROS ENDMS.
 
 
 WCE      BSS    0           ENTRY
          LDN    PDTL        UPDATE CONTROL MODIFICATION DATE
          CRD    CM
          LDD    CM+2
          STM    FCKD,CI
          LDD    CM+3
          STM    FCKD+1,CI
          LDD    CM+4
          STM    FCKD+2,CI
          LDD    CB          REWRITE CATALOG BUFFER
          RJM    WBI
          ENDMS
          EXECUTE  3PU       TERMINATE PROGRAM
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPSDN
 SEI$     SET    0           FORCE TRT UPDATE ON *SEI* CALLS
*CALL     COMPSEI
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF1-2  OVERFLOW INTO CATALOG BUFFER
          OVERLAY  (DEVICE TO DEVICE TRANSFER.),LOCG
          SPACE  4,10
**        THIS OVERLAY PROCESSES DEVICE-TO-DEVICE TRANSFER FOR
*         THE INDIRECT ACCESS FILE COMMANDS *GET*, *OLD*, *SAVE*,
*         *REPLACE*, AND *APPEND*.
 
 
 OVL      BSS    0           ENTRY
          RJM    CES         CREATE EOI SECTOR
          UJN    ".Q"X       RETURN
          TITLE  DEVICE-TO-DEVICE TRANSFER MAIN LOOP.
**        DTD - DEVICE TO DEVICE TRANSFER.
*
*         ENTRY  (T4 - T7) = MASS STORAGE PARMETERS TO START READ AT.
*                (SDAA - SDAC) = MASS STORAGE PARAMETERS FOR 1ST WRITE
*                (BB) = ADDRESS TO START READING IN AT.
*                (FA) = FST ADDRESS.
*                (LF - LF+1) = FILE LENGTH.
*
*         CALLS  IBA, PDV, RNS, SDP, WES, WNS.
*
*         MACROS ERROR, SETMS.
 
 
 DTD      BSS    0           ENTRY
          LDK    PTE         SET ERROR PROCESSOR ADDRESS FOR *RNS*
          STM    MSRA
 DTD0     LDD    BB
          RJM    RNS
          LDI    BB
          ADM    1,BB
          ZJN    DTD1        IF EOI
          RJM    IBA         INCREMENT BUFFER ADDRESSES
          MJN    DTD0        IF BUFFER NOT FULL
 DTD1     RJM    SDP         SWAP DISK PARAMETERS
 DTD2     LDI    BB
          ADM    1,BB
          ZJP    DTD4        IF EOI SECTOR
          SOD    LF+1        DECREMENT LENGTH
          PJN    DTD3        IF NO UNDERFLOW
          AOD    LF+1
          SOD    LF
          MJP    DTD7        IF LENGTH ERROR
 DTD3     RJM    WNS         WRITE NEXT SECTOR
          RJM    IBA         INCREMENT BUFFER ADDRESSES
          MJN    DTD2        IF STILL ANOTHER SECTOR IN BUFFER
          RJM    SDP         SWAP DISK PARAMETERS
          SETMS  READSTR,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LJM    DTD0        LOOP
 
*         EOI SECTOR ENCOUNTERED.
 
 DTD4     LDD    LF          CHECK FILE LENGTH
          ADD    LF+1
          ZJN    DTD8        IF NO LENGTH ERROR
          LDD    CC
          LMN    CCGT
          ZJN    DTD7        IF *GET*
          LMN    CCOD&CCGT
          ZJN    DTD7        IF *OLD*
          LMN    CCUG&CCOD
          ZJN    DTD7        IF *UGET*
 
*         IF EOI ENCOUNTERED ON *SAVE*/*REPLACE*/*APPEND* BEFORE
*         FILE LENGTH EXHAUSTED, FILL TO END OF FILE WITH EOF-S.
 
 DTD5     SOD    LF+1        DECREMENT LENGTH
          PJN    DTD6        IF STILL MORE SECTORS
          AOD    LF+1
          SOD    LF
          MJN    DTD7        IF END OF SPACE
 DTD6     RJM    WNS         WRITE EOF
          UJN    DTD5        CHECK IF MORE EOF-S NEEDED
 
 DTD7     LJM    PLE         PROCESS LENGTH ERROR
 
 DTD8     RJM    WES         WRITE EOI SECTOR
          LDD    FA
          ZJN    DTD9        IF NOT FST
          NFA    FA,R
          ADN    FSTL
          CWD    FS
 
 DTD9     LDC    0
 DTDA     EQU    *-1         (TRANSFER ERROR FLAG)
          ZJN    DTD10       IF NO TRANSFER ERRORS
          LDM    SDAA        SET SOURCE EST ORDINAL
          ERROR  DTE,CH      *DATA TRANSFER ERROR.*
 
 DTD10    LDM    IAIF        CHECK FOR INDIRECT ALLOCATION INTERLOCK
          ZJN    DTD11       IF INDIRECT ALLOCATION INTERLOCK NOT SET
          LDD    EQ          CLEAR INTERLOCK (SET CHECKPOINT BIT)
          ADC    4000
          STD    CM+1
          LDM    DVLW
          STD    CM+2
          LDN    CTIS
          STD    CM+3
          MONITOR  STBM
*         LDN    0           CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
          STM    IAIF
 DTD11    EXECUTE  3PU       TERMINATE PROGRAM
          TITLE  SUBROUTINES.
 DPC      SPACE  4,10
**        DPC - DECREMENT PRU COUNTER.
*
*         ENTRY  (DPCA) PRESET FOR SRU ACCUMULATION OPTION.
*                       .EQ. 0 TO ACCUMULATE SRUS.
*                       .NE. 0 TO NOT ACCUMULATE SRUS.
*
*         EXIT   (IAPF) UPDATED IF SPECIFIED NUMBER OF PRUS TRANSFERRED
*                AND SRU ACCUMULATION OPTION ON.
 
 
 DPC      SUBR               ENTRY/EXIT
          SOM    DPCB        DECREMENT PRUS TRANSFERRED
          NJN    DPCX        IF INCREMENT NOT EXHAUSTED
 DPCA     LDN    0           CHECK SRU ACCUMULATION OPTION
*         LDN    1           (NO SRU ACCUMULATION)
          NJN    DPCX        IF NO SRU ACCUMULATION
          LDN    IPPR        INCREMENT SRUS FOR TRANSFER
          RAM    AIPF+1
          SHN    -14
          RAM    AIPF
          LDN    IPPN        RESET PRU TRANSFER INCREMENT
          STM    DPCB
          UJN    DPCX        RETURN
 
 DPCB     CON    IPPN        PRU TRANSFER INCREMENT
 IBA      SPACE  4,10
**        IBA - INCREMENT BUFFER ADDRESS.
*
*         EXIT   (A) .LT. 0, IF BUFFER NOT FULL.
 
 
 IBA2     LDC    502         FULL BUFFER NEEDED FOR WRITE ERROR
          RAD    BB
          LCN    1
 
 IBA      SUBR               ENTRY/EXIT
          LDD    BB
          LMM    SDPA
          ZJN    IBA2        IF FIRST SECTOR IN BUFFER
          LDI    BB
          ZJN    IBA1        IF EOF
          LDM    1,BB        GET LENGTH
          SHN    2
          ADM    1,BB
 IBA1     ADN    2
          RAD    BB
          ADC    -BFMS
          UJN    IBAX        RETURN
 PLE      SPACE  4,10
**        PLE - PROCESS LENGTH ERROR.
*
*         CALLS  WES.
*
*         MACROS ERROR.
 
 
 PLE      BSS    0           ENTRY
          RJM    WES         WRITE EOI SECTOR
          LDM    PLEA
          NJN    PLE1        IF LENGTH ERROR DUE TO HARDWARE FAILURE
          LDM    SDAA        SET SOURCE EST ORDINAL
          ERROR  FLE,CH,,,,EI  *EQXXX,DNYY, FILE LENGTH ERROR.*
 
 PLE1     LDM    SDAA        SET SOURCE EST ORDINAL
          ERROR  FLE,CH      *EQXXX,DNYY, FILE LENGTH ERROR.*
 
 
 PLEA     CON    0           LINKAGE ERROR DUE TO HARDWARE FAILURE
 PTE      SPACE  4,10
**        PTE - PROCESS TRANSFER ERROR.
*
*         ENTRY  READ ERROR DETECTED BY *COMPRNS*.
*
*         EXIT   (DTDA) .NE. 0 IF DATA TRANSFER ERROR OCCURRED.
*                (PLEA) .NE. 0 IF LINKAGE ERROR OCCURRED.
*
*         CALLS  PES.
 
 
 PTE      SUBR               ENTRY/EXIT
          RJM    PES         PROCESS ERROR STATUS
          LDM    RDCT        CHECK TYPE OF ERROR
          SHN    21-13
          PJN    PTE1        IF VALID SECTOR READ
          AOM    PLEA        INDICATE LINKAGE ERROR
          LDN    0           SET EOI LINKAGE TO TERMINATE TRANSFER
          STM    1,BB
          STI    BB
          UJN    PTEX        RETURN
 
 PTE1     AOM    DTDA        INDICATE TRANSFER ERROR
          UJN    PTEX        RETURN
 SDP      SPACE  4,15
**        SDP - SWAP DISK PARAMETERS.
*
*         ENTRY  (SDAA - SDAC) = NEXT DEVICE PARAMETERS.
*                (T5 - T7) = CURRENT DEVICE PARAMETERS.
*
*         EXIT   (T4 - T7) = DISK INFORMATION FOR NEXT DEVICE.
*                (BB) = STARTING BUFFER ADDRESS.
*                *SETMS* WRITE PERFORMED.
*
*         USES   T0 - T7.
*
*         CALLS  PDV.
*
*         MACROS ENDMS, SETMS.
 
 
 SDP      SUBR               ENTRY/EXIT
          ENDMS
          LDN    T5          SWAP DEVICE PARAMETERS
          STD    T1
 SDP1     LDI    T1
          STD    T0
          LDM    SDAA-T5,T1
          STI    T1
          LDD    T0
          STM    SDAA-T5,T1
          AOD    T1
          LMN    T7+1
          NJN    SDP1        IF NOT ALL PARAMETERS SWAPPGD
          SETMS  IO,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDM    UERR        SET TRANSFER MODE (REWRITE OR NON-REWRITE)
          LPC    -EPRW
          LMM    DTMD
          STM    UERR
          LDC    BUF         SET BUFFER ADDRESS
 SDPA     EQU    *-1
          STD    BB
          STM    WDSE        SET WRITE ERROR BUFFER ADDRESS
          LJM    SDPX        RETURN
 SNS      SPACE  4,15
**        SNS - SET NEXT SECTOR.
*
*         ENTRY  (T7) = CURRENT SECTOR.
*                (SNSA) PRESET IF ACCUMULATION DESIRED.
*
*         EXIT   (T3) = NEXT SECTOR/TRACK.
*
*         USES   T3.
*
*         CALLS  SNT.
 
 
 SNS      SUBR               ENTRY/EXIT
          LDD    T7          SET NEXT SECTOR
          ADN    1
          STD    T3
          LMM    SLM
          NJN    SNSX        IF NOT SECTOR LIMIT
 
*         SET NEXT TRACK.
 
 SNSA     LDN    0
*         LDN    1           (IF PRU ACCUMULATION DESIRED)
          ZJN    SNS1        IF NO PRU ACCUMULATION
          LDM    SLM         INCREMENT PRU COUNT FOR NEXT TRACK
          RAM    AIPR+1
          SHN    -14
          RAM    AIPR
 SNS1     RJM    SNT         SET NEXT TRACK
          STD    T3
          UJN    SNSX        RETURN
 WES      SPACE  4,20
**        WES - WRITE EOI SECTOR.
*
*         ENTRY  (T4) = CHANNEL (RESERVED).
*                (T5) = EST ORDINAL.
*                (T6) = EOI TRACK.
*                (T7) = EOI SECTOR.
*                (CC) = COMMAND CODE.
*
*         EXIT   CHANNEL RELEASED.
*                EOI SET IN TRT IF *GET*, *OLD*, OR *UGET* REQUEST.
*                TO *WSE* TO PROCESS WRITE ERRORS.
*
*         USES   CM - CM+4.
*
*         CALLS  WEI.
*
*         MACROS ENDMS, ERROR, MONITOR.
 
 
 WES      SUBR               ENTRY/EXIT
          LDN    0           CLEAR FST ADDRESS
          STD    FA
          RJM    WEI         WRITE EOI
          MJP    WSE         IF WRITE ERROR
          ENDMS
          LDC    *           RESTORE FST ADDRESS
 WESA     EQU    *-1
          STD    FA
          LDD    CC          CHECK REQUEST
          LMN    CCGT
          ZJN    WES1        IF *GET*
          LMN    CCOD&CCGT
          ZJN    WES1        IF *OLD*
          LMN    CCUG&CCOD
          NJN    WESX        IF NOT *UGET*
 WES1     LDD    T5          SET EST ORDINAL
          STD    CM+1
          LDD    T6          SET TRACK
          LPC    3777
          STD    CM+2
          LDD    T7          SET SECTOR
          STD    CM+3
          MONITOR DTKM       SET EOI IN TRT
          UJP    WESX        RETURN
 
 
 WEIA     BSSZ   WCEI*5+2    EOI BUFFER
 WNS      SPACE  4,15
**        WNS - WRITE NEXT SECTOR.
*
*         WRITE SECTOR WITH NEW LINKAGE.  USES OLD WORD COUNT AND
*         EOF FLAGS.  SYSTEM SECTORS ARE HANDLED PROPERLY ALSO.
*         PRU INCREMENTS AND PF INCREMENTS ARE UPDATED.
*
*         ENTRY  (BB) = ADDRESS OF SECTOR BUFFER.
*
*         EXIT   TO *WSE* TO PROCESS WRITE ERRORS.
*
*         USES   T1, T3 - T7.
*
*         CALLS  SNT, WDS.
 
 
 WNS      SUBR               ENTRY/EXIT
          RJM    SNS         SET NEXT SECTOR
          LDI    BB
          NJN    WNS1        IF NOT EOF
 
*         PROCESS EOF.
 
          LDD    T3          SET NEXT SECTOR ADDRESS
          STM    1,BB
          UJN    WNS3        WRITE SECTOR
 
*         PROCESS SYSTEM SECTOR.
 
 WNS1     LMC    3777
          NJN    WNS2        IF NOT SYSTEM SECTOR
          LDD    T3          SET NEXT SECTOR ADDRESS
          STM    NSSS-BFMS,BB
          UJN    WNS3        WRITE SECTOR
 
*         PROCESS DATA SECTOR.
 
 WNS2     LDD    T3          SET NEXT SECTOR ADDRESS
          STI    BB
 
*         WRITE SECTOR.
 
 WNS3     LDD    BB
          STD    T1
          RJM    IBA         INCREMENT BUFFER ADDRESS
          SHN    -21
          ZJN    WNS4        IF END OF BUFFER
          LDC    WCSF&WLSF   WRITE CONSECUTIVE SECTOR
 WNS4     LMD    T1+WLSF     WRITE LAST SECTOR
          STD    BB          RESET BUFFER ADDRESS
          RJM    WDS
          MJN    WSE         IF WRITE ERROR
          RJM    DPC         DECREMENT PRU COUNT
 
*         SET NEXT SECTOR.
 
          LDD    T3          SET NEXT SECTOR
          STD    T7
          SHN    21-13
          PJN    WNS5        IF NOT TRACK POINTER
          SHN    -21+13      SET NEXT TRACK
          STD    T6
          LDN    0
          STD    T7
 WNS5     LJM    WNSX        RETURN
 WSE      SPACE  4,15
**        WSE - WRITE MASS STORAGE ERROR PROCESSOR.
*
*         ENTRY  (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
*                (RDCT) = DRIVER STATUS.
*                (STAT) = *STNS* BIT SET IF JOB SUSPENSION NOT ALLOWED.
*
*         EXIT   (PWRF) = *RFRR* FLAG SET IF REQUEST TO BE RETRIED
*                         DUE TO UNRECOVERABLE WRITE ERROR.
*                TO *ERR* TO RETRY REQUEST OR ISSUE ERROR MESSAGE.
*
*         MACROS ERROR.
 
 
 WSE      BSS    0           ENTRY
          LDM    STAT        *PFM* STATUS BITS
          LPK    STNS
          NJN    WSE3        IF JOB SUSPENSION INHIBITED
          LDM    RDCT        DRIVER STATUS
          SHN    21-12
          PJN    WSE1        IF RECOVERABLE ERROR
          LDM    PWRF        CHECK RESTART FLAGS
          LPK    RFRR
          NJN    WSE2        IF REQUEST ALREADY RETRIED
          LDK    RFRR        SET RETRY REQUEST FLAG
          RAM    PWRF
 WSE1     ERROR  RTR,CH      RETRY REQUEST
 
 WSE2     ERROR  MSE,CH,,T5  *EQXXX,DNYY, MASS STORAGE ERROR.*
 
 WSE3     ERROR  MSE,CH,,T5,,EI  *EQXXX,DNYY, MASS STORAGE ERROR.*
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPWEI
 BUF      SPACE  4,10
*         BUF - BUFFER USED IN DEVICE TO DEVICE TRANSFER.
 
 
 BUF      BSS    0
 
 .BUFL    SET    EPFW-BUF
          ERRNG  .BUFL-5020  NOT ROOM FOR 8 SECTORS IN BUFFER
 CES      SPACE  4,10
**        CES - CREATE EOI SECTOR.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (FA) = FST ADDRESS.
*                (FS - FS+4) = FST IMAGE (*GET*/*OLD*/*UGET* REQUEST).
*                (SDAA - SDAC) = PARAMETERS FOR 1ST WRITE.
*
*         EXIT   (WEIA) SET UP WITH EOI DATA.
*                (WESA) = FST ADDRESS.
 
 
 CES2     LDD    MA          MOVE FST INFORMATION TO EOI BUFFER
          CWM    SDAA,ON
          SBN    1
 CES3     CRM    WEIA+FSEI,ON
          LDD    FA          SAVE FST ADDRESS
          STM    WESA
          NFA    FA,R        COPY FILE NAME TO EOI BUFFER
          ADK    FNTL
          CRM    WEIA+FNEI,ON
 
 CES      SUBR               ENTRY/EXIT
          LDD    CC          CHECK REQUEST
          LMN    CCGT
          ZJN    CES1        IF *GET* FUNCTION
          LMN    CCOD&CCGT
          ZJN    CES1        IF *OLD*
          LMN    CCUG&CCOD
          NJN    CES2        IF NOT *UGET*
 CES1     LDD    MA          COPY FST IMAGE TO EOI BUFFER
          CWD    FS
          UJN    CES3        READ FST ENTRY
          SPACE  4,10
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 BUF      EQU    /".O"/BUF
 DPCA     EQU    /".O"/DPCA
 DPCB     EQU    /".O"/DPCB
 DTD      EQU    /".O"/DTD
 DTDA     EQU    /".O"/DTDA
 IBA      EQU    /".O"/IBA
 PLE      EQU    /".O"/PLE
 PLEA     EQU    /".O"/PLEA
 PTE      EQU    /".O"/PTE
 SDP      EQU    /".O"/SDP
 SDPA     EQU    /".O"/SDPA
 SNSA     EQU    /".O"/SNSA
 WNS      EQU    /".O"/WNS
          OVERLAY  (APPEND - ORIGINAL FILE TRANSFER.),(BUF+5)
          SPACE  4,10
**        THIS OVERLAY (TOGETHER WITH OVERLAY *3PP*) PERFORMS THE
*         DEVICE-TO-DEVICE TRANSFER OF THE ORIGINAL PERMANENT FILE,
*         WHEN REQUIRED, FOR THE INDIRECT ACCESS FILE COMMAND
*         *APPEND*.  ONCE THIS TRANSFER IS COMPLETE, OVERLAY *3PP*
*         IS CALLED TO COPY THE LOCAL FILE.
 
 
 OVL      BSS    0           ENTRY
          UJN    ".Q"X       RETURN AFTER LOAD
 ADT      SPACE  4,15
**        ADT - APPEND DISK TRANSFER.
*
*         ENTRY  (FS - FS+4) = FST ENTRY FOR SYSTEM FILE.
*                (PFFN) = BEGINNING TRACK OF READ FILE.
*                (PFFN+1) = BEGINNING SECTOR OF READ FILE.
*
*         EXIT   TO *DTD*.
*                TO *PLE* FOR LENGTH ERRORS.
*
*         USES   BB, P0, P1, T5, T6, T7, CM - CM+4, LF - LF+1.
*
*         CALLS  CSS, CTI, DTD, IBA, PDV, PLE, RNS, RSS, SDP, STI, WNS.
*
*         MACROS ENDMS, ERROR, MONITOR, SETMS.
 
 
 ADT      BSS    0           ENTRY
          LDK    PTE         SET ERROR PROCESSOR ADDRESS FOR *RNS*
          STM    MSRA
 ADT2     LDD    BB          READ NEXT SECTOR
          RJM    RNS
          LDI    BB
          ADM    1,BB
          ZJN    ADT3        IF EOI
          RJM    IBA         INCREMENT BUFFER ADDRESSES
          MJN    ADT2        IF BUFFER NOT FULL
 ADT3     RJM    SDP         SWAP DISK PARAMETERS
 ADT4     LDI    BB
          ADM    1,BB
          ZJN    ADT6        IF EOI SECTOR
          SOD    LF+1        DECREMENT LENGTH
          PJN    ADT5        IF NO UNDEFLOW
          AOD    LF+1
          SOD    LF
          PJN    ADT5        IF NO LENGTH ERROR
          LJM    PLE         PROCESS LENGTH ERROR
 
 ADT5     RJM    WNS         WRITE NEXT SECTOR
          RJM    IBA         INCREMENT BUFFER ADDRESS
          MJN    ADT4        IF STILL ROOM IN BUFFER
          RJM    SDP         SWAP DISK PARAMETERS
          SETMS  READSTR,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LJM    ADT2        LOOP
 
*         CHECK FOR DELAYED DELINK REQUEST FOR ORIGINAL FILE.
 
 ADT6     LDM    APDK+1
          ZJP    ADT9        IF NO DELINK REQUESTED
          ENDMS
          LDD    MA          COPY DELINK PARAMETERS
          CWM    APDK,ON
          SBN    1
          CRD    CM
          MONITOR DLKM
          LDM    STAT
          LPC    STBD+STXC
          LMC    STBD+STXC
          ZJN    ADT9        IF EXTENDING CHAIN ON BUFFERED DEVICE
          LDD    EQ          CLEAR INDIRECT ALLOCATION INTERLOCK
          STD    CM+1
          LDM    DVLW
          STD    CM+2
          LDN    CTIS
          STD    CM+3
          MONITOR  STBM
*         LDN    0           CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
          STM    IAIF
 
*         COPY LOCAL FILE TO INDIRECT FILE.
 
 ADT9     SOM    DPCA        ENABLE SRU ACCUMULATION
          LDN    IPPN        RESET PRU TRANSFER INCREMENT
          STM    DPCB
          LDD    FS          SET UP LOCAL FILE PARAMETERS
          STM    SDAA
          LDD    FS+1
          STM    SDAB
          LDN    FSMS
          STM    SDAC
          LDC    BUF         RESET BUFFER ADDRESS
          STM    SDPA
          RJM    SDP         SWAP DISK PARAMETERS
          SETMS  READSTR,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LJM    DTD         ENTER DEVICE TO DEVICE TRANSFER
 BUFA     SPACE  4,10
*         BUFA - BUFFER FOR DEVICE TO DEVICE TRANSFER OF
*                EXISTING INDIRECT FILE.
 
 
 BUFA     BSS    0
 
 .BUFAL   SET    EPFW-BUFA
          ERRNG  .BUFAL-4316 NOT ROOM FOR 7 SECTORS IN BUFFER
          SPACE  4,10
*         EQUIVALENCE EXTERNALLY REFERENCED TAGS.
 
 
          QUAL   *
 
 ADT      EQU    /".O"/ADT
 BUFA     EQU    /".O"/BUFA
          OVERLAY  (STAGE FILE FROM ALTERNATE STORAGE.)
 SPF      SPACE  4,15
**        THIS OVERLAY INITIATES A STAGE OPERATION FOR A FILE WHICH
*         IS NOT CURRENTLY RESIDENT ON DISK, BUT WHICH HAS A VALID
*         COPY ON ALTERNATE STORAGE.  THIS IS ACCOMPLISHED BY
*         ISSUING A *TDAM* REQUEST TO THE APPROPRIATE EXECUTIVE TO
*         INITIATE STAGING OF THE FILE.  THE JOB IS THEN PLACED IN
*         TIMED-EVENT ROLLOUT TO AWAIT COMPLETION OF THE STAGE.  THE
*         ORIGINAL *PFM* REQUEST WILL BE REISSUED AUTOMATICALLY WHEN
*         THE JOB ROLLS IN.
 
 
 SPF      BSS    0           ENTRY
          RJM    RMD         RESET TO MASTER DEVICE
          RJM    CCC         CHECK FOR CARTRIDGE COPY
          STD    P2          SAVE CARTRIDGE COPY STATUS
          RJM    CTC         CHECK FOR TAPE COPY
          STD    P3          SAVE TAPE COPY STATUS
          RJM    UPF         UPDATE PFC
 
*         CHECK ERROR STATUS.
 
          LDN    0           INDICATE CARTRIDGE STAGING ATTEMPT
          STD    P1
          LDD    P2
          ZJN    SPF5        IF NO ERROR ON CARTRIDGE COPY
          AOD    P1          INDICATE TAPE STAGING ATTEMPT
          LDD    P3
          ZJN    SPF5        IF NO ERROR ON TAPE COPY
 
*         FILE CANNOT BE STAGED - DETERMINE CORRECT ERROR MESSAGE.
 
          LDD    P2          CHECK CARTRIDGE COPY ERROR STATUS
          SBN    1
          NJN    SPF1        IF CARTRIDGE COPY EXISTS
          LDD    P3          CHECK TAPE COPY ERROR STATUS
          SBN    1
          NJN    SPF1        IF TAPE COPY EXISTS
          ERROR  AIO,CH,IW   * NO ALTERNATE STORAGE COPY EXISTS.*
 
 SPF1     LDD    P2          CHECK CARTRIDGE COPY ERROR STATUS
          SBN    2
          ZJN    SPF2        IF STAGING DISABLED ERROR
          LDD    P3          CHECK TAPE COPY ERROR STATUS
          SBN    2
          NJN    SPF3        IF NOT STAGING DISABLED ERROR
 SPF2     ERROR  SGD,CH,IW   * STAGING DISABLED.*
 
 SPF3     LDD    P2          CHECK CARTRIDGE COPY ERROR STATUS
          SBN    3
          NJN    SPF4        IF NOT TEMPORARY ERROR
          ERROR  TPE,CH,IW   *(NAME) TEMPORARY ERROR, TRY LATER.*
 
 SPF4     ERROR  PPE,CH,IW   *(FILE NAME) PERMANENT ERROR.*
 
*         LOOP *MXRL* TIMES ISSUING *TDAM* REQUESTS TO THE EXECUTIVE.
 
 SPF5     RJM    STR         SETUP *TDAM* REQUEST
          LDC    ART         SET ROLLOUT TIME LIMIT
          STM    ERRD
          LDN    0           INITIALIZE FOR LOOP
          STD    P0
 
*         CHECK IF STAGING STILL ENABLED.
 
 SPF6     LDN    SSTL        CHECK FOR STAGING DISABLED
          CRD    CM
          LDD    P1
          NJN    SPF8        IF TAPE STAGING REQUEST
          LDD    CM
          SHN    21-6
          PJN    SPF9        IF CARTRIDGE STAGING ENABLED
 SPF7     ERROR  SGD,CH,IW   *STAGING DISABLED.*
 
 SPF7.1   LDD    CM+1        CHECK FOR *ACS TAPE PF STAGING* ENABLED
          SHN    21-11
          UJN    SPF8.1      CHECK IF ENABLED
 
 SPF8     LDM    FCTF,CI
          SHN    21-TFACS
          MJN    SPF7.1      IF FILE ON ACS CARTRIDGE TAPE
          LDD    CM+1        CHECK FOR *TAPE PF STAGING* ENABLED
          SHN    21-7
 SPF8.1   MJN    SPF7        IF STAGING DISABLED
 
*         ISSUE *TDAM* REQUEST.
 
 SPF9     LDN    1           SET WRITE FUNCTION
          STD    CM+1
 SPFA     LDC    MTSI        SET *MAGNET* SUBSYSTEM ID
*         LDC    MFSI        (SET *MSS* SUBSYSTEM ID)
*         LDC    AFSI        (SET *MSE* SUBSYSTEM ID)
          STD    CM+2
          LDC    6*100       SET MESSAGE LENGTH
          STD    CM+3
 SPFB     LDC    /MTX/PFTB   SET ADDRESS OF *MAGNET* *TDAM* BUFFER
*         LDC    MIRE        SET ADDRESS OF *MSS*/MSE* *TDAM* BUFFER
          STD    CM+4
          MONITOR  TDAM      ISSUE *TDAM* REQUEST
          LJM    SPFC,CM+1   PROCESS ACCORDING TO *TDAM* REQUEST STATUS
 
 SPFC     BSS    0           *TDAM* STATUS PROCESSOR TABLE
          UJN    SPF10       (ST=0) *TDAM* REQUEST ACCEPTED
          UJN    SPF12       (ST=1) STORAGE MOVE IN PROGRESS
          UJN    SPF13       (ST=2) NOT READY FOR DATA
          UJN    SPF12       (ST=3) REJECT (NONZERO FIRST WORD)
          UJN    SPF13       (ST=4) INACTIVE
 
*         PROCESS THE (ST=0) NORMAL STATUS CASE OF ACCEPTED REQUEST.
 
 SPF10    RJM    ISM         ISSUE REQUEST STAGE MESSAGE
          LDD    CC
          LMN    CCSP
          ZJN    SPF11       IF *STAGEPF* REQUEST
          EXIT   PSI,CH,IW,,EC2  *(PFN) STAGE INITIATED.*
 
 SPF11    EXECUTE  3PU       TERMINATE *PFM* WITH NO ERROR STATUS
 
*         PROCESS THE (ST=1)/(ST=3) STATUS CASES.
 
 SPF12    AOD    P0          TRY *TDAM* *MXRL* TIMES
          SBN    MXRL
          ZJN    SPF13       IF TIME TO GIVE UP
          PAUSE  NE
          LDC    370001+SBNI DELAY
          NJN    *-1         IF DELAY NOT EXHAUSTED
          UJP    SPF6        CONTINUE REQUEST LOOP
 
*         PROCESS THE (ST=2)/(ST=4) STATUS CASES.
 
 SPF13    LDN    0           SET EST ORDINAL FOR EVENT
          STM    ERRE
 SPFD     LDC    MTXE        SET WAITING FOR *MAGNET* EVENT
*         LDC    MSXE        (SET WAITING FOR *MSS* EVENT)
*         LDC    ASXE        (SET WAITING FOR *MSE* EVENT)
          STM    ERRC
          EXIT   PWE,CH,IW,,EC1 *(PFN) WAITING FOR SUBSYSTEM.*
          TITLE  SUBROUTINES.
 CCC      SPACE  4,20
***       CCC - CHECK FOR CARTRIDGE ALTERNATE STORAGE COPY OF FILE.
*
*         ENTRY  (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
*
*         EXIT   (A) = 0 IF CARTRIDGE COPY AVAILABLE.
*                    = 1 IF NO CARTRIDGE COPY EXISTS.
*                    = 2 IF COPY EXISTS BUT CARTRIDGE STAGING DISABLED.
*                    = 3 IF COPY EXISTS BUT TEMPORARY ERROR FLAG SET.
*                    = 4 IF COPY EXISTS BUT PERMANENT ERROR FLAG SET.
*                *AFTMP* ERROR FLAG CLEARED IN PFC, IF PRESENT.
*
*         USES   CM - CM+4.
 
 
 CCC4     LDN    1           SET *NO CARTRIDGE COPY EXISTS* STATUS
 
 CCC      SUBR               ENTRY/EXIT
          LDM    FCAA,CI
          ADM    FCAA+1,CI
          ADM    FCAA+2,CI
          ZJN    CCC4        IF NO CARTRIDGE ALTERNATE STORAGE COPY
          LDM    FCAF,CI
          LPK    AFOBSM
          NJN    CCC4        IF CARTRIDGE COPY OBSOLETE
          LDK    SSTL        CHECK IF CARTRIDGE STAGING ENABLED
          CRD    CM
          LDD    CM
          SHN    21-6
          PJN    CCC2        IF CARTRIDGE PF STAGING ENABLED
          LDN    2           SET *STAGING DISABLED* STATUS
 CCC1     UJN    CCCX        RETURN
 
*         CLEAR CARTRIDGE TEMPORARY ERROR FLAG, IF PRESENT.
 
 CCC2     LDD    CC
          LMN    CCSP
          ZJN    CCC3        IF *STAGEPF* REQUEST
          LDM    FCAF,CI
          LPN    AFTMPM
          ZJN    CCC3        IF NO TEMPORARY ERROR
          LMM    FCAF,CI     CLEAR TEMPORARY ERROR FLAG
          STM    FCAF,CI
          LDN    3           SET *TEMPORARY ERROR FLAG* STATUS
          UJN    CCC1        RETURN
 
 CCC3     LDM    FCAF,CI     CHECK FOR CARTRIDGE ERROR FLAGS
          LPN    AFPSEM+AFPDEM
          ZJN    CCC1        IF NO PERMANENT ERRORS, RETURN *AVAILABLE*
          LDN    4           SET *PERMANENT ERROR FLAG* STATUS
          UJN    CCC1        RETURN
 CTC      SPACE  4,15
**        CTC - CHECK FOR TAPE ALTERNATE STORAGE COPY OF FILE.
*
*         ENTRY  (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
*
*         EXIT   (A) = 0 IF TAPE COPY AVAILABLE.
*                    = 1 IF NO TAPE COPY EXISTS.
*                    = 2 IF COPY EXISTS BUT TAPE STAGING DISABLED.
*                    = 3 IF COPY EXISTS BUT *VSN MISSING* FLAG SET.
*                    = 4 IF COPY EXISTS BUT *DATA ERROR* FLAG SET.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  STT.
 
 
 CTC6     LDN    1           SET *NO COPY EXISTS* STATUS
 
 CTC      SUBR               ENTRY/EXIT
          LDM    FCTV,CI
          ADM    FCTV+1,CI
          ZJN    CTC6        IF NO TAPE ALTERNATE STORAGE COPY OF FILE
          LDK    SSTL        CHECK IF TAPE STAGING IS ENABLED
          CRD    CM
          LDM    FCTF,CI
          STD    T1          SAVE (FCTF)
          SHN    21-TFACS
          MJN    CTC0.1      IF FILE ON ACS CARTRIDGE TAPE
          LDD    CM+1        CHECK FOR *TAPE PF STAGING* ENABLED
          SHN    21-7
          PJN    CTC1        IF TAPE STAGING IS ENABLED
 CTC0     LDN    2           SET *STAGING DISABLED* STATUS
          UJN    CTCX        RETURN
 
 CTC0.1   LDD    CM+1        CHECK FOR *ACS TAPE PF STAGING* ENABLED
          SHN    21-11
          MJN    CTC0        IF ACS TAPE STAGING IS DISABLED
 CTC1     LDD    T1
          LPK    TFPVNM+TFEPVM
          ZJN    CTC5        IF NO ERRORS ON PRIMARY VSN
          LDD    T1
          LPK    TFSVSM
          NJN    CTC4        IF SECONDARY VSN EXISTS
 CTC2     LDD    T1
          LPK    TFPVNM
          ZJN    CTC3        IF PRIMARY VSN AVAILABLE
          LDN    3           SET *VSN NOT AVAILABLE* STATUS
          UJN    CTC5.1      RETURN
 
 CTC3     LDN    4           SET *DATA ERROR* STATUS
          UJN    CTC5.1      RETURN
 
 CTC4     LDD    T1
          LPK    TFSVNM+TFESVM
          ZJN    CTC5        IF NO ERRORS ON SECONDARY VSN
          LPK    TFSVNM
          NJN    CTC2        IF SECONDARY VSN NOT AVAILABLE
          UJN    CTC3        SET *DATA ERROR* STATUS
 
 CTC5     LDN    0           SET *COPY AVAILABLE* STATUS
 CTC5.1   LJM    CTCX        RETURN
 GEE      SPACE  4,15
**        GEE - GET EST ORDINAL FOR EVENT.
*
*         ENTRY  (P1) .NE. 0 IF TAPE STAGE REQUEST.
*                (GEEA) PRESET WITH CORRECT EQUIPMENT MNEMONIC.
*
*         EXIT   (T5) = EST ORDINAL FOR EVENT.
*                       FOR *MSS* STAGE, ORDINAL OF FIRST *CS* EST.
*                       FOR *MSE* STAGE, ORDINAL OF FIRST *SS* EST.
*                       FOR TAPE STAGE, ORDINAL OF FIRST *MT*/*NT* EST.
*
*         USES   T5, T6, T0 - T0+4.
*
*         MACROS ERROR, SFA.
 
 
 GEE      SUBR               ENTRY/EXIT
 
*         INITIALIZE FOR EST SEARCH.
 
          LDN    ESTP        CALCULATE NUMBER OF EST ENTRIES
          CRD    T0
          LDN    NOPE        INITIALIZE EST ORDINAL FOR SEARCH
          STD    T5
          LDD    T0+2        SAVE LAST EST ORDINAL + 1
          STD    T6
 
*         SEARCH FOR ALTERNATE STORAGE EQUIPMENT.
 
 GEE1     SFA    EST,T5      READ EST ENTRY
          ADK    EQDE
          CRD    T0
          LDD    T0+3        CHECK EQUIPMENT MNEMONIC
 GEEA     LMC    2RMT        EQUIPMENT MNEMONIC FOR TAPE STAGE
*         LMC    2RCS        (EQUIPMENT MNEMONIC FOR *MSS* STAGE)
*         LMC    2RSS        (EQUIPMENT MNEMONIC FOR *MSE* STAGE)
          ZJN    GEEX        IF CORRECT EQUIPMENT MNEMONIC
          LDD    P1
          ZJN    GEE2        IF NOT TAPE STAGE REQUEST
          LDD    T0+3        CHECK EQUIPMENT MNEMONIC AGAIN
          LMC    2RNT        OTHER EQUIPMENT MNEMONIC FOR TAPE STAGE
          ZJN    GEEX        IF CORRECT EQUIPMENT MNEMONIC
 GEE2     AOD    T5          ADVANCE EST ORDINAL
          LMD    T6
          NJN    GEE1        IF NOT END OF EST
          ERROR  PFN,CH,IW   *DEVICE UNAVAILABLE.*
 ISM      SPACE  4,15
**        ISM - ISSUE REQUEST STAGE MESSAGE.
*
*         ISSUES AN *STRS* ACCOUNT FILE MESSAGE TO INDICATE THAT THE
*         REQUEST FOR STAGE WAS SENT TO *MAGNET*.
*
*         ENTRY  (CI) = CATALOG INDEX POINTER TO CATALOG ENTRY.
*                (P1) .NE. 0 IF TAPE STAGE REQUEST.
*                (MSTA) = MST ADDRESS/10.
*
*         EXIT   ACCOUNT FILE MESSAGE ISSUED.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  ACS, C2D, DFM.
 
 
 ISM      SUBR               ENTRY/EXIT
          LDD    P1
 ISME     ZJN    ISMX        IF NOT TAPE PF STAGE REQUEST
*         PSN                (IF OPTICAL DISK REQUEST)
          LDC    ISMB+3      INITIALIZE POINTER FOR *ACS* CALLS
          STD    T1
 
*         SET FILENAME INTO MESSAGE.
 
          LDD    CI          SET ADDRESS OF CATALOG ENTRY
          RAM    ISMA+1
          LDD    MA
 ISMA     CWM    FCFN,ON     PFN AND UI
          SBN    1           READ PFN
          CRD    CM
          LDD    CM+3
          SCN    77
          STD    CM+3        CLEAR UI BITS FROM PFN
          LDN    CM          INSERT FILE NAME IN BUFFER
          RJM    ACS
          LDC    ISMC        APPEND COMMA
          RJM    ACS
 
*         CONVERT USER INDEX TO DISPLAY CODE.
 
          LDD    MA          READ UI
          CRD    CM
          LDD    CM+3
          RJM    C2D         CONVERT 2 OCTAL DIGITS TO DISPLAY CODE
          STD    CM
          LDD    CM+4
          SHN    -6
          RJM    C2D         CONVERT 2 OCTAL DIGITS TO DISPLAY CODE
          STD    CM+1
          LDD    CM+4
          RJM    C2D         CONVERT 2 OCTAL DIGITS TO DISPLAY CODE
          STD    CM+2
 
*         SUPPRESS LEADING ZEROS ON USER INDEX.
 
          LDN    0           TERMINATE STRING BUFFER
          STD    CM+3
          STD    CM+4        CLEAR STARTING BYTE OFFSET
 ISM1     LDM    CM,CM+4
          ADC    -2R00
          STD    T0
          SCN    77
          NJN    ISM3        IF UPPER DIGIT IS NON-ZERO
          LDD    T0
          LPN    77
          NJN    ISM2        IF LOWER DIGIT IS NON-ZERO
          AOD    CM+4        INCREMENT OFFSET
          SBN    3
          MJN    ISM1        IF ALL BYTES NOT EXAMINED
          SOD    CM+4        CORRECT OFFSET
 
*         SET USER INDEX INTO MESSAGE.
 
 ISM2     LDM    CM,CM+4     LOWER DIGIT OF BYTE IS FIRST DIGIT
          SHN    6
          SCN    77
          STM    CM,CM+4
          LDN    CM
          ADD    CM+4
          RJM    ACS         APPEND CHARACTERS TO STRING
          AOD    CM+4
          SBN    3
          PJN    ISM4        IF LAST BYTE WAS SENT
 ISM3     LDN    CM
          ADD    CM+4
          RJM    ACS         APPEND CHARACTERS TO STRING
 ISM4     LDC    ISMC        APPEND COMMA
          RJM    ACS
 
*         SET FAMILY/PACK NAME INTO MESSAGE.
 
          LDM    MSTA        READ FAMILY/PACK NAME
          SHN    3
          ADN    PFGL
          CRD    CM
          LDD    CM+3        CLEAR RESERVED FIELD
          SCN    77
          STD    CM+3
          LDN    CM          INSERT FAMILY IN BUFFER
          RJM    ACS
          LDC    ISMD        APPEND TERMINATOR
          RJM    ACS
 
*         ISSUE MESSAGE.
 
          LDC    ISMB+ACFN   ISSUE MESSAGE TO ACCOUNT FILE
          RJM    DFM
          LJM    ISMX        RETURN
 
 
 ISMB     DATA   C*STRS, *   ACCOUNT FILE MESSAGE BUFFER
          BSSZ   14D
 ISMC     DATA   2H,         MESSAGE SEPARATOR
          CON    0           END OF STRING
 ISMD     DATA   2H.         MESSAGE TERMINATOR
          CON    0           END OF STRING
 STR      SPACE  4,25
**        STR - SETUP *TDAM* REQUEST.
*
*         ENTRY  (CB) = CATALOG BUFFER.
*                (CB-1) = CATALOG SECTOR.
*                (CB-2) = CATALOG TRACK.
*                (CI) = CATALOG INDEX POINTER TO CATALOG ENTRY.
*                (EQ) = MASTER DEVICE EST ORDINAL.
*                (FN - FN+4) = FILE NAME.
*                (MSEQ) = ALTERNATE STORAGE EST ORDINAL.
*                (MSTA) = MST ADDRESS/10.
*                (PFPN - PFPN+4) = PERMANENT FILE CONTROL WORD.
*                (PFUI - PFUI+1) = USER INDEX.
*                (P1) .NE. 0 IF TAPE STAGE REQUEST.
*                (UI - UI+1) = USER INDEX.
*
*         EXIT   MESSAGE BUFFER SETUP FOR *TDAM* REQUEST.
*                (ERRE), (ERRC) SET WITH EVENT TO ROLL JOB OUT WITH.
*                (SPFA), (SPFD) SET WITH SUBSYSTEM ID, EVENT.
*                (SPFB) SET WITH SUBSYSTEM *TDAM* BUFFER ADDRESS.
*
*         USES   CM - CM+4, FN - FN+4, T0 - T0+4.
*
*         CALLS  GEE.
 
 
 STR      SUBR               ENTRY/EXIT
 
*         SET FILE ACCESS LEVEL AND FUNCTION CODE.
 
          LDM    FCAL,CI     SET FILE ACCESS LEVEL
          LPN    7
          SHN    3
          LMD    HN          SET FUNCTION CODE = 1 (TAPE/*MSS*/*MSE*)
          STD    CM
          LDN    0
          STD    CM+1
          LDD    P1
          NJP    STR1.2      IF TAPE STAGE REQUEST
          LDM    FCAT,CI     GET ALTERNATE STORAGE TYPE
          LPN    77B
          STD    T1
          SBN    ATOD
          NJN    STR1        IF NOT OPTICAL STORAGE
          LDD    HN          SET FUNCTION CODE = 2  (OPTICAL DISK)
          RAD    CM
          ISTORE ISME,(PSN)  SET *ISM* TO ISSUE OPTICAL STAGE MESSAGE
          LDC    2RSO
          STM    ISMB
          UJN    STR1.1      SET SUBSYSTEM INFORMATION
 
 STR1     LDC    MIRE        SET *MSS*/*MSE* *TDAM* BUFFER ADDRESS
          STM    SPFB+1
          ERRPL  MIRE-10000B CODE DEPENDS ON VALUE
 
*         SET SUBSYSTEM ID AND SUBSYSTEM EVENT.
 
 STR1.1   LDM    STRC,T1     SET ALTERNATE STORAGE SUBSYSTEM ID
          STM    SPFA+1
          LDM    STRD,T1     SET ALTERNATE STORAGE SUBSYSTEM EVENT
          STM    SPFD+1
          LDM    STRE,T1     SET ALTERNATE STORAGE EQUIPMENT TYPE
          STM    GEEA+1
 
*         SET *PEO* AND *DN*.
 
 STR1.2   LDD    CI          OFFSET INTO CATALOG SECTOR
          SBD    CB
          SBN    2
          SHN    -NWCES      CALCULATE *PEO* VALUE
          LPN    1S"NWCEM"-1
          SHN    6           POSITION FOR *TDAM* REQUEST
          STD    CM+2
          LDM    MSTA        GET DEVICE NUMBER
          SHN    3
          ADN    PFGL
          CRD    T0
          LDD    T0+3
          LPN    77
          RAD    CM+2        COMBINE *PEO* WITH *DN*
 
*         SET FLAGS FOR CARTRIDGE OR OPTICAL STAGE.
 
          LDD    P1
          NJN    STR2        IF TAPE STAGE REQUEST
          LDM    FCAF,CI     GET ALTERNATE STORAGE FLAGS
          LPC    AFPDRM+AFVERM+AFFREM
          SHN    13-6        COMBINE WITH PEO AND DN
          RAD    CM+2
 
*         SET CATALOG TRACK AND SECTOR.
 
 STR2     LDM    -2,CB       SET CATALOG TRACK ADDRESS
          STD    CM+3
          LDM    -1,CB       SET CATALOG SECTOR ADDRESS
          STD    CM+4
          LDD    MA          TDAM+0 INTO MESSAGE BUFFER
          CWD    CM
 
*         SET *AT* AND *ASA* FOR CARTRIDGE OR OPTICAL DISK STAGE.
 
          LDD    P1
          NJN    STR3        IF TAPE STAGE REQUEST
          LDN    0           CLEAR RESERVED FIELD
          STD    CM
          LDM    FCAT,CI     SET ALTERNATE STORAGE TYPE
          LPN    77
          STD    CM+1
          LDM    FCAA,CI     SET ALTERNATE STORAGE ADDRESS (ASA)
          STD    CM+2
          LDM    FCAA+1,CI
          STD    CM+3
          LDM    FCAA+2,CI
          STD    CM+4
          LDD    MA          TDAM+1 INTO MESSAGE BUFFER
          ADN    1
          CWD    CM
          UJN    STR4        PROCESS NEXT WORD
 
*         SET FLAGS, FILE SEQUENCE NUMBER AND VSN FOR TAPE STAGE.
 
 STR3     LDD    CI          SET ADDRESS OF CATALOG ENTRY
          RAM    STRA+1
          LDD    MA          TDAM+1 INTO MESSAGE BUFFER
          ADN    1
 STRA     CWM    FCTF,ON
 
*         SET PERMANENT FILE NAME AND USER INDEX.
 
 STR4     LDD    CI          SET ADDRESS OF CATALOG ENTRY
          RAM    STRB+1
          LDD    MA          TDAM+2 INTO MESSAGE BUFFER
          ADN    2
 STRB     CWM    FCFN,ON
 
*         SET JSN.
 
          LDD    CP          FETCH EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      READ JOB SEQUENCE NUMBER
          ADK    JSNE
          CRD    CM
          LDN    0
          STD    CM+2
 
*         SET EVENT FOR CARTRIDGE STAGE.
 
          RJM    GEE         GET EST ORDINAL FOR EVENT
          LDD    T5
          STD    CM+3
          STM    ERRE
          LDD    P1
          NJN    STR5        IF TAPE STAGE REQUEST
          LDM    FCAA,CI     SET FOLDED ASA IN EVENT
          LMM    FCAA+1,CI
          LMM    FCAA+2,CI
          UJN    STR6        SET EVENT
 
*         SET EVENT FOR TAPE STAGE.
 
 STR5     LDM    -2,CB       FOLD CATALOG TRACK AND SECTOR FOR EVENT
          SHN    6
          LMM    -1,CB
 STR6     STD    CM+4        SET EVENT
          STM    ERRC
          LDD    MA          TDAM+3 INTO MESSAGE BUFFER
          ADN    3
          CWD    CM
 
*         SET FAMILY/PACK NAME AND MASTER DEVICE EST ORDINAL.
 
          LDD    P1
          NJN    STR7        IF TAPE STAGE REQUEST
          LDC    LDNI+0      PREVENT EST ORDINAL STORE
          STM    STRF
 STR7     LDM    MSTA        READ FAMILY/PACK NAME
          SHN    3
          ADN    PFGL
          CRD    CM
          LDD    CM+3        CLEAR RESERVED FIELD
          SCN    77
          STD    CM+3
 STRF     LDD    EQ          SET MASTER DEVICE EST ORDINAL
*         LDN    0           (CARTRIDGE STAGE REQUEST)
          STD    CM+4
          LDD    MA          TDAM+4 INTO MESSAGE BUFFER
          ADN    4
          CWD    CM
 
*         SET FILE LENGTH AND CREATION DATE/TIME.
 
          LDM    FCLF,CI     SET FILE LENGTH
          STD    CM
          LDM    FCLF+1,CI
          STD    CM+1
          LDM    FCBS,CI     GET IAPF/DAPF INDICATOR FROM SECTOR FIELD
          LPC    4000B
          LMC    4000B
          RAD    CM          SET TDAM BLOCK *I* FIELD IF IAPF
          LDM    FCCD,CI     TRANSFER CREATION DATE AND TIME FOR TDAM
          STD    CM+2
          LDM    FCCD+1,CI
          STD    CM+3
          LDM    FCCD+2,CI
          STD    CM+4
          LDD    MA          TDAM+5 INTO MESSAGE BUFFER
          ADN    5
          CWD    CM
          LJM    STRX        RETURN
 
 
 STRC     INDEX              ALTERNATE STORAGE SUBSYSTEM ID-S
          INDEX  ATMS,MFSI   *MSS*
          INDEX  ATAS,ASSI   *MSE*
          INDEX  ATOD,MTSI   *MAGNET*
          INDEX  ATMAX+1
 
 STRD     INDEX              ALTERNATE STORAGE EXECUTIVE EVENTS
          INDEX  ATMS,MSXE   *MSS*
          INDEX  ATAS,ASXE   *MSE*
          INDEX  ATOD,MTXE   *MAGNET*
          INDEX  ATMAX+1
 
 STRE     INDEX              ALTERNATE STORAGE EQUIPMENT MNEMONICS
          INDEX  ATMS,2RCS   *MSS*
          INDEX  ATAS,2RSS   *MSE*
          INDEX  ATOD,2ROD   *MAGNET* - OPTICAL DISK
          INDEX  ATMAX+1
 UPF      SPACE  4,25
**        UPF - UPDATE PFC ON USER ACCESS.
*
*         ON A USER ACCESS WITH NO ERRORS, UPDATE THE LAST ACCESS
*         DATE AND TIME IN THE PFC TO PREVENT THE IMMEDIATE RELEASE
*         OF THE FILE BEFORE IT CAN BE ACCESSED. IF ERRORS WERE
*         DETECTED, ONLY UPDATE THE PFC TO CLEAR *AFTPE* (IF PRESENT).
*
*         ENTRY  (CB) = CATALOG BUFFER ADDRESS.
*                (CC) = COMMAND CODE.
*                (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
*                (P2) = CARTRIDGE COPY ERROR STATUS.
*                (P3) = TAPE COPY ERROR STATUS.
*
*         EXIT   LAST ACCESS DATE AND TIME UPDATED IN THE PFC.
*                *ENDMS* PERFORMED.
*                CATALOG INTERLOCK CLEARED.
*
*         USES   CM - CM+4.
*
*         CALLS  CCI, WBI.
*
*         MACROS ENDMS.
 
 
 UPF      SUBR               ENTRY/EXIT
          LDD    CC
          LMN    CCSP
          ZJN    UPFX        IF *STAGEPF* REQUEST
          LDD    P3
          ZJN    UPF1        IF NO TAPE COPY ERRORS
          LDD    P2
          ZJN    UPF1        IF NO CARTRIDGE COPY ERRORS
          SBN    3
          ZJN    UPF2        IF TEMPORARY ERROR ON CARTRIDGE COPY
          UJN    UPF3        CLEAR INTERLOCK AND RETURN
 
 UPF1     LDN    PDTL        UPDATE LAST ACCESS DATE AND TIME
          CRD    CM
          LDD    CM+2
          STM    FCAD,CI
          LDD    CM+3
          STM    FCAD+1,CI
          LDD    CM+4
          STM    FCAD+2,CI
 UPF2     LDD    CB          REWRITE CATALOG
          RJM    WBI
 UPF3     ENDMS
          RJM    CCI         CLEAR CATALOG INTERLOCK
          UJN    UPFX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPACS
*CALL     COMPC2D
 EJT$     EQU    0           DEFINE *COMPGFP* ACCESS TO EJT
*CALL     COMPGFP
          SPACE  4,10
*         CHECK FOR OVERFLOW.
 
 
          OVERFLOW  OVLC,BUF1-2  OVERFLOW INTO CATALOG BUFFER
          OVERLAY  (CPU FILE TRANSFER.),OVLU
          SPACE  4,10
***       THIS OVERLAY PROCESSES THE TRANSFER OF INDIRECT ACCESS
*         FILES VIA THE CPU.
 
 
 OVL      BSS    0           ENTRY
          LDD    CC          CHECK COMMAND CODE
          LMK    CCRS
          ZJN    OVL1        IF *RPFSTAT* REQUEST
          RJM    SCP         SET UP CPU PARAMETERS
          RJM    SCF         SET UP COMMUNICATION FILES
          RJM    PWS         PREWRITE SYSTEM SECTOR AND EOI
 OVL1     RJM    IDR         INITIATE *DMP=* AND SET UP RECALL REQUEST
          EXECUTE  3PU       RECALL *PFM*
          TITLE  SUBROUTINES.
 IDR      SPACE  4,20
**        IDR - INITIATE *DMP=* AND SET UP *PFM* RECALL REQUEST.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (EQ) = MASTER EST ORDINAL.
*                (CPFB) = *CPUPFM* CALL BLOCK IF NOT *RPFSTAT*
*                         REQUEST.
*                (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
*
*         EXIT   (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
*                (FN - FN+4) = RECALL REQUEST FOR MONITOR.
*                (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
*                (STAU) = *STRP* BIT SET TO RECALL *PFM*.
*                *DMP=* ROLLOUT INITIATED, IF NO TAPE ACTIVITY PENDING.
*
*         USES   T1, CM - CM+4.
*
*         MACROS MONITOR.
 
 
 IDR      SUBR               ENTRY/EXIT
 
*         INITIATE *DMP=*.
 
          LDD    CC          CHECK COMMAND CODE
          LMK    CCRS
          NJN    IDR1        IF NOT *RPFSTAT* REQUEST
          LDM    PWCC        RESET ORIGINAL COMMAND CODE
          STD    CC
          UJN    IDR2        SET ORIGINAL CODE FOR *DMP=* CALL
 
 IDR1     LDN    CPFBL       WRITE *CPUPFM* PARAMETER BLOCK TO NFL
          STD    T1
          NFA    DMPN
          CWM    CPFB,T1
          LDD    CC          SET COMMAND CODE FOR *DMP=* CALL
 IDR2     STM    IDRA+4
          LDD    CP          CHECK CONTROL POINT ACTIVITY
          ADK    STSW
          CRD    CM
          LDD    CM+4
          SHN    -4
          LPN    17
          NJN    IDR3        IF TAPE ACTIVITY PENDING
          LDD    CP          SET *DMP=* CALL
          ADK    SPCW
          CWM    IDRA,ON
          LDN    SAPS        SET *CPUPFM* ACTIVE STATUS
          STD    CM+1
          MONITOR  SJCM
          LDN    ZERL        START *DMP=* ROLLOUT
          CRD    CM
          LDK    ROSR
          STD    CM+1
          MONITOR  ROCM
 
*         SET UP *PFM* RECALL REQUEST.
 
 IDR3     LDD    IA          SET INPUT REGISTER
          CRD    CN
          LDN    ZERL
          CRD    FN          SET RECALL REQUEST
          CRD    MP          SET PARAMETER WORD
          LDM    PWRF        RESTART FLAGS
          STD    MP
          LDD    CC          ORIGINAL COMMAND CODE
          STD    MP+2
          LDD    EQ          MASTER EST ORDINAL
          STD    MP+3
          LDD    CN+2        SET UP *CCRS* REQUEST IN RECALL STACK
          SCN    77
          LMN    CCRS
          STD    CN+2
          LDC    PTMF        TIMED RECALL
          STD    FN+1
          LDC    200D        RECALL FOR 200D MILLISECONDS
          STD    FN+4
          LDK    STRP        SET *RECALL PFM* STATUS BIT
          RAM    STAU
          LJM    IDRX        RETURN
 
 
 IDRA     VFD    18/3LCPF,6/30B,18/0,18/0  *CPUPFM* CALL WORD
 PWS      SPACE  4,15
**        PWS - PREWRITE SYSTEM SECTOR AND EOI.
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*                (FNTB) = FNT ADDRESS OF PERMANENT FILE.
*                (LF - LF+1) = LENGTH OF PERMANENT FILE.
*                (MSTA) = MASTER DEVICE MST ADDRESS/10.
*                (PFCB) = BUFFER CONTAINING COPY OF PFC.
*                (SDAB) = FIRST TRACK OF PERMANENT FILE.
*                (SDAC) = FIRST SECTOR OF PERMANENT FILE.
*
*         EXIT   TO *HNG* IF INDIRECT CHAIN TRUNCATED.
*
*         USES   FA, T1, FS - FS+4, RI - RI+1.
*
*         CALLS  CRA, PDV, WEI, WSS.
*
*         MACROS ENDMS, ERROR, MONITOR, SETMS.
 
 
 PWS      SUBR               ENTRY/EXIT
          LDD    CC
          LMN    CCGT
          ZJN    PWSX        IF *GET*
          LMN    CCOD&CCGT
          ZJN    PWSX        IF *OLD*
          LDD    EQ          SET SYSTEM SECTOR ADDRESS
          STD    T5
          LDM    SDAB
          STD    T6
          LDM    SDAC
          STD    T7
          LDM    FNTB        READ FST
          STD    FA
          NFA    FA,R
          ADK    FSTL
          CRD    FS
 
*         INITIALIZE BUFFER FOR SYSTEM SECTOR AND EOI.
 
          LDC    502-1       CLEAR  BUFFER
          STD    T1
 PWS2     LDN    0           CLEAR NEXT BYTE
          STM    BFMS,T1
          SOD    T1
          PJN    PWS2        IF MORE TO CLEAR
          LDC    5*NWCE-1    COPY PFC TO BUFFER
          STD    T1
 PWS3     LDM    PFCB,T1     COPY NEXT BYTE
          STM    CTSS,T1
          SOD    T1
          PJN    PWS3        IF MORE TO COPY
          LDM    STAT
          LPK    STEC
          ZJN    PWS4        IF NOT APPEND TO END OF CHAIN
          LDN    PSNI        ALLOW FOR LACK OF SYSTEM SECTOR
          STM    PWSA
          UJN    PWS6        SKIP SYSTEM SECTOR WRITE
 
*         WRITE SYSTEM SECTOR.
 
 PWS4     SETMS  IO,NS
          RJM    PDV         PROCESS DEVICE STATUS
          LDM    CBFN+4
          LPN    FGIA
          NJN    PWS5        IF EXTENDING INDIRECTS ON BUFFERED DEVICE
          SETMS  IO,(RW,NS)
          RJM    PDV         PROCESS DEVICE STATUS
 PWS5     RJM    WSS         WRITE SYSTEM SECTOR
          MJP    PWS8        IF WRITE ERROR
          ENDMS
 
*         DETERMINE EOI LOCATION AND WRITE EOI SECTOR.
 
 PWS6     LDM    CBFN+4
          LPN    FGIA
          NJP    PWSX        IF EXTENDING INDIRECTS ON BUFFERED DEVICE
          LDM    SDAB        RESET FIRST TRACK
          STD    T6
          LDD    LF+1        GET NUMBER OF DATA SECTORS
          STD    RI+1
          LDD    LF
          STD    RI
          LDM    SDAC        ADD RANDOM ADDRESS OF FIRST SECTOR
 PWSA     ADN    1           ADD ONE FOR SYSTEM SECTOR
*         PSN                (APPEND TO END OF CHAIN)
          RAD    RI+1        RANDOM ADDRESS OF EOI FROM START OF TRACK
          SHN    -14
          RAD    RI
          RJM    CRA         CONVERT RANDOM ADDRESS TO TRACK AND SECTOR
          MJN    PWS7        IF ERROR IN CONVERSION
          SETMS  IO,(RW,NS)
          RJM    PDV         PROCESS DEVICE STATUS
          LDC    BFMS        WRITE EOI SECTOR
          RJM    WEI
          MJN    PWS8        IF MASS STORAGE ERROR
          ENDMS
          LJM    PWSX        RETURN
 
 PWS7     RJM    HNG         HANG IF INDIRECT CHAIN TRUNCATED
 
 PWS8     ERROR  MSE,CH,,T5,,EI  *EQXXX,DNYY, MASS STORAGE ERROR.*
 SCF      SPACE  4,20
**        SCF - SET UP COMMUNICATION FILES.
*
*         ENTRY  (FNTA) = LOCAL FILE FNT ADDRESS.
*                (FNTB) = /PFM*PFN/ FNT ADDRESS.
*                (FNTC) = /PFM*ILK/ FNT ADDRESS.
*                (FNTD) = /PFM*APF/ FNT ADDRESS.
*                (CC) = COMMAND CODE.
*
*         EXIT   FNT ENTRIES UPDATED FOR COMMUNICATION FILES.
*                /PFM*APF/ RETURNED IF NOT NEEDED.
*                DRIVER RESET FOR MASTER DEVICE.
*
*         USES   FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
*         CALLS  RMD, *0DF*.
*
*         MACROS EXECUTE, NFA.
 
 
 SCF      SUBR               ENTRY/EXIT
 
*         SET UP /PFM*PFN/ FILE TO POINT TO PERMANENT FILE.
 
          LDM    FNTB        SET FNT ADDRESS
          STD    FA
          NFA    FA,R
          ADK    FNTL
          CRD    FN
          LDD    CC
          LMN    CCGT
          ZJN    SCF1        IF *GET* REQUEST
          LMN    CCOD&CCGT
          NJN    SCF2        IF NOT *OLD* REQUEST
 SCF1     LDD    FN+3        SET WRITE LOCKOUT BIT IN FNT
          SCN    1
          LMN    1
          STD    FN+3
 SCF2     LDN    10          SET *UPDATE* MODE
          RAD    FN+3
          LDC    100*LIFT    SET *LIFT* FILE TYPE
          STD    FN+4
          LDD    EQ          SET UP FST
          STD    FS
 SCFC     LDC    *           SET FIRST TRACK OF FILE
*         LDC    (SDAB)      (NORMAL TRANSFER)
*         LDC    (PFCB+FCBT) (APPEND TO END OF CHAIN)
*         LDC    (DVLW)      (EXTENDING CHAIN ON BUFFERED DEVICE)
          STD    FS+1
 SCFA     LDC    *           SET CURRENT TRACK
          STD    FS+2
 SCFB     LDC    *           SET SECTOR
          STD    FS+3
          LDN    5           SET STATUS
          STD    FS+4
          LDM    IAIF
          ZJN    SCF3        IF INDIRECT ALLOCATION INTERLOCK NOT SET
          LDC    1000
          RAD    FS+4        SET TRACK INTERLOCK FLAG FOR FNT
          LDN    0           CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
          STM    IAIF
          LDN    FGIA        SET *CPUPFM* INDIRECT ALLOCATION FLAG
          RAM    CBFN+4
          LDD    FN+3        CLEAR *UPDATE* MODE
          SCN    10
          STD    FN+3
 SCF3     NFA    FA,R        REWRITE FNT
          ADK    FNTL
          CWD    FN
          ADK    FSTL-FNTL
          CWD    FS
 
*         SET UP /PFM*ILK/ FILE TO POINT TO CATALOG TRACK.
 
          LDM    FNTC        SET FNT ADDRESS
          STD    FA
          NFA    FA,R        READ FNT WORDS
          ADK    FNTL
          CRD    FN
          ADN    FUTL-FNTL
          CRD    CM
          LDN    ZERL
          CRD    FS
          LDD    FN+3        SET WRITE LOCKOUT BIT IN FNT
          SCN    1
          LMN    1
          STD    FN+3
          LDC    100*LIFT    *LIFT* FILE TYPE
          STD    FN+4
          LDD    EQ          SET MASTER DEVICE (CATALOG) EST ORDINAL
          STD    FS
          LDM    CCIA        SET CATALOG TRACK
          STD    FS+1
          LDC    1005        STATUS (INCLUDING TRACK INTERLOCK BIT)
          STD    FS+4
          SOM    CCIB        PREVENT CLEAR OF CATALOG TRACK INTERLOCK
          LDN    10          SET PF ACTIVITY FLAG
          RAD    CM+2
          LDN    0           PREVENT PF ACTIVITY DECREMENT IN *DPP*
          STM    EPFA
          NFA    FA,R        REWRITE FNT
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CWD    FS
          ADN    FUTL-FSTL
          CWD    CM
 
*         UNLOAD /PFM*APF/ FILE, IF PRESENT AND NOT NEEDED.
 
          LDM    FNTD        GET FNT ADDRESS
          STD    FA
          ZJN    SCF4        IF NO /PFM*APF/ FILE
          LDM    STAT
          LPC    STEC
          ZJN    SCF5        IF NOT APPEND TO END OF CHAIN
          LDN    1
          STM    OVL0-1
          EXECUTE  0DF,OVL0
          LDN    0           CLEAR FNT ADDRESS
          STM    FNTD
          RJM    RMD         RESET TO MASTER DEVICE
 SCF4     LJM    SCFX        RETURN
 
*         SET UP /PFM*APF/ FILE TO POINT TO ORIGINAL FILE ON *APPEND*.
 
 SCF5     NFA    FA,R        READ FNT WORD
          ADK    FNTL
          CRD    FN
          LDD    FN+3        SET WRITE LOCKOUT BIT IN FNT
          SCN    1
          LMN    1
          STD    FN+3
          LDC    100*LIFT    SET *LIFT* FILE TYPE
          STD    FN+4
          LDD    EQ          SET MASTER DEVICE EST ORDINAL
          STD    FS
          LDM    FCBT,CI     SET FIRST TRACK OF FILE
          STD    FS+1
          LDM    APTK        SET CURRENT TRACK
          STD    FS+2
          STD    T6
          LDM    APSC
          STD    FS+3
          AOD    FS+3        SET TO FIRST DATA SECTOR
          LMM    SLM
          NJN    SCF6        IF NOT AT END OF TRACK
          STD    FS+3        SET TO SECTOR ZERO
          RJM    SNT         SET NEXT TRACK
          STD    FS+2
 SCF6     LDN    5           SET STATUS
          STD    FS+4
          NFA    FA,R        REWRITE FNT WORDS
          ADK    FNTL
          CWD    FN
          ADN    FSTL-FNTL
          CWD    FS
          LJM    SCFX        RETURN
 SCP      SPACE  4,15
**        SCP - SET UP CPU PARAMETERS.
*
*         ENTRY  (CB) = ADDRESS OF OLD CATALOG BUFFER.
*                (CI) = ADDRESS OF OLD CATALOG ENTRY IN BUFFER.
*                (FNTA) = FNT ADDRESS OF LOCAL FILE.
*                (IAIF) = INDIRECT ALLOCATION INTERLOCK FLAG.
*                (MSTA) = MASTER DEVICE MST ADDRESS/10.
*                (PFCA) = ADDRESS OF NEW CATALOG ENTRY IN BUFFER.
*
*         EXIT   (CPFB) = BUFFER CONTAINING CPU TRANSFER PARAMETERS.
*                (PFCB) = BUFFER CONTAINING COPY OF NEW PFC ENTRY.
*                (CRAA) PRESET.
*                (SNTA) PRESET.
*                (SRAA) PRESET.
*
*         USES   T1, T6, T7.
*
*         CALLS  RMD, SNT, SRA.
 
 
 SCP      SUBR               ENTRY/EXIT
          RJM    RMD         RESET TO MASTER DEVICE
          LDM    MSTA        CALCULATE FWA OF TRT
          SHN    3
          ADN    TRLL
          RJM    CTA
          SBD    TH
          STM    CRAA+1      PRESET *COMPCRA*, *COMPSNT* AND *COMPSRA*
          STM    SNTA+1
          STM    SRAA+1
          SHN    -14
          LMC    ADCI
          STM    CRAA
          STM    SNTA
          STM    SRAA
 
*         SAVE COPY OF NEW PFC FOR SYSTEM SECTOR.
 
          LDM    PFCA        GET PFC ADDRESS
          STM    SCPA
          LDC    5*NWCE-1
          STD    T1
 SCP1     LDM    *,T1        COPY NEXT BYTE
 SCPA     EQU    *-1
          STM    PFCB,T1
          SOD    T1
          PJN    SCP1        IF MORE BYTES TO COPY
 
*         SET LOCAL FILE NAME AND FILE LENGTH(S).
 
          NFA    FNTA,R      SET FILE NAME
          ADK    FNTL
          CRM    CBFN,ON
          LDM    CBFN+3      CLEAR STATUS FIELD
          SCN    77
          STM    CBFN+3
          LDN    0
          STM    CBFN+4
          LDD    LF+1        SET UP FILE LENGTHS
          STM    CBLF+4
          LDD    LF
          STM    CBLF+3
          LDM    APLF+1
          STM    CBLF+2
          LDM    APLF
          STM    CBLF+1
          LDN    0
          STM    CBLF
 
*         CALCULATE FIRST DATA TRACK AND SECTOR.
 
          LDM    SDAB        SET TRACK
          STD    T6
          STM    SCFC+1
          STM    SCPC+1
          LDM    SDAC        SET SECTOR
          STD    T7
          LDM    STAT
          LPC    STEC
          ZJN    SCP3.1      IF NOT *APPEND* TO END OF CHAIN
          LDM    PFCB+FCBT   SET CORRECT FIRST TRACK
          STM    SCFC+1
          STM    SCPC+1
          UJN    SCP4        SAVE TRACK AND SECTOR
 
 SCP3.1   AOD    T7          ADVANCE TO FIRST DATA SECTOR
          LMM    SLM
          NJN    SCP4        IF NOT AT END OF TRACK
          STD    T7          SET TO SECTOR ZERO
          RJM    SNT         SET NEXT TRACK
          STD    T6
 SCP4     LDD    T6          SAVE TRACK
          STM    SCFA+1
          LDD    T7          SAVE SECTOR
          STM    SCFB+1
 
*         CALCULATE RANDOM ADDRESS OF PERMANENT FILE.
 
          LDM    IAIF
          ZJN    SCP4.1      IF NOT EXTENDING CHAIN ON BUFFERED DEVICE
          LDM    DVLW        SET CORRECT FIRST TRACK FOR FST
          STM    SCFC+1
          UJN    SCP5        SET *PFID* OF OLD CATALOG
 
 SCP4.1   LDD    CC
          LMN    CCGT
          ZJN    SCP6        IF *GET* REQUEST
          LMN    CCOD&CCGT
          ZJN    SCP6        IF *OLD* REQUEST
 SCPC     LDC    *           CALCULATE RANDOM ADDRESS
*         LDC    (SDAB)      (TRANSFER WITHIN CHAIN)
*         LDC    (PFCB+FCBT) (APPEND TO END OF CHAIN)
          RJM    SRA
          LDD    RI
          STM    CBRI+3
          LDD    RI+1
          STM    CBRI+4
 
*         SET *PFID* OF OLD CATALOG INTO PARAMETER BLOCK (*APPEND*).
 
 SCP5     LDD    CC
          LMN    CCAP
          ZJN    SCP7        IF *APPEND* REQUEST
 SCP6     LJM    SCPX        RETURN
 
 SCP7     LDM    STAT
          LPC    STEC
          NJN    SCP6        IF APPEND TO END OF CHAIN
          LDM    -2,CB       SET TRACK
          STM    CBID+3
          LDM    -1,CB       SET SECTOR
          STM    CBID+4
          LDM    MSTA        SET FAMILY NAME
          SHN    3
          ADN    PFGL
          CRM    CBFM,ON
          LDM    CBFM+3      SET DEVICE NUMBER
          LPN    77
          STM    CBID+2
          LDD    CI          CALCULATE PFC ENTRY ORDINAL (PEO)
          SBD    CB
          SBN    2
          SHN    -NWCES
          LPN    1S"NWCEM"-1
          SHN    6           SET PEO
          RAM    CBID+2
          LDN    2           COPY CREATION DATE/TIME
          STD    T1
          LDD    CI
          RAM    SCPB
 SCP8     LDM    FCCD,T1     COPY NEXT BYTE
 SCPB     EQU    *-1
          STM    CBCD+2,T1
          SOD    T1
          PJN    SCP8        IF MORE BYTES TO COPY
          LDM    CBUI+3      SET USER INDEX
          SCN    77
          LMD    UI
          STM    CBUI+3
          LDD    UI+1
          STM    CBUI+4
          LJM    SCPX        RETURN
          SPACE  4,10
*         WORKING STORAGE AND BUFFERS.
 
*         BUFFERS.
 
 PFCB     BSS    5*NWCE      PFC SAVE BUFFER
 CPFB     BSSZ   5*CPFBL     *CPUPFM* PARAMETER BLOCK BUFFER
 
*         LOCATIONS WITHIN *CPFB* BUFFER.
 
 CBFN     EQU    CPFB        LOCAL FILE NAME
 CBLF     EQU    CPFB+5*1    FILE LENGTHS
 CBRI     EQU    CPFB+5*2    RANDOM INDEX
 CBSR     EQU    CPFB+5*3    SPECIAL REQUEST BLOCK
 
*         LOCATIONS WITHIN SPECIAL REQUEST BLOCK IN *CPFB* BUFFER.
 
 CBID     EQU    CBSR+5*SFID *PFID* FIELD
 CBCD     EQU    CBSR+5*SFCD CREATION DATE FIELD
 CBFM     EQU    CBSR+5*SFFM FAMILY NAME FIELD
 CBUI     EQU    CBSR+5*SFUI USER INDEX FIELD
          SPACE  4,10
*         COMMON DECKS.
 
*CALL     COMPCRA
 WEI$     EQU    1           ALLOW BUFFER SPECIFICATION
*CALL     COMPSRA
*CALL     COMPWEI
 WIS$     EQU    1           WRITE IAPF SYSTEM SECTOR
*CALL     COMPWSS
          SPACE  4,10
          USE    OVERFLOW
 
 OVL0     EQU    *+5         ZERO-LEVEL OVERLAY LOAD ADDRESS
          ERRNG  BFMS-OVL0-ZDFL  *0DF* OVERFLOW
          SPACE  4,10
          OVERFLOW  OVLU,GETA  OVERFLOW INTO *GET* PROCESSING
          SPACE  4,10
          OVERFLOW  OVLU,SAVA  OVERFLOW INTO *SAVE* PROCESSING
          SPACE  4,10
          OVERFLOW  OVLU,APPB  OVERFLOW INTO *APPEND* PROCESSING
          OVERLAY (ERROR PROCESSING.),OVLA
          SPACE  4,10
**        THIS OVERLAY PROCESSES PERMANENT FILE ERRORS BY SENDING
*         THE INDICATED ERROR MESSAGE TO THE DAYFILE, SETTING THE
*         FST ENTRY NOT BUSY OR DELETING THE FNT/FST ENTRY IF CREATED
*         BY *PFM*, AND TERMINATING THE CALLING PROGRAM.
 
 
 OVL      BSS    0           ENTRY
*         LJM    SEP         PROCESS ERROR
          SPACE  4,10
***       PERMANENT FILE ERROR PROCESSING.
*
*
*         COMMAND OR CENTRAL PROGRAM CALLS.
*
*                IF THE ERROR PROCESSING BIT IS SET IN THE FET, PFM
*                RETURNS THE ERROR CODE, SETS THE COMPLETE BIT AND
*                ISSUES THE DAYFILE MESSAGE.  THE ERROR CODE IS
*                RETURNED IN WORD 0 OF THE FET BITS 10 - 17.
*
*                IF THE ERROR PROCESSING BIT IS NOT SET, A DAYFILE
*                MESSAGE IS ISSUED, THE CONTROL POINT ABORTED, AND THE
*                PPU IS DROPPED.
*
*                IF THE ERROR RETURN ADDRESS *ERAD* IS SET AND THE USER
*                IS PROCESSING ERRORS, THE MESSAGE WILL NOT BE ISSUED
*                TO THE DAYFILE BUT WILL BE RETURNED TO THE USER
*                PROGRAM AT RA + ERAD.  FOUR WORDS MUST BE ALLOCATED
*                AT *ERAD* FOR MESSAGE.
*
*                IF THE ERROR *FILE BUSY* IS ENCOUNTERED AN EVENT
*                DESCRIPTOR (EST ORDINAL/FIRST TRACK) WILL BE SET
*                IN *TERW* IN THE CP AREA SO THAT THE CALLING PROGRAM
*                MAY ISSUE A ROLLOUT IF IT WANTS TO WAIT FOR FILE TO
*                BECOME AVAILABLE.
*
*                IF A DEVICE REQUIRED BY PFM IS TEMPORARILY
*                INACCESSIBLE, AN ERROR STATUS WILL BE RETURNED TO THE
*                CALLER IF REAL-TIME PROCESSING WAS SELECTED IN THE
*                FET; OTHERWISE, THE JOB WILL BE ROLLED OUT IF IT IS
*                NOT A SUBSYSTEM.  THE PFM FUNCTION WILL BE RESTARTED
*                WHEN THE JOB RESUMES EXECUTION.  THE *ATTACH*,
*                *CATLIST*, *CHANGE*, *DEFINE*, *DELPFC*, *DROPDS*,
*                *GET*, *PERMIT*, *PURGE*, *SETPFAC*, AND *SETPFAL*
*                REQUESTS CAN BE INTERRUPTED ON ANY I/O OPERATION AND
*                RESTARTED.  THE *APPEND*, *REPLACE*, AND *SAVE*
*                REQUESTS CANNOT BE INTERRUPTED ONCE THE CATALOG
*                ENTRY FOR THE PERMANENT FILE HAS BEEN WRITTEN AND
*                THE FILE TRANSFER IS IN PROGRESS.
*
*
*                IF ANY OF THE FOLLOWING ERRORS ARE ENCOUNTERED AND THE
*                ERROR IS NOT DUE TO A HARDWARE FAILURE, THE MESSAGE
*                     *EQXXX, ERROR IDLE SET.*
*                WILL BE ISSUED TO THE ERROR LOG AND ERROR IDLE STATUS
*                WILL BE SET IN THE MST OF THE APPROPRIATE DEVICE.
*                THIS WILL PREVENT FURTHER ACCESS TO THE DEVICE.
*
*                * BAD CATALOG/PERMIT SECTOR.*
*                * FILE LENGTH ERROR.*
*
*                SETTING OF ERROR IDLE STATUS ON A FAILING DEVICE MAY
*                BE REQUESTED FOR ANY OTHER TYPE 2 ERROR BY SPECIFYING
*                THE *EI* PARAMETER ON THE *ERROR* MACRO CALL.  THIS
*                SHOULD BE DONE IF THE ERROR CAUSES THE CATALOG OR
*                PERMITS FILE TO BE CORRUPTED.  IT WILL BE SET IN
*                THE FOLLOWING SITUATIONS.
*
*                * MASS STORAGE ERROR.*
*                - AN UNRECOVERABLE WRITE ERROR OCCURRED ON THE
*                  CATALOG OR PERMITS FILE AND DATA ON THE FILE HAS
*                  BEEN DESTROYED.
*                - AN UNRECOVERABLE WRITE ERROR OCCURRED OR THE
*                  DEVICE BECAME INACCESSIBLE WHILE PERMIT SECTORS
*                  WERE BEING LINKED.
*                - AN UNRECOVERABLE WRITE ERROR OCCURRED OR THE
*                  DEVICE BECAME INACCESSIBLE WHILE WRITING THE
*                  CATALOG FILE OR PERFORMING THE FILE TRANSFER FOR
*                  *APPEND*, *REPLACE*, OR *SAVE* COMMAND.
*                  (THE CATALOG ENTRY FOR THE PERMANENT FILE HAS BEEN
*                  ASSIGNED TO THE USER PRIOR TO TRANSFERRING THE FILE
*                  AND POINTS TO UNWRITTEN FILE SPACE.)
*
*                * PFM ABORTED.*
*                - *CPUPFM* HAS ABORTED BEFORE THE FILE TRANSFER IS
*                  COMPLETE FOR *APPEND*, *REPLACE*, OR *SAVE*
*                  COMMAND.
*
*                * TRACK LIMIT.*
*                - *CPUPFM* HAS ENCOUNTERED A TRACK LIMIT BEFORE THE
*                  FILE TRANSFER IS COMPLETE FOR *APPEND*, *REPLACE*,
*                  OR *SAVE* COMMAND.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         ERROR  1           * (FILE NAME) BUSY.*
*         DIRECT ACCESS FILE ATTACHED WITH CONFLICTING MODE.
*
*         ERROR  2           * (FILE NAME) NOT FOUND.*
*         PERMANENT FILE SPECIFED COULD NOT BE FOUND.
*         OPTIONAL USER NAME NOT FOUND.
*         LOCAL FILE SPECIFIED NOT FOUND.
*         PERMANENT FILE SPECIFIED WAS NOT THE CORRECT TYPE OF FILE
*         FOR THE COMMAND USED. FOR EXAMPLE, A DIRECT ACCESS FILE
*         WAS FOUND USING A *GET* REQUEST OR AN INDIRECT ACCESS FILE
*         WAS FOUND USING AN *ATTACH* REQUEST.
*
*         ERROR  3           * (FILE NAME) EMPTY.*
*         FILE CONTAINS NO DATA.
*
*         ERROR  4           * (FILE NAME) NOT ON MASS STORAGE.*
*         FILE TO BE SAVED DOES NOT RESIDE ON MASS STORAGE.
*         FIRST TRACK OF FILE NOT RECOGNIZABLE.
*
*         ERROR  5           * (FILE NAME) ALREADY PERMANENT.*
*         USER ALREADY HAS FILE SAVED OR DEFINED.
*
*         ERROR  6           * (FILE NAME) INCORRECT FILE TYPE.*
*         USER HAS TRIED TO DEFINE A FILE THAT IS NOT A LOCAL FILE.
*
*         ERROR  7           * FILE NAME ERROR.*
*         FILE NAME CONTAINS INCORRECT CHARACTERS.
*
*         ERROR  10          * USER ACCESS NOT VALID.*
*         USER NOT VALIDATED FOR DIRECT AND/OR INDIRECT ACCESS FILES,
*         OR ACCESS TO REMOVABLE DEVICES.
*         USER IS NOT VALIDATED FOR ACCESS TO FAST ATTACH FILES.
*         PERMIT *CATLIST* ATTEMPTED ON A FILE WITH AN ACCESS LEVEL
*         ABOVE THAT OF THE JOB.
*
*         ERROR  11          * INCORRECT DEVICE REQUEST.*
*         DEVICE TYPE SPECIFIED ON REMOVABLE DEVICE REQUEST IS
*         UNRECOGNIZED OR DOES NOT EXIST ON SYSTEM.
*         THE PACKNAME REQUESTED FOR AUXILIARY DEVICE REQUEST IS
*         AVAILABLE IN SYSTEM BUT NOT AS TYPE REQUESTED BY *R* OPTION.
*
*         ERROR  12          * FILE TOO LONG.*
*         LENGTH OF FILE TO BE PLACED IN PERMANENT FILES EXCEEDS
*         THE LIMIT SET BY INSTALLATION.
*         THIS MESSAGE IS ISSUED ON AN ATTACH FUNCTION IF THE USER
*         ATTEMPTS TO ATTACH A FILE IN WRITE, APPEND OR MODIFY MODE
*         OR DEFINE AN EXISTING FILE AND THE FILE EXCEEDED THE
*         USERS FILE LENGTH CONTROLS.
*
*         ERROR  13          * PFM INCORRECT REQUEST.*
*         INCORRECT COMMAND CODE PASSED TO PFM.
*         INCORRECT PERMIT MODE OR CATALOG TYPE SPECIFIED.
*         PERMIT TYPE CATLIST WITH NO FILENAME.
*         THE *BR* OR *PR* VALUE SPECIFIED IS INCORRECT.
*
*         ERROR  14          * DEVICE UNAVAILABLE.*
*         ACCESS TO PERMANENT FILE DEVICE REQUESTED IS NOT POSSIBLE.
*         THIS ERROR IS ISSUED IF THE USER INDEX IS ZERO.
*         THIS ERROR IS ISSUED IF THE MSF DEVICE ON WHICH THE FILE
*         RESIDES IS NOT DEFINED IN THE EQUIPMENT CONFIGURATION.
*
*         ERROR  15          * DIRECT ACCESS DEVICE ERROR.*
*         DEVICE THAT FILE RESIDES ON MAY NOT CONTAIN DIRECT ACCESS FILE
*
*         ERROR  16          * PF UTILITY ACTIVE.*
*         UTILITY OPERATION CURRENTLY ACTIVE.  OPERATION NOT ATTEMPTED.
*         USER SHOULD RETRY THE OPERATION.  ERROR CODE 16 IS ALSO
*         RETURNED IN THE FET FOR ERROR 126 WITH THE ERROR MESSAGE,
*         *WAITING - INACCESSIBLE DEVICE.*
*
*         ERROR  17          * DATA TRANSFER ERROR.*
*         ERROR IN READ OF DATA DURING TRANSFER OF FILE.  TRANSFER
*         IS COMPLETED WITH SECTOR CONTAINING ERROR TRANSFERRED AS READ.
*
*         ERROR  20          * TOO MANY PERMANENT FILES.*
*         NUMBER OF FILES IN CATALOG EXCEEDS ALLOWABLE LIMIT.
*
*         ERROR  21          * TOO MUCH INDIRECT ACCESS FILE SPACE.*
*         CUMULATIVE SIZE OF INDIRECT FILES IN CATALOG EXCEEDS
*         THE ALLOWABLE LIMIT.
*
*         ERROR  22          * PRUS REQUESTED UNAVAILABLE.*
*         NUMBER OF PRUS SPECIFIED ON DEFINE REQUEST IS NOT AVAILABLE.
*
*         ERROR  23          * I/O SEQUENCE ERROR.*
*         PFM REQUEST ATTEMPTED ON LOCAL FILE THAT IS CURRENTLY ACTIVE.
*
*         ERROR  24          * LOCAL FILE LIMIT.*
*         THE JOBS LOCAL FILE LIMIT HAS BEEN EXCEEDED BY AN ATTEMPT
*         TO GET OR ATTACH THIS FILE. (FILE NOT ATTACHED OR RETRIEVED)
*
*         ERROR  25          * PRU LIMIT.*
*         THE JOBS MASS STORAGE PRU LIMIT WAS EXCEEDED BY AN
*         ATTEMPT TO GET THIS FILE. (FILE NOT ATTACHED OR RETRIEVED)
*
*         ERROR  26          * PERMIT LIMIT EXCEEDED.*
*         THE NUMBER OF EXPLICIT PERMIT ENTRIES FOR A FILE HAS
*         REACHED THE LIMIT DEFINED BY *PMLN*.
*
*         ERROR  27          * PFM ARGUMENT ERROR.*
*         AN INCORRECT VALUE HAS BEEN SPECIFIED IN THE FET.
*
*         ERROR  30          * RESEX FAILURE.*
*         RESEX HAS DETECTED AN ERROR IN CONTROL FILES OR SOME OTHER
*         FATAL ERROR HAS OCCURRED IN RESEX.
*
*         ERROR  31          *EQXXX,DNYY, TRACK LIMIT.*
*         EST ORDINAL XXX HAS NO SPACE.
*
*         ERROR  32          *EQXXX,DNYY, FILE LENGTH ERROR.*
*         LENGTH OF FILE DOES NOT EQUAL CATALOG LENGTH DURING TRANSFER.
*
*         ERROR  33          *EQXXX,DNYY, RANDOM INDEX ERROR.*
*         PERMIT RANDOM ADDRESS ERROR.
*
*         ERROR  34          *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
*         SYSTEM SECTOR DATA FOR FILE DOES NOT VERIFY.
*
*         ERROR  35          *EQXXX,DNYY, REPLACE ERROR.*
*         SAME FILE FOUND TWICE DURING CATALOG SEARCH.  THIS CAN
*         OCCUR FOR APPEND OR REPLACE COMMANDS AFTER FILE IS FOUND,
*         PURGED AND CATALOG SEARCH FOR HOLE IS CONTINUED.
*
*         ERROR  36          *EQXXX,DNYY, PFM ABORTED.*
*         *PFM* WAS UNABLE TO CONTINUE DUE TO AN OPERATOR OVERRIDE,
*         OR *CPUPFM* ABORTED PRIOR TO COMPLETING ITS TRANSFER.
*
*         ERROR  37          *EQXXX,DNYY, MASS STORAGE ERROR.*
*         ERROR ENCOUNTERED IN READ OR WRITING PORTION OF PF CATALOG OR
*         PERMIT INFORMATION.
*
*         ERROR  40          * ERROR IN FILE DATA.*
*         ERRORS IN THE FILE DATA WERE DETECTED BY *PFDUMP* WHILE
*         IT WAS DUMPING THE FILE; THE FILE WAS LATER RELOADED.
*
*         ERROR  41          * ERROR IN PERMIT DATA.*
*         ERRORS IN THE FILE-S PERMIT ENTRIES WERE ENCOUNTERED BY
*         *PFDUMP* WHILE IT WAS DUMPING THE FILE; THE FILE WAS LATER
*         RELOADED.
*
*         ERROR  42          * DATA/PERMIT ERRORS.*
*         ERRORS WERE ENCOUNTERED IN BOTH THE DATA AND THE PERMIT
*         ENTRIES WHILE *PFDUMP* WAS DUMPING THE FILE; THE FILE
*         WAS LATER RELOADED.
*
*         ERROR  43          * EOI CHANGED BY RECOVERY.*
*         AN ERROR IN THE FILES EOI POSITION WAS DETECTED BY THE
*         RECOVERY ROUTINES. THE POSITION WAS CHANGED TO THE
*         BEST LOGICAL POSITION.
*
*         ERROR  44 - 47     RESERVED
*
*         ERROR  50          *EQXXX,DNYY, FILE BOI/EOI/UI MISMATCH.*
*         THE VERIFICATION OF THE FILE-S STRUCTURE OR OWNER
*         IDENTIFICATION FAILED.  THE FILE DATA HAS BEEN LOST.
*
*         ERROR  51          *EQXXX,DNYY, SYSTEM SECTOR ERROR.*
*         ERRORS ENCOUNTERED IN VERIFICATION OF SYSTEM SECTOR
*         OF FILE.
*
*         ERROR  52          *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
*         THE LENGTH OF THE INDICATED CATALOG OR PERMIT SECTOR IS NOT
*         A MULTIPLE OF THE ENTRY SIZE.
*
*         ERROR  53          *EQXXX,DNYY, TRACK NOT RESERVED.*
*         THERE IS NO TRACK RESERVED FOR THE FILE.  THE DATA FOR THE
*         FILE HAS BEEN LOST.
*
*         ERROR  54 - 70     RESERVED
*
*         ERROR  71          * (FILE NAME) PERMANENT ERROR.*
*         UNRECOVERABLE ERRORS WERE DETECTED IN ATTEMPTING TO ACCESS
*         THE FILE ON ALTERNATE STORAGE.
*
*         ERROR  72          * (FILE NAME) STAGE INITIATED.*
*         THE PERMANENT FILE IS BEING STAGED FROM ALTERNATE STORAGE
*         TO DISK.
*
*         ERROR  73          * (FILE NAME) WAITING FOR SUBSYSTEM.*
*         THE PERMANENT FILE MUST BE STAGED FROM ALTERNATE STORAGE
*         TO DISK AND THE APPROPRIATE SUBSYSTEM IS NOT CURRENTLY
*         AVAILABLE TO PERFORM THE STAGE OPERATION.
*
*         ERROR  74          * (FILE NAME) INTERLOCKED.*
*         A FILE CAN NOT BE ATTACHED IN *WRITE*, *MODIFY* OR *APPEND*
*         MODE WHEN THE FILE IS ATTACHED IN UTILITY MODE.
*
*         ERROR  75          * (FILE NAME) IS DIRECT ACCESS.*
*         USER IS ATTEMPTING AN INDIRECT FILE COMMAND WHEN THE FILE
*         IS A DIRECT ACCESS FILE.
*         CURRENTLY ERROR 2 IS REPORTED IN THE *FET*.
*
*         ERROR  76          * (FILE NAME) IS INDIRECT ACCESS.*
*         USER IS ATTEMPTING A DIRECT ACCESS FILE COMMAND WHEN THE
*         FILE IS AN INDIRECT ACCESS FILE.
*         CURRENTLY ERROR 2 IS REPORTED IN THE *FET*.
*
*         ERROR  77          * (FILE NAME) IS EXECUTE ONLY.*
*         THE SPECIFIED LOCAL FILE CANNOT BE ACCESSED BY *SAVE*,
*         *REPLACE*, *APPEND* OR *DEFINE*, SINCE IT IS AN
*         EXECUTE-ONLY FILE.
*
*         ERROR  100         * PF STAGING DISABLED.*
*         THE PERMANENT FILE MUST BE STAGED FROM ALTERNATE STORAGE
*         TO DISK AND EITHER *CARTRIDGE PF STAGING* OR *TAPE
*         PF STAGING*, OR BOTH, HAVE BEEN DISABLED.
*
*         ERROR  101         * INCORRECT PFC ADDRESS.*
*         THE DEVICE NUMBER, TRACK AND SECTOR SPECIFIED AS THE *PFC*
*         ADDRESS ARE INCORRECT.
*
*         ERROR  102         * PFC VERIFICATION ERROR.*
*         THE CREATION DATE AND TIME, USER INDEX OR ALTERNATE STORAGE
*         ADDRESS DO NOT AGREE WITH THE CURRENT *PFC* CONTENTS.
*
*         ERROR  103         * FILE NOT DISK RESIDENT.*
*         THE *UATTACH* FUNCTION DOES NOT SUPPORT ACCESS TO FILES WHICH
*         ARE NOT DISK RESIDENT.
*
*         ERROR  104         * INTERLOCK NOT AVAILABLE.*
*         A SOFTWARE INTERLOCK IS CURRENTLY NOT AVAILABLE TO A REQUESTOR
*         SPECIFYING *EP* AND *UP* EXIT PROCESSING OPTIONS.
*
*         ERROR  105         * ALTERNATE IMAGE OBSOLETE.*
*         THE *DROPDS* FUNCTION DOES NOT RETURN THE DISK SPACE FOR
*         FILES WITH ALTERNATE STORAGE MARKED OBSOLETE OR WITHOUT
*         AN ALTERNATE STORAGE ADDRESS SPECIFIED IN THE *PFC*.
*
*         ERROR  106         * ALTERNATE STORAGE ERROR.*
*         AN ATTEMPT TO DROP DISK SPACE WHEN A PERMANENT ERROR STATUS
*         IS SET FOR THE ALTERNATE STORAGE FILE COPY.
*
*         ERROR  107         * FNT FULL.*
*         FNT SPACE IS NOT CURRENTLY AVAILABLE FOR A REQUEST WHICH HAS
*         BOTH *EP* AND *UP* EXIT PROCESSING OPTIONS SET.
*
*         ERROR  110         * INCORRECT CATALOG UPDATE.*
*         THIS ERROR IS ISSUED IF AN ALTERNATE STORAGE ADDRESS EXISTS
*         AND THE ALTERNATE STORAGE COPY IS NOT MARKED OBSOLETE WHEN
*         PERFORMING A *SETASA* FUNCTION.  THIS ERROR IS ALSO ISSUED
*         IF A DISK ADDRESS EXISTS FOR A FILE IN THE *PFC* ENTRY WHEN
*         PERFORMING A *SETDA* OR *UREPLAC* FUNCTION.
*
*         ERROR  111         * PFM EXCESS ACTIVITY.*
*         THE SYSTEM *PFM* ACTIVITY COUNT IS AT LIMIT. THIS CONDITION
*         IS ONLY REPORTED FOR REQUESTS WITH BOTH *EP* AND *UP* EXIT
*         PROCESSING OPTIONS SET.
*
*         ERROR  112         * NOT VALIDATED TO SET XD/XT.*
*         THE USER HAS ATTEMPTED TO SET AN EXPIRATION DATE FOR A FILE,
*         AND IS NOT VALIDATED FOR THAT PRIVILEGE.
*
*         ERROR  113         * XD/XT EXCEEDS MAXIMUM.*
*         THIS MESSAGE IS ISSUED WHEN THE USER SPECIFIES AN EXPIRATION
*         DATE OR TERM WHICH IS LARGER THAN THE PREDEFINED SYSTEM
*         MAXIMUM EXPIRATION TERM.
*
*         ERROR  114         * JOB CANNOT ACCESS FILE.*
*         THE ACCESS LEVEL AND CATEGORY SET OF THE CALLING JOB DOES NOT
*         ALLOW ACCESS TO THE SPECIFIED FILE.
*
*         ERROR  115         * ACCESS LEVEL NOT VALID FOR JOB.*
*         THE SPECIFIED ACCESS LEVEL IS NOT VALID FOR THE CALLING JOB.
*
*         ERROR  116         * WRITE-DOWN OF DATA PROHIBITED.*
*         THE LOCAL FILE HAS A HIGHER ACCESS LEVEL THAN THE FILE IT IS
*         REPLACING OR IS BEING APPENDED TO.
*         THE LOCAL FILE FILE HAS A LOWER ACCESS LEVEL THAN THE JOB ON
*         A *DEFINE* REQUEST.
*         THE PERMANENT FILE HAS A LOWER ACCESS LEVEL THAN THE JOB ON
*         A *PERMIT*, *CHANGE*, OR *SETPFAC* REQUEST.
*
*         ERROR  117         * ACCESS CATEGORIES NOT VALID FOR JOB.*
*         THE SPECIFIED ACCESS CATEGORY SET IS NOT VALID FOR THE
*         CALLING JOB.
*
*         ERROR  120         * ACCESS LEVEL NOT VALID ON PF DEVICE.*
*         THE LOCAL FILE ACCESS LEVEL IS INCOMPATIBLE WITH THE
*         USERS MASTER DEVICE ACCESS LEVEL LIMITS.
*
*         ERROR  121         * NOT VALID TO DOWNGRADE DATA.*
*         THE USER HAS ISSUED *SETPFAL* REQUESTING THE FILE TO BE
*         CHANGED TO A LOWER ACCESS LEVEL AND DOES NOT HAVE THE
*         PRIVILEGE TO MAKE DATA LESS SECURE.
*
*         ERROR  122         * (FILE NAME) - NO TEMP DEVICE FOUND.*
*         THE USER HAS ATTEMPTED TO RETRIEVE AN INDIRECT PERMANENT
*         FILE FOR WHICH THERE IS NO TEMPORARY DEVICES VALID FOR THE
*         FILE-S ACCESS LEVEL.
*
*         ERROR  123         * ACCESS LEVEL NOT VALID FOR FILE.*
*         ONE OF TWO ERRORS -
*         1. THE SPECIFIED ACCESS LEVEL IS LESS THAN THE CURRENT
*         ACCESS LEVEL OF THE LOCAL FILE, AND THE CALLER IS NOT
*         VALIDATED TO DOWNGRADE FILES.
*         2. THE SPECIFIED ACCESS LEVEL IS NOT VALID ON THE DEVICE THAT
*         THE LOCAL FILE RESIDES ON; THEREFORE, THE USER CAN NOT *SAVE*
*         OR *DEFINE* THE FILE AT THAT ACCESS LEVEL.
*
*         ERROR  124         * (FILE NAME) TEMPORARY ERROR, TRY LATER.*
*         THE SYSTEM HAS ENCOUNTERED A TEMPORARY PROBLEM WHICH PREVENTS
*         IT FROM STAGING YOUR FILE IN FROM ALTERNATE STORAGE.
*         WAIT AWHILE, THEN TRY AGAIN.
*
*         ERROR  125         * WAITING FOR NFL.*
*         YOUR JOB HAS BEEN DELAYED AND/OR ROLLED OUT WAITING FOR NFL.
*
*         ERROR  126         * WAITING - INACCESSIBLE DEVICE.*
*         ACCESS TO THE PERMANENT FILE DEVICE REQUESTED IS NOT
*         ALLOWED AT THIS TIME BECAUSE THE DEVICE HAS *SUSPECT*,
*         *OFF*, OR *DOWN* STATUS.  ERROR CODE 16 IS RETURNED IN
*         THE FET FOR THIS CONDITION.  USER SHOULD RETRY THE
*         OPERATION.
*
*         ERROR  127         (NO MESSAGE)
*         REQUEST IS BEING RETRIED BY *PFM*.
*
*         ERROR  130         * ERROR IN CATLIST CONTINUATION DATA.*
*         THE CATLIST CONTINUATION DATA SPECIFIED IN *FET+6* POINTS
*         TO AN INCORRECT TRACK AND/OR SECTOR.
          SPACE  4,30
***       ERROR LOG MESSAGES.
*
*         THE FOLLOWING MESSAGES ARE ISSUED TO THE ERROR LOG AS WELL
*         AS TO THE USER AND SYSTEM DAYFILES.  IN THE ERROR LOG, THE
*         PREFIX *EQXXX,DNYY,* IS ADDED TO EACH OF THE MESSAGES.
*
*         * TRACK LIMIT.*
*         * FILE LENGTH ERROR.*
*         * RANDOM INDEX ERROR.*
*         * DIRECT ACCESS FILE ERROR.*
*         * REPLACE ERROR.*
*         * PFM ABORTED.*
*         * MASS STORAGE ERROR.*
*         * FILE BOI/EOI/UI MISMATCH.*
*         * SYSTEM SECTOR ERROR.*
*         * BAD CATALOG/PERMIT SECTOR.*
*         * TRACK NOT RESERVED.*
*
*         WHENEVER ONE OF THE ABOVE MESSAGES IS ISSUED TO THE ERROR
*         LOG, ONE OF THE FOLLOWING MESSAGES IS ALSO ISSUED TO THE
*         ERROR LOG TO IDENTIFY THE FILE IN ERROR.
*
*         *EQXXX, FM=FAMILY,PF=PFN,UI=USERINDEX.*
*         *EQXXX, TK=TRACK,SC=SECTOR.*
*
*         IF *PFM* SETS ERROR IDLE ON THE DEVICE AS THE RESULT OF
*         THE ERROR CONDITION, THE FOLLOWING MESSAGE IS ALSO ISSUED
*         TO THE ERROR LOG.
*
*         *EQXXX, ERROR IDLE SET.*
          TITLE  SYSTEM ERROR PROCESSING.
 SEP      SPACE  4,25
**        SEP - SYSTEM ERROR PROCESSING.
*
*         ENTRY  (P1) = 3/EXC,7/MNE,1/EIF,1/CIF.
*                (EXC) = EXIT CASE.
*                (MNE) = ERROR MNEMONIC.
*                (EIF) = ERROR IDLE FLAG.
*                (CIF) = CHANNEL INTERLOCKED FLAG.
*                (P2) = EST ORDINAL.
*
*         EXIT   (EP) = *EP* BOOLEAN.
*                (P0) = ERROR IDLE FLAG.
*                (P1) = ERROR CODE.
*                (P3) = EXIT CASE.
*                (RT) = *RT* BOOLEAN.
*                (UP) = *UP* BOOLEAN.
*                SEPB = EXIT CASE.
*                TO *EXC* (X=0,1,...,6) TO PROCESS EXIT CASE.
*                TO *RCL* TO RETRY REQUEST.
*
*         USES   T1 - T3, P1 - P3, FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
*         CALLS  CAD, CAI, CEI, CLE, PDE, PPF, PRT, SFA.
 
 
 MBUF     BSS    0           MESSAGE ASSEMBLY BUFFER
 
 SEP      BSS    0           ENTRY
          LDD    P1          SEPARATE EXIT CASE
          SHN    0-11
          STD    P3
          STM    SEPB        SAVE EXIT CASE
          LDD    P1          SEPARATE ERROR IDLE FLAG
          LPN    2
          STD    P0
          LDD    P1          SEPARATE ERROR CODE
          SHN    0-2
          LPC    177
          STD    P1
 
*         SET UP THE *RT*, *EP* AND *UP* DIRECT CELLS.
 
          LDM    EPOP        SET UP *RT*
          SHN    0-1
          LPN    1
          STD    RT
          LDM    EPOP        SET UP *EP*
          SHN    0-2
          LPN    1
          STD    EP
          LDM    EPOP        SET UP *UP*
          SHN    0-3
          LPN    1
          STD    UP
 
*         PERFORM COMMON INITIAL ERROR PROCESSING.
 
          RJM    CAI         CLEAR ALLOCATION AND *DAPF* INTERLOCKS
          RJM    CAD         CHECK FOR ACCESS DENIED
          RJM    CEI         CHECK FOR ERROR IDLE
          RJM    CLE         CHECK FOR LENGTH ERROR
          RJM    PRT         PROCESS PRESERVED AND RESERVED TRACKS
          RJM    PDE         PROCESS *DMP=*
          RJM    PPF         PROCESS SPECIAL *PFM* FILES
 
*         INVOKE EXIT CASE.
 
          LDD    P1          CHECK ERROR CODE
          LMK    /ERRMSG/RTR
          ZJP    RCL         IF REQUEST TO BE RETRIED
          LDM    SEPA,P3     GET EXIT CASE ADDRESS
          STM    SEPA
          LJM    E0C         EXIT 0 CASE
 SEPA     EQU    *-1
          CON    E1C         EXIT 1 CASE
          CON    E2C         EXIT 2 CASE
          CON    E3C         EXIT 3 CASE
          CON    E4C         EXIT 4 CASE
          CON    E5C         EXIT 5 CASE
          CON    E6C         EXIT 6 CASE
          CON    E7C         EXIT 7 CASE
 SEPB     CON    0           EXIT CASE OF *EXC*
 E0C      SPACE  4,15
**        E0C - EXIT 0 CASE PROCESSING.
*
*         EXIT   ERROR CODE IS RETURNED IN THE *FET*.
*                IF (EP) = 0 THE JOB IS ABORTED.
*                IF (EP) = 1, THE JOB IS NOT ABORTED.
*
*         USES   CM - CM+4.
*
*         CALLS  PEM, UFF.
 
 
 E0C      BSS    0           ENTRY
          LDD    P1
          LMK    /ERRMSG/FBS
          NJN    E0C1        IF NOT *FILE BUSY*
          LDD    CP          SET *FILE BUSY* EVENT INTO *TERW*
          ADK    TERW
          CRD    CM
          LDD    CM+2        SET TIME
          SCN    77
          SHN    3
          LMM    ERRD
          SHN    22-3
          STD    CM+2
          SHN    -6
          SCN    77
          LMM    ERRE        SET EST ORDINAL
          STD    CM+3
          LDM    ERRC        SET FOLDED EVENT
          STD    CM+4
          LDD    CP
          ADK    TERW
          CWD    CM
 E0C1     RJM    PEM         PROCESS ERROR MESSAGE
          LJM    UFF         UPDATE FET FIELDS AND EXIT
 E1C      SPACE  4,25
**        E1C - EXIT 1 CASE PROCESSING.
*
*         SPECIAL *EP* AND *UP* CONTROLLED FOR TIME DEPENDENT
*           PROCESSING WITH A POSSIBILITY OF ROLLOUT.
*
*         ENTRY  (EP) = *EP* BOOLEAN.
*                (UP) = *UP* BOOLEAN.
*
*         EXIT   IF *EP* AND *UP*.
*                  IF EMRA, COPY MESSAGE TO EMRA BUFFER.
*                  SET STATUS IN FET.
*                  EXIT PFM.
*                SET MESSAGE IN *MS2W*.
*                IF SSID FIELD ZERO, ROLLOUT JOB.
*                RECALL REQUEST.
*                EXIT PFM.
*
*         USES   CM+1 - CM+4.
*
*         CALLS  GEA, REM, WCM.
*
*         MACROS MONITOR.
 
 
 E1C      BSS    0           ENTRY
          LDD    EP
          ZJN    E1C3        IF *EP* NOT SET
          LDD    UP
          ZJN    E1C3        IF *UP* NOT SET
 
*         RETURN STATUS TO USER.
 
 E1C1     RJM    GEA         GET USER ERROR MESSAGE ADDRESS *EMRA*
          ZJN    E1C2        IF NO ERROR MESSAGE ADDRESS
          LDM    ERRMSG,P1   SPECIFY MESSAGE ADDRESS
          RJM    REM         RETURN ERROR MESSAGE
 E1C2     LJM    UFF         UPDATE FET FIELDS AND EXIT
 
*         RECALL/ROLLOUT THE USER.
 
 E1C3     RJM    WCM         SET MESSAGE IN *MS2W*
          LDM    SSID        CHECK SUBSYSTEM ID
          NJN    E1C4        IF JOB NOT ROLLABLE
          LDM    ERRD        SET ROLLOUT TIME
          STD    CM+2
          LDM    ERRE        SET ROLLOUT EST ORDINAL
          STD    CM+3
          LDM    ERRC        SET FOLDED ROLLOUT EVENT
          STD    CM+4
          ADD    CM+3
          ADD    CM+2
          NJN    E1C3.1      IF TIMED EVENT ROLLOUT
          SOM    E1CA        SET SCHEDULER ROLLOUT OPTION
          ERRNZ  ROTE-ROSR-1 CODE DEPENDS ON VALUE
 E1C3.1   LDD    MA          WRITE *ROCM* PARAMETERS TO MB
          CWD    CM
 E1CA     LDN    ROTE        SELECT TIMED/EVENT ROLLOUT
*         LDN    ROSR        (SELECT SCHEDULER ROLLOUT)
          STD    CM+1
          MONITOR ROCM       REQUEST ROLLOUT
 E1C4     LJM    RCL         SET FOR PFM RECALL AND EXIT PFM
 E2C      SPACE  4,15
**        E2C - EXIT 2 CASE PROCESSING.
*
*         SPECIAL *UP* OR *RT* CONTROLLED FOR STAGE INITIATED
*           PROCESSING.
*
*         ENTRY  (RT) = *RT* BOOLEAN.
*                (UP) = *UP* BOOLEAN.
*
*         EXIT   IF *UP* OR *RT*,
*                  IF *EMRA*, COPY MESSAGE TO *EMRA* BUFFER.
*                  SET STATUS IN FET.
*                  EXIT PFM.
*                SET MESSAGE AT *MS1W* IN *CPA* FOR THE JOB.
*                IF SSID FIELD ZERO, ROLLOUT JOB.
*                RECALL REQUEST.
*                EXIT PFM.
 
 
 E2C      BSS    0           ENTRY
          LDD    UP
          ZJN    E2C2        IF *UP* NOT SET
 E2C1     LJM    E1C1        RETURN STATUS TO CALLER
 
 E2C2     LDD    RT
          NJN    E2C1        IF *RT* SET
          UJP    E1C3        COMPLETE FOR NOT *UP*/*RT*
 E3C      SPACE  4,15
**        E3C - EXIT 3 CASE PROCESSING.
*
*         UNCONDITIONALLY ABORT THE REQUESTING JOB.
*
*         EXIT   MESSAGE ISSUED TO JOB DAYFILE.
*                MESSAGE ISSUED TO SYSTEM DAYFILE.
*
*         CALLS  IDM, UFF.
 
 
 E3C      BSS    0           ENTRY
          LDM    ERRMSG,P1   ISSUE MESSAGE TO DAYFILE
          RJM    IDM
 
*         ABORT THE JOB.
 
          LDK    STAJ        SET *ABORT JOB* STATUS BIT
          RAM    STAU
          LJM    UFF         UPDATE FET FIELDS AND EXIT
 E4C      SPACE  4,15
**        E4C - EXIT 4 CASE PROCESSING.
*
*         SPECIAL *EP*/*IP* OR *EP*/*UP* CONTROLLED FOR TIME DEPENDENT
*           PROCESSING WITH RECALL POSSIBILITY.
*
*         ENTRY  (EP) = *EP* BOOLEAN.
*                (UP) = *UP* BOOLEAN.
*                (EPOP) = ERROR PROCESSING OPTIONS.
*
*         EXIT   IF *EP*/*IP*, OR IF *EP*/*UP* AND NON-ROLLABLE JOB,
*                  IF EMRA, COPY MESSAGE TO EMRA BUFFER.
*                  SET STATUS IN FET.
*                  EXIT PFM.
*                RECALL REQUEST.
*                EXIT PFM.
*
*         CALLS  E1C1, RCL.
 
 
 E4C      BSS    0           ENTRY
          LDD    EP
          ZJN    E4C1        IF *EP* NOT SET
          LDM    EPOP
          LPN    1
          NJN    E4C0        IF *IP* SET
          LDD    UP
          ZJN    E4C1        IF *UP* NOT SET
          LDM    SSID        CHECK SUBSYSTEM ID
          ZJN    E4C1        IF ROLLABLE JOB
 E4C0     LJM    E1C1        RETURN STATUS TO USER
 
 E4C1     RJM    WCM         SET MESSAGE IN *MS2W*
          LJM    RCL         RECALL *PFM*
 E5C      SPACE  4,10
**        E5C - EXIT 5 CASE PROCESSING.
*
*         SECURITY VIOLATION PROCESSING - ABORT JOB WITH *SVET* ERROR.
*           IF CALLER IS *SSJ=*, PROCESS AS NORMAL ERROR.
*
*         ENTRY  (P1) = ERROR CODE.
*
*         EXIT   TO *E0C* IF CALLER IS *SSJ=*.
*                MESSAGE ISSUED TO JOB DAYFILE.
*                MESSAGE ISSUED TO SYSTEM DAYFILE.
*                (SVET) = SECURITY VIOLATION ERROR FLAG SET.
*
*         CALLS  IDM, UFF.
 
 
 E5C      BSS    0           ENTRY
          LDM    SSJS
          NJP    E0C         IF CALLER IS *SSJ=*
          LDM    ERRMSG,P1   ISSUE MESSAGE TO DAYFILE
          RJM    IDM
 
*         ABORT THE JOB WITH AN *SVET* ERROR.
 
          LDN    SVET        SET SECURITY VIOLATION ERROR FLAG
          STD    CM+1
          MONITOR  CEFM
          LJM    UFF         UPDATE FET FIELDS AND EXIT
 E6C      SPACE  4,25
**        E6C - EXIT 6 CASE PROCESSING.
*
*         SPECIAL *RT* CONTROLLED FOR TIME DEPENDENT PROCESSING OF
*           AN INACCESSIBLE MASS STORAGE DEVICE.
*
*         ENTRY  (P1) = ERROR CODE.
*                (P2) = EST ORDINAL OF DEVICE.
*                (RT) = *RT* BOOLEAN.
*                (PWRF) = RESTART FLAGS FOR *PFM* RECALL.
*                *RT* IS SET IF THE CALLER IS A SUBSYSTEM.
*
*         EXIT   TO *E1C1*, IF *RT* SET, TO RETURN STATUS TO CALLER.
*                TO *1RJ* TO ROLLOUT THE JOB.
*
*         USES   IR+4, MP - MP+4.
*
*         CALLS  PAF, *1RJ*.
*
*         MACROS EXECUTE.
 
 
 E6C      BSS    0           ENTRY
          LDD    RT
          NJP    E1C1        IF *RT* SET
 
*         SELECT EVENT ROLLOUT THROUGH OVERLAY *1RJ*.
 
          RJM    PAF         PROCESS PF ACTIVITY COUNT AND FNT
          LDN    ZERL        SET PARAMETER WORD FOR *PFM* RECALL
          CRD    MP
          LDM    PWRF        RESTART FLAGS
          STD    MP
          LDD    P1          ERROR CODE
          STD    MP+1
          LDD    P2          SET EST ORDINAL
          STD    IR+4
          EXECUTE  1RJ       ROLLOUT THE JOB
 E7C      SPACE  4,10
**        E7C - EXIT 7 CASE PROCESSING.
*
*         SPECIAL PROCESSING FOR TYPE 2 ERRORS IN *PURGE*.  ISSUE THE
*           ERROR MESSAGE TO THE ERROR LOG BUT DO NOT ABORT THE JOB.
*
*         NOTE THAT CATALOG ENTRY FOR THE FILE HAS BEEN DELETED BEFORE
*         THIS OVERLAY IS INVOKED IN THIS CASE.
*
*         EXIT   MESSAGE ISSUED TO ERROR LOG.
*                ERROR CODE CLEARED.
*
*         CALLS  SEQ, UFF.
 
 
 E7C      BSS    0           ENTRY
          RJM    SEQ         ISSUE ERROR LOG MESSAGE
          LDN    0           CLEAR ERROR CODE
          STD    P1
          LJM    UFF         UPDATE FET FIELDS AND EXIT
          TITLE  SUBROUTINES.
 CPN      SPACE  4,10
**        CPN - COPY NAME.
*         COPIES NAME WITH BLANK FILL.
*
*         ENTRY  (T3) = SOURCE ADDRESS.
*                (A) = DESTINATION ADDRESS.
*
*         USES   T3, P3.
 
 
 CPN      SUBR               ENTRY/EXIT
          STD    P3          SAVE DESTINATION ADDRESS
          ADN    3
          STM    CPNA
 CPN1     LDI    T3
          SCN    77
          NJN    CPN2        IF NOT NULL CHARACTER
          LDC    100*1R
 CPN2     STI    P3
          LDI    T3
          LPN    77
          NJN    CPN3        IF NOT NULL CHARACTER
          LDN    1R
 CPN3     RAI    P3          ASSEMBLE CHARACTERS
          AOD    T3
          AOD    P3
          LMC    **
 CPNA     EQU    *-1
          NJN    CPN1        IF NOT LAST FULL BYTE
          LDI    T3
          SCN    77
          ZJN    CPNX        IF NULL CHARACTER
          LMN    1R,
          STI    P3
          UJN    CPNX        RETURN
 GEA      SPACE  4,15
**        GEA - GET ERROR MESSAGE RETURN ADDRESS.
*
*         ENTRY  (EP) = ERROR PROCESSING STATUS.
*
*         EXIT   (A) = 0 IF *EP* OR *EMRA* NOT SPECIFIED.
*                (A) = *EMRA* ADDRESS IF *EP* AND *EMRA* SPECIFIED.
 
 
 GEA      SUBR               ENTRY/EXIT
          LDD    EP
          ZJN    GEAX        IF *EP* BOOLEAN NOT SET IN *FET*
          LDM    EMRA        FORM *EMRA* BASE ADDRESS
          LPN    37
          SHN    14
          ADM    EMRA+1
          UJN    GEAX        RETURN WITH*EMRA*
 IDM      SPACE  4,10
**        IDM - ISSUE DAYFILE MESSAGE.
*
*         ENTRY  (A) = ADDRESS OF MESSAGE PLUS DESTINATION.
*
*         EXIT   ISSUES MESSAGE WITH FET ADDRESS.
*
*         USES   T1 - T4.
*
*         CALLS  DFM, C2D.
 
 
 IDM      SUBR               ENTRY/EXIT
          STD    T4          SAVE ADDRESS
          STD    T1
          SHN    -14
          STD    T3
          LDM    SFAA
          LPN    77
          ADM    SFAA+1
          ZJN    IDM1        IF NO FET ADDRESS PRESET
          LDM    EPOP        CHECK ADDRESS SUPPRESS BIT
          LPN    20
          ZJN    IDM2        IF FET ADDRESS NOT TO BE SUPPRESSED
 IDM1     LJM    IDM6        ISSUE MESSAGE WITHOUT ADDRESS
 
*         FIND END OF MESSAGE.
 
 IDM2     LDI    T1
          SHN    -6
          ZJN    IDM3        IF END OF MESSAGE
          LDI    T1
          LPN    77
          ZJN    IDM4        IF END OF MESSAGE
          AOD    T1
          UJN    IDM2        LOOP
 
 IDM3     SOD    T1          REPLACE *.* WITH *,*
          LDI    T1
          SCN    77
          ADN    1R,
          STI    T1
          AOD    T1
          UJN    IDM5        ADD FET ADDRESS TO MESSAGE
 
 IDM4     LDC    2R,         REPLACE *.* WITH *,*
          STI    T1
          AOD    T1
 
*         STORE * AT * AT END OF MESSAGE.
 
 IDM5     LDC    2R A
          STI    T1
          AOD    T1
          LDC    2RT
          STI    T1
          AOD    T1
 
*         SET FET ADDRESS IN MESSAGE.
 
          RJM    SFA         CONVERT FET ADDRESS
          SHN    14
          SBD    RA
          SHN    6
          STD    T2
          SHN    -14
          RJM    C2D         CONVERT DIGITS
          STI    T1
          AOD    T1
          LDD    T2
          SHN    -6
          RJM    C2D         CONVERT DIGITS
          STI    T1
          AOD    T1
          LDD    T2
          RJM    C2D         CONVERT DIGITS
          STI    T1
          AOD    T1
          LDC    2R.
          STI    T1
          AOD    T1
          LDN    0           SET ZERO BYTE
          STI    T1
 
*         ISSUE MESSAGE.
 
 IDM6     LDD    T3          RESET MESSAGE ADDRESS
          SHN    14
          ADD    T4
          RJM    DFM         ISSUE MESSAGE
          LJM    IDMX        RETURN
 MEC      SPACE  4,15
**        MEC - MODIFY ERROR CODES.
*
*         ENTRY  (P1) = ERROR CODE FOR POSSIBLE MODIFICATION.
*
*         EXIT   (P1) = ERROR CODE TO BE REPORTED IN THE *FET*.
 
 
 
*         CHANGE CODE WHICH REPORTS A WAIT FOR AN INACCESSIBLE
*         DEVICE TO *PF UTILITY ACTIVE*.
 
 MEC2     LMK    /ERRMSG/WID&/ERRMSG/FIA
          NJN    MECX        IF NOT *WID*, RETURN
          LDK    /ERRMSG/PFA CHANGE ERROR CODE TO *PFA*
          STD    P1
 
 MEC      SUBR               ENTRY/EXIT
          LDD    P1          CHECK FOR ERROR CODES TO MODIFY
          LMN    /ERRMSG/FDA
          ZJN    MEC1        IF *FDA* THEN MODIFY
          LMN    /ERRMSG/FIA&/ERRMSG/FDA
          NJN    MEC2        IF NOT *FIA*
 MEC1     LDN    /ERRMSG/FNF CHANGE ERROR CODE TO *FNF*
          STD    P1
          UJN    MECX        RETURN
 MFN      SPACE  4,10
**        MFN - MERGE FILE NAME WITH MESSAGE.
*
*         ENTRY  (A) = FIRST WORD ADDRESS OF MESSAGE.
*                (FN - FN+3) = FILE NAME.
*
*         EXIT   (A) = FIRST WORD ADDRESS OF MESSAGE.
*
*         USES   T1 - T3.
 
 
 MFN      SUBR               ENTRY/EXIT
          STD    T1          SAVE MESSAGE ADDRESS
          LDC    MBUF        ASSEMBLY AREA
          STD    T2
          LDN    1R          BLANK FIRST CHARACTER
          STI    T2
          AOD    T2
          LDN    FN
          STD    T3
          LDD    FN+3        CLEAR TRAILING CONTROL INFORMATION
          SCN    77
          STD    FN+3
 MFN1     LDI    T3          GET BYTE
          SHN    -6          UPPER CHARACTER
          ZJN    MFN2        IF END OF FILE NAME
          STI    T2
          AOD    T2
          LDI    T3          LOWER CHARACTER
          LPN    77
          ZJN    MFN2        IF END OF FILE NAME
          STI    T2
          AOD    T2
          AOD    T3
          UJN    MFN1        LOOP TO END OF FILE NAME
 
 MFN2     LDN    1R          INSERT SPACE
          STI    T2
          AOD    T2
 MFN3     LDI    T1          UPPER MESSAGE CHARACTER
          SHN    -6
          STI    T2
          ZJN    MFN4        IF END OF MESSAGE
          AOD    T2
          LDI    T1          LOWER MESSAGE CHARACTER
          LPN    77
          STI    T2
          ZJN    MFN4        IF END OF MESSAGE
          AOD    T2
          AOD    T1
          UJN    MFN3        MOVE NEXT CHARACTER
 
 MFN4     STM    1,T2        SET END OF MESSAGE
          STM    2,T2
          LDC    MBUF
          STD    T1
          STD    T3
 MFN5     LDI    T1
          ZJN    MFN6        IF END OF MESSAGE REACHED
          SHN    6
          LMM    1,T1
          STI    T3
          AOD    T3
          LDN    2
          RAD    T1
          UJN    MFN5        LOOP TO COMPLETE MESSAGE
 
 MFN6     STI    T3          SET END OF MESSAGE
          LDC    MBUF        EXIT WITH (A) = MESSAGE ADDRESS
          LJM    MFNX        RETURN
 PAF      SPACE  4,15
**        PAF - PROCESS PF ACTIVITY COUNT AND LOCAL FILE FNT.
*
*         ENTRY  (EPFA) = EST ORDINAL OF DEVICE IF PF ACTIVITY
*                         TO BE DECREMENTED.
*                (FNTA) = FNT ADDRESS OF LOCAL FILE.
*
*         EXIT   LOCAL FILE FNT SET COMPLETE.
*                PF ACTIVITY COUNT DECREMENTED IF IT WAS SET.
*
*         USES   CM - CM+4, FS - FS+4.
*
*         MACROS MONITOR.
 
 
 PAF      SUBR               ENTRY/EXIT
 
*         DECREMENT PF ACTIVITY COUNT.
 
          LDM    EPFA        EST ORDINAL
          ZJN    PAF1        IF ACTIVITY NOT SET
          STD    CM+1
          LDN    DPAS        DECREMENT PF ACTIVITY COUNT
          STD    CM+3
          MONITOR  STBM
 
*         SET LOCAL FILE FNT COMPLETE.
 
 PAF1     LDM    FNTA
          STD    FA
          ZJN    PAFX        IF NO LOCAL FILE FNT, RETURN
          NFA    FA,R
          ADN    FSTL
          CRD    FS
          LDD    FS+4        SET FST COMPLETE
          SCN    1
          ADN    1
          STD    FS+4
          NFA    FA,R
          ADN    FSTL
          CWD    FS
          UJN    PAFX        RETURN
 PEA      SPACE  4,15
**        PEA - PROCESS ERRORS REQUIRING SPECIAL ACTION.
*
*         ENTRY  (P1) = ERROR CODE.
*                (EP) = *EP* BOOLEAN FROM *FET*.
*                (SEPB) = EXIT CASE.
*
*         EXIT   IF THE USER IS NOT PROCESSING ERRORS;
*                  SET *TKET* ERROR FLAG IF *PRL* ERROR.
*                  SET *FLET* ERROR FLAG IF *LFL* ERROR.
*                  THE *STAJ* (ABORT JOB) STATUS BIT IS SET.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR.
 
 
 PEA      SUBR               ENTRY/EXIT
          LDD    EP
          NJN    PEAX        IF *EP* SPECIFIED
          LDD    P1          CHECK ERROR TYPE
          LMN    /ERRMSG/PRL
          NJN    PEA1        IF NOT TRACK LIMIT
          LDN    TKET        SET *TKET* ERROR FLAG
          STD    CM+1
          UJN    PEA2        SET TRACK LIMIT
 
 PEA1     LMN    /ERRMSG/LFL&/ERRMSG/PRL CHECK ERROR TYPE
          NJN    PEA3        IF NOT FILE LIMIT
          LDN    FLET        SET *FLET* ERROR FLAG
          STD    CM+1
 PEA2     MONITOR CEFM
          UJN    PEAX        RETURN
 
 PEA3     LDM    SEPB
          NJN    PEAX        IF SPECIAL EXIT CASE
          LDK    STAJ        SET *ABORT JOB* STATUS BIT
          RAM    STAU
          UJN    PEAX        RETURN
 PEM      SPACE  4,15
**        PEM - PROCESS ERROR MESSAGE.
*
*         ENTRY  (P1) = ERROR CODE.
*                (EP) = *EP* BOOLEAN FROM FET (0 OR 1).
*
*         EXIT   ERROR MESSAGE ISSUED BY TYPE.
*
*         USES   T1.
*
*         CALLS  DFM, GEA, IDM, MFN, PEA, REM, SEQ.
 
 
 PEM      SUBR               ENTRY/EXIT
          LDD    P1
          ZJN    PEMX        IF NO ERROR (*RPFSTAT* REQUEST)
          LDM    ERRCLS,P1   ERROR TYPE OR CLASS
          STD    T1
          SHN    1           DETERMINE MESSAGE CODE BASE ADDRESS
          ADC    TDMO
          STM    PEMB        SET MESSAGE CODE ADDRESS
          LDM    PEMA,T1     ESTABLISH CASE OF MESSAGE TYPE
          STM    PEMA
          LJM    PEM1        TYPE = 0 (FILE NAME REQUIRED)
 PEMA     EQU    *-1
          CON    PEM2        TYPE = 1 (ISSUE TO JOB DAYFILE ONLY)
          CON    PEM5        TYPE = 2 (SYSTEM ERROR)
          CON    PEM6        TYPE = 3 (NO MESSAGE ERROR)
 
*         PROCESS TYPE 0 ERROR MESSAGE.
 
 PEM1     LDM    ERRMSG,P1   BASE ADDRESS OF MESSAGE
          RJM    MFN         MERGE FILENAME AND MESSAGE
          STM    ERRMSG,P1   SET NEW ERROR MESSAGE ADDRESS
 
*         PROCESS TYPE 1 ERROR MESSAGE.
 
 PEM2     RJM    GEA         GET USER ERROR MESSAGE ADDRESS *EMRA*
          ZJN    PEM3        IF ERMSG AND *EP* NOT SPECIFIED
          LDM    ERRMSG,P1   SPECIFY MESSAGE ADDRESS
          RJM    REM         RETURN ERROR MESSAGE
          UJN    PEM4        RETURN
 
 PEM3     RJM    PEA         PROCESS ERRORS REQUIRING SPECIAL ACTION
          LDM    **,EP       GET MESSAGE OPTION
 PEMB     EQU    *-1         (TABLE ADDRESS FOR MESSAGE TYPE)
          SHN    14          POSITION
          MJN    PEM4        IF NO MESSAGE TO ISSUE
          ADM    ERRMSG,P1   ADD MESSAGE ADDRESS
          RJM    IDM         ISSUE MESSAGE
 PEM4     LJM    PEMX        RETURN
 
*         PROCESS TYPE 2 ERROR MESSAGE.
*         SYSTEM ERROR - ISSUE *SYSTEM ERROR* TO JOB DAYFILE.
 
 PEM5     LDC    PEMD+CPON   *SYSTEM ERROR*
          RJM    DFM
          RJM    SEQ         ISSUE ERROR LOG MESSAGE
          UJN    PEM2        COMPLETE ERROR PROCESSING
 
*         PROCESS TYPE 3 ERROR MESSAGE.
 
 PEM6     LDM    ERRMSG,P1   SET MESSAGE DESTINATION ADDRESS
          STM    PEMC
          LDD    CP          READ MESSAGE AT CP AREA
          ADN    MS1W
          CRM    **,TR
 PEMC     EQU    *-1
          LJM    PEM2        COMPLETE ERROR PROCESSING
 
 PEMD     DATA   C*SYSTEM ERROR.*
 TDMO     SPACE  4,10
**        TDMO - TABLE OF DAYFILE MESSAGE OPTIONS.
*
*T        12/(OPTION IF CP ABORTING),12/(OPTION IF *EP* SET)
*         BIT 5 IS SET IF NO MESSAGE IS TO BE ISSUED.
 
 
 TDMO     BSS    0
          CON    0,CPON/10000B                   TYPE 0
          CON    0,CPON/10000B                   TYPE 1
          CON    NMSN/10000B,NMSN/10000B         TYPE 2
          CON    40B,40B                         TYPE 3
 PPF      SPACE  4,15
**        PPF - PROCESS SPECIAL *PFM* FILES.
*
*         ENTRY  (FNTA) = LOCAL FILE FNT ADDRESS.
*                (ERRB) = 0 IF LOCAL FILE CREATED BY *PFM*.
*                (FNTB) = /PFM*PFN/ FNT ADDRESS.
*                (FNTC) = /PFM*ILK/ FNT ADDRESS.
*                (FNTD) = /PFM*APF/ FNT ADDRESS.
*
*         EXIT   FILES UNLOADED IF CREATED BY *PFM*.
*
*         CALLS  *0DF*.
 
 
 PPF      SUBR               ENTRY/EXIT
          LDN    1
          STM    LOCF-1      SET *UNLOAD* OPTION FOR *0DF*
 
*         PROCESS LOCAL FILE.
 
          LDM    FNTA
          ZJN    PPF1        IF NO LOCAL FILE FNT
          STD    FA
          LDM    ERRB
          NJN    PPF1        IF LOCAL FILE NOT CREATED BY *PFM*
 PPFA     LDN    0
*         LDN    1           (*SYOT* + *GET* + *FILE LENGTH ERROR*)
          NJN    PPF1        IF FILE SHOULD NOT BE RETURNED
          EXECUTE  0DF,LOCF
          MJN    PPF1        IF DEVICE INACCESSIBLE
          LDN    0           CLEAR LOCAL FILE FNT ADDRESS
          STM    FNTA
 
*         PROCESS /PFM*PFN/.
 
 PPF1     LDM    FNTB        GET FNT ADDRESS
          ZJN    PPF2        IF FILE NOT PRESENT
          STD    FA
          EXECUTE  0DF,LOCF
 
*         PROCESS /PFM*ILK/.
 
 PPF2     LDM    FNTC        GET FNT ADDRESS
          ZJN    PPF3        IF FILE NOT PRESENT
          STD    FA
          EXECUTE  0DF,LOCF
 
*         PROCESS /PFM*APF/.
 
 PPF3     LDM    FNTD        GET FNT ADDRESS
          ZJN    PPF4        IF FILE NOT PRESENT
          STD    FA
          EXECUTE  0DF,LOCF
 PPF4     LJM    PPFX        RETURN
 RCL      SPACE  4,15
**        RCL - RECALL PFM.
*
*         ENTRY  (P1) = ERROR CODE.
*                (PWRF) = RESTART FLAGS.
*
*         EXIT   (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
*                (FN - FN+4) = RECALL REQUEST FOR MONITOR.
*                (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
*                (AIPF, AIPF+1) = 0.
*                (STAU) = *STRP* BIT SET TO RECALL *PFM*.
*                TO *3PU* TO RECALL *PFM*.
 
 
 RCL      BSS    0           ENTRY
          LDN    0           CLEAR PF ACCUMULATOR INCREMENT
          STM    AIPF
          STM    AIPF+1
          LDN    ZERL
          CRD    FN          SET RECALL REQUEST
          CRD    MP          SET PARAMETER WORD
          LDM    PWRF        RESTART FLAGS
          STD    MP
          LDD    P1          ERROR CODE
          STD    MP+1
          LDD    IA          READ INPUT REQUEST REGISTER
          CRD    CN
          LDD    MP+1        CHECK ERROR CODE
          LMK    /ERRMSG/RTR
          NJN    RCL2        IF NOT RETRY REQUEST
          LDD    CC          COMMAND CODE
          LMN    CCRS
          NJN    RCL1        IF NOT *RPFSTAT* REQUEST
          LDD    CN+2        SET ORIGINAL COMMAND CODE IN REQUEST
          SCN    77
          LMM    PWCC
          STD    CN+2
 RCL1     LDN    0
          UJN    RCL3        SET DELAY TO 0 MILLISECONDS
 
 RCL2     LDC    250D        SET DELAY TO 250D MILLISECONDS
 RCL3     STD    FN+4
          LDC    PTMF        SET TIMED RECALL
          STD    FN+1
          LDK    STRP        SET *RECALL PFM* STATUS BIT
          RAM    STAU
          EXECUTE  3PU       RECALL *PFM*
 REM      SPACE  4,10
**        REM - RETURN ERROR MESSAGE.
*
*         ENTRY  (A) = ADDRESS OF ERROR MESSAGE.
*                (EMRA - EMRA+1) ADDRESS FOR MESSAGE RETURN.
*
*         CALLS  NONE
*
*         USES   T1, T2, T3
 
 
 REM      SUBR
          STM    REMA        SAVE MESSAGE ADDRESS
          STD    T1
          LDN    5           SET BYTES PER WORD
          STD    T2
          LDN    1
          STD    T3          INITIALIZE CM WORD COUNT
 
 REM1     LDI    T1          SEARCH FOR END OF MESSAGE
          ZJN    REM2        IF ZERO BYTE FOUND
          AOD    T1
          SOD    T2
          NJN    REM1        IF NOT FULL CM WORD
          AOD    T3
          LDN    5
          STD    T2          RESET BYTES PER WORD
          UJN    REM1        CONTINUE TO END OF MESSAGE
 
 REM2     AOD    T1          CLEAR REMAINDER OF MESSAGE TO FULL WORD
          SOD    T2
          ZJN    REM3        IF FULL CM WORD
          LDN    0
          STI    T1          CLEAR MESSAGE TAIL
          UJN    REM2        LOOP FOR FULL CM WORD
 
 REM3     LDM    EMRA        STORE MESSAGE
          LPN    37
          SHN    6
          ADD    RA
          SHN    6
          ADM    EMRA+1
          CWM    *,T3        SEND MESSAGE TO CENTRAL
 REMA     EQU    *-1
          LJM    REMX        RETURN
 SEQ      SPACE  4,12
**        SEQ - SET EQUIPMENT INFORMATION IN MESSAGE.
*
*         SETS THE DEVICE TYPE, EST ORDINAL AND DEVICE NUMBER INTO
*         THE ERROR MESSAGE AND ISSUES IT TO THE ERROR LOG.  ALSO
*         ISSUES TO THE ERROR LOG EITHER A MESSAGE SPECIFYING FAMILY,
*         FILE NAME AND USER INDEX, OR A MESSAGE SPECIFYING TRACK
*         AND SECTOR.
*
*         ENTRY  (CC) = COMMAND CODE.
*                (P1) = ERROR CODE.
*                (P2) = EST ORDINAL.
*                (ERRC) = TRACK (FOR *BCS* ERROR).
*                (ERRD) = SECTOR (FOR *BCS* ERROR).
*
*         CALLS  CFN, C2D, DFM.
*
*         USES   T2, T3, CM - CM+4.
*
*         MACROS SFA.
 
 
 SEQ6     LDM    ERRMSG,P1   ISSUE MESSAGE TO ERRLOG
          ADC    ERLN
          RJM    DFM
 SEQA     LDN    0
*         LDN    1           (EXTENDED MESSAGE REQUIRED)
          ZJN    SEQX        IF EXTENDED MESSAGE NOT REQUIRED
          LDC    SEQB+ERLN   ISSUE FM/PF/UI EXTENDED MESSAGE
*         LDC    SEQD+ERLN   (ISSUE TRACK/SECTOR EXTENDED MESSAGE)
 SEQE     EQU    *-1
          RJM    DFM
 SEQF     UJN    SEQX        RETURN
*         PSN                (ERROR IDLE SET)
          LDC    SEQG+ERLN   *EQXXX, ERROR IDLE SET.*
          RJM    DFM
 
 SEQ      SUBR               ENTRY/EXIT
          LDD    P1
          LMN    /ERRMSG/RSE
          ZJN    SEQ6        IF RESEX ERROR
          AOM    SEQA        FLAG EXTENDED MESSAGE REQUIRED
          LDM    ERRMSG,P1   SET MESSAGE ADDRESS
          STD    T2
          LDD    P2          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -3
          RJM    C2D
          STM    1,T2
          STM    SEQB+1
          STM    SEQD+1
          STM    SEQG+1
          LDD    P2          CONVERT LOWER DIGIT OF EST ORDINAL
          LPN    7
          SHN    6
          ADC    2R0,
          STM    2,T2
          STM    SEQB+2
          STM    SEQD+2
          STM    SEQG+2
          SFA    EST,P2      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM+4        READ PFGL WORD OF MST
          SHN    3
          ADN    PFGL
          CRD    CM
          LDD    CM+3        CONVERT DEVICE NUMBER
          RJM    C2D
          STM    4,T2
          LDD    P1
          LMN    /ERRMSG/BCS
          NJN    SEQ1        IF NOT *BAD CATALOG/PERMIT SECTOR*
          LJM    SEQ5        PROCESS TRACK/SECTOR ERROR MESSAGE
 
*         SET UP *EQXXX, FM= ,PF= ,UI= .* MESSAGE.
 
 SEQ1     LDN    CM          COPY FAMILY NAME
          STD    T3
          LDC    SEQB+5      COPY NAME TO BUFFER
          RJM    CPN
          LDD    CC
          LMN    CCCT
          NJN    SEQ2        IF NOT CATLIST ERROR
          LDD    FN
          NJN    SEQ2        IF FILE NAME DEFINED
          LDC    SEQC        SET FILE NAME TO *PERMITS*
          UJN    SEQ4        SET *PERMITS* ADDRESS
 
 SEQ2     LDM    PFFN        CHECK PERMANENT FILE NAME
          ZJN    SEQ3        IF NOT SPECIFIED IN FET
          LDC    PFFN        SET ADDRESS OF PERMANENT FILE NAME
          UJN    SEQ4        SET ADDRESS
 
 SEQ3     LDN    FN          SET ADDRESS OF LOCAL FILE NAME
 SEQ4     STD    T3
          LDC    SEQB+13
          RJM    CPN
          LDD    UI+1        COPY USER INDEX
          RJM    C2D
          STM    SEQB+23
          LDD    UI+1
          SHN    -6
          RJM    C2D
          STM    SEQB+22
          LDD    UI
          RJM    C2D
          STM    SEQB+21
          LJM    SEQ6        ISSUE MESSAGES
 
*         SET UP *EQXXX, TK= ,SC= .* MESSAGE.
 
 SEQ5     LDM    ERRC        CONVERT TRACK NUMBER
          SHN    -6
          RJM    C2D
          STM    SEQD+5
          LDM    ERRC
          RJM    C2D
          STM    SEQD+6
          LDM    ERRD        CONVERT SECTOR NUMBER
          SHN    -6
          RJM    C2D
          STM    SEQD+11
          LDM    ERRD
          RJM    C2D
          STM    SEQD+12
          LDN    SEQD-SEQB   FORCE TRACK/SECTOR OF EXTENDED MESSAGE
          RAM    SEQE
          LJM    SEQ6        ISSUE MESSAGES
 
 SEQB     DATA   C*EQXXX, FM=       , PF=       , UI=      .*
 SEQC     DATA   C*PERMITS*
 SEQD     DATA   C*EQXXX, TK=    ,SC=    .*
 SEQG     DATA   C*EQXXX, ERROR IDLE SET.*
 UFF      SPACE  4,15
**        UFF - UPDATE FET FIELDS.
*
*         ENTRY  (P1) = ERROR CODE.
*
*         EXIT   TO *3RT*.
*                (FN - FN+4) = FET + 0 WITH ERROR STATUS SET.
*                (FS - FS+4) = FET + 1.
*                (STAU) = *STDS* FLAG SET TO DROP PP.
*
*         USES   T1, T2.
*
*         CALLS  MEC, SFA, *3PU*.
 
 
 UFF      BSS    0           ENTRY
          RJM    MEC         MODIFY ERROR CODE IF NEEDED
          RJM    SFA         READ FIRST WORD OF *FET*
          ZJN    UFF1        IF NO FET ADDRESS
          CRD    FN
          ADN    1           READ FET + 1
          CRD    FS
          LDD    P1          FORM MSB OF ERROR CODE
          SHN    -2
          STD    T2
          LDD    P1          FORM LSB OF ERROR CODE
          LPN    3
          SHN    13-1
          ADN    1           SET COMPLETE BIT
          STD    T1
          LDD    FN+3        MERGE WITH END OF FILE NAME
          SCN    77
          ADD    T2
          STD    FN+3
          LDD    FN+4
          LPC    1776        CLEAR COMPLETE AND ERROR CODE BITS
          ADD    T1
          STD    FN+4
 UFF1     LDK    STDS        SET *DROP PP* STATUS BIT
          RAM    STAU
          EXECUTE  3PU       DROP PP
 WCM      SPACE  4,15
**        WCM - WRITE CONTROL POINT MESSAGE.
*
*         ENTRY  (P1) = ERROR CODE.
*
*         EXIT   MESSAGE WRITTEN TO *MS2W* OF JOB CONTROL POINT.
*
*         USES   T1.
*
*         CALLS  MFN.
 
 
 WCM      SUBR               ENTRY/EXIT
          LDM    ERRCLS,P1   CHECK MESSAGE TYPE
          NJN    WCM1        IF NOT TYPE 0 MESSAGE
          LDM    ERRMSG,P1   MERGE FILE NAME WITH MESSAGE
          RJM    MFN
          UJN    WCM2        SETUP TO WRITE MESSAGE
 
 WCM1     LDM    ERRMSG,P1
 WCM2     STM    WCMA        SET FOR MESSAGE COPY TO *MS2W*
          ADN    5*3-1       FORCE END OF LINE
          STM    WCMB+1
          LDN    0
 WCMB     STM    *
          LDD    CP          SET DESTINATION ADDRESS
          ADN    MS2W
          CWM    *,TR        COPY MESSAGE TO *MS2W* OF JOB
 WCMA     EQU    *-1
          UJN    WCMX        RETURN
          TITLE  ERROR MESSAGES.
**        ERROR MESSAGES.
*
*         FORMAT (FIRST WORD), ERROR DESTINATION FLAG.
*                (SECOND WORD), FIRST WORD ADDRESS OF MESSAGE.
*
*         CONTENTS OF FIRST WORD.
*                0, SEND FILE NAME MESSAGE TO CONTROL POINT DAYFILE.
*                1, SEND MESSAGE TO CONTROL POINT DAYFILE.
*                2, SEND MESSAGE TO CONTROL POINT DAYFILE AND ERRORLOG.
 
 
          LIST   -R
 
 MXER     EQU    /ERRMSG/MXER
 ERRCLS   INDEX
 
 FBS      ERRMSG 0,(BUSY.)
 FNF      ERRMSG 0,(NOT FOUND.)
 EFL      ERRMSG 0,(EMPTY.)
 NMS      ERRMSG 0,(NOT ON MASS STORAGE.)
 FAP      ERRMSG 0,(ALREADY PERMANENT.)
 IFT      ERRMSG 0,(INCORRECT FILE TYPE.)
 
 FNE      ERRMSG 1,( FILE NAME ERROR.)
 IUA      ERRMSG 1,( USER ACCESS NOT VALID.)
 IDR      ERRMSG 1,( INCORRECT DEVICE REQUEST.)
 FTL      ERRMSG 1,( FILE TOO LONG.)
 ILR      ERRMSG 1,( PFM INCORRECT REQUEST.)
 PFN      ERRMSG 1,( DEVICE UNAVAILABLE.)
 DAD      ERRMSG 1,( DIRECT ACCESS DEVICE ERROR.)
 PFA      ERRMSG 1,( PF UTILITY ACTIVE.)
 DTE      ERRMSG 1,( DATA TRANSFER ERROR.)
 COF      ERRMSG 1,( TOO MANY PERMANENT FILES.)
 COS      ERRMSG 1,( TOO MUCH INDIRECT ACCESS FILE SPACE.)
 SPN      ERRMSG 1,( PRUS REQUESTED UNAVAILABLE.)
 IOE      ERRMSG 1,( I/O SEQUENCE ERROR.)
 LFL      ERRMSG 1,( LOCAL FILE LIMIT.)
 PRL      ERRMSG 1,( PRU LIMIT.)
 PLE      ERRMSG 1,( PERMIT LIMIT EXCEEDED.)
 PAE      ERRMSG 1,( PFM ARGUMENT ERROR.)
 RSE      ERRMSG 2,( RESEX FAILURE.)
 TKL      ERRMSG 2,(EQXXX,DNYY, TRACK LIMIT.)
 FLE      ERRMSG 2,(EQXXX,DNYY, FILE LENGTH ERROR.)
 RIN      ERRMSG 2,(EQXXX,DNYY, RANDOM INDEX ERROR.)
 DAF      ERRMSG 2,(EQXXX,DNYY, DIRECT ACCESS FILE ERROR.)
 RPE      ERRMSG 2,(EQXXX,DNYY, REPLACE ERROR.)
 ABT      ERRMSG 2,(EQXXX,DNYY, PFM ABORTED.)
 MSE      ERRMSG 2,(EQXXX,DNYY, MASS STORAGE ERROR.)
 EDA      ERRMSG 1,( ERROR IN FILE DATA.)
 EPT      ERRMSG 1,( ERROR IN PERMIT DATA.)
 EDP      ERRMSG 1,( DATA/PERMIT ERRORS.)
 FLC      ERRMSG 1,( EOI CHANGED BY RECOVERY.)
 NEM      ERRMSG 3,(                              )
 RS2      ERRMSG 1,()        RESERVED
 RS3      ERRMSG 1,()        RESERVED
 RS4      ERRMSG 1,()        RESERVED
 FSE      ERRMSG 2,(EQXXX,DNYY, FILE BOI/EOI/UI MISMATCH.)
 SSE      ERRMSG 2,(EQXXX,DNYY, SYSTEM SECTOR ERROR.)
 BCS      ERRMSG 2,(EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.)
 TNR      ERRMSG 2,(EQXXX,DNYY, TRACK NOT RESERVED.)
 PPE      ERRMSG 0,(PERMANENT ERROR.)
 PSI      ERRMSG 0,(STAGE INITIATED.)
 PWE      ERRMSG 0,(WAITING FOR SUBSYSTEM.)
 FIN      ERRMSG 0,(INTERLOCKED.)
 FDA      ERRMSG 0,(IS DIRECT ACCESS.)
 FIA      ERRMSG 0,(IS INDIRECT ACCESS.)
 FEO      ERRMSG 0,(IS EXECUTE ONLY.)
 SGD      ERRMSG 1,( PF STAGING DISABLED.)
 IPA      ERRMSG 1,( INCORRECT PFC ADDRESS.)
 PVE      ERRMSG 1,( PFC VERIFICATION ERROR.)
 FND      ERRMSG 1,( FILE NOT DISK RESIDENT.)
 INA      ERRMSG 1,()  INTERLOCK NOT AVAILABLE (NO MESSAGE)
 AIO      ERRMSG 1,( NO ALTERNATE STORAGE COPY OF FILE.)
 ASE      ERRMSG 1,( ALTERNATE STORAGE ERROR.)
 FTF      ERRMSG 1,( FNT FULL.)
 ICU      ERRMSG 1,( INCORRECT CATALOG UPDATE.)
 PEA      ERRMSG 1,( PFM EXCESS ACTIVITY.)
 NVX      ERRMSG 1,( NOT VALIDATED TO SET XD/XT.)
 DEM      ERRMSG 1,( XD/XT EXCEEDS MAXIMUM.)
 JCA      ERRMSG 1,( JOB CANNOT ACCESS FILE.)
 LNJ      ERRMSG 1,( ACCESS LEVEL NOT VALID FOR JOB.)
 WDP      ERRMSG 1,( WRITE-DOWN OF DATA PROHIBITED.)
 CNJ      ERRMSG 1,( ACCESS CATEGORIES NOT VALID FOR JOB.)
 LNP      ERRMSG 1,( ACCESS LEVEL NOT VALID ON PF DEVICE.)
 NVD      ERRMSG 1,( NOT VALID TO DOWNGRADE DATA.)
 NTD      ERRMSG 0,(- NO TEMP DEVICE FOUND.)
 LNF      ERRMSG 1,( ACCESS LEVEL NOT VALID FOR FILE.)
 TPE      ERRMSG 0,(TEMPORARY ERROR, TRY LATER.)
 WNF      ERRMSG 1,( WAITING FOR NFL.)
 WID      ERRMSG 1,( WAITING - INACCESSIBLE DEVICE.)
 RTR      ERRMSG 3,()  REQUEST BEING RETRIED BY PFM (NO MESSAGE)
 ECD      ERRMSG 1,( ERROR IN CATLIST CONTINUATION DATA.)
 
          INDEX  MXER
 
 
 ERRMSG   INDEX
 ERRMT    HERE
          INDEX  MXER
 
          LIST   *
 
          USE    LITERALS
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPACS
*CALL     COMPCTI
*CALL     COMPC2D
*CALL     COMPSES
*CALL     COMPTGB
 
 
*         ACCOUNT FILE MESSAGE BUFFER.
 
 SVM      DATA   C*MPNF, *
          BSSZ   14
 
 SVMA     DATA   2H,         MESSAGE SEPARATOR
          CON    0           END OF STRING
 SVMB     DATA   2H.         MESSAGE TERMINATOR
          CON    0
          SPACE  4,10
 LOCF     EQU    *+5         ZERO LEVEL OVERLAY ADDRESS
          ERRNG  BFMS-LOCF-ZDFL   *0DF* OVERFLOW
          TITLE  OVERLAYABLE SUBROUTINES.
 CAD      SPACE  4,10
**        CAD - CHECK FOR ACCESS DENIED.
*
*         ENTRY  (P1) = ERROR MESSAGE.
*                (PFPN) = OPTIONAL PACK NAME.
*                (PFOU) = ALTERNATE USER NAME.
*
*         EXIT   *MPNF* ACCOUNT FILE MESSAGE ISSUED ON *FNF* ERRORS.
*
*         CALLS  ACS, DFM, SFN.
*
*         USES   T1, FN - FN+4.
 
 
 CAD      SUBR               ENTRY/EXIT
          LDD    P1
          LMN    /ERRMSG/FNF
          NJN    CADX        IF NOT * FILE NOT FOUND.*
          LDM    PFOU
          ZJN    CADX        IF NOT AN ALTERNATE USER
          LDD    MA          SAVE FN - FN+4
          CWD    FN
          CRM    CADA,ON
          LDM    PFFN        GET PERMANENT FILE NAME
          ZJN    CAD1        IF PF NAME NOT SPECIFIED
          LDN    PFFN-PFSN
 CAD1     ADC    PFSN
          RJM    SFN
          LDC    SVM+3       INITIALIZE MESSAGE POINTER FOR ACS CALLS
          STD    T1
          LDN    FN          INSERT FILE NAME IN MESSAGE BUFFER
          RJM    ACS
          LDC    SVMA        APPEND COMMA SEPARATOR
          RJM    ACS
          LDC    PFOU        SET USER NAME IN MESSAGE BUFFER
          RJM    SFN
          LDN    FN
          RJM    ACS
          LDC    SVMA        APPEND COMMA SEPARATOR
          RJM    ACS
          LDM    PFPN        CHECK FOR PACK NAME
          ZJN    CAD2        IF NO PACK NAME
          LDC    PFPN        SET PACK NAME IN MESSAGE BUFFER
          RJM    SFN
          LDN    FN
          RJM    ACS
 CAD2     LDC    SVMB        APPEND MESSAGE TERMINATOR
          RJM    ACS
          LDC    SVM+ACFN    ISSUE DAYFILE MESSAGE
          RJM    DFM
          LDC    CADA        RESTORE FILE NAME
          RJM    SFN
          LJM    CADX        RETURN
 
 
 CADA     BSSZ   5           FILE NAME
 CAI      SPACE  4,15
**        CAI - CLEAR ALLOCATION AND *DAPF* INTERLOCKS.
*
*         ENTRY  (EQ) = MASTER DEVICE EST ORDINAL.
*                (AILK) = CATALOG/PERMIT ALLOCATION INTERLOCK TRACK.
*                (DAIF) = DIRECT ACCESS FILE INTERLOCK FLAG.
*                (IAIF) = INDIRECT ALLOCATION INTERLOCK FLAG.
*                (PFEQ) = DIRECT ACCESS FILE EST ORDINAL.
*                (PFFT) = DIRECT ACCESS FILE FIRST TRACK.
*
*         EXIT   ALLOCATION INTERLOCKS CLEARED.
*                DIRECT ACCESS FILE INTERLOCK CLEARED.
*
*         USES   T5.
*
*         CALLS  CTI.
 
 
 CAI      SUBR               ENTRY/EXIT
          LDD    EQ
          ADC    4000        SET CHECKPOINT VIA *STBM*
          STD    T5
          LDM    AILK
          ZJN    CAI1        IF NO CATALOG/PERMIT ALLOCATION INTERLOCK
          RJM    CTI         CLEAR TRACK INTERLOCK
 CAI1     LDM    IAIF
          ZJN    CAI2        IF INDIRECT ALLOCATION INTERLOCK NOT SET
          LDM    DVLW
          RJM    CTI         CLEAR INDIRECT ALLOCATION INTERLOCK
          LDN    0           CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
          STM    IAIF
 CAI2     LDM    DAIF
          ZJN    CAIX        IF DIRECT ACCESS FILE INTERLOCK NOT SET
          LDM    PFEQ
          ADC    6000        CHECKPOINT + NO HANG ON UNRESERVED TRACK
          STD    T5
          LDM    PFFT
          RJM    CTI         CLEAR DIRECT ACCESS FILE INTERLOCK
          UJP    CAIX        RETURN
 CEI      SPACE  4,15
**        CEI - CHECK FOR ERROR IDLE REQUIRED.
*
*         ENTRY  (P0) = ERROR IDLE FLAG.
*                (P1) = ERROR CODE.
*                (P2) = EST ORDINAL.
*
*         EXIT   ERROR IDLE STATUS SET ON DEVICE IF APPROPRIATE.
*                (SEQF) = PRESET TO FORCE *EQXXX, ERROR IDLE SET.*
*                         MESSAGE IF ERROR IDLE SET.
*
*         USES   T5.
*
*         CALLS  SES.
*
*         MACROS SMSTF.
 
 
 CEI      SUBR               ENTRY/EXIT
          LDD    P0
          ZJN    CEIX        IF NO ERROR IDLE REQUESTED
          ISTORE SEQF,(PSN)  FORCE *EQXXX, ERROR IDLE SET.* MESSAGE
          LDD    P2          SET ERROR IDLE STATUS ON DEVICE
          STD    T5
          LDN    STEI        ERROR IDLE STATUS
          RJM    SES
          SMSTF  GDEI        SET ERROR IDLE FLAG
          UJN    CEIX        RETURN
 CLE      SPACE  4,10
**        CLE - CHECK FOR LENGTH ERROR.
*
*         ENTRY  (P1) = ERROR CODE.
*                (CC) = COMMAND CODE.
*
*         EXIT   (PPFA, PRTA) UPDATED IF *SYOT* LENGTH ERROR ON *GET*.
 
 
 CLE      SUBR               ENTRY/EXIT
          LDD    CC
          LMN    CCGT
          NJN    CLEX        IF NOT *GET* REQUEST
          LDM    JORG
          LMK    SYOT
          NJN    CLEX        IF NOT SYSTEM ORIGIN JOB
          LDD    P1
          LMN    /ERRMSG/FLE
          NJN    CLEX        IF NOT *FILE LENGTH ERROR*
          AOM    PPFA
          AOM    PRTA
          UJN    CLEX        RETURN
 PDE      SPACE  4,15
**        PDE - PROCESS *DMP=* JOB.
*
*         ENTRY  (CP) = CONTROL POINT ADDRESS.
*
*         EXIT   (SEPW) = CPU COMMUNICATION WORD CLEARED
*
*         USES   T3, CM - CM+4.
 
 
 PDE      SUBR               ENTRY/EXIT
          LDD    CP          CHECK *DMP=* STATUS
          ADC    SEPW
          STD    T3
          CRD    CM
          LDD    CM
          LPN    20
          NJN    PDEX        IF *DMP=* ENTRY POINT PRESENT
          LDN    ZERL        CLEAR CPU COMMUNICATION WORD
          CRD    CM
          LDD    T3
          ADN    SPCW-SEPW
          CWD    CM
          UJN    PDEX        RETURN
 PRT      SPACE  4,20
**        PRT - PROCESS PRESERVED AND RESERVED TRACKS.
*
*         ENTRY  (FS - FS+4) = LOCAL FILE FST.
*                (FNTA) = LOCAL FILE FNT ADDRESS.
*                (PTKT) = PRESERVED TRACK IF NON-ZERO.
*                (RTKE) = EST ORDINAL FOR RESERVED TRACK.
*                (RTKT) = RESERVED TRACK IF NON-ZERO.
*
*         EXIT   (FS+1 - FS+3) = 0 IF RESERVED TRACK RELEASED.
*                (AIPR, AIPR+1) = 0 IF RESERVED TRACK RELEASED.
*                PRESERVED FILE BIT CLEARED IF SET.
*                RESERVED TRACK RELEASED IF RESERVED.
*
*         USES   FA, CM - CM+4.
*
*         MACROS MONITOR, NFA.
 
 
 PRT      SUBR               ENTRY/EXIT
          LDM    PTKT        CHECK PRESERVED TRACK
          ZJN    PRT1        IF TRACK NOT PRESERVED
          STD    CM+2
          SBM    RTKT
          ZJN    PRT1        IF TRACK ALSO RESERVED
          LDD    FS          SET EST ORDINAL AND CHECKPOINT
          LMC    4000
          STD    CM+1
          LDN    CPFS        CLEAR PRESERVED FILE BIT
          STD    CM+3
          MONITOR  STBM
 PRT1     LDN    0
*         LDN    1           (*SYOT* + *GET* + *FILE LENGTH ERROR*)
 PRTA     EQU    *-1
          NJN    PRTX        IF TRACK SHOULD NOT BE RELEASED
          LDM    RTKT        CHECK RESERVED TRACK
          ZJN    PRTX        IF NO RESERVED TRACK TO RELEASE
          STD    CM+2        DROP RESERVED TRACK
          LDM    RTKE
          LMC    4000
          STD    CM+1
          MONITOR DTKM
*         LDN    0           CLEAR FST
          STD    FS+1
          STD    FS+2
          STD    FS+3
          STM    AIPR        CLEAR MASS STORAGE INCREMENT
          STM    AIPR+1
          LDM    FNTA        RESTORE FNT ADDRESS
          STD    FA
          NFA    FA,R        UPDATE FST
          ADN    FSTL
          CWD    FS
          UJP    PRTX        RETURN
 
 
          OVERFLOW  OVLA,EPFW  OVERFLOW INTO ERROR PROCESSING AREA
          OVERLAY  (TERMINATE PROGRAM.),OVLA
          SPACE  4,10
***       THIS OVERLAY PERFORMS TERMINATION PROCESSING FOR *PFM*.
 
 
 OVL      BSS    0           ENTRY
          LDM    IAIF
          ZJN    OVL0        IF INDIRECT ALLOCATION INTERLOCK NOT SET
          RJM    HNG         HANG
 
 OVL0     RJM    CLF         COMPLETE LOCAL FILE FST
          LDM    STAU        CHECK *PFM* STATUS BITS
          LPK    STRP+STDP
          NJN    OVL1        IF *PFM* TO BE RECALLED OR TERMINATED
          RJM    CCI         CLEAR CATALOG INTERLOCK
          RJM    SFS         SET FET STATUS
 OVL1     UJN    DPP         DROP PP
 CLF      SPACE  4,10
**        CLF - COMPLETE LOCAL FILE FST.
*
*         ENTRY  (FNTA) = LOCAL FILE FNT ADDRESS.
*
*         USES   CM - CM+4.
 
 
 CLF      SUBR               ENTRY/EXIT
          LDM    FNTA
          STD    FA
          ZJN    CLFX        IF NO LOCAL FILE FNT
          NFA    FA,R
          ADN    FSTL
          CRD    CM
          LDD    CM+4        SET LOCAL FILE FST COMPLETE
          SCN    1
          LMN    1
          STD    CM+4
          NFA    FA,R
          ADN    FSTL
          CWD    CM
          UJN    CLFX        RETURN
 DPP      SPACE  4,25
**        DPP - DROP PP.
*
*         ENTRY  (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
*                (FN - FN+4) = RECALL REQUEST FOR MONITOR.
*                (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
*                (AIPF, AIPF+1) = ACCUMULATOR INCREMENT FOR PF ACCESS.
*                (AIPR, AIPR+1) = ACCUMULATOR INCREMENT FOR PRU COUNT.
*                (EPFA) = EST ORDINAL OF DEVICE IF PF ACTIVITY COUNT
*                         TO BE DECREMENTED.
*                (STAU) = *STAJ* BIT SET IF JOB TO BE ABORTED.
*                         *STRP* BIT SET IF *PFM* TO BE RECALLED.
*
*         EXIT   PF ACTIVITY COUNT DECREMENTED IF IT WAS SET.
*                ACCOUNTING UPDATED.
*                JOB ABORTED IF *STAJ* SET.
*                *PFM* RECALLED IF *STRP* SET.
*                TO *PPR*.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR, NFA.
 
 
 DPP      BSS    0           ENTRY
 
*         DECREMENT PF ACTIVITY COUNT.
 
          LDM    EPFA        EST ORDINAL
          ZJN    DPP2        IF ACTIVITY NOT SET
          STD    CM+1
          LDN    DPAS        DECREMENT PF ACTIVITY COUNT
          STD    CM+3
          MONITOR STBM
 
*         UPDATE ACCOUNTING.
 
 DPP2     LDM    AIPR        SET ACCUMULATOR INCREMENT FOR PRU COUNT
          STM    DPPB
          LDM    AIPR+1
          STM    DPPB+1
          LDM    AIPF        SET ACCUMULATOR INCREMENT FOR PF ACCESS
          STM    DPPD
          LDM    AIPF+1
          STM    DPPD+1
          LDD    MA          TRANSMIT REQUEST TO MESSAGE BUFFER
          CWM    DPPA,TR
          LDN    2           SET NUMBER OF REQUESTS
          STD    CM+1
          LDM    STAU        CHECK *PFM* STATUS BITS
          LPK    STAJ+STRP
          NJN    DPP3        IF JOB BEING ABORTED OR *PFM* RECALLED
          STD    CM+2        SELECT DROP PP OPTION
          MONITOR  UADM      UPDATE ACCOUNTING
          LJM    DPP5        EXIT TO PP RESIDENT
 
 DPP3     LDM    DPPB
          ADM    DPPB+1
          ADM    DPPD
          ADM    DPPD+1
          ZJN    DPP3.1      IF NO ACCOUNTING TO UPDATE
          LDN    1           SELECT NO DROP OPTION
          STD    CM+2
          MONITOR  UADM      UPDATE ACCOUNTING
 DPP3.1   LDM    STAU
          LPK    STRP
          NJN    DPP4        IF *PFM* TO BE RECALLED
          MONITOR  ABTM      ABORT JOB
          UJN    DPP5        EXIT TO PP RESIDENT
 
*         RECALL *PFM*.
 
 DPP4     LDD    CN+1        CLEAR AUTO RECALL BIT IN INPUT REGISTER
          SCN    40
          STD    CN+1
          LDD    IA
          CWD    CN
          LDN    40          FORCE AUTO RECALL BIT IN RECALL REQUEST
          RAD    CN+1
          LDD    MA
          CWD    CN          INPUT REGISTER FOR RECALL
          ADN    1
          CWD    MP          PARAMETER WORD FOR RECALL
          ADN    1
          CWD    FN
          CRD    CM          RECALL REQUEST
          MONITOR  RECM      RECALL AND DROP PP
 DPP5     LJM    PPR         EXIT TO PP RESIDENT
 
 
 DPPA     BSS    0           REQUEST TO UPDATE ACCOUNTING
          CON    CDCS        SUBFUNCTION CODE
          CON    ACLW        ADDRESS OF CONTROL POINT WORD
          CON    0*100+22    POSITION AND WIDTH OF FIELD
 DPPB     CON    0,0         VALUE OF INCREMENT FOR PRU COUNT
 
 DPPC     BSS    0           REQUEST TO UPDATE ACCOUNTING
          CON    AISS        SUBFUNCTION CODE
          CON    IOAW        ADDRESS OF CONTROL POINT WORD
          CON    0*100+24    POSITION AND WIDTH OF FIELD
 DPPD     CON    0,0         VALUE OF INCREMENT FOR PF ACCESS
 SFS      SPACE  4,15
**        SFS - SET FET STATUS.
*
*         ENTRY  (STAU) = STATUS FLAGS.
*                (FN - FN+4) = FET + 0 IF *STDS* SET IN *STAU*.
*                (FS - FS+4) = FET + 1 IF *STDS* SET IN *STAU*.
*
*         EXIT   FET SET COMPLETE.
*
*         USES   CM - CM+4, FN - FN+4, FS - FS+4.
*
*         CALLS  SFA.
 
 
 SFS      SUBR               ENTRY/EXIT
          RJM    SFA
          ZJN    SFSX        IF NO FET ADDRESS
          LDM    STAU
          LPK    STDS
          NJN    SFS1        IF RETURNING ERROR CODE IN FET
          RJM    SFA
          CRD    FN          READ FET STATUS WORD
          ADN    1
          CRD    FS          FET LENGTH/RANDOM BIT
          LDD    FN+4
          LPC    1776
          LMN    1           SET COMPLETION STATUS
          STD    FN+4
          LDD    FN+3        CLEAR UPPER BITS OF ERROR STATUS
          SCN    77
          STD    FN+3
 
*         UPDATE RANDOM INDEX IF RANDOM FET.
*         DO NOT UPDATE IF FET IS TOO SHORT OR OUTSIDE FL.
 
 SFS1     LDD    FS+3        CHECK FET LENGTH
          SHN    -6
          SBN    CFCN-4
          MJN    SFS2        IF FET TOO SHORT
          LDD    FS+1
          SHN    21-13
          PJN    SFS2        IF NOT RANDOM FET
          LDD    IR+3        CHECK RANDOM INDEX FIELD WITHIN FL
          LPN    77
          SHN    14
          LMD    IR+4
          ADN    CFCN
          SHN    -6
          SBD    FL
          PJN    SFS2        IF RANDOM INDEX FIELD NOT WITHIN FL
          LDN    ZERL
          CRD    CM
          LDD    HN          SET RANDOM INDEX REWOUND
          STD    CM+2
          RJM    SFA
          ADN    CFCN
          CWD    CM
 SFS2     RJM    SFA
          CWD    FN
          UJP    SFSX        RETURN
          SPACE  4,10
**        DEFINE COMMAND PROCESSOR SYMBOLS.
 
 
          QUAL   3PC
 CMD      HERE
          QUAL   *
          SPACE  4,10
          OVERFLOW  OVLA,EPFW  OVERFLOW INTO ERROR PROCESSING AREA
 
          TTL    PFM - PERMANENT FILE MANAGER.
          END
Retro1.org codex

Table of Contents

PFM

Table Of Contents

Source Code
