Retro1.org codex

          IDENT  RESEX,FETS
          ABS
          SST
          ENTRY  ASSIGN
          ENTRY  LABEL
          ENTRY  REQUEST
          ENTRY  RESOURC
          ENTRY  VSN
          ENTRY  LFM
          ENTRY  PFM
          ENTRY  REQ
          ENTRY  ARG=
          ENTRY  DMP=
          ENTRY  RFL=
          ENTRY  SDM=
          ENTRY  SSJ=
          SYSCOM B1
          TITLE  RESEX - RESOURCE EXECUTIVE.
*COMMENT  RESEX - RESOURCE EXECUTIVE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       RESEX - RESOURCE EXECUTIVE.
*         M. E. MADDEN.      73/05/31.
*         W. E. GOEBEL.      74/05/10.
*         J. L. LARSON.      77/05/04.
*         J. L. LARSON.      82/06/24.
          SPACE  4,10
***              RESEX PROCESSES REQUESTS FOR MAGNETIC TAPE AND
*         REMOVABLE DISK PACK RESOURCES.
*
*
*         THE FOLLOWING TAPE RELATED COMMANDS ARE PROCESSED -
*
*                ASSIGN(EQ,LFN,P1,P2,...,PN)
*                LABEL(LFN,P1,P2,...,PN)
*                REQUEST(LFN,P1,P2,...,PN)
*                VSN(LFN=VSN1/VSN2=VSN3)
*
*
*         THE FOLLOWING COMMAND DEFINES THE MAXIMUM NUMBER
*         OF TAPE AND PACK RESOURCE UNITS THAT WILL BE IN USE
*         CONCURRENTLY -
*
*                RESOURC(RT1=N1/AL,RT2=N2/AL,.....RTN=NN/AL)
*
*                RT    RESOURCE TYPE.
*                N     NUMBER OF UNITS DEMANDED.
*                AL    ACCESS LEVEL, FOR TAPE DRIVES ONLY.
*                      ( SEE *COMSMLS* FOR MICRO DEFINITION.)
*
*
*         THE OVERCOMMITMENT ALGORITHM IS CONTAINED IN *RESEX*.
*         THE COMMANDS PROCESSED HEREIN CALL THE OVERCOMMITMENT
*         ALGORITHM DIRECTLY, IF NECESSARY.
*         USER REQUESTS FOR TAPES DONE BY MACROS, ETC. (INCLUDING
*         *NOS/BE* FORMATTED CALLS) AND ALL REMOVABLE PACK REQUESTS
*         ARE TRANSFERRED TO *RESEX* SO THAT THE OVERCOMMITMENT
*         ALGORITHM MAY BE EXERCISED.
*
*
*         RESEX INTERLOCKS A TAPE EQUIPMENT BY CALLING LFM VIA VSN
*         FUNCTION.  THEN RESEX CALLS MAGNET TO ASSIGN THE REQUESTED
*         TAPE.
*
*
*
*         LABELS WILL BE PROPERLY VERIFIED IN STANDARD LABEL
*         PROCESSING MODE BY OPEN/ALTER OR OPEN/WRITE CALLS IF
*         LABEL COMMAND IS USED.
*
*
*
*         RESOURCE FILES.
*
*         RESEX USES TWO DIRECT ACCESS PERMANENT FILES AS FAST ATTACH
*         FILES.  IN EACH CASE THE *ID* SUFFIX IN THE FILE NAME IS THE
*         MACHINE ID. -
*
*         RSXDID      RESOURCE DEMAND FILE.
*                     EACH ENTRY CONSISTS OF JOB IDENTIFICATION,
*                     RESOURCE VALIDATION LIMITS, MAXIMUM CONCURRENT
*                     DEMAND FOR EACH RESOURCE TYPE, AND A REMOVABLE
*                     DISK SHARE TABLE.
*                     EACH ENTRY IS TWO PRUS (200 CM WORDS) IN LENGTH.
*
*         RSXVID      VSN FILE.
*                     EACH ENTRY CONSISTS OF JOB IDENTIFICATION,
*                     FILE NAME, *RSXDID* ENTRY RANDOM INDEX, DEMAND
*                     FILE TAPE RESOURCE INDEX AND BYTE POINTER,
*                     AND THE VOLUME SERIAL NUMBER(S) ASSOCIATED
*                     WITH THE NAMED FILE.
*                     EACH ENTRY IS ONE PRU (100 CM WORDS).
*
*
*         ERROR MESSAGES.
*
*         ARGUMENT ERROR.
*                ARGUMENTS IN COMMAND OR *DMP=* CALL INCORRECT.
*
*         JSQN ASSIGNS EXCEED DEMANDS.
*                JOB WITH JOB SEQUENCE NUMBER JSQN HAS ASSIGN
*                COUNTS GREATER THAN DEMAND COUNTS.
*
*         CIO ERROR.
*                REWRITE ON RESOURCE FILE RETURNED ERROR STATUS OTHER
*                THAN END-OF-DEVICE.
*
*         CONFLICTING RESOURCE TYPES.
*                *PE*, *HD*, AND *GE* RESOURCES CANNOT BE SPECIFIED
*                CONCURRENTLY IN THE SAME JOB WITH AN *NT* RESOURCE.
*
*         DEMAND EXCEEDED.
*                USER ATTEMPTING TO EXCEED DEMAND.
*
*         DEMAND FILE ERROR.
*                DEMAND FILE ENTRY DOES NOT MATCH JOB IDENTIFICATION.
*
*         DEMAND VALIDATION ERROR.
*                DEMAND EXCEEDS USER VALIDATION LIMITS.
*
*         EQUIPMENT NOT AVAILABLE.
*                SELECTED EQUIPMENT CANNOT BE ASSIGNED TO JOB.
*
*         FORMAT REQUIRES UNLABELED TAPE.
*                THE FORMAT SPECIFIED IS VALID ONLY FOR UNLABELED
*                TAPES.
*
*         FRAME COUNT TOO LARGE.
*                THE TAPE BLOCK SIZE CALCULATED FROM THE SPECIFIED
*                FRAME COUNT IS LARGER THAN THE MAXIMUM BLOCK SIZE.
*
*         FRAME COUNT TOO SMALL.
*                THE SPECIFIED FRAME COUNT IS SMALLER THAN THE MINIMUM
*                  ALLOWED.
*
*         IMPROPER ACCESSIBILITY.
*                FILE ACCESSIBILITY FIELD IN *HDR1* TAPE LABEL DOES NOT
*                ALLOW USER TO ACCESS THAT FILE.
*
*         INCORRECT ACCESS LEVEL FOR EQUIPMENT.
*                USER HAS SPECIFIED AN ACCESS LEVEL OUTSIDE OF THE
*                ACCESS LEVEL LIMITS.
*
*         INCORRECT COMMAND.
*                *LFM*, *PFM* OR *REQ* ENTRY POINTS EXECUTED AS A
*                COMMAND.
*
*         INCORRECT CONVERSION MODE.
*                THE SPECIFIED CONVERSION MODE IS INCORRECT.
*
*         INCORRECT CONVERSION MODE FOR TAPE DEVICE TYPE.
*                THE SPECIFIED CONVERSION MODE IS NOT SUPPORTED FOR THE
*                TAPE DEVICE TYPE.
*
*         INCORRECT DENSITY.
*                THE SPCIFIED DENSITY IS INCORRECT.
*
*         INCORRECT DENSITY FOR FORMAT.
*                THE SPECIFIED DENSITY IS NOT SUPPORTED FOR THE TAPE
*                FORMAT.
*
*         INCORRECT DENSITY FOR TAPE DEVICE TYPE.
*                THE SPECIFIED DENSITY IS NOT SUPPORTED FOR THE TAPE
*                DEVICE TYPE.
*
*         INCORRECT END OF TAPE OPTION FOR FORMAT.
*                THE SPECIFIED END OF TAPE OPTION IS NOT SUPPORTED FOR
*                THE TAPE FORMAT.
*
*         INCORRECT EQUIPMENT.
*                USER SPECIFIED EQUIPMENT THAT DOES NOT EXIST OR IS
*                NOT ALLOWED.
*
*         INCORRECT LFM CALL.
*                INCORRECT FUCTION CODE IN LFM *DMP=* CALL.
*
*         INCORRECT RESOURCE COUNT.
*                TOTAL RESOURCE DEMAND EXCEEDS MAXIMUM ALLOWED, AS
*                DEFINED BY INSTALLATION PARAMETER *MAXD* (DEFINED
*                IN RESEX).
*
*         INCORRECT RESOURCE TYPE.
*                RESOURCE TYPE IS NOT RECOGNIZED.
*
*         INCORRECT TAPE FORMAT.
*                THE SPECIFIED TAPE FORMAT IS INCORRECT.
*
*         INSUFFICIENT RESOURCES ON SYSTEM.
*                RESOURCE DEMAND EXCEEDS NUMBER OF UNITS AVAILABLE ON
*                SYSTEM.
*
*         MAGNETIC TAPE SUBSYSTEM NOT ACTIVE.
*                RSB OR SIC CALL GETS SUB-SYSTEM MISSING STATUS.
*
*         MISSING DEMAND FILE ENTRY.
*                OVERCOMMITMENT ALGORITHM SUBROUTINE *CRQ* IS CALLED
*                WITHOUT HAVING PREVIOUSLY BUILT A DEMAND FILE ENTRY.
*
*         JSQN MISSING RESOURCE.
*                RESEX WAS UNABLE TO FIND A RESOURCE UNIT ASSIGNED TO
*                THE JOB WITH JOB SEQUENCE NUMBER JSQN.
*
*         MISSING VSN OR EQUIPMENT ASSIGNMENT.
*                SUBROUTINE *CRQ* EXPECTS TO FIND AN EQUIPMENT
*                ASSIGNMENT OR A VSN, BUT DOES NOT.
*
*         MULTIPLE END OF TAPE OPTIONS SELECTED.
*                MORE THAN ONE END OF TAPE OPTION WAS SPECIFIED.
*
*         NOISE SIZE TOO LARGE.
*                THE SPECIFIED NOISE SIZE IS LARGER THAN THE MAXIMUM
*                ALLOWED FOR THE TAPE DEVICE TYPE.
*
*         NOT VALIDATED FOR REQUESTED ACCESS LEVEL.
*                USER HAS SPECIFIED AN ACCESS LEVEL OUTSIDE OF THE
*                USER-S ACCESS LEVEL VALIDATIONS.
*
*         NOT VALIDATED FOR WRITING UNLABELED TAPES.
*                USER HAS NOT BEEN VALIDATED FOR WRITING ON UNLABELED
*                TAPES. * SAV=CULT.*
*
*         NO VSN SPECIFIED ON ACS TAPE REQUEST.
*                NO VSN WAS SPECIFIED ON A REQUEST FOR AN ACS TAPE.
*
*         NT DENSITY CONFLICT.
*                9-TRACK TAPE UNIT SPECIFIED BY EST ORDINAL ON *ASSIGN*
*                COMMAND DOES NOT SUPPORT THE REQUIRED DENSITY.
*
*         NT DRIVE CONFLICT.
*                INCREASED RESOURCE DEMANDS CANNOT BE SATISFIED DUE TO
*                CONFLICTS WITH CURRENTLY ASSIGNED RESOURCES (JOB
*                WOULD DEADLOCK ITSELF).  9-TRACK TAPE UNIT SPECIFIED
*                BY EST ORDINAL ON *ASSIGN* COMMAND CONFLICTS WITH THE
*                OTHER RESOURCE REQUIREMENTS FOR THIS JOB (ASSIGNMENT
*                REJECTED TO PREVENT JOB FROM DEADLOCKING ITSELF).
*
*         PRIOR TAPE ASSIGNMENT LOST.
*                MAGNET HAS BEEN DROPPED WITH TAPES ASSIGNED.  USER
*                MUST RETURN ALL TAPE FILES AND REASSIGN.
*
*         REMOVABLE PACKS OVERCOMMITMENT.
*                REMOVABLE PACKS REQUEST WITHOUT *NA* SELECTED
*                OVERCOMMITS.
*
*         RESEX ABORT - INTERNAL ERROR.
*                *RESEX* HAS ABORTED WITH ONE OF THE FOLLOWING ERRORS -
*                  *CPU ERROR EXIT*
*                  *PP CALL ERROR*
*
*         RESEX ABORT - OPERATOR TERMINATION.
*                ERROR FLAG SET ON *RESEX* DUE TO OPERATOR *DROP*,
*                *KILL*, OR *RERUN*.  *RESEX* PERFORMS APPROPRIATE
*                CLEAN-UP BEFORE ABORTING.
*
*         RESEX ABORT - SYSTEM RESOURCE LIMIT.
*                *RESEX* TERMINATED PREMATURELY DUE TO TIME LIMIT, SRU
*                LIMIT, OR TRACK LIMIT.  *RESEX* PERFORMS APPROPRIATE
*                CLEAN-UP BEFORE ABORTING.
*
*         RESEX ABORT - TAPE MANAGER.
*                THE TAPE MANAGER (TMS) HAS ABORTED THE TAPE REQUEST.
*
*         RESEX ABORT - TERMINAL INTERRUPT.
*                TERMINAL USER INTERRUPTED *RESEX*.  *RESEX*
*                PERFORMS APPROPRIATE CLEAN-UP BEFORE ABORTING.
*
*         RESOURCE DEMAND ERROR.
*                RESOURCE DEMAND REQUEST CAUSES OVERCOMMITMENT OR USER
*                HAS MORE ASSIGNED UNITS THAN NEW DEMAND.
*
*         RESOURCE ENVIRONMENT ERROR.
*                INTERNAL ENVIRONMENT BUILDING FAILS DUE TO POSSIBLE
*                MASS STORAGE TABLE (MST), UNIT DESCRIPTOR TABLE (UDT),
*                OR EST ERRORS.
*
*         RESOURCE NEGATIVE SHARE COUNT.
*                OVERCOMMITMENT ALGORITHM RETURNS MORE SHARERS THAN
*                ARE SHARING THE REMOVABLE PACK.
*
*         RESOURCE PF ERROR NN FFFFFF.
*                IN ATTACHING EITHER RESOURCE FILE, *PFM* ERROR *NN* IS
*                DETECTED ON FILE *FFFFFF*.
*
*         RESOURCE SCRATCH FILE ERROR.
*                AN EMPTY ENTRY HAS BEEN FOUND ON THE OVERCOMMITMENT
*                ALGORITHM SCRATCH FILE.
*
*         SHARE TABLE ERROR.
*                SHARE TABLE IS FULL OR THE ENTRY IS NOT FOUND DURING A
*                SHARE TABLE SEARCH.
*
*         JSQN SHARE TABLE MISMATCH.
*                AN EXPECTED SHARE TABLE MATCH WITH EVSB DID NOT OCCUR
*                WHILE PROCESSING JOB WITH JOB SEQUENCE NUMBER JSQN.
*
*         STAGE REQUEST FILE ERROR.
*                *RESEX* HAS DETECTED AN ERROR IN THE STAGE REQUEST
*                FILE.
*
*         SYSTEM ERROR.
*                RESEX IS UNABLE TO COMMUNICATE WITH (SUB)SYSTEM BY
*                MONITOR CALLS *RSB* OR *SIC*.
*
*         TAPE DEVICE TYPE CONFLICT.
*                INCONSISTENT DEVICE TYPES (MT/NT/CT/AT) SPECIFIED ON
*                ASSIGN COMMAND OR LABEL MACRO REQUEST.
*
*         TOTAL ASSIGNED COUNT ERROR.
*                SUM OF INDIVIDUAL RESOURCE ASSIGNED COUNTS DIFFERS
*                FROM TOTAL ASSIGNED COUNT IN DEMAND ENTRY.
*
*         TOTAL DEMAND COUNT ERROR.
*                SUM OF INDIVIDUAL RESOURCE DEMANDS DIFFERS FROM TOTAL
*                DEMAND COUNT IN DEMAND ENTRY.
*
*         UNKNOWN ACCESS LEVEL NAME.
*                USER HAS SPECIFIED AN INCORRECT ACCESS LEVEL.
*
*         USER ACCESS NOT VALID.
*                USER NOT VALIDATED FOR RESOURCE(S).
*
*         VSN FILE ERROR.
*                VSN FILE ENTRY DOES NOT MATCH JOB IDENTIFICATION.
*
*         VSN VVVVVV NOT IN REQUESTED ACS.
*                THE TAPE WITH VSN VVVVVV IS NOT IN THE ACS ACCESSIBLE
*                BY THIS SYSTEM.
*
*         VSN VVVVVV UNREADABLE OPTICAL LABEL.
*                THE TAPE WITH VSN VVVVVV CANNOT BE ASSIGNED BECAUSE
*                THE ACS SERVER IS UNABLE TO VERIFY THE OPTICAL LABEL.
*
*         VSN VVVVVV NOT IN ACS LIBRARY.
*                THE TAPE WITH VSN VVVVVV IS NOT IN THE ACS LIBRARY.
*
*         WRITE ENABLE AND DISABLE OPTIONS BOTH SELECTED.
*                WRITE ENABLE AND WRITE DISABLE REQUIRED OPTIONS WERE
*                SPECIFIED SIMULTANEOUSLY.
*
*
*         INFORMATIVE MESSAGES TO USER DAYFILE.
*
*
*         WRITE DISABLE FORCED ON NON-TMS ACS TAPE REQUEST.
*                A SYSTEM ORIGIN JOB HAS REQUESTED ACCESS TO AN ACS
*                TAPE WITHOUT TMS VALIDATION AND WRITE DISABLE (PO=R)
*                WAS NOT SPECIFIED.
*
*         WRITE DISABLE FORCED ON UNLABELED REQUEST.
*                USER IS NOT VALIDATED FOR WRITING ON UNLABELED TAPES
*                AND DID NOT SPECIFY *PO=R* ON THE COMMAND.
*
*         TTUUU, ASSIGNED TO FFF, VSN=VVV.
*                INFORMATIVE MESSAGE INDICATING TAPE ASSIGNMENT IS
*                COMPLETE, WHERE TT = TYPE (MT, NT, CT, OR AT) OF
*                UNIT ASSIGNED, UUU = EST ORDINAL OF DRIVE ASSIGNED,
*                FFF = FILENAME, VVV = VSN OF TAPE ASSIGNED.
*
*
*
*         OPERATOR MESSAGES (DISPLAYED AT CONTROL POINT).
*
*
*         WAITING FOR RESOURCE FILE.
*                INDICATES *RESEX* IS WAITING TO ATTACH THE DEMAND
*                FILE TO COMPLETE OPERATOR ASSIGNMENT OF TAPE
*                EQUIPMENT OR *ASSIGN* OF SPECIFIC TAPE UNIT OR TO
*                COMPLETE CLEAN-UP PROCESSING AFTER AN INTERRUPT
*                HAS BEEN DETECTED.  THIS SHOULD NOT NORMALLY OCCUR,
*                SINCE SEVERAL ATTEMPTS HAVE ALREADY BEEN MADE TO
*                ATTACH THE DEMAND FILE.  IF THE OPERATOR DECIDES TO
*                *OVERRIDE* AN INTERRUPTED JOB AT THIS POINT,
*                THE DEMAND FILE ENTRY AND THE *E,P* PREVIEW
*                DISPLAY WILL NOT BE CLEANED UP.
*
*
*         OPERATOR MESSAGES ISSUED TO LINE 2 OF CONTROL POINT
*         IMMEDIATELY PRIOR TO ROLLOUT TO INDICATE THE REASON
*         FOR ROLLOUT.
*
*
*         WAITING FOR MAGNET.
*                *RESEX* IS WAITING FOR THE MAGNETIC TAPE SUBSYSTEM.
*
*         WAITING FOR RESOURCE FILE.
*                *RESEX* IS WAITING FOR THE RESOURCE DEMAND OR VSN
*                FILE TO BECOME AVAILABLE.
*
*         WAITING FOR RESOURCES.
*                *RESEX* IS WAITING FOR SUFFICIENT RESOURCES TO
*                BECOME AVAILABLE TO ALLOW ASSIGNMENT OF THE
*                TAPE/PACK WITHOUT CAUSING A SYSTEM DEADLOCK.
*
*         WAITING FOR PN=NNNNNNN, TTT.
*                *RESEX* IS WAITING FOR THE OPERATOR TO MOUNT
*                PACKNAME *NNNNNNN* ON DEVICE TYPE *TTT*.
*
*         WAITING ON TRACK LIMIT.
*                *RESEX* IS WAITING FOR ADDITIONAL TRACKS TO
*                BECOME AVAILABLE ON THE FAMILY DEVICE CONTAINING
*                THE RESOURCE DEMAND AND VSN FILES.
*
*         WAITING FOR VSN=VVVVVVV, TT.
*                *RESEX* IS WAITING FOR THE OPERATOR TO MOUNT
*                TAPE WITH VSN *VVVVVVV* ON RESOURCE TYPE *TT*.
*                *VVVVVVV* = *SCRATCH* IMPLIES ANY SCRATCH TAPE IS
*                NEEDED.
*
*         WAITING FOR STAGING TAPE.
*                *RESEX* IS WAITING FOR THE OPERATOR TO MOUNT
*                A STAGING TAPE.
*
*
*
*         *DMP=* CALL RETURN STATUS.
*
*
*         *RESEX* RETURNS THE FOLLOWING IN RESPONSE TO A *DMP=* CALL IN
*           THE STATUS BYTE OF *SPCW* -
*
*                8/ RESERVED, 1/ MV, 1/ OV, 1/ FE, 1/ OK
*
*
*                MV     MISSING VSN OR PACKNAME
*                OV     OVERCOMMITMENT REJECTION
*                FE     FATAL ERROR
*                OK     COMPLETED NORMALLY
          TITLE  MACROS.
 CLEAR    SPACE  4,10
**        CLEAR.
*         CLEAR BUFFER.
*
*         CLEAR  BUFFER,LENGTH,MASK
 
          PURGMAC CLEAR
 
 CLEAR    MACRO  B,L,M
          MACREF CLEAR
          R=     A2,B+L
          R=     B5,L
          IFNE   M,,
          MX6    M
          ELSE   1
          MX6    0
          RJ CLB
          ENDM
 ENDRI    SPACE  4,10
**        ENDRI.
*         ENTER DEMAND FILE RANDOM INDEX.
*
*         ENDRI  N
 
          PURGMAC ENDRI
 
 ENDRI    MACRO  N
          MACREF ENDRI
          R= X1,N
          SX2 20B
          RJ =XCPM=
          ENDM
 FATRF    SPACE  4,10
**        FATRF.
*         ATTACH RESOURCE FILE AND SET INTERLOCK.
*
*         FATRF  FILE,MODE
 
          PURGMAC FATRF
 
 FATRF    MACRO  F,MD
          MACREF FATRF
          R=     X2,F
 
*         SET FILE MODE.
 
 A        SET    /COMSPFM/PTRD
          ECHO   3,B=(W,R,A,M,RM,RA,U,RU),C=(/COMSPFM/PTWR,/COMSPFM/PTRD
,,/COMSPFM/PTAP,/COMSPFM/PTMD,/COMSPFM/PTRM,/COMSPFM/PTRA,/COMSPFM/PTUP,
,/COMSPFM/PTRU)
          IFC    EQ,$B$MD$,2
          STOPDUP
 A        SET    C
          SX6    A
          RJ     CFA
          ENDM
 INTRC    SPACE  4,10
**        INTRC - INTERRUPT PROCESSING CONTROL.
*
*         INTRC  ON          INTERRUPT CAN BE PROCESSED IMMEDIATELY
*
*         INTRC  OFF         CONTROL RETURN IS REQUIRED
 
 
          PURGMAC INTRC
 INTRC    MACRO  S
          MACREF INTRC
 I1       IFC    EQ,$S$ON$
          SX7    0
 I1       ELSE
          SX7    1
 I1       ENDIF
          SA7    RPVC
          ENDM
 INTRP    SPACE  4,10
**        INTRP.
*         CHECK FOR AND PROCESS INTERRUPT.
*
*         INTRP  ADDR
 
          PURGMAC INTRP
 
 INTRP    MACRO  A
          MACREF INTRP
          SA1    RPVA
          NZ     X1,A
          ENDM
 MKTE     SPACE  4,10
**        MKTE.
*         MAKE KEYWORD TABLE ENTRY.
*
* KW      MKTE   PRAD,EQI,PARMS
*
*         KW     KEYWORD
*         PRAD   PROCESSOR ADDRESS (COMPLEMENT OF PROCESSOR ADDRESS
*                IF PARAMETER MUST BE EQUIVALENCED)
*         EQI    EQUIVALENT PARAMETERS INDEX
*         PARMS  INDIVIDUAL PROCESSOR PARAMETERS
*
*T  KW    18/KW, 6/EQI, 18/PARMS, 18/PRAD
 
          PURGMAC MKTE
 
          MACRO  MKTE,K,A,I,P
          MACREF MKTE
 K        VFD    18/0L_K
          VFD    6/I
 K1       IFC    EQ,$P$$
          VFD    18/0
 K1       ELSE
          VFD    P
 K1       ENDIF
          VFD    18/A
          ENDM
 ROAE     SPACE  4,10
**        ROAE.
*         REQUEST OPERATOR TO ASSIGN EQUIPMENT (FC=0).
*         REQUEST OPERATOR SELECTION ON DUPLICATE VSN (FC=1).
*
*         ROAE   FILE,FC
 
          PURGMAC ROAE
 
 ROAE     MACRO  F,FC
          MACREF ROAE
          R=     X2,F
          SX7    26B
          R=     X4,FC
          LX4    18D
          BX2    X2+X4
          RJ =XLFM=
          ENDM
 RDSB     SPACE  4,10
**        RDSB.
*         READ SUB-SYSTEM BLOCK.
*
*         STATUS WORD *SS* IS USED.
*         RDSB PROCESSES ITS OWN ERRORS UNLESS *X* IS PRESENT.
*
*         RDSB   SID,WC,FROM,TO,X
 
          PURGMAC RDSB
 
 RDSB     MACRO  Q,W,F,T,X
          MACREF RDSB
          R= X5,W
          R= X6,T
          R= X7,F
          R= X1,Q
          RJ     RSB
          IFC    EQ,$X$$,2
          SA2 SS
          PL X2,ERR1         IF ERROR
          ENDM
 RETRF    SPACE  4,10
**        RETRF - RETURN RESOURCE FILE.
*         RETURN RESOURCE FILE AND CLEAR ITS INTERLOCK.
*
*         RETRF  F
 
 
          PURGMAC RETRF
 RETRF    MACRO  F
          MACREF RETRF
          RETURN F
          BX7    X7-X7       CLEAR INTERLOCK
          SA7    X2-1
          ENDM
 TMS      SPACE  4,15
**        TMS - CALL THE TAPE MANAGEMENT SYSTEM PP *TFM*.
*
*         TMS    ADDR,FUNC
*
*         ENTRY  ADDR = FET ADDRESS.
*                FUNC = SUBFUNCTION FOR *RSXF* REQUEST.
*
*         EXIT   *TFM* REQUEST PROCESSED.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 7.
*
*         MACROS SYSTEM.
 
 
          PURGMAC TMS
 
 TMS      MACRO  AD,FC
          MACREF TMS
          SA1    AD
          SX6    /TFM/_FC
          MX0    42
          LX6    3
          BX2    X0*X1
          BX7    X2+X6
          SA7    A1
          SYSTEM TFM,R,AD,/TFM/RSXF*100B
          ENDM
 VSN      SPACE  4,10
**        VSN.
*         BUILD VSN FNT/FST ENTRY.
*
*         VSN    F
*
*         F+10 HAS VSN RANDOM INDEX AND EQUIPMENT IF NEEDED.
*         FET STATUS (BIT 0) GUARANTEED SET = 1.
 
          PURGMAC VSN
 
 VSN      MACRO  F
          MACREF VSN
          R= X2,F
          SX7 27B
          RJ =XLFM=
          ENDM
 WTSB     SPACE  4,10
**        WTSB - WRITE MAGNET SUB-SYSTEM BLOCK.
*
*         WTSB   ADDR,BUFN
*
*                ADDR = ADDRESS OF DATA TO WRITE.
*                BUFN = MAGNET BUFFER NUMBER.
 
 
          PURGMAC WTSB
 
 WTSB     MACRO  B,N
          MACREF WTSB
          R= X6,B
          R= X7,N
          RJ WSB
          ENDM
          TITLE  COMMON DECKS.
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
          QUAL   COMSEJT
*CALL     COMSEJT
          QUAL   *
          QUAL   COMSLFD
*CALL     COMSLFD
          QUAL   *
          QUAL   COMSLFM
*CALL     COMSLFM
          QUAL   *
          QUAL   COMSMSP
*CALL     COMSMSP
          QUAL   *
          QUAL   COMSMTX
          LIST   X
*CALL     COMSMTX
          LIST   *
          QUAL   *
          QUAL   COMSPFM
*CALL     COMSPFM
          QUAL   *
*CALL     COMSRPV
          LIST   X
*CALL     COMSRSX
          LIST   *
          QUAL   COMSSRU
*CALL     COMSSRU
          QUAL   *
*CALL     COMSSFM
*CALL     COMSSSD
          QUAL   COMSSSJ
*CALL     COMSSSJ
          QUAL   MLS
*CALL     COMSMLS
          QUAL   *
          QUAL   *
          QUAL   EVENT
*CALL     COMSEVT
          QUAL   *
*CALL     COMSPRD
          QUAL   TFM
*CALL     COMSTFM
          QUAL   *
          TITLE  SPECIAL USAGE SYMBOLS.
          SPACE  4,10
**        FET EQUIVALENCES FOR LABEL FIELDS.
 
 
 FDTY     EQU    1           DEVICE TYPE
 FRTL     EQU    4           *REQ* TAPE LABELS
 FSAL     EQU    4           SECURITY ACCESS LEVEL
 FRAN     EQU    6           RANDOM REQUEST WORD
 FNFN     EQU    6           NEW FILE NAME (RENAME)
 FCID     EQU    7           CHECKPOINT ID WORD
 FESN     EQU    /TFM/TFES   EXTERNAL SERIAL NUMBER
 FTAP     EQU    10B         TAPE DESCRIPTORS
 FEVE     EQU    10B         ENTER VSN ENTRY CONTROL WORD
 FVSN     EQU    11B         VOLUME SERIAL NUMBER
 FFAS     EQU    11B         FILE ACCESSIBILITY
 FSTN     EQU    11B         FILE SECTION NUMBER
 FID1     EQU    12B         FILE IDENTIFIER WORD 1
 FID2     EQU    13B         FILE IDENTIFIER WORD 2
 FSQN     EQU    13B         FILE SEQUENCE NUMBER
 FMSI     EQU    14B         MULTI-SET IDENTIFIER
 FGVN     EQU    14B         GENERATION VERSION NUMBER
 FGRN     EQU    14B         GENERATION NUMBER
 FRTD     EQU    15B         RETENTION DATE
 FCRD     EQU    15B         CREATION DATE
 FAUN     EQU    /TFM/TFUN   ALTERNATE ACCESS USERNAME
 FFTO     EQU    /TFM/TFUN   TAPE MANAGER OPTIONS
 FPSW     EQU    /TFM/TFPW   ALTERNATE ACCESS PASSWORD
 FFAC     EQU    /TFM/TFPW   AUDIT ACCESSIBILITY
 FFCT     EQU    /TFM/TFPW   CATEGORY TYPE
 FFMD     EQU    /TFM/TFPW   FILE MODE
 FMAX     EQU    /TFM/TFPL   NUMBER OF *TMS* WORDS IN FET
 
 SFET     EQU    SPPR+1      SPECIAL CALL FET POSITION
          SPACE  4,10
**        LFM FUNCTIONS PROCESSED BY RESEX.
 
 
          QUAL   LFM
 
 RENAME   EQU    0           RENAME (FUNCTION 0)
 LABEL    EQU    24B         LABEL (FUNCTION 24)
 
          QUAL   *
          TITLE  ASSEMBLY CONSTANTS.
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 
 BUFL     EQU    RDEL        SHORT BUFFER LENGTH
 IOBL     EQU    1001B       I/O BUFFER LENGTH
 
 DBMC     EQU    6           DEMAND FILE BUSY MESSAGE COUNT
 DFRC     EQU    12          DEMAND FILE ATTACH RETRY COUNT
 ESTEB    EQU    100B/ESTE   EST ENTRIES PER BLOCK
 MAXR     EQU    MSMX+/COMSMTX/MUNIT  MAXIMUM SYSTEM RESOURCES
 EVBL     EQU    MAXR*2+2    ENVIRONMENT VSN BUFFER LENGTH
 MEMI     EQU    100B        CM FL INCREMENT TO REQUEST
 MMSD     MIN    RPSL,MSMX   MAXIMUM USER MS DEMAND
 MMTD     EQU    /COMSMTX/MUNIT  MAXIMUM USER MT DEMAND
 PBFL     EQU    LPDS-1      LENGTH OF SYSTEM PREVIEW BUFFER
 PBMX     EQU    PBFL/PVEL   MAXIMUM PREVIEW ENTRIES
 RPBE     EQU    PVEL+1      *RESEX* PREVIEW ENTRY LENGTH
 RPBL     EQU    PBMX*RPBE+1 LENGTH OF *RESEX* PREVIEW BUFFER
 MRMX     EQU    40B         MAXIUM NUMBER OF ACS TAPE MOUNT REQUESTS
 RMBE     EQU    2           *RESEX* MOUNT REQUEST ENTRY LENGTH
 RMBL     EQU    1+/COMSMTX/MXRM*RMBE+1  LENGTH OF MOUNT REQUEST BUFFER
 RDTL     EQU    MMSD*2+MMTD*2  RESOURCES DEMANDED TABLE LENGTH
 RETL     EQU    MAXR+1      RESOURCE EQUIPMENT TABLE LENGTH
 TDDSL    EQU    8+1         TABLE OF CHAINED EQUIPMENTS LENGTH
 
 
****
          TITLE  CONSTANTS AND TEMPORARIES.
**        FETS.
 
          ORG    120B
 
 FETS     BSS    0           FILE ENVIRONMENT TABLES
 
 F        BSS    0           REQUESTED FILE
 FILE     FILEB  BUF,BUFL,(FET=20B)
          ORG    F
          CON    1           CLEAR REQUESTED FILE NAME
          ORG    F+20B
 
 T        BSS    0           TFM ASSIGNMENT FET
 TFM      FILEB  0,0,(FET=20B),EPR
          ORG    T+5
          VFD    42/0,18/EMSG  ERROR MESSAGE ADDRESS
          ORG    T+20B
 
 VF       BSS    0           VSN ENTRY FILE
 VFILE    FILEB  BUF,BUFL,(FET=14)
 
 INTD     CON    0           DEMAND FILE INTERLOCK
 D        BSS    0           RESOURCE DEMAND FILE
 RSXD     RFILEB DBUF,IOBL,(FET=14)
          ORG    D+/COMSPFM/CFPW
          CON    CFAA        SET PF ERROR MESSAGE ADDRESS
          ORG    D+14
 
 
 INTV     CON    0           VSN FILE INTERLOCK
 V        BSS    0           VSNFILE
 RSXV     RFILEB VBUF,IOBL,(FET=14)
          ORG    V+/COMSPFM/CFPW
          CON    CFAA        SET PF ERROR MESSAGE ADDRESS
          ORG    V+14
 
 INTR     CON    1           REQUEST FILE INTERLOCK (ZERO IF ATTACHED)
 R        BSS    0           STAGE REQUEST FILE
 STRQ     FILEB  RBUF,IOBL,(FET=/COMSPFM/CFLM),EPR
          ORG    R+/COMSPFM/CFPW
          CON    CFAA        SET PF ERROR MESSAGE ADDRESS
          ORG    R+/COMSPFM/CFLM
 
 
 S1       BSS    0           SCRATCH 1
 RESEXS1  FILEB  SBUF1,IOBL
 
 
 S2       BSS    0           SCRATCH 2
 RESEXS2  FILEB  SBUF2,IOBL
 SSJ      SPACE  4,10
**        SPECIAL SYSTEM JOB PARAMETERS.
 
 
 SSJ=     BSS    0           SSJ= PARAMETER BLOCK
          VFD    12/0,24/-0,12/RXCS,12/IRSI
          CON    /COMSPFM/SYUI  SET SYSTEM USER INDEX
          BSSZ   /COMSSSJ/SSJL-2  LENGTH OF SSJ= PARAMETERS
 CPA      SPACE  4,10
**        CONTROL POINT AREA INFORMATION.
 
 
          QUAL   CPA
 CPA      BSS    0
 JCIW     CON    //JCIW      JOB CONTROL INFORMATION
 PFCW     CON    //PFCW      PERMANENT FILE CONTROL WORD
 PKNW     CON    //PKNW      DEFAULT PACKNAME
 RFCW     CON    //RFCW      DEMAND FILE RANDOM INDEX
 TFSW     CON    //TFSW      JOB EJT ORDINAL
 SPCW     CON    //SPCW      SYSTEM PROCESSOR CALL WORD
 CPAL     EQU    *-CPA
          QUAL   *
 LWC      SPACE  4,10
**        LOW CORE INFORMATION.
 
 
          QUAL   LWC
 EJTP     VFD    1/1,59/0    EJT POINTER
 ESTP     VFD    1/1,59/0    EST POINTER
 IPRL     VFD    1/1,59/0    INSTALLATION PARAMETERS
 PFNL     VFD    1/1,59/0    PERMANENT FILE CONTROL WORD
          QUAL   *
 ARG=     SPACE  4,10
**        SPECIAL ENTRY POINTS.
 
 
 ARG=     BSS    0           SUPPRESS ARGUMENT PROCESSING
 DMP=     EQU    100000B     SELECT NO DMP IF COMMAND CALL
 SDM=     EQU    0           SECURE DAYFILE MESSAGE
 TEMP     SPACE  4,10
**        GLOBAL DATA.
 
 
 AA       CON    -1          AUTOMATIC TAPE ASSIGNMENT FLAG
 
*         AA = -1, IF AUTOMATIC VSN ASSIGNMENT OF TAPE.
*         AA = 0, IF OPERATOR ASSIGNMENT OF TAPE (NO VSN).
*         AA = 1, IF *ASSIGN* WITH EST ORDINAL SPECIFIED.
 
 AL       CON    0           ACCESS LEVEL PERMISSION
 AU       CON    0           ADDRESS OF UDT OF ASSIGNED VSN
 AV       CON    0           ASSIGNED VSN POINTER
 CF       CON    0           CALL FLAG
 CI       CON    0           CHECKPOINT ID
 DFDI     CON    0           DEFAULT DEMAND INDICATOR
 DFPT     CON    /COMSPFM/DFPT  DEFAULT REMOVABLE PACK TYPE
*                (THE ACTUAL VALUE OF *DFPT* IS READ FROM *PFNL*)
 EF       CON    0           END-OF-FILE FLAG
 EMSG     BSS    /TFM/MBML   ERROR MESSAGE BUFFER
 EQ       CON    0           MAGNETIC TAPE EQUIPMENT
 EVSN     CON    0           EXTERNAL VSN
 FAMO     CON    0           FAMILY ORDINAL
 FS       CON    -1          FILE STATUS
 IVSN     CON    0           INTERNAL VSN
 JEEO     CON    0           JOB EJT ENTRY ORDINAL
 JALA     CON    0           JOB ACCESS LEVEL
 JCWA     CON    0           JOB CONTROL WORD
 JSN      CON    0           JOB SEQUENCE NAME
 MF       CON    0           MULTI-FILE POSITIONING
 MIDI     CON    0           *MAGNET* IDLEDOWN INDICATOR
 OO       CON    0           OPEN OPTION
 OT       CON    0           JOB ORIGIN TYPE
 OV       CON    0           TAPE BLOCK OVERFLOW CHUNK COUNT
 PVDC     CON    0           PREVIEW DISPLAY CLEAN-UP FLAG
 PVST     CON    0           PACKED VSN OF STAGING TAPE
 RE       CON    0           ROLLOUT EVENT
 RETE     CON    0           RET/EVSB ENDING EQUIPMENT INDEX
 RETI     CON    0           RET/EVSB MT BEGINNING INDEX
 RM       CON    0           ROLLOUT MESSAGE ADDRESS
 RMN      CON    0           RESOURCE TYPE MNEMONIC
 RT       CON    0           REQUEST TYPE
 SS       CON    0           SUB-SYSTEM COMMUNICATION STATUS WORD
 SSMA     CON    0           SYSTEM SECURITY MODE
 TA       CON    0           *MAGNET* TAPE ASSIGNED FLAG
 TB       CON    0           TAPE BLOCK DEFINITION
 TPAL     CON    0           TAPE ACCESS LEVELS
 TS       CON    0           SYMBOLIC *TMS* TAPE FLAG (IF NEGATIVE)
 UCRI     CON    0           INTERRUPT REQUIRES FILE UPDATE/CLEAN-UP
 VA       CON    0           VSN RANDOM ADDRESS
 VC       CON    0           VSN FROM *VSN* COMMAND FLAG
          SPACE  4,10
**        TTDV - TABLE OF TAPE DEVICE TYPES.
*
*         ENTRIES ARE IN ORDER OF *COMSMTX* TAPE DEVICE CODES.
*
*         42/RT,6/0,12/DM
*
*                RT = *COMSRSX* RESOURCE TYPE.
*                DM = DEVICE MNEMONIC.
*
*         TABLE IS TERMINATED WITH A ZERO WORD.
 
 
 TTDV     IVFD
          IVFD   /COMSMTX/DVMT,(42/RMTP,18/2RMT)
          IVFD   /COMSMTX/DVCT,(42/RCTP,18/2RCT)
          IVFD   /COMSMTX/DVNT,(42/RNTP,18/2RNT)
          IVFD   /COMSMTX/DVAT,(42/RATP,18/2RAT)
          IVFD   /COMSMTX/DVMX,(60/0)  TABLE TERMINATOR
          IVFD   /COMSMTX/DVMX+1
 TTFM     SPACE  4,10
**        TTFM - TABLE OF TAPE FORMAT CHARACTERISTICS.
*
*         ENTRIES ARE IN ORDER OF *COMSMTX* TAPE FORMAT DEFINITIONS.
*
*         1/I,1/B,10/0,12/ WC, 12/ OV,6/ N7,6/ N9,12/0
*
*         I      INTERNAL FORMAT.
*         B      COMPUTE BLOCK SIZE FROM FRAME COUNT.
*         WC     BLOCK WORD COUNT.
*         OV     LONG BLOCK OVERFLOW IN CHUNKS.
*         N7     DEFAULT 7 TRACK NOISE BLOCK DEFINITION.
*         N9     DEFAULT 9 TRACK NOISE BLOCK DEFINITION.
 
 
 TTFM     BSS    0           START OF TABLE
          VFD    1/1,1/0,10/0,12/1000B,12/0,6/4,6/4,12/0   *I*
          VFD    1/1,1/0,10/0,12/1000B,12/0,6/4,6/4,12/0   *SI*
          VFD    1/0,1/1,10/0,12/0,12/0,6/11B,6/14B,12/0   *F*
          VFD    1/0,1/0,10/0,12/0,12/0,6/11B,6/14B,12/0   *S*
          VFD    1/0,1/0,10/0,12/0,12/0,6/11B,6/14B,12/0   *L*
          VFD    1/1,1/0,10/0,12/400B,12/12B,6/0,6/0,12/0  *LI*
          SPACE  4,10
**        SCRATCH VSN EQUIVALENCES.
 
 
 BLANK    VFD    36/6H      ,24/0
 SCRATCH  VFD    60/0LSCRATCH
 ZERO     VFD    60/0L0
 RSX      SPACE  4,10
**        RESOURCE FILE IDENTIFIER TABLES.
 
 
          LIST   D,E,G
 TRSL     HERE               *COMSRSX* TABLE OF RESOURCE LISTS
 
 TRID     HERE               *COMSRSX* TAPE/PACK RESOURCE ENTRIES
          LIST   *
 EVENTS   SPACE  4,10
**        EVENT SKELETONS AND ROLLOUT MESSAGE ADDRESSES.
 
 
 MSUB     VFD    30/0,18//EVENT/MTXE,12//TIMES/SUBM
          CON    =C*WAITING FOR MAGNET.*
 PEMV     VFD    30/0,18//EVENT/VSNE,12//TIMES/RPMS
          VFD    60/-WPKM
 PEOV     VFD    30/0,18//EVENT/OVRE,12//TIMES/RPOV
          CON    =C*WAITING FOR RESOURCES.*
 PFRE     CON    0           PF FILE ROLLOUT (USE EVENT IN CPA *UPCW*)
          CON    =C*WAITING FOR RESOURCE FILE.*
 TEMV     VFD    30/0,18//EVENT/VSNE,12//TIMES/MTMS
          VFD    60/-WTPM
 TEOV     VFD    30/0,18//EVENT/OVRE,12//TIMES/MTOV
          CON    =C*WAITING FOR RESOURCES.*
 TLIM     VFD    30/0,18/0,12//TIMES/RFTL
          CON    =C*WAITING ON TRACK LIMIT.*
 WSTG     VFD    30/0,18//EVENT/VSNE+7777B,12//TIMES/MTMS
          CON    =C*WAITING FOR STAGING TAPE.*
          SPACE  4,10
 WTPB     BSSZ   4           WAITING FOR TAPE/PACK MESSAGE BUFFER
 
 WPKM     DATA   C*WAITING FOR PN=+++++++, ---.*
 
 WTPM     DATA   C*WAITING FOR VSN=+++++++, --.*
 TMPF     SPACE  4,10
**        TAPE MANAGER PROCESSING FLAGS.
 
 
 TMPF     BSS    0           TAPE MANAGER PROCESSING FLAGS
          VFD    1/1         59 - SET IF *TMS* DISABLED
          VFD    1/0         58 - SET IF *TMS* CONTROLLED REQUEST
          VFD    1/0         57 - SET IF SCRATCH TAPE ASSIGNMENT
          VFD    1/0         56 - SET IF OPERATOR VERIFY REQUIRED
          VFD    1/0         55 - SET IF RESERVE ASSIGNED SCRATCH
          VFD    1/0         54 - SET IF SYMBOLIC ACCESS
          VFD    1/0         53 - SET IF DEFAULT *TO=T*
          VFD    1/0         52 - SET IF USER OWNED TAPE
          VFD    1/0         51 - SET IF DEFAULT *TO=C*
          VFD    1/0         50 - SET IF OFFSITE TAPE
          VFD    1/0         49 - UNUSED
          VFD    1/0         48 - UNUSED
          VFD    48/0        47 TO 0 - UNUSED
          TITLE  OVERVIEW DOCUMENTATION.
***       OVERCOMMITMENT ALGORITHM DESCRIPTION.
*
*         THE PURPOSE OF THIS DOCUMENTATION IS TO OVERVIEW HOW THE
*         EXERCISING OF THE OVERCOMMITMENT ALGORITHM IS PERFORMED.
*
*         9-TRACK MAGNETIC TAPE *RESOURC* IDENTIFICATION BY DENSITY
*         (*HD* = 800 BPI, *PE* = 1600 BPI, *GE* = 6250 BPI) CANNOT
*         BE SPECIFIED CONCURRENTLY IN THE SAME JOB WITH THE *NT*
*         *RESOURC* IDENTIFIER.  IN THE OVERCOMMITMENT ALGORITHM,
*         UNSATISFIED *NT* DEMANDS ARE LOGICALLY SATISFIED ONLY BY
*         800/1600 BPI DRIVES.  HOWEVER, AT REQUEST TIME, IF THE
*         DESIRED 1600 BPI TAPE FOR AN *NT* DEMAND IS FOUND MOUNTED
*         ON A 1600/6250 BPI DRIVE, THE ASSIGNMENT WILL BE ALLOWED
*         IF IT DOES NOT CAUSE OVERCOMMITMENT.
*
*     *BRE*      BUILDS RESOURCE EQUIPMENT TABLE (RET) AND ENVIRONMENT
*                VSN TABLE (EVSB) FROM THE MASS STORAGE TABLES (MST),
*                *MAGNET* UNIT DESCRIPTOR TABLES (UDT) AND EQUIPMENT
*                STATUS TABLE (EST).
*
*     *BSF*      BUILDS SCRATCH FILE OF THE DEMAND FILE ENTRIES FOR
*                ALL JOBS WITH ASSIGNED RESOURCES, EXCEPT REQUESTOR.
*                BY THE RESOURCE EQUIPMENT DEFINED IN THE ENVIRONMENT.
*
*     *CFU*      REQUESTED VSN/PACKNAME IF FOUND IN EVSB IS ASSIGNED
*                TO THE REQUESTOR.  IF REMOVABLE PACK, A SHARE TABLE
*                ENTRY IS BUILT.  IF REQUEST IS FOR A TAPE VSN AND
*                DUPLICATE VSNS HAVE BEEN DECLARED, THEY WILL BE
*                CHECKED IF THE ORIGINAL VSN IS NOT FOUND IN EVSB.
*                IF THE REQUESTED VSN/PACKNAME IS NOT FOUND IN THE
*                EVSB, A PSUEDO EVSB ENTRY IS MADE IF THE RET
*                CONTAINS A FREE DEVICE OF THE REQUESTED TYPE.
*                (SO THAT IF OVERCOMMITMENT IS LATER DETECTED, THE
*                PREVIEW DATA WILL BE CLEARED AND THE JOB WILL ROLL
*                OUT WITH OVERCOMMITMENT STATUS RATHER THAN MISSING
*                VSN.)  FOR 9-TRACK *PE* REQUESTS FOR A *SCRATCH*
*                TAPE OR FOR A VSN NOT FOUND IN THE ENVIRONMENT,
*                *CFU* WILL GUARENTEE THAT THE SELECTED DRIVE WILL
*                NOT CAUSE INTERNAL CONFLICT FOR THE JOB.
*
*     *CIC*      SETS ASSIGNED STATUS ONLY ON THOSE TAPE EQUIPMENTS
*                IN THE ENVIRONMENT CURRENTLY ASSIGNED TO THE
*                REQUESTOR AND DETERMINES THE SATISFIABILITY OF THE
*                REQUESTOR,S REMAINING DEMANDS.  IF THESE DEMANDS
*                CANNOT BE SATISFIED, BUT *DEI* HAS SHOWN THAT THE
*                ENVIRONMENT CAN SATISFY THE REQUESTOR,S TOTAL
*                DEMANDS WHEN NONE ARE CURRENTLY ASSIGNED, THE JOB
*                IS IN A STATE OF DEADLOCKING ITSELF.  THIS CAN OCCUR
*                WHEN THE CURRENT REQUEST IS FOR A 9-TRACK *PE* TAPE
*                THAT IS FOUND MOUNTED ON THE WRONG DRIVE TYPE, SUCH
*                THAT THE REMAINING *HD* OR *GE* DEMANDS CANNOT BE
*                SATISFIED.  IN THIS CASE, THE ASSIGNMENT IS
*                REJECTED AND THE OPERATOR IS INFORMED OF THE
*                CONFLICT, SO THE TAPE CAN BE MOUNTED ON THE CORRECT
*                DRIVE TYPE.  INTERNAL CONFLICT CAN ALSO OCCUR WHEN A
*                9-TRACK *PE* TAPE IS CURRENTLY ASSIGNED TO THE JOB
*                AND AN INCREASE IN *HD* OR *GE* RESOURCE
*                REQUIREMENTS IS SPECIFIED (RECIEVES *NT DRIVE
*                CONFLICT.* ERROR).
*
*     *CRC*      DETERMINE IF REQUESTOR COMPLETES (SATISFIES ALL
*                DEMANDS) WITH THE ASSIGNMENT OF THIS RESOURCE.
*                IF SO, THERE IS NO NEED TO EXERCISE THE
*                OVERCOMMITMENT ALGORITHM.
*
*     *CRQ*      VALIDATES OPERATOR ASSIGNED EQUIPMENT, READS
*                REQUESTOR DEMAND FILE ENTRY INTO RESB BUFFER, AND
*                BUILD PREVIEW DATA FOR THIS REQUEST.
*
*     *DDS*      DETERMINES THE SATISFIABILITY OF THE RESOURCE DEMANDS.
*
*     *DEI*      DETERMINES IF RESOURCE DEMANDS ARE SATISFIABLE
*
*     *OCA*      OVERCOMMITMENT ALGORITHM IS EXERCISED.  *DDS* IS USED
*                TO SATISFY ALL DEMANDS WHICH HAVE NOT BEEN MET.
*                IF ANY JOB DOES NOT COMPLETE, THEN A DEADLOCK HAS
*                OCCURRED AND THE ASSIGNMENT WILL BE PROHIBITED.
*
*
*
*
*     PP ROUTINES *0RF* AND *0RT*.
*         *0RT* CLEARS THE ASSOCIATED VSN FILE ENTRY AND UPDATES
*         THE JOB DEMAND FILE ENTRY WHEN A TAPE RESOURCE IS
*         RETURNED.  *0RF* CLEARS THE SHARE TABLE ENTRY AND UPDATES
*         THE DEMAND AND ASSIGNED COUNTS IN THE JOB DEMAND FILE
*         ENTRY WHEN A REMOVABLE PACK RESOURCE IS RETURNED.
*         WHEN A TAPE FILE IS RETURNED OR WHEN THE LAST DIRECT ACCESS
*         FILE FOR THE JOB ON A REMOVABLE PACK IS RETURNED, BOTH THE
*         TOTAL ASSIGNED COUNT AND THIS RESOURCE ASSIGNED COUNT ARE
*         DECREMENTED BY ONE.  IF TOTAL RESOURCE DEMANDS HAVE BEEN
*         SATISFIED, BOTH THE TOTAL DEMAND COUNT AND THE RESOURCE
*         DEMAND COUNT ARE DECREMENTED BY ONE, UNLESS *UNLOAD* WAS
*         USED TO RELEASE THE FILE.
*         *0RF* IS ALSO USED TO CLEAR THE JOB DEMAND FILE ENTRY AT
*         JOB COMPLETION.
          SPACE  4,10
***       ENVIRONMENT TABLES AND BUFFERS.
*
*
*         RESOURCE EQUIPMENT TABLE CONSISTS OF A COMBINATION OF DATA
*         COLLECTED FROM THE EST, MST AND UDT TABLES.
*         EACH *RET* ENTRY IS ONE WORD IN LENGTH AND HAS THE FORMAT -
*
*  RET    1/A, 11/DM, 6/CH1, 6/CH2, 12/NE, 12/EO, 3/CS, 3/OS, 6/FLAGS
*
*         DT     DEVICE MNEMONIC IF FLAG *A* IS NOT SET, OTHERWISE DT
*                IS AN INDEX INTO *TRSL* TABLE.  EACH *TRSL* ENTRY IS A
*                LIST OF EQUIVALENT RESOURCE TYPES.
*         CH1    CHANNEL 1 FOR DISK, ACCESS LEVELS FOR TAPES
*                3/LA, 3/UA
*                LA = LOWER ACCESS LEVEL, FOR TAPE ONLY
*                UA = UPPER ACCESS LEVEL, FOR TAPE ONLY
*         CH2    CHANNEL 2 FOR DISKS
*         NE     NEXT EQUIPMENT NUMBER
*         EO     EST ORDINAL
*         CS     CURRENT SPINDLES
*         OS     ORIGINAL SPINDLES
*         FLAGS  2/0, 1/LDAM, 1/EOC, 1/EO, 1/A
*                LDAM = LDAM EQUIPMENT
*                EOC  = END OF CHAIN
*                EO   = EQUIPMENT *OFF* OR *DOWN*
*                A    = ASSIGNED
*
*
*         ENVIRONMENT VSN BUFFER CONSISTS OF DATA WHICH RELATES TO THE
*         USAGE OF MOUNTED MAGNETIC TAPES AND REMOVABLE PACKS.
*         EACH *EVSB* ENTRY, CORRESPONDING IN POSITION TO ITS
*         *RET* ENTRY, IS TWO WORDS IN LENGTH AND HAS THE FORMAT -
*
*  EVSB   42/VSN OR PACKNAME, 6/LA, 6/UA, 6/RI
*         12/EQ, 12/SHARERS, 6/FLAGS, 18/UDT,MST ADDRESS, 12/EJTO
*
*         NOTE - FOR ACS TAPES *VSN* IS THE EXTERNAL VSN.
*
*         LA     LOWER ACCESS LEVEL
*                6/0 FOR PACKS
*                3/0, 3/LOWER ACCESS LEVEL FOR TAPES
*         UA     UPPER ACCESS LEVEL
*                6/UNIT COUNT FOR PACKS
*                3/UPPER ACCESS LEVEL, 3/BYTE POINTER FOR TAPES
*         RI     DEMAND FILE RESOURCE INDEX
*         FLAGS  1/A, 1/S, 1/U, 1/D, 1/P, 1/
*                A = ASSIGNED
*                S = SCRATCH VSN
*                U = UNLOADED PACK WITH USER COUNT
*                D = DEFAULT VSN
*                P = DEVICE SUSPECT FLAG
*         EJTO   EJT ORDINAL OF ASSIGNED JOB.
*
*
*         RESOURCES DEMANDED TABLE CONSISTS OF A TWO WORD ENTRY FOR
*         EACH RESOURCE WHICH IS YET TO BE SATISFIED.  THE FORMAT IS-
*
*  RDT    12/RESOURCE TYPE, 6/UNIT COUNT, 6/AL, 9/E1, 9/E2, 9/E3, 9/E4,
*         12/OE, 12/0, 9/E5, 9/E6, 9/E7, 9/E8
*                OE, E1 - E8 = *RET* ENTRY INDEX FOR EQUIPMENT
*                AL = ACCESS LEVEL, TAPES ONLY
*
*
*         RESOURCE TYPE NAMES ARE FOUND IN *RSXB*.
          SPACE  4,30
***       RESOURCE REQUEST BLOCK.
*
*         THE USER RESOURCE REQUEST BLOCK IS A COMMON REQUESTING
*         MECHANISM OF THE OVERCOMMITMENT ALGORITHM FOR BOTH TAPES AND
*         PACKS.  THE USER RESOURCE REQUEST BLOCK CONSISTS OF THE JOB
*         DEMAND FILE ENTRY IN THE REQUEST DEMAND ENTRY BUFFER (RESB)
*         AND REQUEST IDENTIFICATION INFORMATION.  THIS INFORMATION
*         CONSISTS OF A REQUEST WORD (RQ) HAVING FORMAT--
*
*T  PACK  42/ PACKNAME,12/ RTYPE,6/UNITS
*         WHERE  UNITS = UNIT COUNT (1-8) IN DISPLAY CODE
*                RTYPE = RESOURCE TYPE IN DISPLAY CODE
*T  TAPE  36/ VSN,6/0,12/ RTYPE,6/0
*
*         THE REQUESTED RESOURCE INDEX (RI) HAVING FORMAT-
*
*T        51/0, 3/UC, 6/ RI
*         WHERE  RI = DEMAND FILE RESOURCE INDEX
*                UC = UNIT COUNT FOR PACKS, BYTE POINTER FOR TAPES
*
*         FOR 9-TRACK TAPE ASSIGNMENTS, *DD* HAS FOLLOWING FORMAT-
*
*T        48/ 0, 12/ DC
*         WHERE  DC = DISPLAY CODE FOR 9-TRACK RESOURCE DENSITY
*
*         FOR 9-TRACK TAPE ASSIGNMENTS, *OI* HAS FOLLOWING FORMAT-
*
*T        54/ 0, 6/ DI
*         WHERE  DI = ORIGINAL 9-TRACK TAPE DENSITY RESOURCE INDEX
 
 
 RQ       CON    0           REQUEST
 RI       CON    0           REQUESTED RESOURCE INDEX
 TM       CON    0           TIME OF REQUEST (ABSOLUTE SECONDS)
 OI       CON    0           ORIGINAL NT TAPE DENSITY RESOURCE INDEX
          TITLE  OVERCOMMITMENT ALGORITHM.
 COM      SPACE  4,25
**        COM - CHECK FOR OVERCOMMITMENT.
*
*         ENTRY  USER RESOURCE REQUEST BLOCK BUILT.
*                VSNE = VSN ENTRY FOR TAPES.
*                AT *COM4* IF ASSIGNMENT REJECTED DUE TO
*                     *MAGNET* IDLEDOWN.
*                AT *COM5*, IF RE-REQUEST OPERATOR ASSIGNMENT OF
*                     EQUIPMENT.
*                AT *COM6*, IF REQUEST OPERATOR SELECTION FOR
*                     DUPLICATE VSN.
*
*         EXIT   (X2) = STATUS.
*
*         ERROR  TO *PER* IF NT DRIVE CONFLICT.
*
*         USES   A - 1, 2, 3, 4, 6.
*                B - 2, 3, 5.
*                X - ALL.
*
*         CALLS  BRE, BSF, CFU, CIC, CRC, CRQ, DEI, IRC, OCA, PMM, ROA,
*                SDT, SPM.
*
*         MACROS MESSAGE, RETRF.
 
 
 COM      SUBR               ENTRY/EXIT
 COM1     RJ     BRE         BUILD RESOURCE ENVIRONMENT
          NG     X0,COM4     IF SUBSYSTEM MISSING
          RJ     CRQ         CHECK REQUEST
          RJ     DEI         DEMAND EXCEEDS INSTALLATION CHECK
          RJ     BSF         BUILD SCRATCH FILE
          RJ     CFU         CHECK FOR UNIT
          SA1    TPAL        TAPE ACCESS LEVEL
          SX6    ALC         ACCESS LEVEL CONFLICT ERROR
          NG     X1,COM8.1   IF ACCESS LEVEL CONFLICT
          RJ     CIC         CHECK FOR INTERNAL CONFLICT
          NZ     X2,COM8     IF DEMANDS NOT SATISFIABLE
          SB2    RESB
          RJ     CRC         CHECK REQUESTOR COMPLETE
          ZR     X5,COM2     IF REQUESTOR COMPLETES
          RJ     OCA         EXERCISE OVERCOMMITMENT ALGORITHM
          SX2    /STATUS/OV
          ZR     X5,COM3     IF OVERCOMMITMENT
 COM2     SX2    /STATUS/OK
 COM3     SA1    AV          CHECK IF VSN IN ENVIRONMENT
          NZ     X1,COMX     IF VSN PRESENT
          SX2    X2+/STATUS/MV  SET MISSING VSN
          EQ     COMX        RETURN
 
 
**        PROCESS SUBSYSTEM MISSING.
 
 
 COM4     RJ     PMM         PROCESS *MAGNET* MISSING
          SA1    AA
          BX6    X6-X6
          SB2    X1
          GT     B2,COM4.1   IF *ASSIGN* WITH EST ORDINAL SPECIFIED
          SA6    EQ          CLEAR EQUIPMENT ASSIGNMENT
          NG     B2,COM1     IF AUTOMATIC ASSIGNMENT
 COM4.1   SA1    RQ          CLEAR VSN
          MX6    -24
          BX6    -X6*X1
          SA6    A1
          EQ     COM1        RETRY OVERCOMMITMENT CHECK
 
*         REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT.
 
 COM5     SA1    RQ          CLEAR VSN IN REQUEST
          MX6    -24
          BX6    -X6*X1
          SX4    B0          INDICATE OPERATOR ASSIGNMENT OF EQUIPMENT
          SA6    A1
          EQ     COM7        RE-REQUEST OPERATOR ASSIGNMENT
 
*         REQUEST OPERATOR ASSIGNMENT ON DUPLICATE VSN OR VERIFY OF
*         NON-TMS TAPE REQUEST.
 
 COM6     SX4    B1+         INDICATE DUPLICATE VSN
 COM7     RETRF  D           RETURN DEMAND FILE AND RELEASE INTERLOCK
          RJ     ROA         RE-REQUEST OPERATOR ASSIGNMENT
          EQ     COM1        RETRY OVERCOMMITMENT CHECK
 
 
**        PROCESS INTERNAL CONFLICT.
*         VSN FOUND MOUNTED ON WRONG 9-TRACK DRIVE TYPE.
 
 
 COM8     SA1    OI          GET ORIGINAL TAPE DENSITY INDEX
          SB2    /PER/DRC    * NT DRIVE CONFLICT.*
          SX1    X1-RPEP
          NZ     X1,PER      IF NOT *PE* REQUEST
          SA2    AV
          ZR     X2,PER      IF RESEX SELECTED DRIVE TYPE
          SA3    AA
          SA4    X2
          SB3    X3
          GT     B3,PER      IF *ASSIGN* WITH EST ORDINAL
          RJ     SDT         SWITCH 9-TRACK DRIVE TYPE
          SX6    DRC         SET DRIVE CONFLICT
 COM8.1   RJ     SPM         SET PREVIEW DISPLAY MESSAGE
          SA1    EQ
          SX2    /STATUS/MV  SET MISSING VSN STATUS
          ZR     X1,COMX     IF NO OPERATOR ASSIGNMENT
          SB5    -1          DECREMENT TOTAL AND RESOURCE ASSIGN COUNTS
          RJ     IRC
          SA1    AA
          NG     X1,COM6     IF DUPLICATE VSN
          EQ     COM5        RE-REQUEST OPERATOR ASSIGNMENT
          TITLE  OVERCOMMITMENT ALGORITHM SUBROUTINES.
 BRE      SPACE  4,25
**        BRE - BUILD RESOURCE ENVIRONMENT.
*
*         EXIT   DEMAND FILE INTERLOCKED AND RET AND EVSB
*                TABLES BUILT.
*                (X0) .LT. 0 IF *MAGNET* MISSING.
*
*         ERROR  TO *ERR2*, IF SUBSYSTEM COMMUNICATION ERROR.
*                TO *PER*, IF RESOURCE ENVIRONMENT ERROR.
*
*         USES   A - 0, 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                X - ALL.
*
*         CALLS  CET, CTE, DLY, GRI, GRL.
*
*         MACROS CLEAR, FATRF, RDSB, RETRF.
 
 
 BRE17    SX6    B3+         SAVE ENDING RET/EVSB INDEX
          SA6    RETE
 
 BRE      SUBR               ENTRY/EXIT
 
*         INTERLOCK DEMAND FILE.
 
          RETRF  D
 BRE0     FATRF  D,M
 
*         CLEAR ENVIRONMENT.
 
          CLEAR  RET,RETL+EVBL  CLEAR RET AND EVSB
          SB3    B1          PRESET BEGINNING RET/EVSB INDEX
          SB5    B0          PRESET EST ORDINAL
          SA0    BUF2        TAPE EST ENTRY BUFFER
 
*         PROCESS REMOVABLE PACKS.  SAVE EST ENTRIES FOR TAPES.
 
 BRE0.1   SB5    B5-B1
          RJ     CET         COPY EST BLOCK
          NG     B6,BRE9     IF END OF EST
          SX0    B5+B1       SAVE STARTING BLOCK EST ORDINAL
          SB6    X0+B6       SAVE ENDING BLOCK EST ORDINAL
 BRE1     SB5    B5+B1       ADVANCE EST ORDINAL
          EQ     B5,B6,BRE0.1  IF END OF EST BLOCK
          SX1    B5          GET NEXT EST ENTRY
          R=     X2,ESTE
          IX1    X1-X0
          SX3    11B
          IX1    X1*X2
          LX3    -4
          SA4    SBUF2+EQDE+X1  GET *EQDE*
          BX5    X3*X4
          ZR     X4,BRE1     IF NO ENTRY
          BX6    X5-X3
          MX2    -12
          ZR     X6,BRE1.2   IF REMOVABLE PACK
          BX6    X2*X4
          LX4    -12
          BX7    -X2*X4      DEVICE CODE
          RJ     CTE         CHECK FOR TAPE EQUIPMENT
          ZR     X2,BRE1     IF NOT TAPE DEVICE
          SA1    A4+B1
          ERRNZ  EQAE-EQDE-1
          SX7    B5          SAVE EST ORDINAL AND EST ENTRY
          BX6    X6+X7
          MX2    6
          LX2    17-59
          BX1    X1*X2
          LX1    12
          LX2    12
          BX6    -X2*X6      CLEAR *AL* FIELD
          BX6    X1+X6       SAVE *AL* FIELD OF EST
          SA6    A0
          SA0    A0+B1
          EQ     BRE1        CONTINUE EST SCAN
 
 BRE1.2   BX7    -X2*X4      MST ADDRESS
          SA7    BREA        SAVE MST ADDRESS
          MX6    1
          LX7    3
          SA6    BUF
          RDSB   0,MSTL,X7,A6  READ MST
          MX2    -11
          LX4    -12
          BX7    -X2*X4      DEVICE TYPE
          MX2    -3
          SA3    BUF+DDLL    NUMBER OF UNITS
          LX3    12
          BX5    -X2*X3
          LX7    6
          SX2    X5+1R1
          BX1    X7+X2
          LX1    42
          AX7    6
          RJ     GRI         GET RESOURCE INDEX
          ZR     B2,BRE16    IF NO MATCH
          SA2    BREB        MASK FOR FULL TRACK CONTROLLER
          LX4    12
          BX1    X4-X2
          SB7    X6
          BX6    X2*X1
          SA1    BUF+DILL
          LX1    59-22
          NG     X1,BRE2     IF BUFFERED DEVICE
          ZR     X6,BRE2     IF NOT CONNECTED TO FULL TRACK CONTROLLER
          SB4    TRSLL1
          RJ     GRL         GET INDEX OF RESOURCE LIST
          NG     B4,BRE2     IF RESOURCE NOT FOUND
          SX7    B4+4000B    SET RESOURCE LIST INDICATOR AND FLAG
 BRE2     SA3    BUF+DDLL
          SA1    BUF+PFGL
          MX2    6
          LX4    59-41
          BX2    X2*X4
          BX7    X7+X2       CHANNEL 1
          LX4    59-29-59+41
          MX2    6
          BX2    X2*X4
          LX2    -6
          BX7    X7+X2       CHANNEL 2
          LX7    0-9-12
          BX7    X7+X5
          MX2    -3
          LX3    -51
          BX5    -X2*X1      NUMBER OF MULTI-UNITS
          LX7    3
          BX6    -X2*X3      ORIGINAL NUMBER OF UNITS
          LX1    -3
          SA3    BUF+STLL
          BX7    X7+X6
          LX3    -3
          BX1    -X2*X1      RELATIVE UNIT NUMBER
          MX2    -9
          BX6    -X2*X3      NEXT EQUIPMENT
          LX4    59-54-59+29
          SX2    B5          EST ORDINAL
          LX6    12
          BX6    X6+X2
          LX6    12
          MX2    -1
          BX1    X1-X5
          LX7    6
          BX2    -X2*X4      LDAM STATUS
          BX7    X7+X6
          LX2    3
          BX7    X7+X2
          SX6    4
          BX5    X4
          NZ     X1,BRE3     IF NOT END OF CHAIN
          BX7    X6+X7
 BRE3     LX3    -12+3       GET USER COUNT
          MX2    -12
          LX5    54-59+1-49
          SX6    B1+B1
          BX2    -X2*X3
          BX1    X6*X5       SAVE *OFF*/*DOWN* FLAG
          BX7    X7+X1
          BX5    -X5*X6      GET *OFF*/*DOWN* FLAG
          SA7    RET+B3      ENTER RESOURCE EQUIPMENT TABLE
          SX6    B3-RETL
          ZR     X6,BRE16    IF TABLE OVERFLOW
          SB3    B3+B1
          BX1    X2+X5
          ZR     X1,BRE1     IF DEVICE *OFF*/*DOWN* WITH NO USER COUNT
          SA1    BUF+MDGL    CHECK FOR FAMILY DEVICE
          NG     X4,BRE1     IF DEVICE UNAVAILABLE
          LX1    59-58
          MX6    1
          PL     X1,BRE1     IF FAMILY DEVICE
          SA4    BUF+PFGL
          LX3    59-51+12
          SX7    B5
          ZR     X5,BRE4     IF DEVICE *OFF*/*DOWN* WITH USER COUNT
          PL     X3,BRE5     IF PACK NOT UNLOADED
          ZR     X2,BRE1     IF NO USER COUNT
 BRE4     LX6    33-59+12    SET UNLOAD FLAG
          BX7    X7+X6
 BRE5     SA1    BUF+DALL
          LX1    59-55
          MX6    1
          BX6    X6*X1       GET SUSPECT STATUS
          LX6    31-59+12
          BX7    X6+X7       SET SUSPECT FLAG
          MX1    42
          BX4    X1*X4       PACKNAME
          SA1    BREA        MST ADDRESS
          SX5    B7          UNIT COUNT
          LX7    -24
          BX6    X5+X4       PACKNAME/INDEX
          BX7    X7+X1
          LX7    12
          SB2    B3+B3
          SA6    EVSB-2+B2   ENTER EVSB WORD 1
          SA7    A6+B1       ENTER EVSB WORD 2
          ZR     X2,BRE1     IF NO USERS
          MX5    1
          LX5    35-59
          BX7    X7+X5
          SA7    A7
          EQ     BRE1        PROCESS NEXT EQUIPMENT
 
*         READ UDT,S FROM MAGNET.
 
 BRE7     SA4    SBUF2+/COMSMTX/UBUF  INITIALIZE POINTERS TO READ UDT-S
          SB2    -100B
          ZR     X4,BRE17    IF UDT POINTER ZERO
          SX6    X4
          AX4    24
          SA6    BREA
          SX7    B2+SBUF2
          SA7    A6+1
          SX7    X6+B2
          SA7    A7+B1
          SX7    X4+B1
          SA7    A7+B1
          SA1    SBUF2       SET *MAGNET* IDLEDOWN INDICATOR
          BX6    X1
          LX6    59-15
          SA6    MIDI
          EQ     BRE11       READ UDT,S
 
 BRE8     RETRF  D           RETURN DEMAND FILE
          RJ     DLY         WAIT FOR *MAGNET* EXTERNAL CALLS
          EQ     BRE0        RETRY BUILD OF ENVIRONMENT
 
 BRE9     SX6    B3          SAVE RET/EVSB TAPE INDEX
          BX7    X7-X7       READ FROM *MAGNET* RA+0
          SA6    RETI
          SX6    SBUF2       SET UP TO READ UDT POINTER WORD
          SA7    A0          SET END OF TAPE EST ENTRIES
          MX0    1           PRESET *MAGNET* MISSING FLAG
          SX5    /COMSMTX/UBUF+1  SET WORD COUNT
          SA7    BREA
 BRE10    RDSB   MTSI,X5,X7,X6,X  READ UDT WORD
          SA2    SS          READ STATUS WORD
          NG     X2,BRE11    IF TRANSFER COMPLETE
          LX2    1
          PL     X2,ERR2     IF SYSTEM COMMUNICATION ERROR
          EQ     BREX        RETURN WITH *MAGNET* MISSING STATUS
 
 BRE11    SA2    BREA
          ZR     X2,BRE7     IF POINTER READ
          SA2    A2+B1
          SA3    A2+B1
          SB2    100B
          SA4    A3+B1
          SX6    X2+B2
          SX7    X3+B2
          SA6    A2
          SA7    A3
          SB7    X7+B2
          SX5    B2
          SB5    X4
          GE     B5,B7,BRE10 IF MORE THAN 100 WORD BLOCKS TO TRANSFER
          SB7    /COMSMTX/UNITL
          IX5    X4-X7
          PL     X5,BRE10    IF LAST SHORT BLOCK TO TRANSFER
          SB5    -B7
 
*         PROCESS MAGNETIC TAPES.
 
 BRE12    SB5    B5+B7
          SA2    B5+SBUF2
          SX0    B1          SET ENVIRONMENT BUILD COMPLETE STATUS
          NG     X2,BRE17    IF ALL UDTS PROCESSED
          SA4    B5+SBUF2+/COMSMTX/UST4
          SA3    B5+SBUF2+/COMSMTX/UST1
          MX0    -2
          LX4    0-55
          LX3    59-37
          BX4    -X0*X4      TAPE DEVICE TYPE
          SA5    TTDV+X4
          SX0    X5          SET DEVICE MNEMONIC
          SX4    X4-/COMSMTX/DVNT
          AX5    18          SET RESOURCE TYPE
          NZ     X4,BRE13    IF NOT *NT* DEVICE
          SX0    TRHD+4000B  SET HD, PE, NT RESOURCE LIST
          SX5    RHDP
          PL     X3,BRE13    IF 800/1600 NT DRIVE
          SX0    TRGE+4000B  SET PE, GE RESOURCE LIST
          SX5    RGEP
 BRE13    MX2    -12
          LX3    0-24-59+37
          BX4    -X2*X3      EST ORDINAL
          LX0    -12
          SA1    BUF2-1
 BRE13.1  SA1    A1+B1
          ZR     X1,BRE16    IF EST ENTRY NOT FOUND
          BX6    -X2*X1
          BX6    X6-X4
          NZ     X6,BRE13.1  IF NOT CORRECT EST ENTRY
          LX2    36
          BX6    -X2*X1      EXTRACT PRIMARY CHANNEL
          LX6    59-46
          PL     X6,BRE13.3  IF PRIMARY CHANNEL UP
          LX2    -12
          BX6    -X2*X1
          ZR     X6,BRE13.2  IF NO SECONDARY CHANNEL
          LX6    59-34
          PL     X6,BRE13.3  IF SECONDARY CHANNEL UP
 BRE13.2  BX2    X4          ALL CHANNELS DOWN
          LX2    12
          SX7    B1+B1       SET *OFF* FLAG
          BX2    X2+X7
          EQ     BRE15       TREAT AS IF UNIT *OFF*
 
 BRE13.3  BX2    X4
          LX4    -12
          LX1    -48         POSITION DEVICE STATE
          SX7    2
          LX2    12
          BX7    X7*X1       EXTRACT *OFF*/*DOWN* STATUS
          BX2    X2+X7
          LX1    48-30       POSITION ACCESS LEVEL
          MX3    6
          BX3    X1*X3
          LX3    -12
          BX2    X2+X3       ACCESS LEVEL
          LX3    14-59-0+12
          BX5    X3+X5       SAVE ACCESS LEVEL IN *EVSB*
          SA1    B5+SBUF2+/COMSMTX/UVRI
          MX6    12
          BX1    X6*X1       ASSIGNED JOB EJT ORDINAL
          NZ     X1,BRE13.4  IF UNIT ASSIGNED
          NZ     X7,BRE15    IF OFF AND NOT ASSIGNED
 BRE13.4  SA3    B5+SBUF2+/COMSMTX/UVSN
          SX6    B0+         SET NO VSN
          ZR     X3,BRE13.5  IF LABELS NOT READ
          LX3    59-23
          NG     X3,BRE13.5  IF LABEL CHECK IN PROGRESS
          LX3    23-23-59+23
          BX6    X3          USE INTERNAL VSN
          SA3    B5+SBUF2+/COMSMTX/UST1
          LX3    59-49
          MX7    -2
          PL     X3,BRE13.5  IF NOT ACS UNIT
          SA3    B5+SBUF2+/COMSMTX/UMST
          BX6    X3          USE EXTERNAL VSN
          BX7    -X7*X3      ACS UNIT MOUNT STATUS
          SX7    X7-2
          ZR     X7,BRE13.5  IF UNIT MOUNTED
          SX6    B0+         SET NO VSN
 BRE13.5  LX1    12          POSITION EJT ORDINAL
          MX7    36
          BX6    X7*X6       VSN
          BX7    X6+X1
          ZR     X7,BRE15    IF NO VSN AND NOT ASSIGNED
          SA3    B5+SBUF2+/COMSMTX/UVSN  GET LABEL FLAGS
          BX6    X6+X5       MERGE VSN IN EVSB WORD 1
          SX5    B1
          LX5    34
          LX3    34-22
          BX7    X5*X3
          BX4    X7+X4       MERGE SCRATCH VSN BIT
          LX3    32-14-34+22
          LX5    32-34
          BX7    X5*X3
          LX5    35-32
          SA3    BREA
          BX4    X7+X4       MERGE DEFAULT VSN BIT
          BX4    X4+X1
          SX3    X3+B5       UDT ADDRESS
          SB2    B3+B3
          SA6    EVSB+B2     ENTER EVSB WORD 1
          LX3    12
          ZR     X1,BRE14    IF NOT ASSIGNED
          BX4    X4+X5       MERGE ASSIGNED BIT
 BRE14    BX7    X3+X4       MERGE UDT ADDRESS
          SA7    A6+B1       ENTER EVSB WORD 2
 BRE15    BX7    X0+X2
          SA7    RET+B3      ENTER RESOURCE EQUIPMENT TABLE
          SB3    B3+B1
          SX6    B3-RETL-1
          NZ     X6,BRE12    IF NO TABLE OVERFLOW
 BRE16    SB2    /PER/REV    * RESOURCE ENVIRONMENT ERROR.*
          EQ     PER         PROCESS ERROR
 
 
 BREA     CON    0           UDT/MST ADDRESS TEMPORARY
          CON    0           SBUF2 POINTER
          CON    0           UDT POINTER
          CON    0           UDT LWA+1
 
 BREB     VFD    12/0,12/400B,12/400B,24/0  FULL TRACK CONTROLLER MASK
 BRT      SPACE  4,15
**        BRT - BUILD RESOURCE DEMAND TABLE.
*
*         ENTRY  (B2) = FWA DEMAND FILE ENTRY.
*                (B5) = 0, IF RESOURCE DEMANDS TO BE BUILT FROM
*                     REMAINING DEMANDS.
*                (B5) .NE. 0, IF RESOURCE DEMANDS TO BE BUILT FROM
*                     TOTAL DEMANDS.
*
*         EXIT   (B6) = FWA RESOURCES DEMANDED TABLE.
*                (B7) = LWA+1 RESOURCES DEMANDED TABLE.
*                (X5) .LT. 0, IF TOTAL ASSIGNS EXCEED TOTAL DEMAND.
*
*         USES   A - 1, 2, 6, 7.
*                B - 2, 3, 4, 6, 7.
*                X - ALL.
 
 
 BRT6     SB7    B7-B1
          PL     B7,BRT1     IF MORE TAPE/PACK RESOURCES
          SB7    A6+B1       LWA+1 RESOURCES DEMANDED TABLE
 
 BRT      SUBR               ENTRY/EXIT
          SB6    RDT         INITIALIZE REGISTERS
          SB7    RRPL+RMTL-2
          SA1    B6-B1
          MX0    -6
          SA2    B2+RMTP
          BX6    X1
          MX4    12
          SA6    A1
          BX6    X6-X6
 
*         SEARCH DEMAND FILE ENTRY FOR RESOURCE REQUESTS.
 
 BRT1     SA1    A2+B7       GET DEMAND TABLE ENTRY
          SX2    B7-RMTL
          BX3    X4*X1       GET RESOURCE TYPE
          SB3    RPEW        TAPE ENTRIES PER RESOURCE WORD
          SB4    B3+B3       INITIALIZE ACCESS LEVEL COUNT
          SA1    A1+B1       READ SECOND WORD
          SB2    -B1
 
*         SEARCH DEMAND FILE WORD FOR RESOURCE REQUESTS.
 
 BRT2     BX5    -X0*X1      DEMAND
          LX1    -6
          NZ     B5,BRT3     IF TOTAL DEMANDS TO BE USED
          BX7    -X0*X1      ASSIGNED
          IX5    X5-X7       USE REMAINING DEMANDS
          NG     X5,BRTX     IF TOTAL ASSIGNS EXCEED TOTAL DEMAND
 BRT3     ZR     X5,BRT5     IF DEMAND SATISFIED OR NOT SPECIFIED
          SX7    B4          NUMBER OF PHYSICAL UNITS ON DEVICE
          LX7    42
          PL     X2,BRT4     IF NOT A TAPE UNIT
          SX7    B4-B1
          SX7    X7+100B
          LX7    36
 
*         ENTER *RDT* FOR EACH RESOURCE REQUESTED
 
 BRT4     BX7    X7+X3
          SX5    X5+B2
          SA7    A6+B1       ENTER RESOURCE DEMAND IN RDT
          SA6    A7+B1
 BRT5     NZ     X5,BRT4     IF MORE DEMANDS FOR THIS RESOURCE
          LX1    -6          POSITION TO NEXT DEMAND FOR RESOURCE TYPE
          SB4    B4-B1       NEXT UNIT COUNT
          GT     B4,B3,BRT2  IF MORE RESOURCE DEMANDS IN THIS WORD
          SB3    B0
          SA1    A2+B7       READ FIRST WORD FOR PACKS
          GT     B4,B3,BRT2  IF NOT END OF PACK RESOURCES
          SB7    B7-B1
          EQ     BRT6        ADVANCE TO NEXT DISK/TAPE RESOURCE
 BSF      SPACE  4,15
**        BSF - BUILD SCRATCH FILE.
*
*         ENTRY  USER RESOURCE REQUEST BLOCK BUILT.
*                DEMAND FILE INTERLOCKED.
*
*         EXIT   SCRATCH FILE BUILT WITH ALL JOBS HAVING ASSIGNED
*                RESOURCES, EXCEPT REQUESTOR.
*
*         USES   A - 1, 3, 7.
*                X - 1, 3, 4, 7.
*
*         CALLS CAU.
*
*         MACROS READ, READW, REWIND, WRITEW.
 
 
 BSF      SUBR               ENTRY/EXIT
          MX7    0
          SA7    NS1         CLEAR NUMBER OF JOBS
          REWIND D
          READ   X2          READ DEMAND FILE
          REWIND S1,R
 BSF1     READW  D,BUF,RDEL
          NZ     X1,BSFX     IF EOR
          SA3    BUF+RJID    GET JOB IDENTIFICATION
          ZR     X3,BSF1     IF NO JOB
          SA1    RESB+RJID   CHECK IF REQUESTOR
          BX1    X1-X3
          ZR     X1,BSF1     IF REQUESTOR
          SX4    A3
          RJ     CAU         COUNT ASSIGNED UNITS
          ZR     B3,BSF1     IF NO UNITS ASSIGNED
          WRITEW S1,BUF,RDEL COPY ENTRY TO SCRATCH FILE
          SA1    NS1         INCREMENT JOB COUNT
          SX7    X1+B1
          SA7    A1
          EQ     BSF1        CONTINUE PROCESSING DEMAND ENTRIES
 CFU      SPACE  4,25
**        CFU - CHECK FOR UNIT.
*
*         ENTRY  ENVIRONMENT AND USER RESOURCE REQUEST BLOCK BUILT.
*                (EQ) = EST ORDINAL IF SPECIFIED.
*                RESB = REQUESTOR DEMAND ENTRY.
*                VSNE = VSN ENTRY FOR TAPES.
*
*         EXIT   (AV) = EVSB ADDRESS OF VSN MATCH.
*                (AV) = 0 IF VSN MISSING.
*                (AU) = MAGNET UDT ADDRESS IF VSN NOT MISSING.
*                UNIT ASSIGNED TO REQUESTOR.
*                TO *COMX*, IF REQUEST NOT SATISFIABLE OR DUPLICATE
*                     SHARE TABLE ENTRY ALREADY PRESENT.
*                     (X2) = STATUS.
*                TO *COM5* IF OPERATOR ASSIGNMENT OF EQUIPMENT
*                     NEEDED AND CAN BE SATISFIED.
*                TO *COM6*, IF OPERATOR SELECTION REQUIRED FOR
*                     DUPLICATE VSN.
*                TO *COM6*, IF OPERATOR VALIDATION REQUIRED FOR *TMS*
*                            REQUEST.
*
*         ERROR  TO *PER*, IF ENVIRONMENT, EQUIPMENT, SHARE TABLE,
*                     INCORRECT ACCESS, OR DEMAND ERROR.
*
*         USES   A - ALL.
*                B - 2, 3, 4, 5, 6, 7.
*                X - ALL.
*
*         CALLS  CBP, CIC, CRM, DDS, IAS, IRC, SDT.
 
 
 CFU      SUBR               ENTRY/EXIT
 CFU1     SA4    RI          PRESET RESOURCE INDEX AND UNIT COUNT
 
 CFU2     SA2    RI          CALCULATE RESOURCE BYTE POSITION
          RJ     CBP
          BX7    X7-X7
          SA7    AU          CLEAR VSN AND UDT POINTERS
          SA2    B2+RESB
          SA7    AV
          AX2    B4
          MX0    -6
          BX5    -X0*X2      DEMAND COUNT
          LX2    -6
          SB7    B2-RRPP     REMOVABLE PACKS FLAG
          BX3    -X0*X2      ASSIGNED COUNT
          IX6    X3-X5       POSITIVE IF DEMAND REACHED OR EXCEEDED
          SX5    B7
          BX5    -X5+X6
          SA3    B0
          SB5    B0
          SA1    RQ
          PL     X5,CFU24    IF DEMAND REACHED FOR TAPE EQUIPMENT
          SA5    CFUA        CHECK FOR SCRATCH VSN
          BX7    X1-X5
          SA6    A5+B1       DEMAND EXCEEDED FLAG
          AX7    17
          SB2    B1+B1
          SB6    EVSB
          SA2    RETE        GET ENDING RET/EVSB INDEX
          SB3    B1
          LX2    1           2 WORDS PER ENTRY IN EVSB
          SB4    EVSB+X2
          NZ     X7,CFU3     IF NOT SCRATCH REQUEST
          SA2    EQ
          NZ     X2,CFU3     IF EST ORDINAL SPECIFIED
          SB3    B0
          EQ     CFU4        SEARCH FOR SCRATCH VSN
 
*         SEARCH ENVIRONMENT FOR CORRECT VSN AND NO DUPLICATE VSN,S.
 
 CFU3     NZ     B5,COM6     IF DUPLICATE VSN FOUND
          SB5    A3+         INDICATE VSN FOUND
          ZR     B3,CFU6     IF SCRATCH REQUEST
 CFU4     EQ     B6,B4,CFU6  IF END OF EVSB
          SA3    B6
          SB6    B6+B2
          ZR     X3,CFU4     IF EMPTY ENTRY
          SA2    A3+B1
          BX5    X1-X3
          LX2    59-34
          AX5    18
          ZR     X5,CFU5     IF MATCH
          NZ     B3,CFU4     IF NOT SCRATCH VSN REQUEST
          PL     X2,CFU4     IF NOT SCRATCH VSN
 CFU5     LX2    59-33-59+34
          BX0    X4
          NG     X2,CFU4     IF PACK UNLOADED
          LX2    59-31-59+33
          NG     X2,CFU4     IF DEVICE SUSPECT
          SX5    X3          EQUIPMENT RESOURCE INDEX AND BYTE POINTER
          SA2    OI          GET ORIGINAL TAPE DENSITY INDEX
          RJ     CRM         CHECK FOR MATCHING RESOURCES
          NZ     X7,CFU4     IF NO MATCH
          PL     B7,CFU7     IF REMOVABLE PACK
          SA2    A3+B1
          MX7    -12
          BX5    -X7*X2
          SX7    A3
          NZ     X5,CFU4     IF TAPE ASSIGNED
          RJ     CAL         CHECK ACCESS LEVEL
          NZ     X5,CFU4     IF NOT CORRECT EQUIPMENT
          SA2    EQ          EQUIPMENT NUMBER
          ZR     X2,CFU3     IF EQUIPMENT NOT SPECIFIED
          SX7    A3
          SA1    TPAL        TAPE ACCESS LEVEL
          PL     X1,CFU10    IF A LEGAL ACCESS LEVEL
          SB2    /PER/IAL    * INCORRECT ACCESS LEVEL FOR EQUIPMENT.*
          EQ     PER         PROCESS ERROR
 
 CFU6     ZR     B5,CFU11    IF VSN NOT FOUND
          SA5    B5+B1
          SX7    B5
          LX5    59-32
          ZR     B3,CFU10    IF SCRATCH VSN REQUEST
          PL     X5,CFU10    IF NOT DEFAULT VSN
          SA2    OT
          SA3    SSJ=+/COMSSSJ/AACS
          SX2    X2-SYOT
          ZR     X2,CFU10    IF SYSTEM ORIGIN
          LX3    59-4
          NG     X3,CFU10    IF PERMITTED TO REQUEST BY DEFAULT VSN
          SB2    /PER/UAV    * USER ACCESS NOT VALID.*
          EQ     PER
 
*         PROCESS REMOVABLE PACK.
 
 CFU7     SB4    RRPS
          SB5    RRPS+RPSL
          SB6    B0
          SX7    A3
          SB2    RESB
 CFU8     EQ     B4,B5,CFU9  IF SHARE TABLE COMPLETED
          SA4    B4+B2
          BX6    X4-X3
          SB4    B4+B1
          AX6    18
          ZR     X6,CFU22    IF PACKNAME MATCH (DUPLICATE)
          NZ     X4,CFU8     IF ENTRY PRESENT
          NZ     B6,CFU8     IF EMPTY ALREADY FOUND
          SB6    A4
          EQ     CFU8        CONTINUE SCAN OF SHARE TABLE
 
 CFU9     ZR     B6,CFU23    IF SHARE TABLE FULL (ERROR)
          SA2    CFUB        CHECK FOR DEMAND EXCEEDED
          PL     X2,CFU24    IF DEMAND EXCEEDED
          BX6    X3
          SA6    B6          STORE ENTRY IN SHARE TABLE
 CFU10    SA5    TMPF        CHECK VALIDATION REQUIRED FLAG
          LX5    59-56
          NG     X5,COM6     IF VALIDATION REQUIRED
          SA7    AV          SET ASSIGNED VSN POINTER
          SA5    X7+B1       SAVE ORIGINAL EVSB+1 ENTRY
          BX6    X5
          SB5    B0+         INCREMENT TOTAL AND RESOURCE ASSIGN COUNTS
          SA6    CFUF+1
          RJ     IRC
          SX0    B1
          LX0    36-0
          IX5    X5+X0       SHARE PACK (RESERVE TAPE)
          LX0    35-0-36+0
          BX6    X0+X5       SET ASSIGNED BIT
          SA6    A5
          PL     B7,CFUX     IF REMOVABLE PACKS
          SA3    RESB+RJID   INDICATE ASSIGNEE
          MX0    -12
          BX3    -X0*X3
          BX6    X6+X3
          SA6    A5+
          MX0    -12
          LX6    -12
          BX7    -X0*X6      UDT ADDRESS
          SA7    AU          SAVE UDT ADDRESS
 
*         CHECK FOR INTERNAL CONFLICT ON SCRATCH REQUEST.
 
          NZ     B3,CFUX     IF NOT SCRATCH REQUEST
          MX0    -6
          BX0    -X0*X4
          SX0    X0-RPEP
          NZ     X0,CFU10.1  IF NOT *PE* REQUEST
          RJ     CIC         CHECK FOR INTERNAL CONFLICT
          ZR     X2,CFU10.1  IF DEMANDS SATISFIABLE
          SA4    CFUF+1      RESTORE ORIGINAL EVSB+1 ENTRY
          SA5    AV
          BX6    X4
          SB5    -B1         DECREMENT TOTAL AND RESOURCE ASSIGN COUNTS
          SA6    X5+B1
          RJ     IRC
          SA4    X5          SWITCH 9-TRACK DRIVE TYPE
          RJ     SDT
          SX6    B0+
          SA6    AU          CLEAR UDT ADDRESS
          SA6    AV          CLEAR ASSIGNED VSN POINTER
          EQ     CFU2        RESELECT WITH CORRECT DRIVE TYPE
 
*         SET VSN FOR SCRATCH TAPE ASSIGNMENT.
 
 CFU10.1  SA1    AV          GET *EVSB* POINTER
          SA1    X1+         GET VSN
          MX7    36
          BX7    X7*X1
          SA7    EVSN        SET EXTERNAL VSN
          SA7    IVSN        SET INTERNAL VSN
          EQ     CFUX        RETURN
 
*         PROCESS VSN/PACK NOT FOUND.
 
 CFU11    PL     B7,CFU13    IF REMOVABLE PACK
          SA2    EQ
          NZ     X2,CFU25    IF EQUIPMENT SPECIFIED
          EQ     CFU14       BUILD PSEUDO EVSB ENTRY
 
 CFU13    SA2    CFUB        CHECK FOR DEMAND EXCEEDED
          PL     X2,CFU24    IF DEMAND EXCEEDED
 CFU14    SB5    B0          INCREMENT TOTAL AND RESOURCE ASSIGN COUNTS
          RJ     IRC
          SA1    RQ          BUILD RESOURCE DEMANDED TABLE
          MX2    -6
          BX2    -X2*X1
          SX6    X1+B1
          SA3    AL          ACCESS LEVEL
          LX3    35          POSITION ACCESS LEVEL
          ZR     X2,CFU15    IF TAPE RESOURCE
          SX3    B0+
          SX6    X1-1R0      SET UNIT COUNT
 CFU15    LX6    42
          BX7    X7-X7
          SB7    CFUC+2
          BX6    X6+X3
          SA6    CFUC
          BX3    X3-X3       SET IAS OPTION FOR ALL EQUIPMENTS
          SB6    A6
          SA7    A6+B1
          RJ     IAS         INITIALIZE ASSIGNMENTS
          RJ     DDS         SATISFY THIS DEMAND
          SA1    AA
          BX7    X2          SAVE SATISFIABILITY STATUS
          BX1    X1+X2
          SA2    EQ
          SA7    CFUE
          BX1    X1+X2
          CX1    X1
          ZR     X1,COM5     IF OPERATOR ASSIGNMENT NEEDED
          SA4    JEEO        GET REQUESTING JOB EJT ORDINAL
          SA3    CFUC        BUILD WORKING TABLE ENTRIES
          SA5    RI
          LX3    -27
          MX0    -9
          BX7    -X0*X3      FIRST EQUIPMENT RET INDEX
          LX0    12
          SA2    RET+X7
          SB2    X7
          BX7    -X0*X2      EST ORDINAL
          LX7    -24
          MX6    42
          BX4    X7+X4
          SX3    B1          SET USER COUNT
          SA1    RQ
          LX3    36
          BX1    X6*X1
          BX6    X5+X1
          BX4    X4+X3
          SA6    CFUB        SAVE SHARE TABLE ENTRY
          LX3    35-0-36+0   SET ASSIGNED BIT
          BX7    X4+X3
          SA3    CFUE
          NZ     X3,CFU19    IF DEMAND NOT SATISFIABLE
          SB2    B2+B2       EVSB INDEX
          SA3    EVSB+B2     SAVE ORIGINAL EVSB ENTRY
          BX6    X3
          SA6    CFUF
          SA4    A3+B1
          BX6    X4
          SA6    A6+B1
          SA7    A4
          PL     X2,CFU17    IF NOT LIST INDEX
          LX7    X2,B1       GET EQUIPMENT RESOURCE INDEX
          AX7    49
          SX4    X7-TRSLL1
          NG     X4,CFU17    IF REMOVABLE PACK EQUIPMENT
          SX5    RHDP
          ZR     X4,CFU17    IF *HD* EQUIPMENT
          SX5    RGEP
 CFU17    BX6    X1+X5
          SA1    CFUF        ORIGINAL EVSB ENTRY
          MX0    6
          LX0    11-59
          BX1    X0*X1       ACCESS LEVEL RANGE
          BX6    -X0*X6      CLEAR OLD VALUE
          BX6    X1+X6
          SA6    A3
          MX6    -36
          SA1    CFUD
          MX0    -9
          BX1    -X6*X1
          NZ     X1,CFU18    IF END OF CHAIN IN SECOND WORD
          SA1    A1-B1       END OF CHAIN IN FIRST WORD
 CFU18    BX5    -X0*X1
          LX1    -9
          ZR     X5,CFU18    IF NOT END OF CHAIN
          SX7    B1
          LX7    2
          SA2    X5+RET      SET END OF CHAIN
          BX7    X7+X2
          SA7    A2
          SA1    CFUC        CHECK FOR *PE* REQUEST
          AX1    48
          SX1    X1-2RPE
          NZ     X1,CFU19    IF NOT *PE* REQUEST
 
*         CHECK FOR INTERNAL CONFLICT ON SELECTED *PE* DRIVE.
 
          SX6    A3          SAVE EVSB ENTRY ADDRESS
          SA6    A1
          RJ     CIC         CHECK FOR INTERNAL CONFLICT
          ZR     X2,CFU19    IF DEMAND SATISFIABLE
          SA5    CFUC        GET EVSB ENTRY ADDRESS
          SA4    X5          GET 9-TRACK DRIVE TYPE
          SA1    CFUF        RESET ORIGINAL EVSB ENTRY
          SA2    A1+B1
          BX6    X1
          LX7    X2
          SA6    X5
          SA7    X5+B1
          RJ     SDT         SWITCH 9-TRACK DRIVE TYPE
          LX6    6
          SX6    X6+B1
          EQ     CFU15       RESELECT WITH OPPOSITE DRIVE TYPE
 
 CFU19    SA1    RI          CHECK FOR TAPE EQUIPMENT
          MX0    -6
          BX1    -X0*X1
          SX1    X1-RRPP
          NG     X1,CFU21    IF TAPE EQUIPMENT
          SB5    RESB+RRPS-1 FIND EMPTY SHARE TABLE ENTRY
          SB6    RESB+RRPS+RPSL
 CFU20    SB5    B5+B1
          EQ     B5,B6,CFU23 IF END OF SHARE TABLE
          SA1    B5
          NZ     X1,CFU20    IF NOT EMPTY ENTRY
          SA2    CFUB        MAKE SHARE TABLE ENTRY
          BX7    X2
          SA7    B5
 CFU21    SA1    CFUE        CHECK SATISFIABILITY
          ZR     X1,CFUX     IF SATISFIABLE
          SX2    /STATUS/OV  FORCE OVERCOMMITMENT STATUS
          EQ     COMX        RETURN OVERCOMMITMENT STATUS
 
 CFU22    SX2    /STATUS/OK
          EQ     COMX        RETURN OK STATUS ON PACKNAME DUPLICATE
 
 CFU23    SB2    /PER/STE    * SHARE TABLE ERROR.*
          EQ     PER         PROCESS ERROR
 
 CFU24    SB2    /PER/DEX    * DEMAND EXCEEDED.*
          EQ     PER         PROCESS ERROR
 
 CFU25    SB2    /PER/EQN    * EQUIPMENT NOT AVAILABLE.*
          EQ     PER         PROCESS ERROR
 
 
 CFUA     VFD    36/6H      ,24/0      SCRATCH VSN
 CFUB     CON    0           DEMAND EXCEEDED FLAG/SHARE TABLE ENTRY
 CFUC     CON    0           RDT ENTRY
 CFUD     CON    0           RDT+1 ENTRY
 CFUE     CON    0           SATISFIABILITY STATUS
 CFUF     BSS    2           ORIGINAL EVSB ENTRY
 CIC      SPACE  4,10
**        CIC - CHECK FOR INTERNAL CONFLICT.
*
*         EXIT   (X2) = 0, IF DEMANDS SATISFIABLE.
*
*         ERROR  TO *PNE*, IF ASSIGNS EXCEED DEMANDS.
*
*         USES   A - 1, 3.
*                B - 2, 5.
*                X - 1, 3.
*
*         CALLS  BRT, DDS, IAS.
 
 
 CIC      SUBR               ENTRY/EXIT
          SA3    JEEO        GET JOB EJT ORDINAL
          RJ     IAS         INITIALIZE ASSIGNMENTS FOR THIS JOB
          SB2    RESB        BUILD RDT FROM REMAINING DEMANDS
          SB5    B0+
          RJ     BRT
          SB2    /PER/AXD    * JSQN ASSIGNS EXCEED DEMANDS.*
          SA1    JEEO        GET JOB EJT ORDINAL
          NG     X5,PNE      IF ASSIGNS EXCEED DEMANDS (ERROR)
          RJ     DDS         DETERMINE DEMAND SATISFACTION
          EQ     CICX        RETURN
 COE      SPACE  4,15
**        COE - CHECK FOR *OFF* OR *DOWN* EQUIPMENT.
*
*
*         ENTRY  (X2) = *COM* RETURN STATUS.
*
*         EXIT   (X2) = *COM* RETURN STATUS.
*                (X6) = *OFF* PREVIEW DISPLAY MESSAGE CODE IF *OFF* OR
*                       *DOWN* EQUIPMENT NEEDED TO SATISFY REQUEST.
*
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 2, 3, 6, 7.
*                B - 4, 5, 6, 7.
*
*         CALLS  DDS, IAS.
 
 
 COE      SUBR               ENTRY/EXIT
          SX6    X2+
          SA3    RQ          BUILD RESOURCES DEMANDED TABLE
          SA6    COEA        SAVE STATUS FOR LATER
          SA2    AL          GET ACCESS LEVEL
          MX5    -6
          BX5    -X5*X3
          SX6    X3+B1
          ZR     X5,COE1     IF TAPE REQUEST
          SX2    B0+
          SX6    X3-1R0      SET UNIT COUNT
 COE1     LX2    35          POSITION POSSIBLE ACCESS LEVEL
          LX6    42
          BX7    X7-X7
          BX6    X6+X2
          MX3    0
          SA6    COEB
          SA7    A6+B1
          SB6    A6          SET FWA OF DEMAND TABLE
          SB7    B6+2        SET LWA+1 OF DEMAND TABLE
          RJ     IAS         INITIALIZE ASSIGNMENTS
          SX1    B1
          SB4    RETL
          SX3    B1+B1
          SB5    B0+         CLEAR *OFF*/*DOWN* UNIT COUNT
 COE2     SA2    RET-1+B4    GET RESOURCE EQUIPMENT TABLE ENTRY
          SB4    B4-B1
          BX6    X3*X2       ISOLATE *OFF*/*DOWN* FLAG
          NG     B4,COE3     IF FINISHED WITH RESOURCE EQUIPMENT TABLE
          ZR     X6,COE2     IF UNIT NOT *OFF*/*DOWN*
          BX7    X2+X1       SET ASSIGNED FLAG
          SB5    B5+B1       INCREMENT COUNT OF *OFF*/*DOWN* UNITS
          SA7    A2
          EQ     COE2        CONTINUE PROCESSING
 
 COE3     ZR     B5,COE4     IF NO *OFF*/*DOWN* UNITS TO TEST
          RJ     DDS         DETERMINE DEMAND SATISFACTION
          SX6    B0+
          ZR     X2,COE4     IF DEMAND SATISFIED WITH ON UNITS
          SX6    OFF         SET *OFF*/*DOWN* EUIPMENT REQUIRED
 COE4     SA2    COEA        RESTORE RETURN STATUS
          EQ     COEX        RETURN
 
 
 COEA     CON    0           *COM* RETURN STATUS
 COEB     CON    0,0         RESOURCES DEMANDED TABLE ENTRY FOR *DDS*
 CRC      SPACE  4,10
**        CRC - CHECK REQUESTOR COMPLETE.
*
*         ENTRY  (B2) = FWA DEMAND FILE ENTRY.
*
*         EXIT   (X5) = 0 IF REQUESTOR COMPLETE.
*
*         USES   A - 1.
*                X - 1, 2, 5.
 
 
 CRC      SUBR               ENTRY/EXIT
          SA1    B2+RVAL     CHECK TOTAL DEMAND SATISFIED
          MX2    -12
          BX5    -X2*X1      TOTAL DEMAND
          LX1    -12
          BX2    -X2*X1      TOTAL ASSIGNED
          IX5    X5-X2
          EQ     CRCX        RETURN
 CRQ      SPACE  4,25
**        CRQ - CHECK REQUEST.
*
*         ENTRY  ENVIRONMENT AND USER RESOURCE REQUEST BLOCK BUILT.
*                (/CPA/RFCW) = DEMAND FILE INDEX.
*                (EQ) = EQUIPMENT, IF SPECIFIED.
*
*         EXIT   REQUESTOR DEMAND FILE ENTRY IN RESB BUFFER.
*                TO *COM4* IF ASSIGNMENT REJECTED DUE TO *MAGNET*
*                     IDLEDOWN.
*                TO *COM6*, IF OPERATOR SELECTED WRONG UNIT ON
*                     DUPLICATE VSN.
*
*         ERROR  TO *PER*, IF DEMAND FILE ENTRY MISSING, VSN/EQUIPMENT
*                     ASSIGNMENT MISSING, DENSITY CONFLICT, OR
*                     EQUIPMENT NOT AVAILABLE.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 5, 7.
*                X - ALL.
*
*         CALLS  CAU, CRM, CRV, CTA, IDE, IRC, RDF, SPI.
*
*         MACROS MOVE.
 
 
 CRQ      SUBR               ENTRY/EXIT
          SA2    RI          GET RESOURCE INDEX
          SA3    RQ          CHECK REQUEST
          MX4    -6
          SB2    /PER/EQN    * EQUIPMENT NOT AVAILABLE.*
          BX4    -X4*X2      RESOURCE DEMAND ENTRY INDEX
          MX0    42
          SX4    X4-RRPP
          BX5    X0*X3       VSN
          SA1    EQ
          ZR     X1,CRQ3     IF EQUIPMENT NOT SPECIFIED
          PL     X4,PER      IF REMOVABLE PACKS (ERROR)
          MX0    -12
          SB3    B1+B1
          MX7    12
          SA3    RETI        GET RET/EVSB BEGINNING TAPE INDEX
          LX3    1
          SA3    EVSB-2+X3
          SA4    RETE        GET RET/EVSB ENDING INDEX
          LX4    1
          SB5    EVSB+X4
 CRQ1     SA3    A3+B3       FIND EQUIPMENT IN EVSB
          SB7    A3-B5
          ZR     B7,CRQ10    IF END OF EVSB
          SA4    A3+B1
          ZR     X3,CRQ1     IF NO ENTRY
          BX6    X1-X4
          BX6    X7*X6
          NZ     X6,CRQ1     IF NO MATCH ON EST ORDINAL
          BX6    -X0*X4
          MX0    36
          ZR     X5,CRQ2     IF NOT DUPLICATE VSN
          BX0    X0*X3       CHECK FOR MATCHING VSN
          BX0    X0-X5
          NZ     X0,COM6     IF WRONG UNIT ASSIGNED
 CRQ2     NZ     X6,CRQ9     IF ALREADY ASSIGNED
          SX0    X2
          SX5    X3
          SA2    OI          GET ORIGINAL NT TAPE DENSITY INDEX
          RJ     CRM         CHECK FOR RESOURCE MATCH
          SB2    /PER/DEC    * NT DENSITY CONFLICT.*
          NZ     X7,CRQ9     IF DENSITY CONFLICT
          MX1    36
          BX6    X1*X3
          SA4    RQ          ENTER DEFAULT VSN INTO REQUEST
          SA6    IVSN        SET INTERNAL VSN
          SA6    EVSN        SET EXTERNAL VSN
          BX4    -X1*X4
          BX6    X6+X4
          SA6    A4
          EQ     CRQ4        GET DEMAND FILE ENTRY
 
 CRQ3     SA1    AA
          ZR     X1,CRQ4     IF OPERATOR TO ASSIGN EQUIPMENT
          SB2    /PER/MVE    * MISSING VSN OR EQUIPMENT ASSIGNMENT.*
          ZR     X5,PER      IF VSN NOT SPECIFIED (ERROR)
 CRQ4     RJ     IDE         INITIALIZE DEMAND ENTRY
          RJ     RDF         READ DEMAND FILE
          SA1    /CPA/RFCW
          SX1    X1
          SB2    /PER/MDE    * MISSING DEMAND FILE ENTRY.*
          ZR     X1,PER      IF NO DEMAND FILE ENTRY
          MOVE   RDEL,DBUF,RESB  COPY DEMAND FILE ENTRY
          SA1    RESB+RVAL   CHECK FOR LOST TAPES
          SX4    RESB        DEMAND FILE ENTRY ADDRESS
          LX1    59-53
          PL     X1,CRQ5     IF NO TAPE ASSIGNMENT LOST
          SB5    B0          GET MAGNETIC TAPE ASSIGNED COUNT
          RJ     CTA
          SB2    /PER/PTL    * PRIOR TAPE ASSIGNMENT LOST.*
          NZ     B3,PER      IF LOST TAPES NOT RETURNED
          MX2    1
          SA1    RESB+RVAL   CLEAR TAPE ASSIGNMENT LOST FLAG
          LX2    53-59
          BX6    -X2*X1
          SA6    A1
 CRQ5     SA3    JEEO        GET JOB EJT ORDINAL
          RJ     CAU         COUNT ASSIGNED UNITS
          NZ     B3,CRQ6     IF RESOURCES ASSIGNED
          SA1    MIDI        CHECK FOR *MAGNET* IDLEDOWN
          NG     X1,COM4     IF IDLEDOWN REQUESTED
 CRQ6     NZ     X7,CRQ7     IF DEMAND SPECIFIED
          SB5    B1          INCREMENT TOTAL AND RESOURCE DEMAND COUNTS
          SX7    B1          SET DEFAULT DEMAND INDICATOR
          SA7    DFDI
          RJ     IRC
          RJ     CRV         CHECK RESOURCE VALIDATION
 CRQ7     RJ     SPI         SET DEMAND FILE PREVIEW INFORMATION
          EQ     CRQX        RETURN
 
*         PROCESS TAPE UNIT ALREADY ASSIGNED OR DENSITY CONFLICT.
 
 CRQ9     SA1    AA
          NG     X1,COM6     IF DUPLICATE VSN CHOICE
          NZ     X1,PER      IF *ASSIGN* WITH EST ORDINAL SPECIFIED
 CRQ9.1   SX6    B0+         CLEAR OPERATOR ASSIGNED EQUIPMENT
          SA6    EQ
          EQ     CRQ4        COMPLETE CHECKS BEFORE EQUIPMENT REQUEST
 
*         PROCESS TAPE NOT MOUNTED.
 
 CRQ10    SA3    AA
          ZR     X3,CRQ9.1   IF OPERATOR ASSIGNMENT OF EQUIPMENT
          NG     X3,COM6     IF DUPLICATE VSN CHOICE
          EQ     PER         ABORT WITH EQUIPMENT NOT AVAILABLE
 DEI      SPACE  4,15
**        DEI - DEMAND EXCEEDS INSTALLATION CHECK.
*
*         ENTRY  RESOURCE ENVIRONMENT BUILT.
*                USER RESOURCE REQUEST BLOCK BUILT.
*
*         EXIT   TO CALLER IF SUFFICIENT RESOURCES PRESENT.
*                TO *PER*, IF SUFFICIENT RESOURCES NOT PRESENT.
*
*         USES   B - 2, 5.
*
*         CALLS  BRT, DDS.
 
 
 DEI      SUBR               ENTRY/EXIT
          SB2    RESB        BUILD RDT FROM TOTAL DEMANDS
          SB5    B1+
          RJ     BRT         BUILD RESOURCE DEMAND TABLE
          RJ     DDS         DETERMINE DEMAND SATISFACTION
          ZR     X2,DEIX     IF RESOURCE DEMAND SATISFIABLE
          SB2    /PER/IRS    * INSUFFICIENT RESOURCES ON SYSTEM.*
          EQ     PER         PROCESS ERROR
 OCA      SPACE  4,20
**        OCA - OVERCOMMITMENT ALGORITHM.
*
*         ENTRY  ENVIRONMENT BUILT.
*                USER RESOURCE REQUEST BLOCK BUILT.
*
*         EXIT   (X5) = 0 IF OVERCOMMITMENT.
*
*         ERROR  TO *PER*, IF SCRATCH FILE ERROR OR NEGATIVE SHARE
*                COUNT.
*                TO *PNE*, IF ASSIGNS EXCEED DEMANDS OR SHARE TABLE
*                     ERROR.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 2, 3, 5, 6, 7.
*                X - ALL.
*
*         CALLS  BRT, CRC, DDS, IAS.
*
*         MACROS READ, READW, REWIND, WRITER, WRITEW.
 
 
 OCA      SUBR               ENTRY/EXIT
          WRITEW S1,RESB,RDEL ENTER REQUESTOR ON SCRATCH FILE
          WRITER S1,R
          SA1    NS1         INCREMENT JOB COUNT
          SX6    X1+B1
          SA6    A1
 OCA1     SX7    B0+         CLEAR JOBS WRITTEN ON SCRATCH 2 COUNTER
          SA7    NS2
          REWIND S2
          REWIND S1
          READ   X2,R
 
 OCA2     READW  S1,BUF,RDEL READ SCRATCH 1 ENTRY
          NZ     X1,OCA9     IF EOR
          SA3    BUF+RJID    GET JOB EJT ORDINAL
          SB2    /PER/RSF    * RESOURCE SCRATCH FILE ERROR.*
          ZR     X3,PER      IF NO JOB (ERROR)
          BX3    X3-X3
          RJ     IAS         INITIALIZE ASSIGNMENTS
          SB2    BUF
          RJ     CRC         CHECK REQUEST COMPLETE
          ZR     X5,OCA3     IF TOTAL ASSIGNED = TOTAL DEMAND
          SB5    B0+         BUILD RDT FROM REMAINING DEMANDS
          RJ     BRT
          SB2    /PER/AXD    * JSQN ASSIGNS EXCEED DEMANDS.*
          NG     X5,OCA8     IF ASSIGNS EXCEED DEMANDS (ERROR)
          RJ     DDS         DETERMINE DEMAND SATISFACTION
          ZR     X2,OCA3     IF JOB COMPLETES
          WRITEW S2,BUF,RDEL COPY ENTRY TO SCRATCH 2
          SA1    NS2         ADVANCE NUMBER OF JOBS
          SX7    X1+B1
          SA7    A1
          EQ     OCA2
 
*         ADJUST ENVIRONMENT ON COMPLETED JOB.
*         RELEASE TAPES ASSIGNED TO THIS JOB.
 
 OCA3     SA1    RETI        GET RET/EVSB TAPE INDEX
          LX1    1
          SB3    EVSB+X1
          SA3    RETE        GET RET/EVSB ENDING INDEX
          LX3    1
          SB6    EVSB+X3
          SB7    B3          END OF REMOVABLE PACK ENTRIES
          SA3    BUF+RJID    GET JOB EJT ORDINAL
          MX4    -6
          SB2    /PER/REV    * RESOURCE ENVIRONMENT ERROR.*
          SB5    RRPS+RPSL-1
 OCA4     EQ     B3,B6,OCA5  IF END OF ENTRIES
          SA1    B3
          MX0    -12
          SB3    B3+2
          ZR     X1,OCA4     IF EMPTY ENTRY
          SA2    A1+B1
          BX5    X3-X2
          BX5    -X0*X5
          NZ     X5,OCA4     IF NOT ASSIGNED TO THIS JOB
          BX1    -X4*X1      GET RESOURCE INDEX
          MX0    1
          SX1    X1-RRPP
          PL     X1,PER      IF NOT MAGNETIC TAPE
          LX0    35-59
          BX6    -X0*X2      CLEAR PHYSICALLY ASSIGNED BIT
          SA6    A2
          EQ     OCA4        CONTINUE SCAN OF ENVIRONMENT
 
*         CHECK REMOVABLE PACK SHARING.
 
 OCA5     SA1    B5+BUF
          SX5    B5-RRPS
          NG     X5,OCA2     IF SHARE TABLE COMPLETE
          SB5    B5-B1
          MX0    -12
          ZR     X1,OCA5     IF NO SHARED ENTRY
          SB6    EVSB
          SB2    B1+B1
          SB3    -B1
          MX7    1
          LX7    35-59
 
*         DECREMENT USER COUNT ON SHARED PACK.
 
 OCA6     EQ     B6,B7,OCA7  IF NO MATCHING EVSB ENTRY
          SA3    B6
          SB6    B6+B2
          ZR     X3,OCA6     IF EMPTY ENTRY
          BX5    X3-X1
          AX5    18
          NZ     X5,OCA6     IF NO MATCH
          SA3    A3+B1       DECREMENT SHARE COUNT
          LX3    24
          BX5    -X0*X3
          BX6    X0*X3
          SX5    X5+B3
          BX6    X5+X6
          SB2    /PER/RNS    * RESOURCE NEGATIVE SHARE COUNT.*
          NG     X5,PER      IF SHARE COUNT NEGATIVE
          LX6    -24
          SA6    A3
          NZ     X5,OCA5     IF MORE SHARERS
          BX6    -X7*X6      CLEAR PHYSICALLY ASSIGNED BIT
          SA6    A6
          EQ     OCA5        CONTINUE SCAN OF SHARE TABLE
 
 OCA7     SB2    /PER/STM    * JSQN SHARE TABLE MISMATCH.*
 OCA8     SA1    BUF+RJID    GET JOB EJT ORDINAL
          EQ     PNE         PROCESS NAMED ERROR
 
*         CLOSE SCRATCH 2 FILE.
 
 OCA9     SA1    NS1
          SA2    A1+B1
          IX5    X1-X2
          ZR     X5,OCAX     IF NO JOBS COMPLETED ON THIS PASS
          ZR     X2,OCAX     IF NO MORE JOBS
 
*         SWAP SCRATCH 1 AND SCRATCH 2.
 
          WRITER S2,R
          REWIND S1,R
          REWIND S2,R
          SA2    X2
          SA1    S1
          BX6    X2
          LX7    X1
          SA6    A1
          SA1    NS2
          SA7    A2
          BX7    X1
          SA7    NS1
          EQ     OCA1        REPEAT LOOP
 
 
 NS1      CON    0           NUMBER OF JOBS IN SCRATCH 1
 NS2      CON    0           NUMBER OF JOBS IN SCRATCH 2
          TITLE  OVERCOMMITMENT UTILITY SUBROUTINES.
 CAU      SPACE  4,20
**        CAU - COUNT ASSIGNED UNITS.
*
*         ENTRY  (X3) = 48/,12/ JOB EJT ORDINAL.
*                (X4) = DEMAND ENTRY ADDRESS.
*
*         EXIT   ASSIGNED UNITS COUNTED FOR TAPES AND PACKS.
*                (B3) = ASSIGNED COUNT.
*                (X7) = TOTAL DEMAND COUNT.
*
*         ERROR  TO *PNE*, IF INDIVIDUAL RESOURCE ASSIGNED COUNT
*                ERROR.
*
*         USES   A - 1, 2, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                X - 0, 1, 2, 3, 5, 6, 7.
*
*         CALLS  CRM, CTA.
 
 
 CAU9     SB5    -B1         COUNT TOTAL ASSIGNS AND DEMANDS
          RJ     CTA
 
 CAU      SUBR               ENTRY/EXIT
          SX6    B1
          LX6    36          POSITION RESERVATION INCREMENT
          SA2    X4+RVAL     CHECK FOR LOST TAPES
          LX2    59-53
          NG     X2,CAU4     IF TAPE ASSIGNMENT LOST
          SB3    RMTP+RMTL   SET TAPE STARTING POSITION
          SA5    RETI        GET RET/EVSB TAPE INDEX
          SA1    RETE        GET RET/EVSB ENDING INDEX
          LX5    1
          LX1    1
          SB6    EVSB+X1
          SB7    EVSB+X5
 
*         CHECK MAGNETIC TAPES.
 
 CAU0     SB3    B3-B1
          SA0    B3-B1
          SB4    RPEW*2*100B RESOURCE BYTE POSITION
          SB2    6
 CAU1     SA2    X4+B3       RESOURCE DEMAND ENTRY
          MX0    -6
          AX2    B2
          BX5    -X0*X2      ASSIGNED COUNT
          ZR     X5,CAU3     IF NO ASSIGN COUNT
          SX0    A0+B4
          SB5    X5
          SA5    B7-B1
 CAU2     SA1    A5+B1       READ EVSB ENTRIES
          SX7    A1-B6
          ZR     X7,CAU8     IF EVSB SCAN COMPLETE
          SA5    A1+B1
          ZR     X1,CAU2     IF EMPTY ENTRY
          BX7    X6*X5
          NZ     X7,CAU2     IF UNIT ALREADY RESERVED
          BX7    X3-X5
          MX2    -12
          BX7    -X2*X7
          SX5    X1
          NZ     X7,CAU2     IF NO MATCH ON JOB ASSIGNMENT
          SX2    RPEP        FORCE *GE* EQUIPMENT MATCH FOR *NT*
          RJ     CRM         CHECK FOR MATCHING RESOURCES
          NZ     X7,CAU2     IF WRONG RESOURCE TYPE
          SA5    A5          INDICATE RESERVED
          BX7    X5+X6
          SA7    A5
          SB5    B5-B1
          NZ     B5,CAU2     IF MORE RESOURCES
 CAU3     SB4    B4-100B     DECREMENT RESOURCE BYTE POSITION
          SB5    RPEW*100B
          SB2    B2+12
          ZR     B4,CAU3.1   IF END OF THIS RESOURCE
          NE     B4,B5,CAU1  IF CONTINUE SAME RESOURCE WORD
          SB3    B3-B1       PROCESS FIRST WORD OF RESOURCE
          SB2    6
          EQ     CAU1        PROCESS RESOURCE
 
 CAU3.1   SB5    RMTP        FIRST TAPE ENTRY
          NE     B3,B5,CAU0  IF MORE TAPES TO PROCESS
 
*         COUNT ASSIGNED PACKS.
 
 CAU4     SB5    RPSL        SHARE TABLE LENGTH
          SA1    RRPS-1+X4
          EQ     CAU6        SCAN SHARE TABLE
 
 CAU5     BX7    X7-X7       CLEAR ENTRY
          SA7    A1
 CAU6     ZR     B5,CAU9     IF END OF SHARE TABLE
          SA1    A1+B1
          SB5    B5-B1
          ZR     X1,CAU6     IF NO ENTRY
          SA2    EVSB-2
 CAU7     SA2    A2+2
          BX7    X2-X1
          SX5    A2-B7
          ZR     X5,CAU8     IF END OF EVSB
          ZR     X2,CAU7     IF EMPTY ENTRY
          NZ     X7,CAU7     IF NO MATCH ON PACKNAME OR RESOURCE INDEX
          SA5    A2+B1
          IX7    X5+X6       COUNT AS SHARED
          SA7    A5
          EQ     CAU6        CONTINUE SCAN OF SHARE TABLE
 
 CAU8     SB2    /PER/MAR    * JSQN MISSING RESOURCE.*
          SA1    X4+RJID     GET JOB EJT ORDINAL
          EQ     PNE         PROCESS NAMED ERROR
 DDS      SPACE  4,20
**        DDS - DETERMINE DEMAND SATISFACTION.
*
*         ENTRY  (B6) = FWA OF RESOURCES DEMANDED TABLE (*RDT* FORMAT).
*                (B7) = LWA+1 OF RESOURCES DEMANDED TABLE.
*
*         EXIT   (X2) = 0 IF DEMAND SATISFIABLE.
*
*         ERROR  TO *PER*, IF ENVIRONMENT ERROR.
*
*         USES   A - ALL.
*                B - 2, 3, 4, 5, 6.
*                X - ALL.
*
*         CALLS  GRL.
 
 
 DDS      SUBR               ENTRY/EXIT
 
*         AN ATTEMPT IS MADE TO ASSIGN EQUIPMENTS AS FOLLOWS-
*
*         1. RESOURCE DEMANDS ARE SATISFIED WITH LARGER MULTI-SPINDLE
*            DEMANDS FIRST, TAPES LAST.
*
*         2. THE DEMAND IS SATISFIED BY A SINGLE EQUIPMENT WITH A *BEST
*            FIT* DETERMINED BY THE LARGEST SPINDLE RESIDUE.
*
*         3. THE DEMAND IS SATISFIED BY A CHAIN OF EQUIPMENTS WITH NO
*            REGARD TO SPINDLE OR EQUIPMENT RESIDUE AS A CRITERION FOR
*            A *BEST FIT*.
*
*         4. IF A RESOURCE DEMAND CANNOT BE SATISFIED, THEN THE
*            PREVIOUS DEMAND SATISFACTION IS NEGATED AND RETRIED (STEP
*            2).  THIS IS DONE UNTIL ALL POSSIBLE CHAINS HAVE BEEN
*            ATTEMPTED FOR ALL DEMANDED RESOURCES.
 
          SA2    RETE        GET RET ENDING INDEX
          SB3    RET+X2
 DDS1     BX2    X2-X2
          SA1    B6          READ RESOURCES DEMANDED TABLE ENTRY
          EQ     B6,B7,DDSX  IF COMPLETED
          BX7    X1
          AX7    48
          SB4    TRSLL2
          RJ     GRL         GET RESOURCE LIST INDEX
          SB4    -B4
          SX7    X7-2RPE
          SA0    B1
          NZ     X7,DDS2     IF NOT *PE* REQUEST
          SA0    -TRHD       SATISFY WITH *HD* OR *GE* EQUIPMENT
 DDS2     SB2    RET+1       FIND SINGLE EQUIPMENT WHICH MEETS DEMAND
          SA3    A1+B1
          SX6    -B1
          BX7    X7-X7
          SA6    TDDS        CLEAR TEMPORARIES
          SA7    A6+B1
          BX4    X1
          MX5    -6
          LX4    18
          BX4    -X5*X4      NUMBER OF UNITS REQUIRED
          MX5    12
          BX5    X5*X3       ORIGINAL EQUIPMENT
          ZR     X5,DDS3     IF FIRST ATTEMPT TO SATISFY
          SA5    DDSA        SET STARTING POSITION
          SB2    X5+RET+1
 DDS3     SA2    B2
          GE     B2,B3,DDS5  IF END OF RESOURCE EQUIPMENT TABLE
          SB2    B2+B1
          LX7    X2,B1
          BX5    X1-X2
          LX2    -1
          NG     X2,DDS3     IF LOGICALLY ASSIGNED
          AX5    48
          PL     X5,DDS4     IF NOT RESOURCE LIST INDEX
          AX7    49
          SX5    X7+B4
          SB5    A0+
          GT     B5,DDS4     IF NOT *PE* REQUEST
          ZR     X5,DDS4     IF MATCH
          SX5    X7+B5
 DDS4     LX2    -5
          NZ     X5,DDS3     IF NO MATCH
          SX0    B2-RET-1
          SA5    RETI        TAPE BEGINNING INDEX
          IX5    X0-X5
          NG     X5,DDS4.0   IF NOT A TAPE ENTRY
          RJ     CLM         CHECK LEVEL MATCH
          NG     X0,DDS3     IF LEVELS DO NOT MATCH
 DDS4.0   MX5    -3
          BX5    -X5*X2
          SX5    X5+B1
          IX6    X5-X4
          NG     X6,DDS3     IF INSUFFICIENT UNITS
          SA5    A6
          IX5    X6-X5
          NG     X5,DDS3     IF NOT BEST RESIDUE
          ZR     X5,DDS3     IF SAME RESIDUE
          SA6    A6          SAVE UNIT COUNT RESIDUE
          SX7    A2          SAVE RET ADDRESS
          SA7    A7
          EQ     DDS3        LOOP FOR BEST RESIDUE
 
 DDS5     SA5    A7
          ZR     X5,DDS6     IF SINGLE EQUIPMENT ENTRY NOT FOUND
          SA4    X5          LOGICALLY ASSIGN
          SX7    B1
          BX7    X7+X4
          SA7    A4
          SX6    A4-RET      RET INDEX
          LX6    27
          EQ     DDS18       CHECK FOR FIRST ATTEMPT TO SATISFY
 
 
*         ATTEMPT TO SATISFY DEMAND WITH CHAINED EQUIPMENT.
 
 DDS6     SB2    RET+1
          MX5    12
          BX5    X5*X3
          ZR     X5,DDS7     IF FIRST ATTEMPT TO SATISFY
          SA5    DDSA        SET STARTING POSITION
          SB2    X5+RET+1
 DDS7     LX4    X1
          BX7    X7-X7
          LX4    18
          MX2    -6
          BX4    -X2*X4      NUMBER OF UNITS REQUIRED
          SA7    DDSB        CLEAR LDAM CONTROL
          CLEAR  TDDS,TDDSL  CLEAR EQUIPMENT CHAIN TABLE
 DDS8     SA2    B2          READ RESOURCE EQUIPMENT TABLE ENTRY
          GE     B2,B3,DDS12 IF END OF TABLE
          SB2    B2+B1
          BX5    X1-X2
          LX7    X2,B1
          LX2    59-0
          NG     X2,DDS8     IF LOGICALLY ASSIGNED
          AX5    48
          PL     X5,DDS9     IF NOT RESOURCE LIST INDEX
          AX7    49
          SX5    X7+B4
          SB5    A0+
          GT     B5,DDS9     IF NOT *PE* REQUEST
          ZR     X5,DDS9     IF MATCH
          SX5    X7+B5
 DDS9     NZ     X5,DDS8     IF NO MATCH
          SX0    B2-RET-1
          SA5    RETI        TAPE BEGINNING INDEX
          IX5    X0-X5
          NG     X5,DDS9.0   IF NOT A TAPE ENTRY
          RJ     CLM         CHECK LEVEL MATCH
          NG     X0,DDS8     IF LEVELS DO NOT MATCH
 DDS9.0   BX7    X2
          LX7    59-3-59+0
          PL     X7,DDS11    IF NOT LDAM EQUIPMENT
          LX7    12-59+3
          MX0    12
          BX7    X0*X7       CHANNELS
          SX6    B2-B1       SET STARTER
          SA5    DDSB        COMPARE CHANNELS
          NZ     X5,DDS10    IF STARTER CHOSEN
          BX6    X7+X6
          SA6    A5
          EQ     DDS11       CHECK NUMBER OF UNITS
 
 DDS10    BX5    X0*X5
          BX0    X5-X7
          ZR     X0,DDS11    IF CHANNELS MATCH
          MX0    6           INTERCHANGE CHANNELS
          BX6    X0*X7
          LX7    6
          BX7    X0*X7
          LX6    -6
          BX7    X7+X6
          BX0    X5-X7
          NZ     X0,DDS12    IF CHANNELS DO NOT MATCH
 DDS11    LX2    -6-59+0+60  GET ORIGINAL SPINDLES
          MX5    -3
          BX5    -X5*X2
          SX5    X5+B1
          SX7    A2-RET      RET INDEX
          IX4    X4-X5
          SA7    A7+B1       ENTER CHAIN
          ZR     X4,DDS15    IF DEMAND SATISFIED
          NG     X4,DDS15    IF DEMAND SATISFIABLE
          LX2    -30
          SA5    DDSB        CHECK LDAM CONTROL
          ZR     X5,DDS13    IF NOT LDAM EQUIPMENT
 DDS12    LT     B2,B3,DDS8  IF NOT END OF TABLE
          SA5    DDSB        CHECK LDAM CONTROL
          ZR     X5,DDS21    IF STARTER NEVER SELECTED
          SB2    X5+B1       ADVANCE STARTING POSITION
          GE     B2,B3,DDS21 IF TABLE EXCEEDED
          JP     DDS7        CONTINUE WITH NEXT TABLE POSITION
 
 DDS13    MX6    12
          BX5    X6*X2       NEXT EQUIPMENT
          ZR     X5,DDS7     IF END OF CHAIN
          SA2    RET
 DDS13.1  SB5    A2+B1
          EQ     B5,B3,DDS25 IF EQUIPMENT NOT IN RET
          SA2    A2+B1
          LX2    -24
          BX7    X6*X2
          BX7    X7-X5
          NZ     X7,DDS13.1  IF NOT MATCHING EQUIPMENT
          LX2    24
          BX5    X2-X1
          LX7    X2,B1
          AX5    48
          LX2    -1
          NG     X2,DDS7     IF LOGICALLY ASSIGNED (PREMATURE ENDCHAIN)
          PL     X5,DDS14    IF NOT RESOURCE LIST INDEX
          AX7    49
          SX5    X7+B4
          SB5    A0+
          GT     B5,DDS14    IF NOT *PE* REQUEST
          ZR     X5,DDS11    IF MATCH
          SX5    X7+B5
 DDS14    NZ     X5,DDS25    IF NO MATCH (ERROR)
          EQ     DDS11       CONTINUE WITH NEXT CHAINED EQUIPMENT
 
 DDS15    SB4    4
          SB5    B4+B4
          BX6    X6-X6
 DDS16    SB4    B4+B1
          SA4    TDDS+B4
          SX7    B1
          ZR     X4,DDS17    IF NO EQUIPMENT
          SA2    RET+X4      INDICATE EQUIPMENT LOGICALLY ASSIGNED
          BX7    X2+X7
          SA7    A2
 DDS17    LX6    9
          BX6    X6+X4
          NE     B4,B5,DDS16 IF MORE *RET* INDICES TO ENTER
          SB5    B5-4
          ZR     B5,DDS18    IF ALL CHAINED EQUIPMENTS PROCESSED
          BX3    X3+X6
          BX6    X6-X6
          SB5    4
          SB4    B0
          EQ     DDS16       CONTINUE CHAINING EQUIPMENTS
 
 DDS18    BX6    X1+X6       SAVE EQUIPMENT CHAIN
          LX7    X3
          SA6    A1          UPDATE RDT ENTRY
          SA7    A3
          MX4    12
          BX4    X4*X3       GET ORIGINAL EQUIPMENT
          LX6    -27         GET FIRST EQUIPMENT
          MX7    -9
          BX7    -X7*X6
          LX7    48
          NZ     X4,DDS20    IF NOT FIRST ATTEMPT
          BX7    X7+X3
          SA7    A3
 DDS19    SX7    B0+         CLEAR STARTING POSITION
          SB6    B6+2        ADVANCE POINTER
          SA7    DDSA
          EQ     DDS1        LOOP FOR ALL DEMANDED RESOURCES
 
 DDS20    BX5    X4-X7
          NZ     X5,DDS19    IF NOT ORIGINAL EQUIPMENT
 
 
*         ALGORITHM MAY HAVE SELECTED A FIRST EQUIPMENT THAT CAUSES
*         UNSATISFACTION WHEN IN FACT SATISFACTION IS POSSIBLE.
*
*         BACKUP AND TRY ANOTHER CHAIN.
 
 
 DDS21    SB4    RDT
          SA2    B6          READ CURRENT DEMANDED RESOURCE
          MX0    -9
          SB6    B6-2
          LT     B6,B4,DDS24 IF FIRST RESOURCE (NO BACKUP POSSIBLE)
          SA1    B6          CHECK IF SAME EQUIPMENT
          BX5    X2-X1
          AX5    48
          NZ     X5,DDS24    IF PREVIOUS RESOURCE NOT SAME TYPE
          MX4    59
          MX3    24
          BX6    X3*X1       CLEAR EQUIPMENTS
          SA6    A1
          SB4    4
          LX1    -27
          BX7    -X0*X1      FIRST EQUIPMENT INDEX
          SA7    DDSA        SET STARTING POSITION
 DDS22    BX6    -X0*X1      EQUIPMENT INDEX
          ZR     X6,DDS1     IF END OF EQUIPMENTS
          SB4    B4-B1
          SA2    RET+X6      GET RESOURCE EQUIPMENT TABLE ENTRY
          LX1    9
          BX6    X4*X2       CLEAR LOGICALLY ASSIGNED BIT
          SA6    A2
          NZ     B4,DDS22    IF MORE ENTRIES IN FIRST WORD
          SA1    A1+B1
          BX6    X3*X1       CLEAR EQUIPMENTS
          BX1    -X3*X1
          SA6    A1
          LX1    -27
          EQ     DDS22       LOOP FOR ALL CHAINED EQUIPMENTS
 
 DDS24    SX2    B1          SET ERROR STATUS
          EQ     DDSX        RETURN
 
 DDS25    SB2    /PER/REV    * RESOURCE ENVIRONMENT ERROR.*
          EQ     PER         PROCESS ERROR
 
 
 DDSA     CON    0           STARTING POSITION
 DDSB     CON    0           LDAM CONTROL
 DLY      SPACE  4,10
**        DLY - DELAY.
*
*         DLY DELAYS 2 SECONDS FOR MAGNET TO FINISH ACTIVE
*         OPERATIONS BEFORE CONTINUING RESEX PROCESSING.
*
*         USES   A - 1, 2.
*                X - 1, 2.
*
*         MACROS RECALL, RTIME.
 
 
 DLY      SUBR               ENTRY/EXIT
          RTIME  DLYB        GET START TIME
 DLY1     RECALL
          RTIME  DLYB+1      GET CURRENT TIME
          SA1    DLYB        CHECK FOR DELAY COMPLETE
          SA2    A1+B1
          IX2    X2-X1       CALCULATE ELAPSED TIME IN MILLISECONDS
          SX2    X2-2000
          NG     X2,DLY1     IF NOT SUFFICIENT DELAY
          JP     DLYX        RETURN
 
 
 DLYB     CON    0,0         TIME TEMPORARIES
 IAS      SPACE  4,15
**        IAS - INITIALIZE ASSIGNMENTS.
*
*         ENTRY  (X3) = 0, IF ALL PHYSICALLY ASSIGNED EQUIPMENTS TO
*                     BE LOGICALLY ASSIGNED.
*                (X3) = JOB EJT ORDINAL, IF PHYSICALLY ASSIGNED.
*                     EQUIPMENTS FOR THIS JOB TO BE LOGICALLY ASSIGNED.
*
*         EXIT   LOGICALLY ASSIGNED BITS SET FOR PHYSICALLY ASSIGNED
*                EQUIPMENTS.
*
*         USES   A - 2, 5, 7.
*                B - 2, 3, 5.
*                X - 0, 2, 4, 5, 7.
*
*         MACROS CLEAR.
 
 
 IAS      SUBR               ENTRY/EXIT
          CLEAR  RET,RETL,-1 CLEAR LOGICALLY ASSIGNED BITS
          SA2    RETE        GET RET/EVSB ENDING INDEX
          SB2    RET+X2
          LX2    1
          SX4    B1
          SB3    EVSB
          MX0    -12
          SB5    B3+X2
 IAS1     SA2    B3+B1
          EQ     B3,B5,IASX  IF END OF EVSB
          LX2    59-35
          SB3    B3+2
          ZR     X2,IAS1     IF EMPTY ENTRY
          PL     X2,IAS1     IF NOT PHYSICALLY ASSIGNED
          BX5    -X0*X2      GET USER COUNT
          LX2    12
          ZR     X5,IAS1     IF NO USERS
          ZR     X3,IAS2     IF JOB EJT ORDINAL MATCH NOT REQUIRED
          SA5    A2
          BX5    X5-X3
          BX5    -X0*X5
          NZ     X5,IAS1     IF NO MATCH
 IAS2     LX2    -24
          BX5    -X0*X2      NEXT EQUIPMENT
          SA2    RET
 IAS3     SA2    A2+B1
          SX7    A2-B2
          ZR     X7,IAS1     IF EQUIPMENT NOT FOUND
          LX2    -12
          BX7    -X0*X2
          BX7    X7-X5
          NZ     X7,IAS3     IF NOT CORRECT ENTRY
          LX2    12
          BX7    X4+X2       MARK AS ASSIGNED
          SA7    A2
          LX7    59-2
          NG     X7,IAS1     IF END OF CHAIN
          EQ     IAS2        CONTINUE INITIALIZATION
 SDT      SPACE  4,10
**        SDT - SWITCH 9-TRACK DRIVE TYPE.
*
*         ENTRY  (X4) = PREVIOUS 9-TRACK DRIVE TYPE SELECTION IN
*                     BITS 0 - 5.
*
*         EXIT   (X4) = NEW 9-TRACK DENSITY RESOURCE INDEX.
*                (X6) = DISPLAY CODE FOR NEW 9-TRACK DENSITY.
*
*         USES   X - 0, 1, 4, 6.
 
 
 SDT      SUBR               ENTRY/EXIT
          MX0    -6
          BX1    -X0*X4      GET PREVIOUS DRIVE TYPE
          SX6    2RGE
          SX1    X1-RHDP
          SX4    RGEP
          ZR     X1,SDTX     IF *HD* DRIVE PREVIOUSLY SELECTED
          SX6    2RHD
          SX4    RHDP
          EQ     SDTX        RETURN
 SPI      SPACE  4,10
**        SPI - SET PREVIEW INFORMATION IN DEMAND FILE ENTRY.
*
*         ENTRY  DEMAND FILE ENTRY IN *RESB*.
*
*         EXIT   PREVIEW INFORMATION SET IN DEMAND FILE ENTRY.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6.
*
*         CALLS  SFN.
 
 
 SPI      SUBR               ENTRY/EXIT
 
*         SET TIME OF REQUEST AND CHECK REQUEST TYPE.
 
          SA1    TM
          SA2    RQ
          SA3    RI
          MX0    -6
          BX6    X1
          BX3    -X0*X3
          SA6    RESB+RREQ   SET REQUEST TIME
          SX3    X3-RRPP
          NG     X3,SPI1     IF TAPE REQUEST
 
*         SET PACKNAME, PACK RESOURCE TYPE, AND UNIT COUNT.
 
          MX6    42
          MX7    -12
          BX6    X6*X2       PACK NAME
          LX7    6
          SA6    RESB+RQPV+PVSN  SET PACK NAME
          SA6    RESB+RQPV+PVSI
          BX0    -X0*X2      DISPLAY CODE UNIT COUNT
          BX7    -X7*X2      RESOURCE MNEMONIC
          SX0    X0-1R1      UNIT COUNT - 1
          LX7    6
          LX0    9
          SX6    20B
          BX7    X7+X0       MERGE RESOURCE TYPE AND UNIT COUNT
          BX7    X6+X7       SET UNIT COUNT FLAG
          SA7    RESB+RQPV+PRES
          SX6    B0+         CLEAR FLAGS
          SA6    RESB+RQPV+PFLG
          EQ     SPI4        SET USER AND JOB IDENTIFICATION
 
*         SET EXTERNAL VSN, RESOURCE TYPE, AND ACCESS LEVEL.
 
 SPI1     SA1    EVSN
          SA2    RMN
          SA3    AL
          SA4    BLANK
          BX6    X1
          LX2    12
          SA6    RESB+RQPV+PVSN  SET VSN
          LX3    6
          BX4    X1-X4
          SX3    X3+10B      SET ACCESS LEVEL AND FLAG
          NZ     X4,SPI2     IF NOT SCRATCH REQUEST
          SX3    X3+40B      SET SCRATCH VSN FLAG
 SPI2     BX6    X2+X3       MERGE RESOURCE TYPE AND FLAGS
          SA6    RESB+RQPV+PRES
 
*         SET INTERNAL VSN AND FLAGS.
 
          MX0    1
          SA1    IVSN
          SA2    TMPF
          SA3    F+FTAP
          BX7    X1
          LX2    59-58
          SA7    RESB+RQPV+PVSI  SET VSN
          LX3    59-58
          BX2    X0*X2       TMS REQUEST FLAG
          BX4    X0*X3       LABELED FLAG
          LX2    21-59
          LX3    0-39-59+58
          MX0    -2
          LX4    20-59
          BX3    -X0*X3      PO = R, PO = W FLAGS
          LX3    18-0
          BX3    X2+X3       MERGE TMS AND READ/WRITE FLAGS
          BX6    X3+X4       MERGE LABELED FLAG
          SA6    RESB+RQPV+PFLG  SET FLAGS
 
*         SET USER NAME, FAMILY ORDINAL, AND EJT ORDINAL.
 
 SPI4     SA1    SSJ=+/COMSSSJ/UIDS
          MX0    42
          BX1    X0*X1
          SA2    FAMO
          RJ     SFN         SPACE FILL USER NAME
          SA3    JEEO
          BX1    X0*X6       USER NAME
          LX2    12
          BX6    X1+X2       MERGE USER NAME AND FAMILY ORDINAL
          BX6    X6+X3       MERGE EJT ORDINAL
          SA6    RESB+RQPV+PJID  SET USER AND JOB INDENTIFICATION
          EQ     SPIX        RETURN
          TITLE  RESOURCE RESERVATION SUBROUTINES.
 RMT      SPACE  4,25
**        RMT - REQUEST MAGNETIC TAPE.
*
*         ENTRY  (FET+10B) = TAPE DESCRIPTORS.
*                (FET+11B - FET+15B) = LABEL DESCRIPTORS.
*                (VA) = VSN ENTRY RANDOM ADDRESS, IF VSN ENTRY PRESENT.
*                VSNB = VSN ENTRY FROM VSN FILE, IF (VA) .NE. 0.
*
*         EXIT   TAPE ASSIGNED AND APPROPRIATELY OPENED.
*                TO *END1*, IF LABEL COMMAND PROCESSING.
*                TO *END2*, IF NOT LABEL COMMAND PROCESSING.
*                TO *PIT*, IF INTERRUPT DETECTED.
*
*         ERROR  TO *PER*, IF CONFLICTING RESOURCE TYPES.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2.
*                X - ALL.
*
*         CALLS  BEV, BPD, COE, COM, CUP, GTM, IDE, IVE, MVE, OPN, PRO,
*                RDF, SDD, UDF, VUR.
*
*         MACROS MOVE, RETRF, REWIND, SETFET.
 
 
 RMT      BSS    0           ENTRY
          RJ     SDD         SET DEVICE TYPE AND DENSITY DISPLAY
          RJ     IDE         INITIALIZE DEMAND ENTRY
          RJ     RDF         READ DEMAND FILE ENTRY
          SA1    /CPA/RFCW   GET DEMAND FILE RANDOM INDEX
          SA5    DBUF+RNTP   GET *NT* RESOURCE DEMAND
          MX3    -6
          LX5    24
          SX6    X1
          BX5    -X3*X5
          NZ     X6,RMT1     IF DEMAND ENTRY PRESENT
          SX5    B0+         PREVENT RETURN OF DEMAND FILE
          RJ     UDF         UPDATE DEMAND FILE
          SX5    B0+         INDICATE NO *NT* DEMAND
 RMT1     RETRF  D           RETURN DEMAND FILE, RELEASE INTERLOCK
          SA1    F+FTAP      BUILD RESOURCE TYPE AND INDEX
          LX1    -55
          MX3    -2
          BX4    -X3*X1      DEVICE TYPE
          SA2    TTDV+X4
          SX3    X4-/COMSMTX/DVNT
          AX2    18
          SX7    X2          RESOURCE TYPE
          NZ     X3,RMT3     IF NOT *NT* REQUEST
          LX1    0-51+55     GET DENSITY
          MX3    -3
          BX3    -X3*X1
          SX3    X3-/COMSMTX/D16
          SX7    RHDP        INDICATE *HD* REQUEST
          NG     X3,RMT2     IF *HD* REQUEST
          SX7    RPEP        INDICATE *PE* REQUEST
          ZR     X3,RMT2     IF *PE* REQUEST
          SB2    /PER/CRT    * CONFLICTING RESOURCE TYPES.*
          NZ     X5,PER      IF *GE* REQUEST WITH *NT* DEMANDS
          SX7    RGEP        INDICATE *GE* REQUEST
 RMT2     SA7    OI          SAVE ORIGINAL NT TAPE DENSITY INDEX
          ZR     X5,RMT3     IF NO *NT* DEMANDS
          SX7    RNTP        INDICATE *NT* REQUEST
 RMT3     SA3    IVSN        GET INTERNAL VSN
          SA2    TRID-RMTP+X7  GET RESOURCE INDEX
          SX4    X4-/COMSMTX/DVAT
          NZ     X4,RMT3.1   IF NOT *AT* REQUEST
          SA3    EVSN        USE EXTERNAL VSN FOR ACS REQUEST
 RMT3.1   SA1    AL          REQUESTED ACCESS LEVEL
          LX2    18
          SX1    X1+B1
          LX1    6           POSITION TAPE BYTE POINTER
          BX7    X1+X7       ENTER RESOURCE INDEX (RI)
          SA7    RI          ENTER RESOURCE INDEX (RI)
          SA1    F           SET VSN CALL FET
          BX6    X3+X2
          SA6    RQ          ENTER USER REQUEST (RQ)
          BX7    X1
          SA7    VF
          RJ     GTM         GET CURRENT TIME
 
*         GUARANTEE VSN ENTRY.
 
          SA1    VA          CHECK ENTRY PRESENT
          NZ     X1,RMT4     IF VSN ENTRY PRESENT
          SA3    F
          SB2    B1+
          RJ     IVE         INITIALIZE VSN ENTRY
          EQ     RMT5        UPDATE VSN FILE
 
 RMT4     MOVE   VSNL,VSNB,VSNE  MOVE VSN ENTRY TO WORKING BUFFER
 RMT5     SA1    RI          SET RESOURCE INDEX IN VSN ENTRY
          SA2    VSNE+VDFI
          LX1    24
          BX6    X1+X2
          SA6    A2+
          RJ     MVE         CREATE OR REWRITE VSN ENTRY
 
*         EXERCISE OVERCOMMITMENT ALGORITHM.
 
 RMT6     RJ     COM         CHECK FOR OVERCOMMITMENT
          SX5    X2-/STATUS/OK
          ZR     X5,RMT12    IF PERMITTED TO ASSIGN AVAILABLE TAPE
          SX5    /STATUS/OV
          BX5    X5*X2
          NZ     X5,RMT9     IF OVERCOMMITMENT REJECTION
          RJ     COE         CHECK *OFF*/*DOWN* EQUIPMENT
          NZ     X6,RMT7     IF *OFF*/*DOWN* EQUIPMENT REQUIRED
          RJ     CVA         CHECK VSN AVAILABILITY
          ZR     X6,RMT8     IF NO PREVIEW DISPLAY MESSAGE
 RMT7     RJ     SPM         SET PREVIEW DISPLAY MESSAGE
 
*         PROCESS MISSING VSN.
 
 RMT8     MX2    36
          SA1    RQ          BUILD MISSING VSN EVENT
          BX1    X2*X1
          SA3    TEMV
          RJ     BEV
          EQ     RMT10       CLEAN UP AND ROLLOUT
 
*         PROCESS OVERCOMMITMENT REJECTION.
 
 RMT9     SA3    TEOV
          BX7    X7-X7       CLEAR MOUNT REQUEST
          LX6    X3
          SA7    RESB+RREQ
 
*         ROLL OUT ON MISSING VSN OR OVERCOMMITMENT.
 
 RMT10    SA1    A3+B1       SAVE ROLLOUT MESSAGE ADDRESS
          SA6    RE          SET ROLLOUT EVENT DESCRIPTOR
          BX7    X1
          SA7    RM
          RJ     CUP         CLEAN UP REQUEST
          SX5    RE          SET ROLLOUT DESCRIPTOR
          SA1    RM          GET ROLLOUT MESSAGE ADDRESS
          RJ     PRO         PROCESS TIMED EVENT ROLLOUT
 
*         INITIALIZE TO RECHECK FOR OVERCOMMITMENT.
 
 RMT10.1  SA4    AA
          SB2    X4
          BX6    X6-X6
          GT     B2,RMT11    IF *ASSIGN* WITH EST ORDINAL SPECIFIED
          SA6    EQ          CLEAR EQUIPMENT ASSIGNMENT
          NG     B2,RMT11.1  IF AUTOMATIC ASSIGNMENT
 RMT11    SA1    RQ          CLEAR VSN
          MX6    -24
          BX6    -X6*X1
          SA6    A1
 RMT11.1  RJ     CCV         CHECK FOR CHANGE OF TMS REQUEST VSN
          EQ     RMT6        CHECK FOR OVERCOMMITMENT
 
*         ASSIGN UNIT.
 
 RMT12    RJ     VUR         VERIFY UNIT REQUEST
          ZR     X6,RMT13    IF UNIT ASSIGNED
          ZR     X2,RMT9     IF OPERATOR ASSIGNMENT
          EQ     RMT8        SET MISSING VSN EVENT
 
 RMT13    RJ     BPD         BUILD PREVIEW DISPLAY
 
*         OPEN OR REWIND FILE.  MAGNET COMPLETES THE TAPE ASSIGNMENT ON
*         RECEIPT OF THE FIRST *CIO* REQUEST.  IF AN UNLABELED TMS
*         SCRATCH TAPE IS BEING ASSIGNED, AN EOF WILL BE WRITTEN TO
*         PREVENT A READ OF PREVIOUSLY WRITTEN DATA.
 
          SA2    CF          CHECK CALL TYPE
          SA1    RT          CHECK COMMAND TYPE
          NZ     X2,RMT14    IF *LFM* OR *REQ* CALL
          NZ     X1,RMT15    IF NOT *LABEL* COMMAND
 RMT14    RJ     OPN         OPEN FILE
          NZ     X6,END1     IF FILE OPENED
 RMT15    SETFET F,ERP=E     SET ERROR PROCESSING
          SA1    TMPF
          LX1    59-57
          PL     X1,RMT16    IF NOT TMS SCRATCH TAPE ASSIGNMENT
          WRITEF F,R         INHIBIT READ OF UNLABELED TAPE
          RJ     CER         CHECK ERROR
 RMT16    REWIND F,R         REWIND TO COMPLETE ASSIGNMENT
          RJ     CER         CHECK ERROR
          SETFET F,ERP=0     CLEAR ERROR PROCESSING
          EQ     END1        PROCESS TERMINATION
 RRP      SPACE  4,20
**        RRP - REQUEST REMOVABLE PACK.
*
*         ENTRY  USER RESOURCE REQUEST WORDS ARE BUILT (RQ - TM).
*
*         EXIT   PACK ASSIGNED.
*                TO *END4*, IF NOT OVERCOMMITMENT.
*                TO *PIT*, IF INTERRUPT DETECTED.
*
*         ERROR  TO *PER*, IF PACK OVERCOMMITMENT ERROR.
*
*         USES   A - 1, 3, 6, 7.
*                B - 2.
*                X - 0, 1, 3, 5, 6, 7.
*
*         CALLS  BEV, COE, COM, CUP, IDE, PRO, RDF, SPM, UDF.
*
*         MACROS INTRC.
 
 
 RRP      BSS    0           ENTRY
          SA1    /CPA/RFCW   CHECK FOR DEMAND FILE ENTRY
          SX5    X1
          NZ     X5,RRP1     IF DEMAND FILE PRESENT
          RJ     IDE         INITIALIZE DEMAND ENTRY
          RJ     RDF         READ DEMAND FILE
          SX5    B1          SET RETURN DEMAND FILE FLAG
          RJ     UDF         UPDATE DEMAND FILE ENTRY
 
*         EXERCISE OVERCOMMITMENT ALGORITHM.
 
 RRP1     RJ     COM         CHECK FOR OVERCOMMITMENT
          SA1    SFET+FDTY   READ FET DETAILS
          SX5    X2-/STATUS/OK
          SX4    /STATUS/OV
          ZR     X5,RRP4     IF PERMITTED TO ACCESS AVAILABLE PACK
          LX1    59-44
          BX5    X4*X2
          PL     X1,RRP4     IF EP BIT ZERO
          SA3    PEOV
          NZ     X5,RRP2     IF OVERCOMMITMENT REJECTION
          RJ     COE         CHECK FOR *OFF*/*DOWN* EQUIPMENT
          ZR     X6,RRP1.1   IF *OFF*/*DOWN* EQUIPMENT NOT REQUIRED
          RJ     SPM         SET PREVIEW DISPLAY MESSAGE
 RRP1.1   SA3    PEMV        BUILD MISSING PACKNAME EVENT
          SA1    RQ
          MX0    42
          BX1    X0*X1
          RJ     BEV
          EQ     RRP3        CLEAN UP AND ROLLOUT
 
 RRP2     BX7    X7-X7       CLEAR MOUNT REQUEST
          LX6    X3
          SA7    RESB+RREQ
 RRP3     SA1    A3+B1       SAVE ROLLOUT MESSAGE ADDRESS
          SA6    RE          SET ROLLOUT EVENT DESCRIPTOR
          BX7    X1
          SA7    RM
          RJ     CUP         CLEAN UP REQUEST
          SX5    RE          SET ROLLOUT DESCRIPTOR
          SA1    RM          GET ROLLOUT MESSAGE ADDRESS
          RJ     PRO         PROCESS TIMED EVENT ROLLOUT
          EQ     RRP1        REPEAT ALGORITHM
 
 RRP4     LX7    X2          SET RETURN STATUS
          BX4    X4-X2
          LX7    24
          BX6    X6-X6       CLEAR MOUNT REQUEST
          SA7    SPPR
          SA6    RESB+RREQ
          SX6    -2
          NZ     X4,RRP5     IF NOT ONLY OVERCOMMITMENT
          SB2    /PER/RPO    * REMOVABLE PACKS OVERCOMMITMENT.*
          EQ     PER         PROCESS ERROR
 
 RRP5     INTRC  OFF         DISABLE INTERRUPT
          SA6    UCRI        INDICATE CLEAN-UP REQUIRED IF INTERRUPT
          EQ     END4        UPDATE DEMAND FILE
 RRS      SPACE  4,10
**        RRS - REQUEST RESOURCES.
*
*         EXIT   TO *END4* IF NO ERROR.
*                TO *PER* IF ERROR.
*
*         USES   X - 1, 2.
*                A - 1.
*                B - 2.
*
*         CALLS  BRE, BSF, CIC, DEI, OCA, PMM.
 
 
 RRS      BSS    0           ENTRY
          RJ     CRV         CHECK RESOURCE VALIDATION
          RJ     DEI         DEMAND EXCEEDS INSTALLATION CHECK
          SA1    RESB+RVAL   GET TOTAL ASSIGNED COUNT
          MX2    -12
          LX1    -12
          BX1    -X2*X1
          ZR     X1,END4     IF NO ASSIGNED UNITS
          RJ     CIC         CHECK FOR INTERNAL CONFLICT
          SB2    /PER/DRC    * NT DRIVE CONFLICT.*
          NZ     X2,PER      IF 9 TRACK DRIVE CONFLICT
          RJ     BSF         BUILD SCRATCH FILE
          RJ     OCA         CHECK FOR OVERCOMMITMENT
          NZ     X5,END4     IF NO OVERCOMMITMENT
          SB2    /PER/RDE    * RESOURCE DEMAND ERROR.*
          EQ     PER         PROCESS ERROR
 ROA      SPACE  4,30
**        ROA - REQUEST OPERATOR ASSIGNMENT.
*
*         ENTRY  (X4) = 0 IF REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT.
*                (X4) = 1 IF REQUEST OPERATOR ASSIGNMENT ON DUPLICATE
*                         VSN OR VERIFICATION OF NON-TMS TAPE REQUEST.
*
*                TAPE DEVICE MNEMONIC IN FET+1 IF TAPE EQUIPMENT
*                  REQUIRED, OTHERWISE DEVICE TYPE ZERO.
*
*         EXIT   (X4) = DEVICE TYPE OF EQUIPMENT ASSIGNED.
*                (EQ) = OPERATOR ASSIGNED EST ORDINAL, IF TAPE DEVICE.
*                OPERATOR VERIFY FLAG CLEARED IN *TMPF*.
*
*         FOR *NT* REQUEST, DISPLAY CODE FOR DENSITY (*HD*, *PE*,
*           OR *GE*) WILL BE SET IN FET+1 BITS 24-35.
*         FET+7 BITS 54-59 IS THE CHECKPOINT ID FIELD FROM A
*         *LABEL* MACRO CALL OR IS ZERO IN ALL OTHER CASES.
*         DEVICE TYPE OF EQUIPMENT ASSIGNED IS RETURNED IN FET+1.
*         FOR TAPE EQUIPMENT ASSIGNMENTS, EQUIPMENT EST ORDINAL IS
*           RETURNED IN FET+1 BITS 24-29.
*
*         USES   A - 1, 2, 7.
*                X - 1, 2, 4, 7.
*
*         CALLS  COV, CUC.
*
*         MACROS ROAE, SETRNR.
 
 
 ROA      SUBR               ENTRY/EXIT
          SA1    F+FDTY
          SA2    RMN
          MX7    48
          LX1    -24
          BX7    X7*X1
          BX7    X7+X2       SET RESOURCE MNEMONIC IN FET
          LX7    24
          SA7    A1+
 ROA2     SETRNR OPROLL      ALLOW OPERATOR ROLLOUT
          SA1    SSJ=+/COMSSSJ/UIDS
          RJ     CUC         CHANGE USER NAME IN CONTROL POINT AREA
          ROAE   F,X4        REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT
          SA1    =0LSYSTEMX
          RJ     CUC         CHANGE USER NAME IN CONTROL POINT AREA
          SETRNR NOROLL      PREVENT JOB ROLLOUT
          RJ     COV         CLEAR OPERATOR VERIFY FLAG
          SA1    F+FDTY      GET EQUIPMENT TYPE AND EST ORDINAL
          MX2    -11
          LX1    12
          BX4    -X2*X1
          LX1    12
          MX2    12
          BX7    X2*X1
          SA7    EQ
          EQ     ROAX        RETURN
 SDD      SPACE  4,10
**        SDD - SET DEVICE TYPE AND DENSITY DISPLAY.
*
*         ENTRY  (F+FTAP) = CONVERTED TAPE DESCRIPTORS.
*
*         EXIT   (F+FDTY) = TAPE DEVICE TYPE SET IN BITS 48-59.
*                (RMN) = RESOURCE TYPE MNEMONIC.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*                B - 2.
 
 
 SDD      SUBR               ENTRY/EXIT
 
*         GET TAPE DEVICE TYPE AND SET MNEMONIC IN ASSIGNMENT FET.
 
          SA1    F+FTAP
          SA2    F+FDTY
          MX0    -2
          LX1    0-55
          BX6    -X0*X1      TAPE DEVICE TYPE
          SB2    X6
          SA3    TTDV+X6
          MX0    -48
          SX3    X3          DEVICE MNEMONIC
          BX2    -X0*X2
          LX3    -12
          BX6    X3+X2
          LX3    12
          SA6    A2+
 
*         SET RESOURCE TYPE MNEMONIC.
 
          LX1    0-51-0+55
          MX0    -3
          BX2    -X0*X1      DENSITY
          SX6    B2-/COMSMTX/DVNT
          NZ     X6,SDD1     IF NOT *NT* DEVICE TYPE
          SA3    TSDD+X2-/COMSMTX/D08  GET *NT* DENSITY MNEMONIC
 SDD1     BX6    X3
          SA6    RMN
          EQ     SDDX        RETURN
 
 
 TSDD     BSS    0           TABLE OF NINE TRACK DENSITY MNEMONICS
          CON    2RHD        800 CPI
          CON    2RPE        1600 CPI
          CON    2RGE        6250 CPI
 VUR      SPACE  4,20
**        VUR - VERIFY UNIT REQUEST.
*
*         EXIT   (X6) = 0 IF UNIT ASSIGNED.
*                (X6) .NE. 0 IF UNIT NOT ASSIGNED.
*                TO *PIT*, IF INTERRUPT DETECTED.
*                TO *ERR2* OR *ERR3* IF SUBSYSTEM COMMUNICATION ERROR.
*                TO *PER* IF UNIT NOT ASSIGNED AND ASSIGNMENT BY EST
*                  ORDINAL.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 5.
*
*         CALLS  BTR, CUP, UDF.
*
*         MACROS INTRC, INTRP, RDSB, RECALL, VSN, WTSB.
 
 
 VUR      SUBR               ENTRY/EXIT
 
*         CHECK UNIT AVAILABLE AND CORRECT VSN MOUNTED.
 
          SA1    AU
          RDSB   MTSI,/COMSMTX/UNITL,X1,UDT  READ UDT ENTRY
          SA1    UDT+/COMSMTX/UST1
          SA2    UDT+/COMSMTX/UVRI
          SA3    UDT+/COMSMTX/UVSN
          SA4    IVSN
          MX0    36
          LX1    59-49
          NZ     X2,VUR5     IF UNIT ASSIGNED OR SELECTED FOR UNIT SWAP
          ZR     X3,VUR5     IF LABELS NOT READ
          LX3    59-23
          NG     X3,VUR5     IF LABEL CHECK IN PROGRESS
          LX3    23-23-59+23
          PL     X1,VUR1     IF NOT ACS UNIT
          SA3    UDT+/COMSMTX/UMST  GET EXTERNAL VSN
          MX7    -2
          BX7    -X7*X3      ACS UNIT MOUNT STATUS
          SX7    X7-2
          NZ     X7,VUR5     IF UNIT NOT MOUNTED
          SA4    EVSN
 VUR1     BX4    X3-X4
          BX4    X0*X4
          NZ     X4,VUR5     IF VSN NOT MOUNTED ON UNIT
 
*         RESERVE TAPE EQUIPMENT.
 
          MX6    12
          LX1    59-35-59+49
          BX6    X6*X1       SET EST ORDINAL
          SA6    VF+FEVE
          VSN    VF          RESERVE EQUIPMENT
          SA1    VF+FEVE     CHECK RESERVATION
          ZR     X1,VUR5     IF EQUIPMENT ALREADY RESERVED
 
*         SEND ASSIGN UNIT REQUEST TO MAGNET.
 
          RJ     BTR         BUILD MAGNET TAPE ASSIGNMENT REQUEST
          INTRC  OFF         DISABLE INTERRUPT
          WTSB   BUF,0       SEND ASSIGNMENT REQUEST
          SA1    SS          CHECK STATUS
          SX5    X1-1
          ZR     X5,VUR2     IF TRANSFER COMPLETE
          SX5    X1-3
          INTRC  ON          REENABLE INTERRUPT
          INTRP  PIT         PROCESS INTERRUPT
          ZR     X5,ERR3     IF MAGNET NOT ACTIVE
          EQ     ERR2        PROCESS ERROR
 
 VUR2     RECALL
          SX7    /COMSMTX/RCAL ADDRESS OF CALL BUFFER 0
          RDSB   MTSI,1,X7,BUF+20
          SA1    BUF+20
          NZ     X1,VUR2     IF REQUEST IN PROGRESS
          SA1    AU
          RDSB   MTSI,/COMSMTX/UNITL,X1,UDT  READ UDT
          SA1    UDT+/COMSMTX/UVRI
          SA2    JEEO
          AX1    48
          BX1    X1-X2
          ZR     X1,VUR3     IF UNIT ASSIGNED
          INTRC  ON          REENABLE INTERRUPT
          INTRP  PIT         PROCESS INTERRUPT
          SA1    VF+FEVE     CLEAR EQUIPMENT ASSIGNMENT
          MX6    1
          BX6    X1+X6
          SA6    A1
          VSN    VF
          EQ     VUR5        PROCESS UNIT NOT ASSIGNED
 
*         BUILD TAPE FILE FNT/FST ENTRY AND UPDATE DEMAND FILE.
 
 VUR3     SA1    AU
          SA3    UDT+/COMSMTX/UST1
          MX0    12
          MX6    1
          LX3    24
          SA4    F+FTAP
          BX7    X0*X3       EST ORDINAL
          LX1    36
          MX0    4
          LX4    2
          BX7    X7+X1       MERGE EST ORDINAL AND UDT ADDRESS
          LX0    -24
          BX5    X0*X4
          BX7    X7+X5       SET FORMAT
          MX0    2
          LX4    -1          CHECK LABELED AND NON-STANDARD BITS
          BX4    X0*X4
          ZR     X4,VUR4     IF NOT LABELED ACCESS
          LX6    11-59
          BX7    X7+X6       SET LABELED STATUS
 VUR4     SA7    VF+FEVE
          VSN    VF          ENTER EQ AND UDT ASSIGNMENT IN FST
          SX6    1
          SA6    TA          SET TAPE ASSIGNED TO MAGNET FLAG
          BX6    X6-X6       CLEAR MOUNT REQUEST
          MX5    0           SET NO RETURN OF DEMAND FILE
          SA6    RESB+RREQ
          RJ     UDF         UPDATE DEMAND FILE
          INTRC  ON          REENABLE INTERRUPT
          INTRP  PIT         PROCESS INTERRUPT
          SX6    B0          SET UNIT ASSIGNED
          EQ     VURX        RETURN
 
*         PROCESS UNIT NOT ASSIGNED.
 
 VUR5     SA2    AA
          SB2    X2
          SX6    B1          SET UNIT NOT ASSIGNED
          LE     B2,VURX     IF NOT *ASSIGN* WITH EST ORDINAL
          SX7    B0+
          SA7    RESB+RREQ   CLEAR MOUNT REQUEST
          RJ     CUP         CLEAN UP REQUEST
          SB2    /PER/EQN    * EQUIPMENT NOT AVAILABLE.*
          EQ     PER         PROCESS ERROR
          TITLE  RESOURCE FILE SUBROUTINES.
 MVE      SPACE  4,20
**        MVE - MAKE VSNFILE ENTRY.
*
*         ENTRY  VSNE = NEW VSN ENTRY.
*                (VA) = VSN RANDOM INDEX.
*                VSN FILE INTERLOCKED.
*
*         EXIT   ENTRY MADE INTO VSN FILE.
*                FNT/FST ENTRY FOR FILE CREATED.
*                VSN FILE INTERLOCK CLEARED.
*                TO *PIT*, IF INTERRUPT DETECTED.
*
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 5, 6, 7.
*
*         CALLS  URF.
*
*         MACROS INTRC, INTRP, VSN.
 
 
 MVE      SUBR               ENTRY/EXIT
          SA1    VSNE+VLFN   SET FILE NAME IN VSN FET
          SX7    1
          MX6    0
          BX7    X1+X7
          SA7    VF
          SA1    VA          CHECK FOR ENTRY REWRITE
          SA6    VF+FEVE
          NZ     X1,MVE1     IF REWRITE
          VSN    VF          RESERVE VSN FNT ENTRY
          SA1    VA
          INTRC  OFF         INHIBIT INTERRUPT
 MVE1     SX2    V
          SX6    VSNE
          SX7    VSNB
          SX5    B1          SET RETURN VSN FILE
          SX0    VSNL        VSN ENTRY LENGTH
          RJ     URF         UPDATE RESOURCE FILE
          SA2    VA          CHECK FOR EXISTING ENTRY
          SA1    URFA
          NZ     X2,MVEX     IF EXISTING ENTRY
          BX6    X1
          SA6    A2
          LX6    12
          SA6    VF+FEVE     MAKE VSN FNT ENTRY
          VSN    VF          MAKE VSN ENTRY
          INTRC  ON          REENABLE INTERRUPT
          INTRP  PIT         PROCESS INTERRUPT
          EQ     MVEX        RETURN
 RDF      SPACE  4,15
**        RDF - READ DEMAND FILE.
*
*         ENTRY  (/CPA/RFCW) = DEMAND FILE INDEX IF ENTRY EXISTS.
*                (RESB+RJID) = JOB EJT ORDINAL.
*
*         EXIT   DEMAND FILE ENTRY IN DBUF.
*                DEMAND FILE INTERLOCK SET.
*
*         ERROR  TO *PER*, IF DEMAND FILE ERROR.
*
*         USES   A - 1, 3, 6.
*                B - 2.
*                X - 1, 3, 6.
*
*         MACROS FATRF, READ, READW.
 
 
 RDF      SUBR               ENTRY/EXIT
          FATRF  D,M         ATTACH DEMAND FILE
          SA1    /CPA/RFCW   CHECK DEMAND FILE RANDOM INDEX
          SX6    X1
          ZR     X6,RDF2     IF NO ENTRY
          SA6    D+6
          READ   X2,R        RANDOM READ DEMAND FILE
          SA1    DBUF+RJID   COMPARE JOB IDENTIFICATION
          SA3    RESB+RJID
          BX1    X1-X3
          ZR     X1,RDFX     IF CORRECT ENTRY
 RDF1     SB2    /PER/DFE    *DEMAND FILE ERROR.*
          EQ     PER         PROCESS ERROR
 
*         SCAN DEMAND FILE TO VERIFY THAT NO ENTRY EXISTS.
 
 RDF2     READ   X2,R
 RDF3     READW  D,BUF,RDEL  READ ENTRY
          NZ     X1,RDFX     IF NO DUPLICATE FOUND
          SA1    BUF+RJID    COMPARE JOB IDENTIFICATION
          SA3    RESB+RJID
          BX1    X1-X3
          NZ     X1,RDF3     IF ENTRY DOES NOT MATCH
          EQ     RDF1        ERROR
 UDF      SPACE  4,20
**        UDF - UPDATE DEMAND FILE.
*
*         ENTRY  (/CPA/RFCW) = DEMAND FILE INDEX IF ENTRY EXISTS.
*                RESB = DEMAND ENTRY TO BE WRITTEN.
*                (X5) = 0, IF DEMAND FILE NOT TO BE RETURNED.
*                DEMAND FILE INTERLOCK SET.
*
*         EXIT   DEMAND FILE UPDATED.
*                (X6) = RANDOM INDEX.
*                (/CPA/RFCW) = DEMAND FILE RANDOM INDEX.
*                IF NEW DEMAND FILE ENTRY IS BUILT, RANDOM
*                INDEX IS ENTERED INTO CONTROL POINT WORD *RFCW*.
*                TO *PIT*, IF INTERRUPT DETECTED.
*
*         USES   A - 1, 2, 5, 6.
*                X - 0, 1, 2, 5, 6, 7.
*
*         CALLS  URF.
*
*         MACROS ENDRI, INTRC, INTRP.
 
 
 UDF      SUBR               ENTRY/EXIT
          SA2    RESB+RREQ   SET/CLEAR PREVIEW DISPLAY CLEAN-UP FLAG
          SA1    /CPA/RFCW   GET DEMAND FILE INDEX
          BX6    X2
          SX1    X1
          SA6    PVDC
          SX2    D
          SX6    RESB
          NZ     X1,UDF1     IF NOT NEW DEMAND FILE ENTRY
          INTRC  OFF         DISABLE INTERRUPT
          SX1    -1
 UDF1     SX7    BUF
          SX0    RDEL        DEMAND ENTRY LENGTH
          RJ     URF         UPDATE RESOURCE FILE
          SA5    /CPA/RFCW   GET DEMAND FILE INDEX
          SA1    URFA
          SX6    X5
          NZ     X6,UDFX     IF NOT NEW ENTRY
          BX6    X5+X1
          SA6    A5          SET NEW ENTRY
          ENDRI  X1
          SA5    A5
          SX6    X5          SET RANDOM INDEX
          INTRC  ON          REENABLE INTERRUPT
          INTRP  PIT         PROCESS INTERRUPT
          EQ     UDFX        RETURN
 URF      SPACE  4,20
**        URF - UPDATE RESOURCE FILES.
*
*         ENTRY  (X0) = ENTRY LENGTH.
*                (X1) = RANDOM INDEX IF UPDATING EXISTING ENTRY.
*                (X1) = 0 IF TO CREATE NEW ENTRY.
*                (X2) = FET ADDRESS OF RESOURCE FILE.
*                (X5) = 0, IF RESOURCE FILE NOT TO BE RETURNED.
*                (X6) = ADDRESS OF NEW ENTRY.
*                (X7) = WORKING BUFFER ADDRESS IF ALLOCATING NEW ENTRY.
*                RESOURCE FILE INTERLOCK SET.
*
*         EXIT   (URFA) = RANDOM INDEX OF NEW ENTRY.
*                RESOURCE FILE INTERLOCK CLEARED.
*
*         USES   A - 1, 3, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  CTL.
*
*         MACROS FATRF, READ, READW, RECALL, RETRF, REWRITE,
*                REWRITER, WRITEW.
 
 
 URF4     REWRITER  X2,R
 URF5     RJ     CTL         CHECK FOR TRACK LIMIT
          SA1    URFD        CHECK FOR RETURN REQUIRED
          ZR     X1,URFX     IF NOT RETURNING RESOURCE FILE
          RETRF  X2          RETURN RESOURCE FILE, RELEASE INTERLOCK
 
 URF      SUBR               ENTRY/EXIT
          SA7    URFC
          SA6    A7-B1
          BX7    X5          SAVE RETURN RESOURCE FILE INDICATOR
          SA7    A7+B1
          MX6    0
          BX7    X1
          SA7    A7+B1       SAVE INITIAL RANDOM INDEX
          SA7    A6-B1
          SA6    EF          CLEAR EOR FLAG
          BX7    X0          SAVE ENTRY LENGTH
          SA7    URFF
 URF1     FATRF  X2,M        ATTACH RESOURCE FILE
          SA1    URFA
          SB6    X1+
          GT     B6,URF3     IF UPDATING EXISTING ENTRY
 
*         FIND AVAILABLE ENTRY.
 
          READ   X2
 URF2     SA1    URFA        ADVANCE RANDOM INDEX
          SA3    URFF        GET ENTRY LENGTH
          SB7    X3
          AX3    6
          IX7    X1+X3
          SA3    URFC
          SA7    A1
          SB6    X3+
          READW  X2,B6,B7    READ FILE ENTRY
          SA3    URFC
          BX7    X1
          SA3    X3
          SA7    EF          SET END OF FILE FLAG
          NZ     X1,URF3     IF EOR
          NZ     X3,URF2     IF ENTRY IN USE
 
*         WRITE ENTRY TO FILE.
 
 URF3     RECALL X2
          MX0    1           BUILD FET FOR REWRITE
          SA1    URFA
          LX0    30
          SX7    SBUF2
          SA7    X2+2
          SA3    A1+B1
          SA7    A7+B1
          BX6    X0+X1
          SB6    X3
          SA6    X2+6
          SA1    URFF        GET ENTRY LENGTH
          SB7    X1
          WRITEW X2,B6,B7
          SA1    X2+FDTY     SET USER PROCESSING
          MX0    1
          LX0    45-59
          BX6    X0+X1
          SA6    A1
          SA1    EF          CHECK FILE STATUS
          NZ     X1,URF4     IF EOR
          REWRITE X2,R
          EQ     URF5
 
 
 URFA     CON    0           RANDOM INDEX TEMPORARY
 URFB     CON    0           NEW ENTRY BUFFER ADDRESS
 URFC     CON    0           FILE SEARCH WORKING BUFFER ADDRESS
 URFD     CON    0           RETURN RESOURCE FILE FLAG
 URFE     CON    0           INITIAL RANDOM INDEX
 URFF     CON    0           ENTRY LENGTH
          TITLE  TAPE ALTERNATE STORAGE SUBROUTINES.
 AEV      SPACE  4,15
**        AEV - ADD ENTRY TO STAGING TAPE VSN LIST.
*
*         ENTRY  (B6) = FWA OF STAGE REQUEST BLOCK.
*
*         EXIT   ENTRY ADDED TO *STVL*.
*                (LSVL) UPDATED.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*
*         MACROS MEMORY.
 
 
 AEV      SUBR               ENTRY/EXIT
          SA3    B6
          AX3    54          GET FUNCTION CODE
          SX3    X3-2
          ZR     X3,AEVX     IF STAGE REQUEST FROM OPTICAL DISK
          SA1    B6+B1       GET PACKED VSN
          SA3    B6+7        GET RETRY INFORMATION
          MX2    -24
          SA4    STVL-1      SEARCH VSN LIST
 
*         SEARCH VSN LIST FOR EXISTING ENTRY WITH THIS VSN.
 
 AEV1     SA4    A4+B1
          ZR     X4,AEV3     IF END OF LIST
          BX6    X1-X4
          BX6    -X2*X6
          NZ     X6,AEV1     IF VSN DOES NOT MATCH
 
*         PROCESS UPDATE OF EXISTING ENTRY.
 
          MX2    12          GET *FCTF* FLAGS FROM STAGE REQUEST
          BX2    X2*X1
          LX2    -24
          BX4    X4+X2       MERGE *FCTF* FLAGS
          SX2    B1          GET BACKUP VSN FLAG FROM STAGE REQUEST
          LX2    39-0
          BX2    X2*X3
          BX4    X4+X2       UPDATE BACKUP VSN FLAG, IF SET
          MX7    3           CHECK RETRY COUNT
          LX7    36-57
          BX6    X7*X4       EXISTING RETRY COUNT
          BX2    X7*X3       NEW RETRY COUNT
          IX1    X2-X6
          NG     X1,AEV2     IF NOT NEWER RETRY INFORMATION
          IX4    X4+X1       UPDATE RETRY COUNT
 AEV2     BX6    X4
          SA6    A4
          EQ     AEVX        RETURN
 
*         ADD NEW ENTRY TO VSN LIST.
 
 AEV3     MX2    -24         GET PACKED VSN
          BX4    -X2*X1
          MX2    12          GET *FCTF* FLAGS
          BX2    X2*X1
          LX2    -24
          BX4    X4+X2
          MX6    4           GET RETRY COUNT AND BACKUP VSN BIT
          LX6    36-56
          BX6    X6*X3
          BX6    X4+X6       MERGE VSN, FLAGS AND RETRY INFORMATION
          SA6    A4
          BX7    X7-X7       CLEAR LWA+1 OF TABLE
          SA7    A4+B1
          SX6    A7          SET ADDRESS+1 OF LAST ENTRY
          SA6    LSVL
          SA2    AEVA        CHECK FOR MORE MEMORY NEEDED
          AX2    30
          SX3    A7+/COMSMTX/RCALL+8
          IX3    X2-X3
          PL     X3,AEVX     IF NOT NEAR END OF FL
          MEMORY CM,A2,R,X2+MEMI  INCREASE FIELD LENGTH
          EQ     AEVX        RETURN
 
 
 AEVA     VFD    30/RFL=,30/0  CURRENT FIELD LENGTH
 ASF      SPACE  4,10
**        ASF - ATTACH STAGE REQUEST FILE.
*
*         EXIT   STAGE REQUEST FILE ATTACHED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*
*         MACROS ATTACH, DEFINE, INTRPT, MESSAGE, RECALL, RETURN,
*                REWIND, ROLLOUT.
 
 
 ASF      SUBR               ENTRY/EXIT
 ASF1     ATTACH R,,,,W,,,DF,,RT  ATTACH STAGE REQUEST FILE
          SA1    X2          CHECK FOR ERRORS
          MX6    -8
          AX1    10-0
          BX1    -X6*X1      EXTRACT ERROR CODE
          ZR     X1,ASF5     IF FILE ATTACHED SUCCESSFULLY
          SX2    X1-/ERRMSG/FBS
          ZR     X2,ASF2     IF FILE BUSY
          SX2    X1-/ERRMSG/FNF
          ZR     X2,ASF3     IF FILE NOT FOUND
          SX2    X1-/ERRMSG/PFA
          NZ     X2,ASF1     IF NOT PF UTILITY ACTIVE
 ASF2     INTRP  PIT         PROCESS INTERRUPT
          MESSAGE ASFA,2,R   POST MESSAGE
          ROLLOUT            ROLLOUT ON BUSY FILE
          REWIND S1,R        ASSURE ROLLOUT COMPLETE
          EQ     ASF1        RETRY *ATTACH*
 
*         DEFINE FILE IF FILE MISSING.
 
 ASF3     RETURN R
 ASF4     RECALL             GIVE UP CPU
          DEFINE R,,,,,,,,,DF,N,L
          SA1    X2
          MX6    -8
          AX1    10-0
          BX1    -X6*X1      EXTRACT ERROR CODE
          ZR     X1,ASF5     IF DEFINE SUCCESSFUL
          SX2    X1-/ERRMSG/PFA
          NZ     X2,ASF4     IF NOT PF UTILITY ACTIVE
          INTRP  PIT         PROCESS INTERRUPT
          MESSAGE ASFA,2,R   POST MESSAGE
          ROLLOUT            ROLLOUT ON UTILITY ACTIVE
          EQ     ASF4        RETRY *DEFINE*
 
*         FILE ATTACHED OR DEFINED.
 
 ASF5     BX6    X6-X6       SET *FILE ATTACHED* FLAG
          SA6    R-1
          EQ     ASFX        RETURN
 
 
 ASFA     DATA   C*WAITING FOR STAGE REQUEST FILE.*
 GVS      SPACE  4,15
**        GVS - GET VSN FOR STAGING TAPE.
*
*         ENTRY  FROM *LFM* WITH NO VSN SPECIFIED.
*
*         EXIT   (PVST) = PACKED VSN OF STAGING TAPE.
*                VSN ADDED TO FET.
*                TO *RMT* TO REQUEST TAPE.
*
*         USES   X - 0, 1, 2, 3, 5, 7.
*                A - 1, 2, 3, 5, 7.
*                B - 6, 7.
*
*         CALLS  ASF, BPD, BRE, COV, DXB, PRO, UVL.
*
*         MACROS RDSB, RTRF, WRITER, WTSB.
 
 
 GVS      BSS    0           ENTRY
          RJ     ASF         ATTACH STAGE REQUEST FILE
          BX7    X7-X7       SET *OPERATOR ASSIGNMENT* FLAG
          SA7    AA
          BX1    X1-X1       SET *REQUEST FILE NOT YET READ*
 GVS1     RJ     UVL         UPDATE STAGING TAPE VSN LIST
          RJ     BPD         BUILD PREVIEW DISPLAY
          RJ     BRE         BUILD RESOURCE ENVIRONMENT
          SA1    RETE
          SB6    X1
          SB6    B6+B6       INDEX INTO *EVSB* FOR LAST ENTRY
 
*         GET VSN OF NEXT AVAILABLE TAPE FROM *EVSB*.
 
 GVS2     SA5    GVSA        MASK FOR SECOND WORD OF *EVSB* ENTRY
          MX0    36          MASK OF VSN/PACKNAM
 GVS3     ZR     B6,GVS12    IF NO AVAILABLE STAGING TAPES IN *EVSB*
          SB6    B6-2        CHECK NEXT TAPE
          SA1    EVSB+B6     LOAD *EVSB* ENTRY
          SA2    A1+B1
          BX3    X0*X1
          BX6    X5*X2
          ZR     X3,GVS3     IF NO VSN PRESENT
          NZ     X6,GVS3     IF RESOURCE NOT AVAILABLE
 
*         CONVERT VSN TO PACKED VSN.
 
          LX1    12          POSITION OFFSET
          SB7    B1          ASSUME DECIMAL CONVERSION
          BX5    X0*X1       EXTRACT OFFSET
          RJ     DXB         CONVERT OFFSET TO BINARY
          NZ     X4,GVS2     IF ERROR IN CONVERSION
          SX7    X6-5000
          MX0    12
          NG     X7,GVS4     IF NOT BACKUP VSN
          BX6    X7          USE LOWER SET (0-4095) IN COMPARISION
 GVS4     SA1    A1          RELOAD VSN
          BX2    X0*X1
          LX2    -36         POSITION VSN PREFIX
 
*         CHECK IF A STAGING REQUEST EXISTS FOR THIS TAPE.
 
          SA3    STVL-1
          BX6    X2+X6       BUILD PACKED VSN ENTRY
 GVS5     SA3    A3+B1       ADVANCE TO NEXT ENTRY
          ZR     X3,GVS2     IF END OF VSN LIST ENCOUNTERED
          IX7    X3-X6
          MX0    -24
          BX7    -X0*X7
          NZ     X7,GVS5     IF PACKED VSN DOES NOT MATCH
 
*         CHECK TAPE DEVICE TYPE AGAINST REQUEST.
 
          MX0    -6          GET RESOURCE INDEX
          BX2    -X0*X1
          BX4    X3
          LX4    59-32
          LX3    59-30
          NG     X4,GVS7     IF REQUEST FOR *AT* (ACS CARTRIDGE TAPE)
          LX4    59-31-59+32
          NG     X4,GVS8     IF REQUEST FOR *CT* (CARTRIDGE TAPE)
          SX7    X2-RGEP
          ZR     X7,GVS6     IF AVAILABLE TAPE IS *GE*
          SX7    X2-RPEP
          NZ     X7,GVS5     IF AVAILABLE TAPE IS NOT *PE*
 
*         AVAILABLE *PE* TAPE FOUND WITH STAGE REQUEST OUTSTANDING.
 
          SX7    /COMSMTX/D16  SET 1600 CPI DENSITY
          SX4    /COMSMTX/DVNT SET *NT* DEVICE TYPE
          EQ     GVS9        SET TAPE PARAMETERS INTO FET
 
*         AVAILABLE *GE* TAPE FOUND WITH STAGE REQUEST OUTSTANDING.
 
 GVS6     SX7    /COMSMTX/D62  SET 6250 CPI DENSITY
          SX4    /COMSMTX/DVNT SET *NT* DEVICE TYPE
          EQ     GVS9        SET TAPE PARAMETERS INTO FET
 
*         AVAILABLE *AT* TAPE FOUND WITH STAGE REQUEST OUTSTANDING.
 
 GVS7     SX7    X2-RATP
          NZ     X7,GVS5     IF AVAILABLE TAPE IS NOT *AT*
          SX7    /COMSMTX/D380  SET 38000 CPI DENSITY
          SX4    /COMSMTX/DVAT  SET *AT* DEVICE TYPE
          EQ     GVS9        SET TAPE PARAMETERS INTO FET
 
*         AVAILABLE *CT* TAPE FOUND WITH STAGE REQUEST OUTSTANDING.
 
 GVS8     SX7    X2-RCTP
          NZ     X7,GVS5     IF AVAILABLE TAPE IS NOT *CT*
          SX7    /COMSMTX/D380  SET 38000 CPI DENSITY
          SX4    /COMSMTX/DVCT  SET *CT* DEVICE TYPE
          EQ     GVS9        SET TAPE PARAMETERS INTO FET
 
*         SET TAPE DESCRIPTORS, TAPE BLOCK DEFINITION, AND VSN.
 
 GVS9     SA2    GVSC        GET TAPE DESCRIPTORS
          LX4    55-0
          BX2    X2+X4       SET TAPE DEVICE TYPE
          LX7    51-0
          BX2    X2+X7       SET DENSITY
          SX7    /COMSMTX/TFI
          PL     X3,GVS10    IF NOT *LI* FORMAT
          SX7    /COMSMTX/TFLI
 GVS10    SA5    TTFM+X7     GET TAPE FORMAT CHARACTERISTICS
          LX7    30-0        SET TAPE FORMAT
          BX7    X2+X7
          SA2    F+FTAP      GET REQUESTED OPTIONS
          MX0    12
          LX0    -12
          BX2    X0*X2       REQUESTED OPTIONS
          BX7    X2+X7       TAPE DESCRIPTORS AND REQUESTED OPTIONS
          SA7    A2          STORE TAPE DESCRIPTORS AND OPTIONS
          LX5    -24
          MX0    -24
          BX7    -X0*X5      SET BLOCK SIZE (WORD COUNT AND OVERFLOW)
          SA7    TB
          SA6    PVST        SET PACKED VSN BEING ASSIGNED
          MX0    36
          BX6    X0*X1       VSN
          SA6    EVSN        SET EXTERNAL VSN
          SA6    IVSN        SET INTERNAL VSN
          SA6    F+FVSN      SET VSN FOR POSSIBLE DUPLICATE VSN CHECK
 
*         CLEAR TAPE ALTERNATE STORAGE VSN LIST.
 
          SA2    STVL+1
          ZR     X2,GVS11    IF ONLY ONE VSN WAS IN LIST
          SA1    GVSB
          SX6    B1
          LX6    36-0        POSITION *MORE VSN-S* FLAG
          BX6    X6+X1
          SA6    A1
 GVS11    WTSB   GVSB,0      SEND CODE TO CLEAR VSN LIST
          WRITER R,R         FLUSH BUFFER FOR REQUEST FILE
          RJ     COV         CLEAR OPERATOR VERIFY FLAG
          EQ     RMT         REQUEST MAGNETIC TAPE
 
*         NO STAGING TAPE AVAILABLE.
 
 GVS12    RETRF  D           DROP INTERLOCK
          SX5    WSTG        SET EVENT DESCRIPTOR
          SA1    WSTG+1      *WAITING FOR STAGING TAPE.*
          RJ     PRO         PROCESS TIMED EVENT ROLLOUT
          SX1    B1          SET *REQUEST FILE ALREADY READ*
          EQ     GVS1        TRY AGAIN
 
 
 GVSA     VFD    12/,12/-0,6/-0,18/,12/-0
 GVSB     VFD    12//COMSMTX/SEV,12/,18/0,18//COMSMTX/RCALL  CLEAR VSNS
          DATA   0           END OF LIST MARKER
 
*         CONSTANT TAPE DESCRIPTORS FOR STAGING TAPE ASSIGNMENT.
*         LB=KL, CV=AS.
 
 GVSC     VFD    6/20B,3/0,3//COMSMTX/ANS,12/0,6/0,6/0,24/0
 UVL      SPACE  4,20
**        UVL - UPDATE STAGING TAPE VSN LIST.
*
*         ENTRY  STAGE REQUEST FILE ATTACHED.
*                (X1) = 1, IF STAGE REQUEST FILE ALREADY READ.
*
*         EXIT   VSN LIST UPDATED AND TRANSMITTED TO *MAGNET*.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 0, 1, 2, 6.
*                B - 6.
*
*         CALLS  AEV.
*
*         MACROS MOVE, READEI, READW, RECALL, RDSB, WRITE, WRITEW, WTSB.
 
 
 UVL      SUBR               ENTRY/EXIT
          NZ     X1,UVL2     IF REQUEST FILE ALREADY READ
          BX6    X6-X6       INITIALIZE VSN LIST
          SA6    STVL
          SA6    A6+B1
          SX6    A6-B1
          SA6    LSVL
 
*         READ REQUESTS FROM REQUEST FILE.
 
          READEI R
 UVL1     READW  R,UVLA,/COMSMTX/PFTBL
          NZ     X1,UVL2     IF END OF FILE
          SB6    UVLA        SET ADDRESS OF ENTRY
          RJ     AEV         ADD ENTRY TO VSN LIST
          EQ     UVL1        READ NEXT REQUEST FROM FILE
 
*         READ REQUESTS FROM *MAGNET*-S FL AND COPY TO REQUEST FILE.
 
 UVL2     WRITE  R,*         SET WRITE CODE
 UVL3     RJ     GSR         GET STAGE REQUEST FROM *MAGNET*
          NG     B6,ERR3     IF CANNOT COMMUNICATE WITH *MAGNET*
          ZR     B6,UVL4     IF NO REQUEST
          SA0    B6          HOLD ADDRESS
          WRITEW R,B6,/COMSMTX/PFTBL  COPY REQUEST TO REQUEST FILE
          SB6    A0          ADDRESS OF STAGE REQUEST
          RJ     AEV         ADD ENTRY TO VSN LIST
          EQ     UVL3        GET NEXT REQUEST FROM *MAGNET*
 
*         TRANSFER UPDATED VSN LIST TO *MAGNET*.
 
 UVL4     SX0    STVL
          SX6    /COMSMTX/SEV
          SA1    X0+B1
          SX7    /COMSMTX/RCALL
          LX6    48-0
          BX6    X6+X7
          ZR     X1,UVL5     IF ONLY 1 VSN IN LIST
          SX1    B1
 UVL5     LX1    36-0
          BX6    X6+X1       SET MULTIPLE VSN FLAG
          SA6    UVLB        SET VSN HEADER BLOCK
 UVL6     MOVE   /COMSMTX/RCALL-1,X0,UVLB+1
          WTSB   UVLB,0      SEND VSN LIST
 UVL7     RECALL
          RDSB   MTSI,1,/COMSMTX/RCAL,UVLD
          SA1    UVLD
          NZ     X1,UVL7     IF NOT PROCESSED
          SA1    UVLB
          SA2    LSVL        GET LAST ENTRY+1
          SX6    /COMSMTX/RCALL-1
          IX0    X0+X6
          LX6    18
          IX6    X6+X1
          IX7    X2-X0
          SA6    A1
          PL     X7,UVL6     IF MORE IN LIST
          EQ     UVLX        RETURN
 
 
 UVLA     BSSZ   /COMSMTX/PFTBL  REQUEST BLOCK
 UVLB     VFD    12//COMSMTX/SEV,30/**,18//COMSMTX/RCALL  SET VSN
          BSSZ   /COMSMTX/RCALL-1
 UVLD     BSS    1           RSB TRANSFER BLOCK
          TITLE  PREVIEW DISPLAY SUBROUTINES.
 BPD      SPACE  4,15
**        BPD - BUILD PREVIEW DISPLAY.
*
*         ENTRY  (RESB) = DEMAND ENTRY OF CURRENT REQUESTOR.
*
*         EXIT   PREVIEW BUFFER BUILT AND UPDATED.
*                ACS TAPE MOUNT REQUESTS SENT TO MAGNET.
*
*         USES   X - 0, 1, 2, 4, 6, 7.
*                A - 1, 2, 6.
*                B - 2, 3, 5.
*
*         CALLS  BSP, CRB, CTA, EPB, PTE.
*
*         MACROS CLEAR, FATRF, PDATE, READ, READW, RETRF, SYSTEM, WTSB.
 
 
 BPD      SUBR               ENTRY/EXIT
 
*         CLEAR BUFFERS.
 
          CLEAR  RPRB,RPBL
          CLEAR  AMRB,RMBL
 
*         ATTACH DEMAND FILE AND INITIALIZE FOR PRIORITY CALCULATION.
 
          FATRF  D,RM        ATTACH DEMAND FILE
          READ   X2          READ DEMAND FILE
          PDATE  BPDA        GET PACKED DATE AND TIME
          SA1    BPDA
          RJ     PTE         CONVERT TO ABSOLUTE SECONDS
          SA6    BPDA
 
*         CHECK DEMAND FILE ENTRY FOR MOUNT REQUEST.
 
 BPD1     READW  D,BUF,RDEL  READ DEMAND FILE ENTRY
          NZ     X1,BPD4     IF END OF FILE
          SA2    BUF+RREQ
          ZR     X2,BPD1     IF NO REQUEST
 
*         CALCULATE PRIORITY.
*
*         PRIORITY = ((A+1)*T)/(D-A).
*
*                A = NUMBER OF UNITS ASSIGNED.
*                T = TIME THE REQUEST HAS BEEN WAITING IN SECONDS.
*                D = TOTAL NUMBER OF UNITS DEMANDED.
 
          SX4    BUF
          SB5    -1          COUNT TOTAL ASSIGNS AND DEMANDS
          RJ     CTA
          SX4    B3
          MX0    -10
          BX4    -X0*X4      TRUNCATE ASSIGNS TO 10 BITS
          BX0    -X0*X7      TRUNCATE DEMANDS TO 10 BITS
          NZ     X0,BPD2     IF DEMAND SPECIFIED
          SX0    B1+         SET DEFAULT DEMAND
 BPD2     SA1    BPDA
          SA2    BUF+RREQ
          IX1    X1-X2       T
          IX6    X0-X4       D-A
          SX0    X4+B1       A+1
          IX0    X0*X1       (A+1)*T
          IX0    X0/X6       ((A+1)*T)/(D-A)
          NZ     X0,BPD3     IF NON-ZERO PRIORITY
          SX0    1           SET PRIORITY
 BPD3     RJ     EPB         ENTER PREVIEW BUFFER
          EQ     BPD1        CHECK NEXT ENTRY
 
 BPD4     RETRF  D           RETURN DEMAND FILE, RELEASE INTERLOCK
 
*         ADD STAGING TAPE REQUESTS TO PREVIEW BUFFER.
 
          RJ     BSP         BUILD STAGING TAPE PREVIEW ENTRIES
 
*         COMPACT AND TRANSFER REQUEST BUFFERS.
 
          SB2    RPRB
          SB3    RPBE
          RJ     CRB         COMPACT PREVIEW BUFFER
          SA1    BPDB
          SX2    B4-RPRB     LENGTH OF ENTRIES
          MX6    42
          LX2    18
          LX6    18
          BX1    X6*X1
          BX6    X1+X2       SET LENGTH IN REQUEST
          SA6    A1
          SYSTEM SFM,R,RPRB,TPDF*100B  TRANSFER PREVIEW REQUESTS
          WTSB   BPDB,0      INDICATE PREVIEW DISPLAY UPDATED
          SB2    AMRB+1
          SB3    2
          RJ     CRB         COMPACT MOUNT REQUEST BUFFER
          SX7    /COMSMTX/AMR
          SX6    B4-AMRB     BUFFER LENGTH
          LX7    48
          BX6    X7+X6       MERGE REQUEST CODE AND BUFFER LENGTH
          SA6    AMRB        SET REQUEST HEADER
          WTSB   AMRB,0      SEND MOUNT REQUESTS TO MAGNET
          EQ     BPDX        RETURN
 
 
 BPDA     CON    0           CURRENT TIME
 BPDB     VFD    12//COMSMTX/PDU,12/0,18/0,18/1
 BSP      SPACE  4,10
**        BSP - BUILD STAGING TAPE PREVIEW ENTRIES.
*
*         USES   X - ALL.
*                A - 1, 2, 4, 6, 7.
*
*         CALLS  CDD, EPB.
*
*         MACROS RDSB.
 
 
 BSP      SUBR               ENTRY/EXIT
          RDSB   MTSI,1,/COMSMTX/TVSP,BSPA,X  GET VSN LIST POINTER
          SA1    SS
          PL     X1,BSPX     IF *MAGNET* IS NOT ACTIVE
          SA1    BSPA        NUMBER OF STAGING VSN-S TO DISPLAY AT ONCE
          ZR     X1,BSPX     IF NOT DISPLAYING STAGING VSN-S
 
*         READ LIST OF STAGING TAPE VSN-S FROM *MAGNET*.
 
          SX7    X1          GET FWA OF TABLE
          AX1    30
          SX5    X1          GET WORD COUNT
          SX2    X5-BSPBL
          NG     X5,BSP1     IF NOT OVER MAXIMUM
          SX5    BSPBL
 BSP1     RDSB   MTSI,X5,X7,BSPB   READ VSN LIST FROM *MAGNET*
          SX6    B0+
          SA6    BSPC        SET CURRENT OFFSET
 
*         GET NEXT STAGING TAPE VSN.
 
 BSP2     SA1    BSPC        GET OFFSET
          SA2    BSPB+X1     LOAD VSN ENTRY
          SX6    X1+1
          SA6    A1+
          ZR     X2,BSPX     IF ALL VSN ENTRIES PROCESSED
 
*         CONSTRUCT PREVIEW DATA FROM VSN WORD.  THE PREVIEW ENTRY WILL
*         HAVE AN EJT ORDINAL OF ZERO AND A USER NAME OF *(STAGE)*.
 
          BX3    X2
          LX3    59-32
          SX7    2RAT        RESOURCE TYPE FOR *AT* TAPE
          NG     X3,BSP3     IF REQUEST FOR *AT* TAPE
          SX7    2RCT        RESOURCE TYPE FOR *CT* TAPE
          LX3    59-31-59+32
          NG     X3,BSP3     IF REQUEST FOR *CT* TAPE
          SX7    /COMSMTX/DSTD  RESOURCE TYPE FOR *NT* TAPE
 BSP3     LX7    12
          SA7    BUF+RQPV+PRES  SET RESOURCE TYPE
          MX7    -12
          BX1    -X7*X2      VSN ORDINAL
          LX2    0-12
          BX0    -X7*X2      VSN PREFIX
 BSP4     SX1    X1+10000    ASSURE LEADING ZEROS
          RJ     CDD         CONVERT ORDINAL TO DISPLAY
          MX3    4*6
          LX4    6
          BX3    X3*X4       EXTRACT DIGITS
          LX0    48-0        POSITION VSN PREFIX
          LX3    -12
          BX6    X3+X0       MERGE PREFIX AND ORDINAL
          SA6    BUF+RQPV+PVSN  SET EXTERNAL VSN
          SA6    BUF+RQPV+PVSI  SET INTERNAL VSN
          SA4    BSPD        USER NAME = *(STAGE)*, EJT ORDINAL = ZERO
          SX6    5           SET LABELED AND READ ONLY FLAGS
          LX6    18
          BX7    X4
          SA6    BUF+RQPV+PFLG
          SA7    BUF+RQPV+PJID  SET USER AND JOB IDENTIFICATION
          SX0    B1          SET SPECIAL PRIORITY
          LX0    58-0
          RJ     EPB         ENTER PREVIEW BUFFER
          EQ     BSP2        PROCESS NEXT ENTRY
 
 
 BSPA     BSS    1           STAGING TAPE VSN POINTER FROM *MAGNET*
 BSPB     BSSZ   /COMSMTX/SVMX  VSN LIST BUFFER
 BSPBL    EQU    *-BSPB
 BSPC     BSS    1           CURRENT OFFSET INTO *BSPB*
 BSPD     VFD    42/7L(STAGE),6/0,12/0
 CRB      SPACE  4,15
**        CRB - COMPACT REQUEST BUFFER.
*
*         ENTRY  (B2) = ADDRESS OF FIRST UNCOMPACTED ENTRY.
*                (B3) = UNCOMPACTED ENTRY LENGTH.
*
*         EXIT   BUFFER ENTRIES COMPACTED (PRIORITY WORD REMOVED).
*                COMPACTED ENTRIES TERMINATED WITH ZERO WORD.
*                (B4) = ADDRESS OF TERMINATOR WORD.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2, 4, 5.
*
*         MACROS MOVE.
 
 
 CRB      SUBR               ENTRY/EXIT
          SB4    B2+         INITIALIZE COMPACTED ENTRY POINTER
          SB5    B3-1        SET COMPACTED ENTRY LENGTH
 CRB1     SA1    B2
          ZR     X1,CRB2     IF END OF ENTRIES
          MOVE   B5,B2+B1,B4 MOVE ENTRY
          SB2    B2+B3       ADVANCE UNCOMPACTED ENTRY POINTER
          SB4    B4+B5       ADVANCE COMPACTED ENTRY POINTER
          EQ     CRB1        CHECK NEXT ENTRY
 
 CRB2     SX6    B0
          SA6    B4          TERMINATE ENTRIES
          EQ     CRBX        RETURN
 EPB      SPACE  4,15
**        EPB - ENTER PREVIEW OR MOUNT REQUEST BUFFER.
*
*         ENTRY  (X0) = PRIORITY.
*                (BUF) = DEMAND FILE ENTRY.
*
*         EXIT   ENTRY ADDED TO PREVIEW BUFFER OR MOUNT REQUEST BUFFER
*                  IF POSSIBLE.
*
*         USES   A - 1, 5, 6.
*                X - 1, 2, 3, 5, 6, 7.
*
*         MACROS MOVE.
 
 
 EPB      SUBR               ENTRY/EXIT
 
*         CHECK FOR ACS TAPE REQUEST.
 
          SA1    BUF+RQPV+PRES
          MX6    -12
          LX1    -12
          BX1    -X6*X1      RESOURCE TYPE
          SX1    X1-2RAT
          NZ     X1,EPB3     IF NOT *AT* TAPE REQUEST
          SA5    AMRB+1-RMBE
 
*         FIND LOCATION IN MOUNT REQUEST BUFFER.
 
 EPB1     SA5    A5+RMBE     GET NEXT ENTRY
          IX5    X5-X0
          PL     X5,EPB1     IF OLD ENTRY PRIORITY .GE. NEW
          SX6    AMRB+RMBL-1-RMBE  ADDRESS OF LAST ENTRY
          SX2    A5          SET SOURCE ADDRESS
          IX1    X6-X2       SET TO MOVE ALL ENTRIES BUT LAST
          NG     X1,EPB2     IF AT END OF FULL BUFFER
          SX3    A5+RMBE     SET DESTINATION ADDRESS
          MOVE   X1,X2,X3    MOVE LOWER PRIORITY ENTRIES
 
*         ENTER MOUNT REQUEST IN BUFFER.
 
          SA1    BUF+RQPV+PVSN  GET VSN
          BX6    X0
          SA6    A5          SET PRIORITY WORD
          MX7    36
          BX6    X7*X1       VSN
          SA6    A5+1
 
*         CHECK FOR PREVIEW DISPLAY MESSAGE ON ACS TAPE REQUEST.
 
 EPB2     SA1    BUF+RQPV+PFLG
          MX7    -6
          LX1    -12
          BX1    -X7*X1      PREVIEW DISPLAY MESSAGE CODE
          ZR     X1,EPBX     IF NO PREVIEW DISPLAY MESSAGE
 
*         FIND LOCATION IN PREVIEW BUFFER.
 
 EPB3     SA5    RPRB-RPBE
 EPB4     SA5    A5+RPBE     GET NEXT ENTRY
          IX5    X5-X0
          PL     X5,EPB4     IF OLD ENTRY PRIORITY .GE. NEW
          SX6    RPRB+RPBL-1-RPBE  ADDRESS OF LAST ENTRY
          SX2    A5          SET SOURCE ADDRESS
          IX1    X6-X2       SET TO MOVE ALL ENTRIES BUT LAST
          NG     X1,EPBX     IF AT END OF FULL BUFFER
          SX3    A5+RPBE     SET DESTINATION ADDRESS
          MOVE   X1,X2,X3    MOVE LOWER PRIORITY ENTRIES
 
*         ENTER REQUEST IN PREVIEW BUFFER.
 
          BX6    X0
          SA6    A5          SET PRIORITY WORD
          MOVE   PVEL,BUF+RQPV,A5+B1  MOVE PREVIEW ENTRY
          EQ     EPBX        RETURN
          TITLE  UTILITY SUBROUTINES.
 BEV      SPACE  4,10
**        BEV - BUILD EVENT.
*
*         ENTRY  (X1) = VSN OR PACKNAME.
*                (X3) = EVENT SKELETON.
*
*         EXIT   (X6) = ROLLOUT EVENT.
*
*         USES   X - 0, 1, 5, 6, 7.
 
 
 BEV      SUBR               ENTRY/EXIT
          MX0    -12         BUILD ROLLOUT EVENT
          LX1    12
          BX6    -X0*X1      SUM INDIVIDUAL BYTES OF VSN OR PACKNAME
          LX1    12
          BX5    -X0*X1
          IX6    X5+X6
          LX1    12
          BX5    -X0*X1
          IX6    X5+X6
          LX1    12
          BX5    -X0*X1
          IX6    X5+X6
          BX7    -X0*X6      TRUNCATE TO LOWER 12 BITS
          LX7    12
          BX6    X7+X3
          EQ     BEVX        RETURN
 BTR      SPACE  4,10
**        BTR - BUILD TAPE ASSIGNMENT REQUEST BLOCK.
*
*         ENTRY  UDT ENTRY IN *UDT*.
*
*         EXIT   TAPE ASSIGNMENT REQUEST IN *BUF*.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*
*         CALLS  IUT.
 
 
 BTR      SUBR               ENTRY/EXIT
 
*         SET REQUEST HEADER.
 
          SA1    AV
          SA2    RETI
          SX6    /COMSMTX/RMA
          SX7    13B         LENGTH OF REQUEST
          LX6    48          FUNCTION CODE
          SX1    X1-EVSB
          AX1    1           *EVSB* INDEX
          IX1    X1-X2       UDT ORDINAL
          LX1    36
          BX6    X6+X1
          BX6    X6+X7
          SA6    BUF         SET REQUEST HEADER
 
*         SET *UVSN* AND *UMST* FOR VERIFICATION BY MAGNET.
 
          SA1    UDT+/COMSMTX/UVSN
          SA2    UDT+/COMSMTX/UMST
          BX6    X1
          BX7    X2
          SA6    A6+B1       BUF+1
          SA7    A6+B1       BUF+2
 
*         SET TAPE DESCRIPTORS AND BLOCK SIZE (*UST4*).
 
          SA1    F+FTAP      GET TAPE DESCRIPTORS
          SA2    TB          GET BLOCK SIZE
          MX6    30
          BX1    X6*X1
          BX6    X1+X2       MERGE TAPE DESCRIPTORS AND BLOCK SIZE
          SA6    A7+B1       BUF+3
 
*         SET EJT ORDINAL, VSN FILE ADDRESS, AND REEL NUMBER, (*UVRI*).
 
          SA1    JEEO        GET EJT ORDINAL
          SA2    VA          GET VSN FILE RANDOM ADDRESS
          SA3    T+FESN      GET REEL NUMBER IF TMS REQUEST
          MX0    -12
          LX1    48
          LX2    24
          BX3    -X0*X3
          LX3    12
          BX1    X1+X2       MERGE EJT ORDINAL AND VSN FILE ADDRESS
          BX6    X1+X3       MERGE REEL NUMBER
          SA6    A6+B1       BUF+4
 
*         SET TMS FLAGS (*UTMS*).
 
          RJ     IUT         INITIALIZE *UTMS*
          SA7    BUF+5
 
*         SET TMS CATALOG INDEX (*UTCI*).
 
          SA2    T+FRAN      GET CATALOG INDEX
          BX6    X2
          SA6    A7+B1       BUF+6
 
*         SET EXTERNAL VSN AND FLAGS (*UESN*).
 
          SA1    EVSN        GET EXTERNAL VSN
          SA2    RESB+RQPV+PRES  GET RESOURCE TYPE, ACCESS LEVEL, FLAGS
          MX0    36
          BX2    -X0*X2
          BX6    X1+X2       MERGE VSN AND PREVIEW DISPLAY DATA
          SA6    A6+B1       BUF+7
 
*         SET INTERNAL VSN AND FLAGS (*UISN*).
 
          SA1    IVSN        GET INTERNAL VSN
          SA2    RESB+RQPV+PFLG  GET FLAGS
          SA3    UDT+/COMSMTX/UST1
          SA4    TMPF
          BX2    -X0*X2
          LX3    59-49
          LX4    59-58
          PL     X3,BTR1     IF NOT ACS UNIT REQUEST
          NG     X4,BTR1     IF TMS CONTROLLED REQUEST
          SA1    UDT+/COMSMTX/UVSN  USE ACTUAL VSN
 BTR1     BX1    X0*X1       VSN
          BX6    X1+X2       MERGE VSN AND FLAGS
          SA6    BUF+10B
 
*         SET USER NAME, FAMILY ORDINAL, AND SPECIFIED FILE
*         ACCESSIBILITY (*UUFN*).
 
          SA1    F+FFAS      GET SPECIFIED FILE ACCESSIBILITY
          SA2    RESB+RQPV+PJID  GET USER NAME AND FAMILY
          MX0    48
          SX6    7700B
          LX1    -12
          BX2    X0*X2
          BX1    X6*X1
          BX6    X1+X2       MERGE USER NAME, FAMILY, AND FILE ACCESS
          SA6    A6+B1       BUF+11B
 
*         SET JSN AND PACKED VSN FOR STAGING TAPE ASSIGNMENT.
 
          SA1    JSN
          SA2    PVST        PACKED VSN, IF STAGING TAPE ASSIGNMENT
          BX6    X1+X2
          SA6    A6+B1       BUF+12B
          EQ     BTRX        RETURN
 BWM      SPACE  4,15
**        BWM - BUILD WAITING FOR TAPE/PACK MESSAGE.
*
*         ENTRY  (X1) = COMPLEMENT OF MESSAGE SKELETON ADDRESS.
*                PREVIEW INFORMATION IN *RESB+RQPV*.
*
*         EXIT   (X1) = ADDRESS OF UPDATED MESSAGE.
*
*         USES   X - 1, 2, 4, 6.
*                A - 1, 2, 4.
*                B - 2, 3, 5.
*
*         CALLS  SFN, SNM.
 
 
 BWM      SUBR               ENTRY/EXIT
          SA2    RESB+RQPV+PRES
          SB5    X1          COMPLEMENT OF MESSAGE SKELETON ADDRESS
          LX2    59-5
          SA1    SCRATCH
          NG     X2,BWM1     IF SCRATCH VSN
          SA4    RESB+RQPV+PVSN  GET VSN OR PACKNAME
          SA1    BLANK
          BX1    X4-X1       CONVERT TRAILING BLANKS TO ZEROS
          RJ     SFN         COMPUTE MASK OF NON-BLANK CHARACTERS
          BX1    X7*X4       REMOVE TRAILING BLANKS
 BWM1     SB2    1R+         REPLACEMENT CHARACTER
          SB3    WTPB        SET ASSEMBLY BUFFER ADDRESS
          RJ     SNM         INSERT VSN OR PACKNAME INTO MESSAGE
          SA2    RESB+RQPV+PRES  GET RESOURCE TYPE AND UNIT COUNT
          MX6    12
          LX2    59-23
          BX1    X6*X2       RESOURCE MNEMONIC
          LX2    59-4-59+23
          PL     X2,BWM2     IF NO UNIT COUNT
          MX6    -6
          LX2    0-9-59+4+60
          BX6    -X6*X2
          SX6    X6+1R1      UNIT COUNT
          LX6    42
          BX1    X1+X6       MERGE UNIT COUNT
 BWM2     SB5    WTPB        MESSAGE BUFFER
          SB2    1R-         REPLACEMENT CHARACTER
          RJ     SNM         INSERT RESOURCE TYPE INTO MESSAGE
          SX1    WTPB        ADDRESS OF NEW MESSAGE
          EQ     BWMX        RETURN
 CAL      SPACE  4,15
**        CAL - CHECK ACCESS LEVEL.
*
*         ENTRY  (X2) = EST ORDINAL IN BITS 59-48.
*                (X3) = *EVSB* ENTRY OF VSN TO BE CHECKED.
*                (EQ) = EST ORDINAL IF SPECIFIED.
*
*         EXIT   (TPAL) .GE. 0, IF TAPE ACCESS LEVEL WITHIN RANGE,
*                       .LT. 0, IF TAPE ACCESS LEVEL OUT OF RANGE,
*                       UNDEFINED, IF NOT CORRECT EQUIPMENT.
*                (X5) = 0, IF NO SPECIFIED EQUIPMENT
*                     .NE. 0, IF EQUIPMENT SPECIFIED.
*
*         USES   X - 0, 2, 5, 6, 7.
*                A - 2, 5.
 
 
 CAL      SUBR               ENTRY/EXIT
          SA5    EQ
          ZR     X5,CAL1     IF NO SPECIFIED EQUIPMENT
          BX5    X5-X2
          AX5    48
          NZ     X5,CALX     IF NOT CORRECT EQUIPMENT
 CAL1     SA2    SSMA        SYSTEM SECURITY MODE
          BX6    X2
          ZR     X6,CAL2     IF UNSECURED SYSTEM
          MX0    -3
          BX7    X3
          LX7    2-14
          BX5    -X0*X7      LOWER BOUND OF *EVSB* ENTRY
          LX7    2-11-2+14
          BX7    -X0*X7      UPPER BOUND OF *EVSB* ENTRY
          SA2    F+4
          LX2    -36
          BX2    -X0*X2      ACCESS LEVEL FROM FET
          IX6    X7-X2
          NG     X6,CAL2     IF NOT WITHIN ACCESS LEVEL LIMITS
          IX6    X2-X5
          NG     X6,CAL2     IF NOT WITHIN ACCESS LEVEL LIMITS
          LX5    3
          BX6    X7+X5       EQUIPMENT ACCESS LEVELS
 CAL2     SA6    TPAL
          BX5    X5-X5       SET EXIT CONDITION
          EQ     CALX        RETURN
 CBP      SPACE  4,10
**        CBP - CALCULATE RESOURCE BYTE POSITION.
*
*         ENTRY  (X2) = 51/0, 3/UNIT COUNT, 6/RESOURCE INDEX.
*
*         EXIT   (B2) = RESOURCE INDEX, ADJUSTED FOR CONTINUATION WORD.
*                (B4) = RIGHT SHIFT COUNT TO POSITION RESOURCE
*                     ASSIGNED AND DEMAND COUNT IN LOWER 12 BITS.
*
*         USES   B - 2, 4.
*                X - 1, 2, 3, 7.
 
 
 CBP      SUBR               ENTRY/EXIT
          MX3    -6
          BX1    -X3*X2      GET RESOURCE INDEX
          AX2    6
          SB2    X1+B1
          SX7    RPEW*2
          IX3    X7-X2
          MX2    -2
          BX2    -X2*X3
          LX2    2
          BX3    -X3
          LX7    X2,B1
          SB4    X2
          AX3    2
          SB4    B4+X7
          SB2    B2+X3       ADJUST FOR CONTINUATION WORD
          EQ     CBPX        RETURN
 CCV      SPACE  4,10
**        CCV - CHECK FOR CHANGE OF TMS SCRATCH VSN.
*
*         EXIT   REQUEST PARAMETERS UPDATED IF CHANGE IN TMS SCRATCH
*                  VSN.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*
*         CALLS  RDF.
 
 
 CCV      SUBR               ENTRY/EXIT
 
*         CHECK CHANGE OF SCRATCH *TMS* VSN.
 
          SA1    TMPF        CHECK FOR NON-*TMS* TAPE
          LX1    59-58
          PL     X1,CCVX     IF NOT *TMS* CONTROLLED REQUEST
          RJ     RDF         READ DEMAND FILE
          SA1    DBUF+RQPV+PVSI  GET INTERNAL VSN
          SA2    IVSN
          MX0    6*6
          BX2    X1-X2
          ZR     X2,CCVX     IF NO CHANGE IN VSN
          SA1    RQ          REPLACE INTERNAL VSN
          SA7    A2          UPDATE INTERNAL VSN
          BX1    -X0*X1
          BX6    X1+X7
          SA6    A1
          SA1    DBUF+RQPV+PVSN  GET NEW EXTERNAL VSN
          BX7    X1
          SA7    EVSN        UPDATE EXTERNAL VSN
          EQ     CCVX        RETURN
 CDT      SPACE  4,20
**        CDT - CHECK DEVICE TYPE.
*
*         ENTRY  (A2) = ADDRESS OF DEVICE TYPE TABLE.
*                (X7) = DEVICE CODE RIGHT JUSTIFIED.
*
*         EXIT   (X2) = 0 IF DEVICE TYPE NOT FOUND IN TABLE.
*                (X2) = DEVICE TYPE TABLE ENTRY IF FOUND.
*                (A2) = ADDRESS OF TABLE ENTRY IF FOUND.
*
*         USES   X - 2, 7.
*                A - 2.
*
*         DEVICE TYPE TABLE FORMAT -
*
*         42/ PARAMETERS,6/0,12/ DC
*
*                DC = TWO CHARACTER DEVICE CODE.
 
 
 CDT      SUBR               ENTRY/EXIT
 CDT1     BX7    X7-X2
          SX7    X7
          ZR     X7,CDTX     IF ENTRY FOUND
          BX7    X7-X2
          SA2    A2+B1
          NZ     X2,CDT1     IF MORE ENTRIES TO CHECK
          EQ     CDTX        RETURN WITH NOT FOUND STATUS
 CER      SPACE  4,15
**        CER - CHECK FOR *CIO* ERROR ON TAPE FILE OPERATION.
*
*         EXIT   TO CALLER IF NO ERROR.
*                TO *PER* IF ERROR.
*                ERROR PROCESSING CLEARED IF ERROR DETECTED.
*
*         USES   X - 1, 6.
*                A - 1.
*                B - 2.
*
*         MACROS SETFET.
 
 
 CER      SUBR               ENTRY/EXIT
          SA1    F           GET FET STATUS
          MX6    -5
          LX1    -9
          BX1    -X6*X1
          ZR     X1,CERX     IF NO ERROR
          SETFET F,ERP=0     CLEAR ERROR PROCESSING
          SB2    B0          SET NO MESSAGE
          EQ     PER         PROCESS ERROR
 CET      SPACE  4,15
**        CET - COPY EQUIPMENT STATUS TABLE (EST).
*
*         ENTRY  (B5) .LT. 0 IF INITIAL CALL.
*
*         EXIT   (B6) = NUMBER OF EST ENTRIES IN BUFFER.
*                (B6) .LT. 0 IF END OF EST.
*
*         ERROR  TO *PER*, IF ENVIRONMENT ERROR.
*
*         USES   A - 1, 2, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 5, 6, 7.
*
*         MACROS RDSB.
 
 
 CET      SUBR               ENTRY/EXIT
          PL     B5,CET1     IF NOT INITIAL CALL
          SA1    /LWC/ESTP   GET EST FWA
          MX0    -12
          LX1    24
          SX7    X1
          LX1    12
          BX6    -X0*X1      GET NUMBER OF ENTRIES IN EST
          SA7    CETA
          SA6    A7+B1
 CET1     SA1    CETA        GET NEXT BLOCK EST ADDRESS
          SA2    A1+B1       GET REMAINING EST ENTRIES
          MX6    1
          SX5    ESTEB       EST ENTRIES PER BLOCK
          SA6    SBUF2
          IX7    X2-X5
          PL     X7,CET2     IF STILL MORE BLOCKS TO TRANSFER
          SB6    -B1
          ZR     X2,CETX     IF END OF EST
          BX7    X7-X7
          LX5    X2          SET REMAINING NUMBER OF ENTRIES
 CET2     SA7    A2          DECREMENT REMAINING ENTRY COUNT
          SB6    X5          NUMBER OF EST ENTRIES TO TRANSFER
          R=     X2,ESTE
          IX5    X5*X2       LENGTH OF BLOCK TO TRANSFER
          IX7    X1+X5       ADVANCE EST ADDRESS
          SA7    A1
          RDSB   0,X5,X1,A6  READ EST BLOCK
          EQ     CETX        RETURN
 
 
 CETA     CON    0           FWA EST BLOCK
          CON    0           NUMBER OF REMAINING ENTRIES IN EST
 CFA      SPACE  4,15
**        CFA - CHECK FILE ATTACH.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (X6) = FILE MODE FOR ATTACH.
*                IF RESOURCE FILE IS ALREADY ATTACHED AND INTERLOCKED,
*                IT WILL BE REWOUND.
*
*         EXIT   (X2) = FET ADDRESS.
*                (CFAA) = .NE. 0, IF FILE BUSY ROLLOUT OCCURRED.
*                RESOURCE FILE ATTACHED, INTERLOCKED AND REWOUND.
*                TO *PIT*, IF INTERRUPT OCCURRED AND FILE ATTACH IS
*                NOT REQUIRED.
*                TO *PIT2*, IF RETRY COUNT ON FILE ATTACH EXHAUSTED
*                AFTER INTERRUPT HAS OCCURRED.
*
*         ERROR  TO *PER*, IF *PFM* ERROR ON RESOURCE FILE ATTACH.
*
*         USES   A - 0, 1, 6, 7.
*                B - 2, 3.
*                X - 0, 1, 2, 4, 5, 6, 7.
*
*         CALLS  PRO, SFN.
*
*         MACROS ATTACH, INTRP, MESSAGE, RECALL, REWIND.
 
 
 CFA8     REWIND X2,R
 
 CFA      SUBR               ENTRY/EXIT
          SA6    CFAC        SAVE DEMAND FILE ATTACH MODE
          SA1    X2-1        CHECK FILE INTERLOCK
          MX0    1
          NZ     X1,CFA8     IF FILE ALREADY ATTACHED
          SX6    DBMC        RESET MESSAGE COUNT
          SA6    CFAB
          SA1    X2+B1       SET EP BIT
          LX0    -15
          BX7    X0+X1
          SA7    A1
          EQ     CFA2        ATTACH RESOURCE FILE
 
 CFA1     SX0    X2+
          INTRP  CFA4        PROCESS INTERRUPT
          SA1    AA          CHECK FOR EQUIPMENT ASSIGNMENT
          SX2    -1
          PL     X1,CFA5     IF NOT AUTOMATIC TAPE ASSIGNMENT
          SX5    PFRE        SET ROLLOUT EVENT DESCRIPTOR
          SA1    PFRE+1      GET ROLLOUT MESSAGE ADDRESS
          RJ     PRO         PROCESS TIMED EVENT ROLLOUT
          SX2    X0+
 CFA2     ATTACH X2,0,,,CFAC,,,DF,FA
          SA1    X2
          MX0    -8
          LX1    -10
          BX5    -X0*X1      ERROR STATUS
          ZR     X5,CFA3     IF NO ERRORS
          SX6    X5-1
          SX7    X5-16B
          ZR     X6,CFA1     IF FILE BUSY (1)
          ZR     X7,CFA1     IF PF UTILITY ACTIVE (16)
          MX0    -3
          BX6    -X0*X5
          LX5    -3
          BX7    -X0*X5
          SX6    X6+2R00
          LX7    6
          MX0    7*6
          IX5    X6+X7
          LX1    10
          LX5    -12
          BX1    X0*X1
          RJ     SFN         SPACE FILL FILE NAME
          MX0    12
          LX6    -18
          BX6    -X0*X6
          BX6    X6+X5
          SB2    /PER/RFE    *RESOURCE PF ERROR NN FILENAM.*
          SA6    B2+2        ENTER *NN FILENAM*
          MESSAGE CFAA       ISSUE MESSAGE OF PF ERROR
          EQ     PER         PROCESS ERROR
 
 CFA3     MX7    1           SET RESOURCE FILE INTERLOCK
          SA7    X2-1
          SA1    X2+B1       CLEAR EP BIT
          LX7    44-59
          BX7    -X7*X1
          SA7    A1+
          SA3    CFAB
          NZ     X3,CFA8     IF NO MESSAGE POSTED
          MESSAGE CFAB,2,R   CLEAR MESSAGE
          EQ     CFA8        REWIND FILE AND RETURN
 
*         PROCESS INTERRUPT.  DEPENDING ON OPTION SELECTED, WILL DELAY
*         AND RETRY DEMAND FILE ATTACH UNTIL SUCCESSFUL OR FOR
*         REQUESTED NUMBER OF RETRIES.  AFTER *DBMC* TRIES, AN
*         OPERATOR MESSAGE IS POSTED.  IF THE OPERATOR OVERRIDES THE
*         JOB AT THIS POINT, THE DEMAND FILE ENTRY FOR THE JOB MAY BE
*         LEFT WITH INCORRECT DEMAND AND ASSIGN COUNTS WHICH MAY
*         SUBSEQUENTLY CAUSE A *0RF* HANG.
 
 CFA4     SA2    UCRI        CHECK FOR UPDATE REQUIRED
          ZR     X2,PIT      IF UPDATE NOT REQUIRED
 CFA5     SA1    CFAB        CHECK WAIT FOR RESOURCE FILE MESSAGE
          ZR     X1,CFA6     IF MESSAGE ALREADY POSTED
          SX6    X1-1
          SA6    A1
          NZ     X6,CFA6     IF WAIT COUNT NOT EXHAUSTED
          MESSAGE (=C*WAITING FOR RESOURCE FILE.*),2,R
 CFA6     NG     X2,CFA7     IF UPDATE REQUIRED
          SX6    X2-1
          ZR     X6,PIT2     IF NUMBER OF RETRIES EXHAUSTED
          SA6    A2+
 CFA7     RECALL             DELAY
          SX2    X0
          EQ     CFA2        RETRY FILE ATTACH
 
 
 CFAA     BSSZ   3           PF ERROR MESSAGE BUFFER
 CFAB     CON    DBMC        DEMAND FILE BUSY MESSAGE COUNT
 CFAC     CON    0           DEMAND FILE ATTACH MODE
 CLB      SPACE  4,15
**        CLB - CLEAR BUFFER.
*
*         ENTRY  (A2) = LWA+1 OF BUFFER.
*                (B5) = LENGTH OF BUFFER.
*                (X6) = MASK.
*
*         EXIT   BUFFER CLEARED AS DIRECTED BY MASK.
*                (A7) = FWA BUFFER.
*
*         USES   X - 2, 7.
*                B - 5.
*                A - 2, 7.
 
 
 CLB      SUBR               ENTRY/EXIT
 CLB1     SB5    B5-B1
          NG     B5,CLBX     IF CLEAR COMPLETED
          SA2    A2-B1
          BX7    X6*X2
          SA7    A2
          EQ     CLB1
 CLM      SPACE  4,10
**        CLM - CHECK LEVEL MATCH.
*
*         *CLM* COMPARES THE ACCESS LEVELS OF THE *RET* TABLE AND
*         THE *RDT* TABLE.
*
*         ENTRY  (B2) = POINTER +1 TO ENTRY IN *RET* TABLE.
*                (B6) = POINTER TO ENTRY IN *RDT* TABLE.
*
*         EXIT   (X0) .LT.0, IF DEMAND OUTSIDE OF ACCESS LEVEL.
*                     .GE.0, IF DEMAND WITHIN ACCESS LEVEL.
*
*         USES   X - 0, 5, 6, 7.
*                A - 5.
 
 
 CLM      SUBR               ENTRY/EXIT
          MX0    -3
          SA5    B2-B1       *RET* TABLE ENTRY
          LX5    0-45        POSITION ACCESS LEVEL
          BX7    -X0*X5      LOWER BOUND ACCESS LEVEL
          LX5    3
          BX6    -X0*X5      UPPER BOUND ACCESS LEVEL
          SA5    B6          *RDT* TABLE ENTRY
          LX5    0-36        POSITION ACCESS LEVEL
          BX5    -X0*X5
          IX0    X6-X5       UPPER BOUND - REQUEST
          NG     X0,CLMX     IF REQUEST ABOVE UPPER BOUND
          IX0    X5-X7       REQUEST - LOWER BOUND
          EQ     CLMX        RETURN
 COV      SPACE  4,10
**        COV - CLEAR OPERATOR VERIFY FLAG.
*
*         EXIT   OPERATOR VERIFY REQUIRED FLAG CLEARED IN *TMPF*.
*
*         USES   X - 2, 6.
*                A - 2, 6.
 
 
 COV      SUBR               ENTRY/EXIT
          SA2    TMPF
          SX6    B1
          LX6    56-0
          BX6    -X6*X2      CLEAR OPERATOR VERIFY FLAG
          SA6    A2
          EQ     COVX        RETURN
 CRM      SPACE  4,10
**        CRM - CHECK FOR RESOURCE MATCH.
*
*         ENTRY  (X0) = REQUESTED RESOURCE INDEX AND BYTE POINTER.
*                (X5) = EQUIPMENT RESOURCE INDEX AND BYTE POINTER.
*                (X2) = *PE* RESOURCE INDEX, IF *NT* REQUEST MATCH
*                     WITH *GE* EQUIPMENT ALLOWED.
*
*         EXIT   (X7) = 0, IF RESOURCES MATCH.
*
*         USES   X - 5, 7.
 
 
 CRM      SUBR               ENTRY/EXIT
          MX7    -6
          BX5    -X7*X5
          BX0    -X7*X0
          IX7    X0-X5
          ZR     X7,CRMX     IF MATCH
          SX7    X0-RNTP
          ZR     X7,CRM1     IF *NT* REQUEST
          SX7    X0-RPEP
          NZ     X7,CRMX     IF NOT *PE* REQUEST
 CRM1     SX7    X5-RHDP
          ZR     X7,CRMX     IF *HD* EQUIPMENT
          SX7    X5-RGEP
          NZ     X7,CRMX     IF NOT *GE* EQUIPMENT
          SX5    X0-RNTP
          NZ     X5,CRMX     IF NOT *NT* REQUEST
          SX7    X2-RPEP
          EQ     CRMX        RETURN
 CRV      SPACE  4,10
**        CRV - CHECK RESOURCE VALIDITY.
*
*         ENTRY  RESB = RESOURCE DEMAND ENTRY, WITH INDIVIDUAL AND
*                     TOTAL DEMAND COUNTS CORRECTLY SET.
*
*         ERROR  TO *PER*, IF DEMAND VALIDATION ERROR.
*
*         USES   A - 1, 5.
*                B - 2, 3, 4.
*                X - ALL.
 
 
 CRV      SUBR               ENTRY/EXIT
          SB3    RMTL-1
          SB4    RESB+RMTP
          MX2    -6
          BX3    X3-X3
          SB2    /PER/DVE    * DEMAND VALIDATION ERROR.*
          SX4    7           MAXIMUM VALIDATION LIMIT
 CRV1     SA1    B3+B4       COUNT TAPE DEMANDS
          SB3    B3-B1
          SB5    RPEW        TAPE ENTRIES PER WORD
          LX1    24
 CRV1.0   BX5    -X2*X1
          IX3    X3+X5
          SB5    B5-B1       DECUREMENT ENTRIES PER WORD
          LX1    12
          NZ     B5,CRV1.0   IF MORE ENTRIES IN WORD
          PL     B3,CRV1     IF MORE TAPE ENTRIES
          MX0    3
          SA5    RESB+RVAL
          BX6    X0*X5       TAPES VALIDATION LIMIT
          MX2    -12
          LX6    3
          BX2    -X2*X5      TOTAL DEMAND COUNT
          IX1    X6-X4
          LX5    3
          IX2    X2-X3       REMOVABLE PACK DEMANDS
          BX7    X0*X5       REMOVABLE PACK VALIDATION LIMIT
          IX6    X6-X3
          LX7    3
          ZR     X1,CRV2     IF UNLIMITED TAPES
          NG     X6,PER      IF TAPE VALIDATION EXCEEDED
 CRV2     IX1    X7-X4
          ZR     X1,CRVX     IF UNLIMITED PACKS
          IX7    X7-X2
          NG     X7,PER      IF PACK VALIDATION EXCEEDED
          EQ     CRVX        RETURN
 CTA      SPACE  4,15
**        CTA - COUNT TOTAL ASSIGNS AND DEMANDS.
*
*         ENTRY  (X4) = DEMAND ENTRY ADDRESS.
*                (B5) .LT. 0, IF COUNT TOTAL ASSIGNS AND DEMANDS.
*                (B5) .GE. 0, IF COUNT ONLY TAPE ASSIGNS AND DEMANDS.
*
*         EXIT   (B3) = ASSIGNED COUNT (TOTAL OR PARTIAL).
*                (X7) = DEMAND COUNT (TOTAL OR PARTIAL).
*
*         ERROR  TO *PER*, IF TOTAL DEMAND OR ASSIGNED COUNT ERROR.
*
*         USES   A - 1, 2, 5.
*                B - 2, 3, 6.
*                X - 0, 1, 2, 3, 5, 6, 7.
 
 
 CTA      SUBR               ENTRY/EXIT
          SA2    CTAA        GET ASSIGNED COUNT MASK
          BX0    X0-X0
          LX3    X2
          BX6    X6-X6
          LX2    -6          DEMAND COUNT MASK
          SB2    RMTP
          SB6    RMTP+RMTL+RRPL
          LT     B5,CTA1     IF COUNT TOTAL ASSIGNS AND DEMANDS
          SB6    RMTP+RMTL   SET UP TO COUNT TAPE ASSIGNS AND DEMANDS
 CTA1     SA1    X4+B2       ADD UP MULTIPLE RESOURCE DEMANDS PER ENTRY
          BX7    X2*X1
          IX6    X6+X7
          BX1    X3*X1       ADD UP MULTIPLE RESOURCE ASSIGNS PER ENTRY
          IX0    X0+X1
          SB2    B2+B1
          LT     B2,B6,CTA1  IF MORE RESOURCES TO COUNT
          SB2    RPEW
          BX7    X7-X7
          SB3    B0
          LX0    -6
          MX2    -12
 CTA2     BX1    -X2*X6      COUNT RESOURCE DEMANDS AND ASSIGNS
          BX3    -X2*X0
          IX7    X7+X1
          SB3    B3+X3
          LX6    -12
          SB2    B2-1
          LX0    -12
          NZ     B2,CTA2     IF MORE ENTRIES IN MULTIPLE COUNT
          GE     B5,CTAX     IF COUNT ONLY TAPE ASSIGNS AND DEMANDS
          SA5    X4+RVAL     CHECK TOTAL DEMAND COUNT CORRECT
          SX1    B3
          BX6    -X2*X5
          SB2    /PER/TDE    * TOTAL DEMAND COUNT ERROR.*
          LX5    -12
          IX6    X6-X7
          NZ     X6,PER      IF TOTAL DEMAND COUNT INCORRECT
          BX2    -X2*X5      CHECK TOTAL ASSIGNED COUNT CORRECT
          IX2    X2-X1
          SB2    /PER/TAE    * TOTAL ASSIGNED COUNT ERROR.*
          NZ     X2,PER      IF TOTAL ASSIGNED COUNT INCORRECT
          EQ     CTAX        RETURN
 
 
 CTAA     CON    7700770077007700B  MASK FOR ASSIGNED COUNTS
 CTE      SPACE  4,15
**        CTE - CHECK FOR TAPE EQUIPMENT.
*
*         ENTRY  (X7) = DEVICE CODE RIGHT JUSTIFIED.
*
*         EXIT   (X2) = 0 IF NOT TAPE DEVICE.
*                (X2) = *TTDV* ENTRY IF TAPE DEVICE.
*                (X7) = TAPE DEVICE TYPE IF TAPE DEVICE.
*
*         USES   X - 2, 7.
*                A - 2.
*
*         CALLS  CDT.
 
 
 CTE      SUBR               ENTRY/EXIT
          SA2    TTDV        SET TO SEARCH TAPE DEVICE TABLE
          RJ     CDT         CHECK FOR TAPE DEVICE
          ZR     X2,CTEX     IF NOT TAPE DEVICE
          SX7    A2-TTDV     SET DEVICE TYPE
          EQ     CTEX        RETURN
 CTL      SPACE  4,20
**        CTL - CHECK FOR TRACK LIMIT.
*
*         ENTRY  (X2) = FET ADDRESS.
*
*         EXIT   (X2) = FET ADDRESS.
*                TO *URF1*, IF TRACK LIMIT (AFTER TIMED/EVENT ROLLOUT
*                     COMPLETED).
*                TO *PIT*, IF TRACK LIMIT DETECTED AND INTERRUPT
*                HAS OCCURRED.
*
*         ERROR  TO *PER*, IF CIO ERROR OTHER THAN TRACK LIMIT
*                DETECTED.
*
*         USES   A - 0, 1, 3, 4, 6, 7.
*                B - 2.
*                X - ALL.
*
*         CALLS  PRO.
*
*         MACROS INTRP, RETRF, STATUS.
 
 
 CTL      SUBR               ENTRY/EXIT
          SA1    X2          CHECK FOR TRACK LIMIT STATUS
          MX0    -4
          LX1    -10
          BX3    -X0*X1
          MX0    -8          CLEAR STATUS
          BX6    X0*X1
          LX6    10
          SA6    A1
          SA1    X2+FDTY     CLEAR USER PROCESSING
          MX0    1
          LX0    45-59
          BX6    -X0*X1
          SA6    A1
          ZR     X3,CTLX     IF NO ERROR STATUS
          SX5    X3-1
          NZ     X5,CTL1     IF NOT TRACK LIMIT
          STATUS X2,P        SET EVENT
          MX0    18
          SA4    X2+6
          LX0    -6
          SA3    TLIM
          BX4    X0*X4
          LX4    36
          BX7    X4+X3
          SA7    RE
          SA0    X2
          RETRF  X2          RETURN RESOURCE FILE, RELEASE INTERLOCK
          SX5    RE          SET ROLLOUT DESCRIPTOR
          INTRP  PIT         PROCESS INTERRUPT
          SA1   TLIM+1       GET ROLLOUT MESSAGE ADDRESS
          RJ     PRO         PROCESS TIMED EVENT ROLLOUT
          INTRP  PIT         PROCESS INTERRUPT
          SX2    A0+         RESTORE FET ADDRESS
          SA1    URFE        RESET INITIAL RANDOM INDEX
          BX6    X6-X6
          LX7    X1
          SA6    EF          CLEAR EOR FLAG
          SA7    URFA
          JP     URF1        RETRY RESOURCE FILE UPDATE
 
 CTL1     SB2    /PER/CIO    *CIO ERROR.*
          EQ     PER         PROCESS ERROR
 CUC      SPACE  4,10
**        CUC - CHANGE USER NAME IN CONTROL POINT AREA.
*
*         ENTRY  (X1) = USER NAME TO CHANGE TO.
*
*         EXIT   USER NAME SET INTO WORD *UIDW*.
*
*         USES   X - 0, 6.
*                A - 6.
*
*         MACROS SETPFP.
 
 
 CUC      SUBR               ENTRY/EXIT
          SX6    B1+B1       SET USER NAME FLAG
          SA6    CUCA+0
          MX0    42          SET USER NAME
          BX6    X0*X1
          SA6    CUCA+2
          SETPFP CUCA        CHANGE USER NAME
          EQ     CUCX        RETURN
 
 CUCA     BSSZ   3           *SETPFP* BLOCK
 CUP      SPACE  4,10
**        CUP - CLEAN UP REQUEST.
*
*         ERROR  TO *PER*, IF SHARE TABLE ERROR.
*
*         USES   A - 1, 3, 7.
*                B - 2, 5, 6, 7.
*                X - 1, 3, 5, 7.
*
*         CALLS  BPD, IRC, UDF.
 
 
 CUP      SUBR               ENTRY/EXIT
          SA1    DFDI        CHECK FOR DEFAULT DEMAND
          ZR     X1,CUP1     IF DEFAULT DEMAND NOT SET
          SB5    B1+B1       DECREMENT TOTAL AND RESOURCE DEMAND COUNTS
          RJ     IRC
 CUP1     SB5    -B1         DECREMENT TOTAL AND RESOURCE ASSIGN COUNTS
          RJ     IRC
          SX5    B2-RRPP
          NG     X5,CUP3     IF NOT REMOVABLE PACK
          SA1    RQ
          SB6    RRPS+RPSL
          SB7    RRPS
 CUP2     SB6    B6-1
          LT     B6,B7,CUP4  IF END OF SHARE TABLE
          SA3    B6+RESB
          BX5    X3-X1
          AX5    18
          NZ     X5,CUP2     IF NO MATCH
          BX7    X7-X7       CLEAR SHARE TABLE ENTRY
          SA7    A3
 CUP3     BX5    X5-X5       SET NO DEMAND FILE RETURN
          RJ     UDF         UPDATE DEMAND FILE
          RJ     BPD         BUILD PREVIEW DISPLAY
          EQ     CUPX        RETURN
 
 CUP4     SB2    /PER/STE    *SHARE TABLE ERROR.*
          JP     PER         PROCESS ERROR
 CVA      SPACE  4,10
**        CVA - CHECK VSN AVAILABILITY.
*
*         EXIT   (X6) = PREVIEW DISPLAY MESSAGE CODE IF OFFSITE TMS
*                       TAPE REQUESTED OR IF ACS MOUNT ERROR.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2.
*
*         MACROS RDSB.
 
 
 CVA      SUBR               ENTRY/EXIT
 
*         CHECK OFFSITE TMS TAPE.
 
 CVA2     SA1    TMPF
          SX6    VOS         SET VSN OFFSITE
          LX1    59-50
          NG     X1,CVAX     IF OFFSITE TMS TAPE
 
*         CHECK ACS MOUNT ERROR.
 
          SX6    B0          SET NO MESSAGE
          SA1    RESB+RQPV+PRES
          MX7    -12
          LX1    -12
          BX1    -X7*X1      RESOURCE MNEMONIC
          SX1    X1-2RAT
          NZ     X1,CVAX     IF NOT ACS TAPE REQUEST
          RDSB   MTSI,/COMSMTX/VETL,/COMSMTX/VET,CVAA
          SA1    EVSN
          SA2    CVAA-1
          MX0    36
          SX6    B0+         SET NO MESSAGE
 CVA1     SA2    A2+B1
          ZR     X2,CVAX     IF END OF ENTRIES
          BX3    X1-X2
          BX3    X0*X3
          NZ     X3,CVA1     IF NOT SAME VSN
          MX6    -6
          BX6    -X6*X2      PREVIEW DISPLAY MESSAGE CODE
          EQ     CVAX        RETURN
 
 
 CVAA     BSSZ   /COMSMTX/VETL+1  MOUNT ERROR TABLE AND TERMINATOR
 END      SPACE  4,10
**        END - ENDING SEQUENCES.
 
 
 END1     SA1    CF
          ZR     X1,END2     IF NOT *DMP=* CALL
          SX7    /STATUS/OK  RETURN OK STATUS
          LX7    24
          SA7    SPPR
 
 END2     SA1    CI
          ZR     X1,END6     IF NO CHECKPOINT INDEX
          SETFS  F,X1        SET CHECKPOINT FILE STATUS
          EQ     END6        RENABLE CHARGE AND END
 
 END4     SX5    B0          SET NO RETURN FLAG FOR DEMAND FILE
          RJ     UDF         UPDATE DEMAND FILE
          INTRC  ON          REENABLE INTERRUPT
          INTRP  PIT         PROCESS INTERRUPT
          RJ     BPD         BUILD PREVIEW DISPLAY
 
 END6     SA1    R-1
          NZ     X1,END7     IF STAGE REQUEST FILE NOT ATTACHED
          SETFS  R,0         LEAVE FILE ATTACHED
 
 END7     RENSR  /COMSSRU/IARX  REENABLE ACCUMULATION WITH IARX CHARGE
 
 END      ENDRUN
 ERR      SPACE  4,10
**        ERR - COMMAND ERROR PROCESSOR.
 
 
 ERR      SB2    /PER/ARG    *ARGUMENT ERROR.*
          EQ     PER         PROCESS ERROR
 
 
**        ERROR EXIT FOR RSB CALLS.
 
 
 ERR1     LX2    1
          NG     X2,ERR3     IF NO SUBSYSTEM
*         EQ     ERR2        IF SYSTEM ERROR
 
 
**        SUB-SYSTEM COMMUNICATION ERRORS.
 
 
 ERR2     SB2    /PER/SCE    *SYSTEM ERROR.*
          EQ     PER         PROCESS ERROR
 
 ERR3     SB2    /PER/MAG    *MAGNETIC TAPE SUBSYSTEM NOT ACTIVE.*
          EQ     PER         PROCESS ERROR
 
 
**        STAGE PROCESSING ERRORS.
 
 
 ERR4     SB2    /PER/SRF    *STAGE REQUEST FILE ERROR.*
          EQ     PER         PROCESS ERROR
 GEE      SPACE  4,15
**        GEE - GET EST ENTRY.
*
*         ENTRY  (X4) = EST ORDINAL.
*
*         EXIT   (BUF) = EST ENTRY OF LENGTH *ESTE*.
*                (A1) = BUF.
*                (X1) = FIRST WORD OF EST ENTRY.
*
*         UESE   A - 1, 6.
*                X - 1, 5, 6, 7.
*
*         MACROS RDSB.
 
 
 GEE      SUBR               ENTRY/EXIT
          SA1    /LWC/ESTP   GET EST FWA
          AX1    36
          R=     X5,ESTE
          IX6    X4*X5
          IX7    X6+X1
          MX6    1
          SA6    BUF
          RDSB   0,X5,X7,A6  GET EST ENTY
          SA1    BUF
          EQ     GEEX        RETURN
 GRI      SPACE  4,15
**        GRI - GET RESOURCE INDEX.
*
*         ENTRY  (X1) = RESOURCE NAME PARAMETER.
*
*         EXIT   (B2) = RESOURCE DEMAND ENTRY PARAMETER INDEX.
*                (B2) = 0 IF ENTRY NOT FOUND.
*                (B7) = UNIT COUNT (1-8).
*                (X6) = 51/0, 3/UNIT COUNT, 6/PARAMETER INDEX.
*
*         USES   A - 3.
*                B - 2, 4, 7.
*                X - 1, 2, 3, 6.
 
 
 GRI      SUBR               ENTRY/EXIT
          MX3    12
          BX2    -X3*X1      NUMBER OF UNITS
          SB7    B1+
          BX1    X3*X1       RESOURCE TYPE
          LX2    18
          NZ     X2,GRI2     IF NUMBER OF UNITS SPECIFIED
          SB2    RMTP-1
          SB4    RRPP
 GRI1     SB2    B2+B7
          SA3    TRID-RMTP+B2  GET RESOURCE IDENTIFIER
          BX6    X1-X3
          EQ     B2,B4,GRI2  IF END OF TABLE
          NZ     X6,GRI1     IF NO MATCH
          SX6    B2
          EQ     B7,B1,GRIX  IF TAPE ENTRY FOUND
          SA3    A3+B1       GET MAXIMUM NUMBER OF UNITS
          SB7    B1
          SX6    B2+100B
          ZR     X2,GRIX     IF NUMBER OF UNITS NOT SPECIFIED
          SB7    X2-1R0
          UX3    X3,B4
          SX6    B7          MERGE PARAMETER INDEX AND UNIT COUNT
          LE     B7,GRI3     IF INCORRECT NUMBER OF UNITS
          GT     B7,B4,GRI3  IF INCORRECT NUMBER OF UNITS
          LX6    6
          SX6    X6+B2
          EQ     GRIX        RETURN
 
 
 GRI2     SB4    RRPP+RRPL   SET TO SEARCH REMOVABLE PACKS
          SB2    RRPP-2
          SX6    B7-B1
          SB7    B7+B7
          ZR     X6,GRI1     IF NOT END OF SEARCH
 GRI3     SB2    B0
          EQ     GRIX        RETURN
 GRL      SPACE  4,15
**        GRL - GET RESOURCE LIST INDEX.
*
*         ENTRY  (X7) = DEVICE TYPE, 2 CHARACTERS, RIGHT-JUSTIFIED.
*                (B4) = LENGTH OF TABLE.
*
*         EXIT   (B4) .LT. 0, IF RESOURCE LIST NOT FOUND.
*                (B4) = INDEX OF RESOURCE LIST IN TRSL TABLE.
*
*         USES   A - 3.
*                B - 4.
*                X - 2, 3, 6.
 
 
 GRL      SUBR               ENTRY/EXIT
          MX2    -12
          SA3    TRSL+B4
 GRL1     SB4    B4-B1
          SA3    A3-B1
          NG     B4,GRLX     IF RESOURCE NOT FOUND IN LIST
 GRL2     LX3    12
          BX6    -X2*X3
          ZR     X6,GRL1     IF END OF RESOURCES IN THIS LIST
          BX6    X6-X7
          NZ     X6,GRL2     IF NO MATCH
          EQ     GRLX        RETURN
 GTM      SPACE  4,10
**        GTM - GET CURRENT TIME.
*
*         EXIT   (TM) = TIME IN ABSOLUTE SECONDS.
*
*         USES   X - 1.
*                A - 1, 6.
*
*         CALLS  PTE.
*
*         MACROS PDATE.
 
 
 GTM      SUBR               ENTRY/EXIT
          PDATE  TM          GET PACKED DATE AND TIME
          SA1    TM
          RJ     PTE         SET ABSOLUTE SECONDS
          SA6    TM
          EQ     GTMX        RETURN
 IDE      SPACE  4,15
**        IDE - INITIALIZE DEMAND ENTRY.
*
*         EXIT   EJT ORDINAL, VALIDATION LIMITS, AND
*                RESOURCE IDENTIFIERS ENTERED INTO RESB BUFFER.
*                SHARE TABLE AREA OF RESB BUFFER CLEARED.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 2, 3.
*                X - 1, 2, 3, 6, 7.
*
*         MACROS CLEAR, MOVE.
 
 
 IDE      SUBR               ENTRY/EXIT
          SA2    JEEO        GET JOB EJT ORDINAL
          SA3    SSJ=+/COMSSSJ/ALMS  SET VALIDATION LIMITS
          BX6    X2
          LX3    12
          SA6    RESB+RJID
          MX1    6
          BX7    X1*X3
          SA7    RESB+RVAL
          MOVE   RMTL+RRPL,TRID,RESB+RMTP  RESOURCE IDENTIFIERS
          CLEAR  RESB+RRPP+RRPL,RDEL-RRPP-RRPL  CLEAR REMAINING ENTRY
          EQ     IDEX        RETURN
 IRC      SPACE  4,25
**        IRC - INCREMENT RESOURCE COUNT.
*
*         ENTRY  (RI) = REQUESTED RESOURCE INDEX AND BYTE POINTER.
*                (B5) = -1, IF DECREMENT TOTAL AND RESOURCE
*                     ASSIGN COUNTS.
*                (B5) = 0, IF INCREMENT TOTAL AND RESOURCE ASSIGN
*                     COUNTS.
*                (B5) = 1, IF INCREMENT TOTAL AND RESOURCE DEMAND
*                     COUNTS.
*                (B5) = 2, IF DECREMENT TOTAL AND RESOURCE DEMAND
*                     COUNTS.
*
*         EXIT   (B2) = RESOURCE INDEX INTO DEMAND ENTRY.
*                TOTAL AND RESOURCE DEMAND OR ASSIGNED COUNTS
*                FOR (RI) RESOURCE IN RESB BUFFER DECREMENTED
*                OR INCREMENTED BY 1.
*
*         USES   A - 2, 3, 6, 7.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  CBP.
 
 
 IRC      SUBR               ENTRY/EXIT
          SA2    RI          CALCULATE RESOURCE BYTE POSITION
          RJ     CBP
          SA2    RESB+RVAL   INCREMENT/DECREMENT TOTAL COUNT
          SA3    B2+RESB     INCREMENT/DECREMENT RESOURCE COUNT
          SX0    B1
          LX1    X0,B4
          GT     B5,IRC1     IF PROCESSING DEMAND COUNT
          LX0    12
          LX1    6
 IRC1     IX6    X2+X0
          IX7    X3+X1
          ZR     B5,IRC2     IF INCREMENTING ASSIGN COUNTS
          EQ     B5,B1,IRC2  IF INCREMENTING DEMAND COUNTS
          IX6    X2-X0       DECREMENT RESOURCE COUNTS
          IX7    X3-X1
 IRC2     SA6    A2
          SA7    A3
          EQ     IRCX        RETURN
 IUT      SPACE  4,10
**        IUT - INITIALIZE *UTMS*.
*
*         EXIT   (X7) = *UTMS*.
*
*         USES   X - 0, 2, 3, 7.
*                A - 2.
 
 
 IUT      SUBR               ENTRY/EXIT
          SA2    TMPF
          MX0    1
          LX2    59-58
          BX7    X0*X2       SET TMS CONTROL
          LX7    12
          LX2    59-57-59+58
          BX3    X0*X2
          LX3    13
          BX7    X3+X7       SET BLANK LABEL FLAG
          LX2    59-56-59+57
          BX3    X0*X2
          LX3    14
          BX7    X3+X7       SET VERIFY FLAG
          LX2    59-55-59+56
          BX3    X0*X2
          LX3    10
          BX7    X3+X7       SET RESERVE SCRATCH FLAG
          LX2    59-54-59+55
          BX3    X0*X2
          LX3    9
          BX7    X3+X7       SET SYMBOLIC ACCESS FLAG
          LX2    59-52-59+54
          BX3    X0*X2
          LX3    11
          BX7    X3+X7       SET USER OWNED FLAG
          EQ     IUTX        RETURN
 IVE      SPACE  4,20
**        IVE - INITIALIZE VSN ENTRY.
*
*         ENTRY  (X3) = FILE NAME IN UPPER 42 BITS.
*                (B2) = 0, IF ONLY SET UP IDENTIFICATION IN VSN ENTRY,
*                     OTHERWISE INITIALIZE ENTIRE ENTRY.
*
*         EXIT   DEMAND FILE RANDOM INDEX, JOB EJT ORDINAL,
*                AND FILE NAME SET IN VSNE BUFFER.
*                AREA FOR VSN ENTRIES IN VSNE BUFFER CLEARED FOR ENTRY
*                CONDITION (B2) .NE. 0.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 6, 7.
*
*         MACROS CLEAR.
 
 
 IVE      SUBR               ENTRY/EXIT
          SA2    JEEO        GET JOB EJT ORDINAL
          SA1    /CPA/RFCW   GET DEMAND FILE RANDOM INDEX
          MX4    42
          LX2    48
          BX6    X4*X3       SET FILE NAME
          BX7    -X4*X1
          BX7    X7+X2
          SA6    VSNE+VLFN
          SA7    VSNE+VDFI
          ZR     B2,IVEX     IF SET UP IDENTIFICATION ONLY
          CLEAR  VSNE+VRLC,VSNL-VRLC  CLEAR VSN AREA
          EQ     IVEX        RETURN
 OPN      SPACE  4,25
**        OPN - OPEN FILE.
*
*         ENTRY  (FET+10 - FET+13) = NOS LABEL FET PARAMETERS.
*                (LABL) = NOS/BE LABEL PARAMETERS (STANDARD/EXTENDED).
*                (OO) = OPEN OPTION.
*                (RT) = REQUEST TYPE.
*                (CF) = CALL FLAG.
*
*         EXIT   (X6) .NE. 0 IF FILE OPENED.
*                (X6) = 0 IF FILE NOT OPENED.
*                TO *PER* IF ERROR.
*
*         ON OPEN/WRITE CALLS, FIELDS WHICH ARE BINARY ZERO WILL CAUSE
*         THE TAPE EXECUTIVE TO USE DEFAULT VALUES.
*         ON ALL OTHER OPEN CALLS, BINARY ZERO FIELDS WILL CAUSE THE
*         TAPE EXECUTIVE TO SKIP THE COMPARISON BETWEEN THE TAPE LABEL
*         AND THE FIELD.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 5, 6.
*
*         CALLS  CDD, CER.
*
*         MACROS MOVE, OPEN, POSMF, SETFET, SETRNR.
 
 
 OPN      SUBR               ENTRY/EXIT
          SA3    F+FTAP      CHECK IF OPEN REQUIRED
          SX6    B0+         SET FILE NOT OPENED
          LX3    1
          PL     X3,OPNX     IF UNLABELED
          LX3    1
          NG     X3,OPNX     IF NON-STANDARD LABELS
          SETFET F,ERP=E     SET ERROR PROCESSING
          SA2    OO
          SA1    F+FDTY
          MX7    1
          LX7    -18
          NG     X2,OPN7     IF STANDARD NOS/BE OPEN
          BX7    X1+X7       SET XL BIT
          SA7    A1
          NZ     X2,OPN6     IF EXTENDED NOS/BE OPEN
 
*         TRANSLATE NOS FET TO EXTENDED LABEL.
 
          SA1    F+FID1      SHIFT FILE IDENTIFIER
          MX0    36
          SA5    OPNA
          BX6    X0*X1
          LX6    -24
          BX7    X5+X6
          SA7    LABL
          SA3    F+FID2
          BX6    X0*X3
          BX1    -X0*X1
          BX7    X6+X1
          LX7    36
          SA2    F+FMSI      SHIFT MULTI-SET IDENTIFIER
          SA7    A7+B1
          BX2    X0*X2
          MX0    6
          LX3    36
          BX3    X0*X3
          LX2    -6
          BX7    X2+X3
          SA7    A7+B1
          MX0    30
          SA2    F+FCRD      SHIFT CREATION/RETENTION DATES
          BX7    -X0*X2
          BX5    X0*X2
          MX3    0
          ZR     X2,OPN2     IF NO DATES
          SA3    A5+B1       OPNB
          NZ     X7,OPN1     IF CREATION DATE
          BX3    -X0*X3
 OPN1     NZ     X5,OPN2     IF RETENTION DATE
          BX3    X0*X3
 OPN2     MX0    12
          LX7    18
          BX5    X0*X2
          SB6    B1+B1
          LX5    12
          BX7    X7+X5
          MX0    18
          BX7    X7+X3
          LX2    12
          SA7    A7+B6       LABL+4
          BX2    X0*X2
          MX0    6
          SA1    F+FFAS      SHIFT FILE ACCESSIBILITY
          LX1    36
          BX1    X0*X1
          LX1    -18
          SA5    A5+B6       OPNC
          BX7    X1+X2
          BX6    X7+X5
          MX7    0
          SA6    A7+B1       LABL+5
          SA7    A6+B1       LABL+6
          SA7    A7+B1       LABL+7
          MX0    -15
          SA1    F+FSQN      SHIFT FILE SEQUENCE NUMBER
          BX1    -X0*X1
          ZR     X1,OPN3     IF NO FILE SEQUENCE NUMBER
          RJ     CDD
          MX0    -24
          BX4    X0*X4
          SA3    A5+B1       OPND
          BX7    X3+X4
          LX7    X7,B2
          BX7    -X0*X7
          LX7    30
          MX0    -15
 OPN3     SA7    A6-B6       LABL+3
          SA1    F+FGRN      SHIFT GENERATION NUMBER
          BX1    -X0*X1
          ZR     X1,OPN4     IF NO GENERATION NUMBER
          RJ     CDD
          MX0    -24
          BX4    X0*X4
          SA3    OPND
          BX7    X3+X4
          LX7    X7,B2
          SA1    LABL+3
          BX7    -X0*X7
          LX7    6
          BX7    X1+X7
          SA7    A1
 OPN4     MX0    -15
          SA1    F+FSTN      SHIFT FILE SECTION NUMBER
          BX1    -X0*X1
          ZR     X1,OPN5     IF NO FILE SECTION NUMBER
          RJ     CDD
          MX0    -24
          BX4    X0*X4
          SA3    OPND
          BX7    X3+X4
          LX7    X7,B2
          BX7    -X0*X7
          MX0    -18
          SA1    LABL+2
          LX7    -6
          BX5    -X0*X7
          BX6    X5+X1
          SA6    A1
          MX0    6
          BX7    X0*X7
          SA1    A1+1
          BX7    X1+X7
          SA7    A1
 OPN5     MX0    -9
          SA1    F+FGVN      SHIFT GENERATION VERSION NUMBER
          LX1    -15
          BX1    -X0*X1
          ZR     X1,OPN6     IF NO GENERATION VERSION NUMBER
          RJ     CDD
          MX0    -24
          BX4    X0*X4
          SA3    OPND
          BX7    X3+X4
          LX7    X7,B2
          MX0    -12
          BX7    -X0*X7
          SA1    LABL+3
          MX0    -6
          LX7    -6
          BX5    -X0*X7
          BX6    X5+X1
          SA6    A1
          MX0    6
          BX7    X0*X7
          SA1    A1+B1
          BX7    X1+X7
          SA7    A1
 OPN6     SX7    BUFL        BUILD EXTENDED LABEL BUFFER
          SX6    BUF
          LX7    18
          BX7    X6+X7
          SA7    F+9         ENTER XL BUFFER POINTER
          SX6    80
          SA6    BUF         EXTENDED LABEL CONTROL WORD
          MOVE   8,LABL,BUF+1  MOVE EXTENDED LABEL
          SX7    B0+
          SA7    BUF+9       TERMINAL CONTROL WORD
          EQ     OPN8        CHECK TYPE OF OPEN
 
 OPN7     MOVE   4,LABL,F+11B  MOVE STANDARD LABEL PARAMETERS
 OPN8     SA2    F+FTAP      CHECK TYPE OF OPEN
          SA1    MF          CHECK MULTI-FILE POSITIONING
          SA3    FS
          MX0    -3
          BX6    -X0*X1
          PL     X2,OPN9     IF NO LABEL WRITE REQUEST
          NG     X3,OPN9     IF NOT FIRST OPEN
          SX3    X1-10B
          NG     X3,OPN10    IF SEQUENCE NUMBER .LE. 1
 OPN9     SX4    X6-4
          PL     X4,OPN11    IF POSMF
          NG     X2,OPN10    IF WRITE LABEL
          OPEN   F,ALTER,R
          EQ     OPN12       CHECK FOR ERROR
 
 OPN10    OPEN   F,WRITE,R
          EQ     OPN12       CHECK FOR ERROR
 
 OPN11    SETRNR ROLL        ALLOW JOB ROLLOUT
          POSMF  F,R         POSITION MULTI-FILE SET TAPE
 OPN12    RJ     CER         CHECK ERROR
          SETFET F,ERP=0     CLEAR ERROR PROCESSING
          SX6    B1          SET FILE OPENED
          EQ     OPNX        RETURN
 
 
 OPNA     VFD    60/0LHDR1
 OPNB     VFD    6/0,6/1H ,30/0,6/1H ,12/0
 OPNC     VFD    24/0,36/6H000000
 OPND     VFD    36/0,24/4H0000
 
 LABL     BSS    8           LABEL TEMPORARY
 PER      SPACE  4,20
**        PER - PROCESS ERROR.
*
*         ENTRY  (B2) = ERROR MESSAGE ADDRESS.
*                (B2) = 0 IF ERROR MESSAGE ALREADY ISSUED.
*
*         EXIT   FATAL ERROR SET IN *SPPR* RESPONSE IF *DMP=* CALL.
*                ERROR FLAG RESET IF INTERRUPT OCCURRED.
*                JOB ABORTED IF COMMAND CALL.
*                *RESEX* TERMINATED WITH *ENDRUN* IF *DMP=* CALL.
*
*         USES   A - 1, 6, 7.
*                X - 0, 1, 3, 5, 6, 7.
*
*         CALLS  TMA.
*
*         MACROS ABORT, INTRP, MESSAGE, RENSR, REPRIEVE, RETRF,
*                UNLOAD.
 
 
 PER      BSS    0           ENTRY
          SA1    D
          AX1    18
          SX1    X1
          ZR     X1,PER1     IF RESOURCE FILE NAMES NOT SET
          RETRF  D           RETURN DEMAND FILE
          RETRF  V           RETURN VSN FILE
 PER1     SA1    F
          AX1    18
          ZR     X1,PER2     IF REQUESTED FILE NAME NOT SET
          SA1    FS          CHECK IF FILE PREVIOUSLY ASSIGNED
          NZ     X1,PER2     IF FILE NOT TO BE RETURNED
          UNLOAD F
 PER2     SA1    R-1
          NZ     X1,PER2.1   IF *PFM* REQUEST FILE NOT PRESENT
          UNLOAD R
 PER2.1   SX7    /STATUS/FE  SET FATAL ERROR
          LX7    24
          SA7    SPPR        SET *DMP=* RESPONSE
          RJ     TMA         PROCESS *TMS* ABORT
          ZR     B2,PER2.2   IF NO MESSAGE
          MESSAGE B2         ISSUE ERROR MESSAGE TO DAYFILE
 PER2.2   RENSR  /COMSSRU/IARX  REENABLE ACCUMULATION WITH IARX CHARGE
          INTRP  PER3        RESET ERROR IF INTERRUPT OCCURRED
          SA1    CF          CHECK CALL FLAG
          NZ     X1,END      IF *DMP=* CALL
          ABORT
 
 PER3     REPRIEVE  RPVB,RESET,0  RESET ERROR FLAG
 PMM      SPACE  4,10
**        PMM - PROCESS *MAGNET* MISSING.
*
*         USES   A - 1, 2.
*                X - 1, 2, 5, 6.
*
*         CALLS  PRO.
*
*         MACROS RETRF.
 
 
 PMM      SUBR               ENTRY/EXIT
          RETRF  D           RETURN DEMAND FILE, RELEASE INTERLOCK
          SX5    MSUB        SET MISSING SUBSYSTEM ROLLOUT DESCRIPTOR
          SA1    MSUB+1      GET ROLLOUT MESSAGE ADDRESS
          RJ     PRO         PROCESS TIMED EVENT ROLLOUT
          EQ     PMMX        RETURN
 PNE      SPACE  4,10
**        PNE - PROCESS NAMED ERROR.
*
*         ENTRY  (B2) = MESSAGE ADDRESS.
*                (X1) = 48/,12/ JOB EJT ORDINAL.
*
*         EXITS  TO *PER*.
 
 
 PNE      BSS    0           ENTRY
          SA2    /LWC/EJTP   GET FWA EJT
          MX0    -12
          BX1    -X0*X1
          SX7    EJTE
          IX7    X7*X1
          AX2    36
          IX7    X7+X2
          RDSB   0,1,X7,PNEA GET JOB SEQUENCE NUMBER
          SA1    PNEA
          MX0    24          MERGE JOB SEQUENCE NUMBER INTO MESSAGE
          SA2    B2
          BX1    X0*X1
          LX0    -6
          BX2    -X0*X2
          LX1    -6
          BX6    X1+X2
          SA6    A2
          EQ     PER         PROCESS ERROR
 
 
 PNEA     VFD    1/1,59/0    JOB SEQUENCE NUMBER
          SPACE  4,10
**        FATAL ERROR MESSAGES.
 
 
          QUAL   PER
 
 ARG      DATA   C* ARGUMENT ERROR.*
 AXD      DATA   C* JJJJ ASSIGNS EXCEED DEMANDS.*
 CCI      DATA   C* INCORRECT COMMAND.*
 CIO      DATA   C* CIO ERROR.*
 CRT      DATA   C* CONFLICTING RESOURCE TYPES.*
 DEC      DATA   C* NT DENSITY CONFLICT.*
 DEX      DATA   C* DEMAND EXCEEDED.*
 DFE      DATA   C* DEMAND FILE ERROR.*
 DRC      DATA   C* NT DRIVE CONFLICT.*
 DVE      DATA   C* DEMAND VALIDATION ERROR.*
 EQN      DATA   C* EQUIPMENT NOT AVAILABLE.*
 FCL      DATA   C* FRAME COUNT TOO LARGE.*
 FCS      DATA   C* FRAME COUNT TOO SMALL.*
 FRU      DATA   C* FORMAT REQUIRES UNLABELED TAPE.*
 IAL      DATA   C* INCORRECT ACCESS LEVEL FOR EQUIPMENT.*
 ICD      DATA   C* INCORRECT CONVERSION MODE FOR TAPE DEVICE TYPE.*
 ICM      DATA   C* INCORRECT CONVERSION MODE.*
 IDD      DATA   C* INCORRECT DENSITY FOR TAPE DEVICE TYPE.*
 IDF      DATA   C* INCORRECT DENSITY FOR FORMAT.*
 IDN      DATA   C* INCORRECT DENSITY.*
 IEF      DATA   C* INCORRECT END OF TAPE OPTION FOR FORMAT.*
 IEQ      DATA   C* INCORRECT EQUIPMENT.*
 ILC      DATA   C* INCORRECT LFM CALL.*
 IRC      DATA   C* INCORRECT RESOURCE COUNT.*
 IRT      DATA   C* INCORRECT RESOURCE TYPE.*
 IRS      DATA   C* INSUFFICIENT RESOURCES ON SYSTEM.*
 ITF      DATA   C* INCORRECT TAPE FORMAT.*
 MAG      DATA   C* MAGNETIC TAPE SUBSYSTEM NOT ACTIVE.*
 MAR      DATA   C* JJJJ MISSING RESOURCE.*
 MDE      DATA   C* MISSING DEMAND FILE ENTRY.*
 MET      DATA   C* MULIPLE END OF TAPE OPTIONS SELECTED.*
 MVE      DATA   C* MISSING VSN OR EQUIPMENT ASSIGNMENT.*
 NAL      DATA   C* VSN ?????? NOT IN ACS LIBRARY.*
 NSL      DATA   C* NOISE SIZE TOO LARGE.*
 NRA      DATA   C* VSN ?????? NOT IN REQUESTED ACS.*
 NVA      DATA   C* NOT VALIDATED FOR REQUESTED ACCESS LEVEL.*
 NVS      DATA   C* NO VSN SPECIFIED ON ACS TAPE REQUEST.*
 NVU      DATA   C* NOT VALIDATED FOR WRITING UNLABELED TAPES.*
 PTL      DATA   C* PRIOR TAPE ASSIGNMENT LOST.*
 RDE      DATA   C* RESOURCE DEMAND ERROR.*
 REV      DATA   C* RESOURCE ENVIRONMENT ERROR.*
 RFE      DATA   C* RESOURCE PF ERROR NN FFFFFF.*
 RIE      DATA   C* RESEX ABORT - INTERNAL ERROR.*
 RNS      DATA   C* RESOURCE NEGATIVE SHARE COUNT.*
 ROT      DATA   C* RESEX ABORT - OPERATOR TERMINATION.*
 RPO      DATA   C* REMOVABLE PACKS OVERCOMMITMENT.*
 RRL      DATA   C* RESEX ABORT - SYSTEM RESOURCE LIMIT.*
 RSF      DATA   C* RESOURCE SCRATCH FILE ERROR.*
 RTI      DATA   C* RESEX ABORT - TERMINAL INTERRUPT.*
 RTM      DATA   C* RESEX ABORT - TAPE MANAGER.*
 SCE      DATA   C* SYSTEM ERROR.*
 SRF      DATA   C* STAGE REQUEST FILE ERROR.*
 STE      DATA   C* SHARE TABLE ERROR.*
 STM      DATA   C* JJJJ SHARE TABLE MISMATCH.*
 TAE      DATA   C* TOTAL ASSIGNED COUNT ERROR.*
 TDC      DATA   C* TAPE DEVICE TYPE CONFLICT.*
 TDE      DATA   C* TOTAL DEMAND COUNT ERROR.*
 UAL      DATA   C* UNKNOWN ACCESS LEVEL NAME.*
 UAV      DATA   C* USER ACCESS NOT VALID.*
 UOL      DATA   C* VSN ?????? UNREADABLE OPTICAL LABEL.*
 VFE      DATA   C* VSN FILE ERROR.*
 WED      DATA   C* WRITE ENABLE AND DISABLE OPTIONS BOTH SELECTED.*
          QUAL   *
 PRO      SPACE  4,15
**        PRO - PROCESS TIMED EVENT ROLLOUT.
*
*         ENTRY  (X1) = ROLLOUT MESSAGE ADDRESS IF .GT. 0.
*                     = COMPLEMENT OF MESSAGE ADDRESS IF WAITING FOR
*                       PACK OR VSN MESSAGE.
*                (X5) = TIMED/EVENT ROLLOUT DESCRIPTOR ADDRESS.
*
*         CALLS  BWM.
*
*         MACROS MESSAGE, REWIND, ROLLOUT.
 
 
 PRO      SUBR               ENTRY/EXIT
          PL     X1,PRO1     IF NOT WAITING FOR TAPE/PACK MESSAGE
          RJ     BWM         BUILD MESSAGE
 PRO1     MESSAGE X1,2,R     ISSUE ROLLOUT MESSAGE
          ROLLOUT X5         PERFORM TIMED/EVENT ROLLOUT
          REWIND S1,R        GUARANTEE ROLLOUT COMPLETE
          MESSAGE PROA,2,R   CLEAR ROLLOUT MESSAGE
          EQ     PROX        RETURN
 
 
 PROA     CON    0
 PIT      SPACE  4,15
**        PIT - PROCESS INTERRUPT.
*
*         ENTRY  AT *PIT2*, IF ALL RETRIES OF DEMAND FILE ATTACH
*                FAILED.
*
*         EXIT   TO *PER*.
*
*         USES   A - 1, 6.
*                B - 2.
*                X - 1, 5, 6.
*
*         CALLS  BPD, CUP, IDE, RDF, UDF.
*
*         MACROS INTRC, MOVE.
 
 
 PIT      BSS    0           ENTRY
          INTRC  OFF         DISABLE INTERRUPT
          SA1    UCRI        CHECK FOR DEMAND FILE CLEAN-UP REQUIRED
          SX6    X1+B1
          BX7    X7-X7
          PL     X6,PIT1     IF NO DEMAND FILE CLEAN-UP REQUIRED
 
*         CLEAR PREVIEW DATA AND DECREMENT ASSIGN COUNT.
 
          SA7    RESB+RREQ   CLEAR MOUNT REQUEST
          SA6    A1          INDICATE UPDATE IS REQUIRED
          RJ     CUP         CLEAN-UP DEMAND FILE ENTRY
          EQ     PIT2        PROCESS ERROR
 
 PIT1     SA1    PVDC        CHECK FOR PREVIEW DISPLAY CLEAN-UP
          ZR     X1,PIT2     IF NO PREVIEW DATA
 
*         CLEAR PREVIEW DATA IN DEMAND FILE AND REBUILD PREVIEW
*         DISPLAY.
 
          SX6    DFRC        SET RETRY COUNT FOR DEMAND FILE ATTACH
          SA6    UCRI
          RJ     IDE         INITIALIZE DEMAND ENTRY
          RJ     RDF         READ DEMAND FILE
          MOVE   RDEL,DBUF,RESB  COPY DEMAND FILE ENTRY
          SX6    B0          CLEAR MOUNT REQUEST
          BX5    X5-X5       SET NO DEMAND FILE RETURN
          SA6    RESB+RREQ
          RJ     UDF         UPDATE DEMAND FILE
          RJ     BPD         BUILD PREVIEW DISPLAY
 PIT2     SA1    RPVA        GET REPRIEVED ERROR MESSAGE ADDRESS
          SB2    X1+
          EQ     PER         PROCESS ERROR
 RPV      SPACE  4,15
**        RPV - REPRIEVE PROCESSOR.
*
*         EXIT   RESUMES EXECUTION WHERE INTERRUPTED, IF TERMINAL
*                  USER BREAK ONE.
*                TO *PIT* TO PROCESS ERROR, IF *CPU ERROR EXIT*
*                  OR *PP CALL ERROR*.
*                TO *PIT* TO PROCESS INTERRUPT, IF INTERRUPT IS
*                  ENABLED.
*                RE-ENBLES SRU ACCUMULATION AND RESETS ERROR FLAG,
*                  IF *PP ABORT*.
*                RESUMES PRIOR EXECUTION IN INTERRUPT HANDLER MODE,
*                  IF INTERRUPT PROCESSING IS DISABLED.
*
*         USES   A - 1, 2, 6, 7.
*                X - 1, 2, 6, 7.
*
*         MACROS RENSR, REPRIEVE.
 
 
 RPV      BSS    0           ENTRY
 
*         IGNORE USER BREAK ONE.
 
          SA1    RPVB+/COMSRPV/OSEF  CHECK ERROR FLAG
          MX6    -12
          BX1    -X6*X1
          SX1    X1-TIET
          NZ     X1,RPV1     IF NOT TERMINAL USER BREAK 1
          REPRIEVE  RPVB,RESUME,237B  RESUME PRIOR EXECUTION
 
*         CHECK ERROR CLASS.
 
 RPV1     SA1    RPVB+/COMSRPV/ERCL  CHECK ERROR CLASS
          SX6    /PER/RTI    SET TERMINAL INTERRUPT MESSAGE
          LX1    59-19
          MX7    18
          NG     X1,RPV2     IF TERMINAL INTERRUPT
          LX1    59-15-59+19
          SX6    /PER/ROT    SET OPERATOR TERMINATION MESSAGE
          NG     X1,RPV2     IF OPERATOR TERMINATION
          SX6    /PER/RRL    SET RESOURCE LIMIT
          LX1    59-14-59+15
          NG     X1,RPV2     IF RESOURCE LIMIT
          LX1    59-16-59+14
          PL     X1,RPV1.1   IF NOT PP ABORT
          RENSR  /COMSSRU/IARX  REENABLE SRU ACCUMULATION
          REPRIEVE  RPVB,RESET,0   RESET ERROR FLAG
 
*         PROCESS *CPU ERROR EXIT* AND *PP CALL ERROR*.
 
 RPV1.1   SX6    /PER/RIE    SET INTERNAL ERROR
          SA6    RPVA
          EQ     RPV3        PROCESS ERROR
 
*         PROCESS OPERATOR INTERRUPT / RESOURCE LIMIT.
 
 RPV2     SA6    RPVA        SET INTERRUPT INDICATOR
          SA1    RPVC        CHECK FOR INTERRUPT INHIBITED
          ZR     X1,RPV3     IF CONTROL RETURN NOT REQUIRED
          REPRIEVE  RPVB,IRESUME,237B  RESUME PRIOR EXECUTION
 
 RPV3     SA1    F           GUARANTEE ALL FETS COMPLETE
          SX7    B1
          BX6    X1+X7
          SA2    D
          SA6    A1
          BX6    X2+X7
          SA1    V
          SA6    A2
          BX6    X1+X7
          SA2    R
          SA6    A1
          BX7    X2+X7
          SA7    A2
          EQ     PIT         PROCESS INTERRUPT
 
 
 RPVA     CON    0           INTERRUPT FLAG (ERROR MESSAGE ADDRESS)
 
 RPVB     BSS    0           REPRIEVE PROCESSING PARAMETER BLOCK
          VFD    36/0,12/RPVBL,12/0
          VFD    30/0,30/RPV
          BSSZ   7
          BSSZ   16          EXCHANGE PACKAGE
 RPVBL    EQU    *-RPVB
 
 RPVC     CON    0           CONTROL RETURN REQUIRED INDICATOR
 RSB      SPACE  4,15
**        RSB - MAKE RSB REQUEST.
*
*         ENTRY  (X1) = SUBSYSTEM IDENTIFICATION.
*                (X5) = WORD COUNT.
*                (X6) = ADDRESS TO SEND TO.
*                (X7) = ADDRESS FROM.
*
*         USES   A - 2, 7.
*                X - 1, 2, 5, 6, 7.
*
*         CALLS  SYS=.
 
 
 RSB      SUBR               ENTRY/EXIT
          SA2    RSBA
          LX5    36
          BX6    X6+X5
          LX7    18
          BX7    X7+X6
          LX1    18
          BX6    X1+X2
          SA7    X6
          RJ     =XSYS=
          EQ     RSBX        RETURN
 
 
 RSBA     VFD    18/3LRSB,12/2000B,12/0,18/SS  RSB CALL SKELETON
 SPM      SPACE  4,10
**        SPM - SET PREVIEW DISPLAY MESSAGE.
*
*         ENTRY  (X6) = *COMSRSX* MESSAGE CODE.
*
*         EXIT   MESSAGE CODE SET IN PREVIEW DATA.
*
*         USES   X - 1, 6, 7.
*                A - 1, 6.
 
 
 SPM      SUBR               ENTRY/EXIT
          SX7    X6-MXPN
          NG     X7,SPM1     IF NOT EST ORDINAL MESSAGE
          SA1    AV
          SA1    X1+         GET *EVSB* ENTRY
          MX7    9
          BX1    X7*X1       EST ORDINAL
          LX1    -3
          BX6    X6+X1       MERGE ERROR CODE AND EST ORDINAL
 SPM1     SA1    RESB+RQPV+PFLG
          LX6    12
          MX7    42
          BX1    X7*X1
          BX6    X1+X6       SET ERROR AND PARAMETER
          SA6    A1+
          EQ     SPMX        RETURN
 TMA      SPACE  4,10
**        TMA - *TMS* ABORT PROCESSING.
*
*         EXIT   CALL *TFM* IF *TMS* IS ENABLED TO CLEAN UP
*                THE TAPE CATALOG ON INTERRUPTS OR ABORTS.
*
*         USES   X - 1.
*                A - 1.
*
*         MACROS RECALL, TMS.
 
 
 TMA      SUBR               ENTRY/EXIT
          SA1    TMPF
          LX1    59-58
          PL     X1,TMAX     IF NOT *TMS* CONTROLLED REQUEST
          SA1    TA
          NZ     X1,TMAX     IF TAPE ASSIGNED TO *MAGNET*
          RECALL F           WAIT FOR UNLOAD TO COMPLETE
          TMS    T,RAPS      CALL TAPE MANAGER
          EQ     TMAX        RETURN
 WSB      SPACE  4,10
**        WSB - WRITE SUBSYSTEM BLOCK TO MAGNET.
*
*         ENTRY  (X6) = BUFFER ADDRESS.
*                (X7) = MAGNET BUFFER NUMBER.
*
*         USES   A - 1, 6.
*                X - 1, 6, 7.
*
*         CALLS  SYS=.
 
 
 WSB      SUBR               ENTRY/EXIT
          SA1    WSBA
          LX6    18
          BX1    X1+X6       SET BUFFER ADDRESS IN CALL
          SX6    MTSI
          LX7    48
          LX6    30
          BX6    X7+X6       MERGE BUFFER NUMBER AND SUBSYSTEM ID
          SA6    X1+         INITIALIZE STATUS WORD
          BX6    X1
          RJ     SYS=        SEND BLOCK TO MAGNET
          EQ     WSBX        RETURN
 
 
 WSBA     VFD    18/3RSIC,6/20B,18/0,18/SS  SIC CALL SKELETON
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDTC
*CALL     COMCDXB
          QUAL   COMSMTX
 QUAL$    EQU    1
          LIST   X
*CALL     COMCSRI
          LIST   *
          QUAL   *
 GSR      EQU    /COMSMTX/GSR
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCPFM
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCWTW
          TITLE  BUFFERS.
**        BUFFERS.
 
 
          USE    //
 
 RESB     BSSZ   RDEL        DEMAND FILE ENTRY BUFFER
 VSNE     BSSZ   VSNL        NEW VSN FILE ENTRY BUFFER
 RDT      BSSZ   RDTL        RESOURCES DEMANDED TABLE
 VBUF     EQU    *           VSN FILE (RSXVID) I/O BUFFER
 DBUF     EQU    *           DEMAND FILE (RSXDID) I/O BUFFER
 SBUF2L   MAX    IOBL,/COMSMTX/MUNIT*/COMSMTX/UNITL
 SBUF2    BSSZ   SBUF2L      SCRATCH 2 I/O BUFFER
 BUF      BSSZ   BUFL        SHORT SCRATCH BUFFER
 RET      BSSZ   RETL        RESOURCE EQUIPMENT TABLE
 EVSB     BSSZ   EVBL        ENVIRONMENT VSN BUFFER
 BUF2     EQU    *           SHORT SCRATCH BUFFER
          ERRNG  VSNL-/COMSMTX/MUNIT*2  *BUF2* OVERFLOWS *VSNB*
 VSNB     BSSZ   VSNL        VSN FILE ENTRY BUFFER
 UDT      BSSZ   /COMSMTX/UNITL  MAGNET UNIT DESCRIPTOR TABLE ENTRY
 
*         BUFFERS OVERLAYING PRESET.
 
 SBUF1    BSSN   IOBL        SCRATCH 1 I/O BUFFER
 TDDS     BSSN   TDDSL       TABLE OF CHAINED EQUIPMENTS
 RPRB     BSSN   RPBL        *RESEX* FORMAT PREVIEW BUFFER
 AMRB     BSSN   RMBL        ACS TAPE MOUNT REQUESTS BUFFER
 
*         TAPE ALTERNATE STORAGE PROCESSING BUFFERS.
 
 RBUF     BSSN   IOBL        REQUEST FILE BUFFER
 LSVL     CON    STVL        ADDRESS OF LAST *STVL* ENTRY+1
 
*         STVL - STAGING TAPE VSN LIST.
*
*T        20/ ,1/B,3/RTY,12/TF,24/ PACKED VSN
*
*         B                  SELECT BACKUP VSN.
*         RTY                RETRY COUNTER.
*         TF                 *FCTF* FLAGS FROM PFC.
*         PACKED VSN         PACKED VSN OF STAGING TAPE.
 
 STVL     BSSN   100B        STAGING TAPE VSN LIST (CAN EXPAND)
 
 RFL1     EQU    *+4         END OF BUFFERS
 
 END      BSSN               END TAG DEFINITION SEQUENCE
          TITLE  COMMAND PRESET ROUTINES.
 ASSIGN   SPACE  4,15
***       ASSIGN,DV,F,P1,P2,...,PN.
*
*         ASSIGN FILE *F* TO DEVICE TYPE *DV* WITH PARAMETERS P1,P2,
*         ...,PN.  OPTIONAL PARAMETERS ARE APPLICABLE TO MAGNETIC TAPE
*         ONLY.
*
*
*         ASSIGN,N,F,P1,P2,...,PN.
*
*         ASSIGN FILE *F* TO EST ORDINAL *N* WITH PARAMETERS P1,P2,
*         ...,PN.  OPTIONAL PARAMETERS ARE APPLICABLE TO MAGNETIC TAPE
*         ONLY.
 
 
 ASSIGN   BSS    0           ENTRY
 
*         VALIDATE COMMAND PARAMETERS.
 
          SX7    -1          SET REQUEST TYPE FOR *ASSIGN*
          SA7    RT
          SA7    AL          ACCESS LEVEL PERMISSION
          SX5    ASSIGNC
          RJ     CCP         COMMAND PROCESSOR
          RJ     POP         PICK OUT PARAMETER
          NG     B5,ERR      IF NO EQUIPMENT TYPE OR EST ORDINAL
          SX1    X1-1R=
          ZR     X1,ERR      IF SEPARATOR IS *=*
          SA5    POPA        ASSEMBLE EST ORDINAL
          SB7    B0          ASSUME OCTAL VALUE
          RJ     DXB
          NZ     X4,ASG1     IF NON-NUMERIC DEVICE DESIGNATION
          SA3    /LWC/ESTP   CHECK FOR ORDINAL OUTSIDE EST
          LX3    24
          AX3    48
          IX3    X6-X3
          PL     X3,ERR      IF BEYOND LAST EST ORDINAL
          EQ     ASG2        SET EQUIPMENT IN FET
 
 ASG1     SA5    A5          CHECK EQUIPMENT TYPE
          MX2    12
          BX7    -X2*X5
          BX6    X5
          NZ     X7,ERR      IF MORE THAN 2 CHARACTERS
 ASG2     SA6    ASGA        SAVE EQUIPMENT TYPE/NUMBER
          RJ     AFO         ASSEMBLE FILE NAME AND TAPE OPTIONS
          UNLOAD F,R         RETURN FILE
          SA4    ASGA
          MX2    12
          BX5    X2*X4       CHECK TYPE OF ASSIGN
          SX7    B0
          NZ     X5,ASG3     IF ASSIGN BY EQUIPMENT TYPE
          LX4    -12
 ASG3     SA3    F+FDTY      SET EQUIPMENT TYPE / EST ORDINAL IN FET
          SA7    VA          CLEAR VSN ADDRESS
          BX6    -X2*X3
          BX6    X6+X4
          LX4    12
          SA6    A3
          ZR     X5,ASG4     IF ASSIGN BY EST ORDINAL
 
*        ASSIGN BY EQUIPMENT TYPE.
 
          LX5    -48
          BX7    X5
          RJ     CTE         CHECK FOR TAPE DEVICE TYPE
          ZR     X2,ASG6     IF NON-TAPE DEVICE SPECIFIED
          SX6    B0          SET ASSIGNMENT BY DEVICE TYPE
          EQ     ASG10       ASSIGN TAPE DEVICE
 
*         ASSIGN BY EST ORDINAL.
 
 ASG4     RJ     GEE         GET EST ENTRY
          MX7    -12
          LX1    -12
          BX7    -X7*X1      DEVICE TYPE
          SX5    X7          SAVE DEVICE TYPE
          RJ     CTE         CHECK FOR TAPE EQUIPMENT
          NZ     X2,ASG5     IF TAPE DEVICE SPECIFIED
          SX4    X4+7000B    SET ASSIGN-BY-ORDINAL FLAG
          LX4    48
          IX6    X4+X3       RESET EST ORDINAL IN FET
          SA6    A3
          EQ     ASG6        ASSIGN NON-TAPE EQUIPMENT
 
 ASG5     SA1    ASGA        GET EST ORDINAL
          SX6    X1
          LX6    -12
          SA6    EQ          SET EST ORDINAL
          SX6    1           SET ASSIGN BY EST ORDINAL
          EQ     ASG10       ASSIGN TAPE DEVICE
 
*         ASSIGN NON-TAPE DEVICE.
 
 ASG6     SX1    X5-2RTT
          SX7    X5+
          NZ     X1,ASG8     IF NOT *TT* DEVICE
          SA1    OT
          SX1    X1-IAOT
          ZR     X1,ASG9     IF INTERACTIVE JOB
          SB2    /PER/IEQ    * INCORRECT EQUIPMENT.*
          EQ     PER         PROCESS ERROR
 
 ASG8     SA2    SPVT        SET TO CHECK *ASSIGN* DEVICE TYPES
          RJ     CDT         CHECK DEVICE TYPE
          NZ     X2,ASG9     IF SPECIAL VALIDATION NOT REQUIRED
          RJ     CJV         CHECK JOB VALIDATION
 ASG9     REQUEST F,UNIT     REQUEST NON-MAGNETIC TAPE EQUIPMENT
          EQ     END2        CHECK CHECKPOINT INDEX AND END
 
*         ASSIGN TAPE DEVICE.
 
 ASG10    SA3    TT
          SA1    F+FTAP
          SA6    AA          SET ASSIGNMENT TYPE
          SX6    X7-/COMSMTX/DVAT
          SB2    /PER/IEQ    * INCORRECT EQUIPMENT.*
          ZR     X6,PER      IF *AT* DEVICE TYPE
          MX6    -2
          LX7    55
          LX6    55
          ZR     X3,ASG11    IF NO OPTIONAL DEVICE TYPE PARAMETER
          BX2    X1-X7
          BX2    -X6*X2
          ZR     X2,ASG12    IF SAME DEVICE TYPE
          SB2    /PER/TDC    * TAPE DEVICE TYPE CONFLICT*.
          EQ     PER         PROCESS ERROR
 
 ASG11    SX6    B1
          BX7    X1+X7       SET DEVICE TYPE
          SA6    A3          SET DEVICE TYPE SPECIFIED
          SA7    A1
 ASG12    RJ     VCD         VERIFY COMMAND DEFAULTS
          EQ     VTR         VALIDATE TAPE REQUEST
 
 
 ASGA     CON    0           ASSIGNED DEVICE TYPE OR EST ORDINAL
 LABEL    SPACE  4,10
***       LABEL,F,P1,P2,...,PN.
*
*         REQUEST AUTOMATIC ASSIGNMENT OF FILE *F* TO MAGNETIC TAPE OR
*         VALIDATE OR WRITE LABELS ON ASSIGNED TAPE FILE *F* WITH
*         PARAMETERS P1,P2,...PN.
 
 
 LABEL    BSS    0           ENTRY
          SX7    B0          SET REQUEST TYPE FOR *LABEL*
          SB1    1           B1=1
          MX6    1
          SA7    RT
          SA6    AL          ACCESS LEVEL PERMISSION
          SX5    LABELC
          RJ     CCP         COMMAND PROCESSOR
          RJ     AFO         ASSEMBLE FILE NAME AND TAPE OPTIONS
          SA1    FS
          ZR     X1,LRC      IF *TE* FILE OR FILE NOT FOUND
 
*         PROCESS *LABEL* COMMAND ON ASSIGNED TAPE FILE.
 
          RJ     VCD         VERIFY COMMAND DEFAULTS
          SA1    F+FTAP
          RJ     CTI         CONVERT TAPE DESCRIPTORS
          RJ     VTD         VERIFY TAPE DESCRIPTORS
          NZ     B2,PER      IF ERROR IN TAPE DESCRIPTORS
          BX6    X1          UPDATE TAPE DESCRIPTORS
          SA6    A1
          RJ     TBD         BUILD TAPE BLOCK DEFINITION
          RJ     MFA         CHECK *TMS* MULTI-FILE ASSIGNMENT
          RJ     OPN         OPEN FILE
          EQ     END2        CHECK CHECKPOINT INDEX AND END
 REQUEST  SPACE  4,10
***       REQUEST,F,P1,P2,...,PN.
*
*                REQUEST AUTOMATIC ASSIGNMENT OF FILE *F* TO MAGNETIC
*                TAPE WITH PARAMETERS P1,P2,...,PN.  THE TAPE MAY BE
*                LABELED, UNLABELED, OR A MULTI-FILE SET.
 
 
 REQUEST  BSS    0           ENTRY
          SX7    1           SET REQUEST TYPE
          SX5    REQUESC
          SA7    RT
          MX6    1
          SA6    AL          ACCESS LEVEL PERMISSION
          RJ     CCP         COMMAND PROCESSOR
          RJ     AFO         ASSEMBLE FILE NAME AND TAPE OPTIONS
          SA1    FS
          NZ     X1,END2     IF EXISTING FILE NOT ASSIGNED TO *TE*
          EQ     LRC         PROCESS *REQUEST* COMMAND
 RESOURC  SPACE  4,10
***       RESOURC,RT1=N1/AL,RT2=N2/AL,.....RTN=NN/AL.
*
*         SPECIFY MAXIMUM SIMULTANEOUS USAGE OF MAGNETIC TAPE AND
*         REMOVABLE DISK PACK RESOURCES.
*
*                RT    RESOURCE TYPE.
*                N     NUMBER OF UNITS DEMANDED.
*                AL    ACCESS LEVEL, FOR TAPE DRIVES ONLY.
*                      ( SEE *COMSMLS* FOR MICRO DEFINITION.)
 
 
 RESOURC  BSS    0           ENTRY
          SX5    RESOURS
          RJ     CCP         COMMAND PROCESSOR
 RES1     RJ     BRE         BUILD RESOURCE ENVIRONMENT
          PL     X0,RES2     IF SUBSYSTEM NOT MISSING
          RJ     PMM         PROCESS *MAGNET* MISSING
          EQ     RES1        RETRY BUILDING ENVIRONMENT
 
 RES2     RJ     IDE         INITIALIZE DEMAND ENTRY
          RJ     RDF         READ DEMAND FILE
          SA1    /CPA/RFCW
          SX1    X1+
          ZR     X1,RES4     IF NO DEMAND FILE ENTRY
 
*         CHECK FOR LOST TAPE ASSIGNMENT AND COUNT ASSIGNED UNITS.
 
          MOVE   RDEL,DBUF,RESB  COPY DEMAND FILE ENTRY
          BX6    X6-X6       CLEAR MOUNT REQUEST
          SA6    RESB+RREQ
          SA1    RESB+RVAL   CHECK FOR LOST TAPES
          SX4    RESB        DEMAND FILE ENTRY ADDRESS
          LX1    59-53
          PL     X1,RES3     IF NO TAPE ASSIGNMENT LOST
          SB5    B0          GET MAGNETIC TAPE ASSIGNED COUNT
          RJ     CTA
          SB2    /PER/PTL    * PRIOR TAPE ASSIGNMENT LOST.*
          NZ     B3,PER      IF LOST TAPES NOT RETURNED
          MX2    1
          SA1    RESB+RVAL   CLEAR TAPE ASSIGNMENT LOST FLAG
          LX2    53-59
          BX6    -X2*X1
          SA6    A1
 RES3     SA3    JEEO        GET JOB EJT ORDINAL
          RJ     CAU         COUNT ASSIGNED UNITS
 
*         PROCESS COMMAND PARAMETERS.
 
 RES4     SA5    AP          RESET ASSEMBLY POINTERS
          SB6    X5+
 RES5     ZR     B6,RES8     IF END OF COMMAND
          RJ     POP         CHECK TYPE OF RESOURCE
          NG     B5,ERR      IF COMMAND ERROR
          SX1    X1-1R=
          NZ     X1,ERR      IF SEPARATOR IS NOT *=*
          SA1    POPA
 RES6     RJ     GRI         GET RESOURCE DEMAND ENTRY INDEX
          NZ     B2,RES7     IF INDEX FOUND
          SA1    POPA        CHECK FOR *LO*, *HI*, *HY* IDENTIFIERS
          BX7    X1
          LX7    12
          SB4    TRSLL3
          RJ     GRL
          SX1    2RMT
          SB4    B4-TRMT
          LX1    -12
          ZR     B4,RES6     IF RESOURCE IDENTIFIER FOUND
          SB2    /PER/IRT    * INCORRECT RESOURCE TYPE.*
          EQ     PER         PROCESS ERROR
 
 RES7     SA6    RI          SAVE RESOURCE INDEX AND UNIT COUNT
          RJ     POP         GET NUMBER OF RESOURCE UNITS
          NG     B5,ERR      IF COMMAND ERROR
          SX7    X1
          SA7    SC          SEPARATOR CHARACTER
          SX1    X1-1R=
          ZR     X1,ERR      IF SEPARATOR IS *=*
          SA5    POPA
          SB7    B1
          RJ     DXB         CONVERT NUMBER
          NZ     X4,ERR      IF ASSEMBLY ERRORS
          SA6    RESA        SAVE CONVERTED UNIT COUNT
          RJ     PAL         PROCESS ACCESS LEVEL
          SA5    RESA        CONVERTED UNIT COUNT
          BX6    X5
          MX0    54
          BX1    X0*X6
          SB2    /PER/IRC    * INCORRECT RESOURCE COUNT.*
          NZ     X1,PER      IF DEMAND TOO LARGE
          SA2    RI          CALCULATE RESOURCE BYTE POSITION
          RJ     CBP
          SA3    RESB+B2     ENTER NEW DEMAND COUNT
          AX2    X3,B4       POSITION OLD COUNT
          BX6    -X0*X6      NEW DEMAND COUNT
          BX4    -X0*X2      OLD DEMAND COUNT
          SA1    RESB+RVAL   ADJUST TOTAL DEMAND COUNT
          IX5    X6-X4       INCREMENT
          IX7    X1+X5
          LX5    B4          ADJUST INDIVIDUAL DEMAND COUNT
          SA7    A1
          IX7    X3+X5
          LX2    -6
          SA7    A3
          BX2    -X0*X2      ASSIGNED COUNT
          IX5    X6-X2
          PL     X5,RES5     IF ASSIGNEDS .LE. NEW DEMAND
          SB2    /PER/RDE    *RESOURCE DEMAND ERROR.*
          EQ     PER         PROCESS ERROR
 
*         CHECK VALIDITY OF REQUESTED RESOURCES.
 
 RES8     SX4    RESB        COUNT TAPE DEMANDS
          SB5    B0+
          RJ     CTA
          SB2    /PER/IRC    * INCORRECT RESOURCE COUNT.*
          SX1    X7-MMTD-1
          PL     X1,PER      IF TOTAL TAPE DEMAND TOO LARGE
          SA1    RESB+RVAL   CHECK REMOVABLE PACK DEMANDS
          MX0    -12
          BX6    -X0*X1      TOTAL DEMAND COUNT
          IX6    X6-X7
          SX1    X6-MMSD
          PL     X1,PER      IF TOTAL REMOVABLE PACK DEMAND TOO LARGE
          RJ     CCR         CHECK FOR CONFLICTING RESOURCES
          EQ     RRS         REQUEST RESOURCES
 
 
 RESA     CON    0           NUMBER OF RESOURCE UNITS
 VSN      SPACE  4,10
***       VSN    (F1=VSN1,F2=VSN2,...,FN=VSNN)
*
*                ASSOCIATE MAGNETIC TAPE REELS WITH VOLUME SERIAL
*                NUMBERS TO FILE *FI*.
 
 
 VSN      BSS    0           ENTRY
          SX5    VSNC
          RJ     CCP         COMMAND PROCESSOR
          SA1    /CPA/RFCW
          SX1    X1
          SX7    B1          INDICATE VSN ENTRY TO BE MADE
          SA7    VP
          NZ     X1,VSN1     IF DEMAND ENTRY EXISTS
          RJ     IDE         INITIALIZE DEMAND ENTRY
 VSN1     SA1    AP
          SB6    X1          RESET ASSEMBLY POINTER
          ZR     X1,END7     IF END OF COMMAND
          SX6    B0          DISABLE LITERAL PROCESSING
          MX4    -18
          SA6    LIT
          RJ     POP         PICK OUT PARAMETER
          NG     B5,ERR      IF ERROR
          GE     B5,B1,ERR   IF MORE THAN 1 WORD IN PARAMETER
          BX4    -X4*X6
          LX3    X6
          SX2    X1-1R=
          NZ     X4,ERR      IF FILE NAME ERROR
          ZR     X6,ERR      IF NO FILE NAME
          NZ     X2,ERR      IF SEPARATOR IS NOT *=*
          RJ     BVE         BUILD VSN ENTRY
          SA1    VSNE+VLFN
          SX6    B1
          BX6    X1+X6
          SA6    VF
          RJ     FSC         CHECK FOR EXISTING FILE
          NZ     B7,VSN1     IF FILE ALREADY ASSIGNED
          RJ     MFE         MAKE VSN FILE ENTRY
          EQ     VSN1        PROCESS NEXT FILE
 LRC      SPACE  4,10
**        LRC - *LABEL* AND *REQUEST* COMMAND FILE ASSIGNMENT.
*
*         EXIT   TO *VTR* TO PROCESS TAPE REQUEST.
*                TO *ROE* TO REQUEST OPERATOR EQUIPMENT ASSIGNMENT.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*
*         CALLS  FRA, MFE, SVI, VCD.
 
 
 LRC      BSS    0           ENTRY
 
*         CHECK FOR VSN SPECIFIED ON *LABEL* OR *REQUEST* COMMAND.
 
          RJ     MFE         MAKE RESOURCE FILE ENTRIES
          RJ     SVI         SET VSN INDEX
          RJ     FRA         CHECK *TMS* FIRST REEL ASSIGNMENT
          NZ     X5,LRC1     IF VSN NOT FOUND
          RJ     VCD         VERIFY COMMAND DEFAULTS
          EQ     VTR         VALIDATE TAPE REQUEST
 
*         PROCESS *LABEL* OR *REQUEST* WITH NO VSN FOUND.
 
 LRC1     SX6    B0+         SET OPERATOR ASSIGNMENT FLAG
          SA6    AA
          RJ     VCD         VERIFY COMMAND DEFAULTS
          SA1    TT
          NZ     X1,VTR      IF DEVICE TYPE SPECIFIED
*         EQ     ROE         REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT
 ROE      SPACE  4,15
**        ROE - REQUEST OPERATOR EQUIPMENT ASSIGNMENT.
*
*         THIS ROUTINE IS CALLED WHEN THE OPERATOR MUST ASSIGN AN
*         EQUIPMENT IN RESPONSE TO A *LABEL* OR *REQUEST* COMMAND OR
*         *LABEL* MACRO WITH NO VSN SPECIFIED AND IT IS NOT KNOWN
*         WHETHER TAPE EQUIPMENT IS REQUIRED.
*
*         EXIT   TO *RMT* IF TAPE EQUIPMENT SELECTED.
*                TO *END1* IF NON-TAPE EQUIPMENT SELECTED.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 6, 7.
*
*         CALLS  CJV, CTE, CTI, CTP, ROA, TBD, VTD.
 
 
 ROE      BSS    0           ENTRY
          SX4    B0          SET REQUEST OPERATOR EQUIPMENT ASSIGNMENT
          RJ     ROA         REQUEST OPERATOR ASSIGNMENT
          BX7    X4
          RJ     CTE         CHECK FOR TAPE EQUIPMENT
          ZR     X2,END1     IF NON-TAPE EQUIPMENT ASSIGNED
          SA7    ROEA        SAVE DEVICE TYPE OF SELECTED EQUIPMENT
          SA1    F+FTAP
          RJ     CTI         CONVERT TAPE DESCRIPTORS
          RJ     VTD         VERIFY TAPE DESCRIPTORS
          NZ     B2,PER      IF ERROR IN TAPE DESCRIPTORS
          BX6    X1
          SA1    A1          PRESERVE UNCONVERTED TAPE DESCRIPTORS
          SA2    ROEA
          SA6    A1+         SET CONVERTED TAPE DESCRIPTORS
          SX7    B4          TAPE DEVICE TYPE
          BX4    X7-X2
          ZR     X4,ROE2     IF NO DEVICE TYPE CONFLICT
          NZ     B4,ROE1     IF NOT *MT* REQUEST
          ERRNZ  /COMSMTX/DVMT
          LX2    55
          BX1    X1+X2       TRY SELECTED DEVICE TYPE IN DESCRIPTORS
          RJ     CTI         CONVERT TAPE DESCRIPTORS
          RJ     VTD         VERIFY TAPE DESCRIPTORS
          NZ     B2,ROE1     IF CONFLICT USING SELECTED DEVICE TYPE
          BX6    X1          SET CONVERTED TAPE DESCRIPTORS
          SA6    A1
          EQ     ROE2        BUILD TAPE BLOCK DEFINITION
 
 ROE1     SX7    B0+         REJECT OPERATOR SELECTED EQUIPMENT
          SA7    EQ
 ROE2     RJ     TBD         BUILD TAPE BLOCK DEFINITION
          RJ     CJV         CHECK JOB VALIDATION
          RJ     CTP         CHECK TAPE ACCESS PRIVILEGES
          EQ     RMT         REQUEST MAGNETIC TAPE
 
 
 ROEA     CON    0           TAPE DEVICE TYPE
 VTR      SPACE  4,15
**        VTR - VALIDATE NON-TMS TAPE REQUEST.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*
*         CALLS  CAR, COV, CJV, CTI, CTP, TBD, VTD.
*
*         EXIT   TO *RMT*.
*                OPERATOR VERIFY FLAG CLEARED IF *SYOT* JOB AND READ
*                  ONLY ACCESS.
*                TO *PER* IF ACS TAPE REQUEST WITH NO VSN.
 
 
 VTR      BSS    0           ENTRY
          SA1    F+FTAP
          RJ     CTI         CONVERT TAPE DESCRIPTORS
          RJ     VTD         VERIFY TAPE DESCRIPTORS
          NZ     B2,PER      IF ERROR IN TAPE DESCRIPTORS
          RJ     CAR         CHECK ACS TAPE REQUEST
          BX6    X1          UPDATE TAPE DESCRIPTORS
          SA6    F+FTAP
          SA2    OT
          LX1    59-39
          SX2    X2-SYOT
          NZ     X2,VTR1     IF NOT SYSTEM ORIGIN JOB
          PL     X1,VTR1     IF NOT READ ONLY ACCESS
          RJ     COV         CLEAR OPERATOR VERIFY FLAG
 VTR1     RJ     TBD         BUILD TAPE BLOCK DEFINITION
          RJ     CJV         CHECK JOB VALIDATION
          RJ     CTP         CHECK TAPE ACCESS PRIVILEGES
          EQ     RMT         REQUEST MAGNETIC TAPE
          TITLE  PRESET UTILITY ROUTINES.
 CAR      SPACE  4,20
**        CAR - CHECK ACS TAPE REQUEST NOT UNDER TMS CONTROL.
*
*         ENTRY  (X1) = TAPE DESCRIPTORS.
*
*         EXIT   (X1) = UPDATED TAPE DESCRIPTORS.
*                READ ONLY ACCESS FORCED IF SYSTEM ORIGIN JOB, WRITE
*                  ACCESS NOT REQUIRED AND NOT CALLED FROM *SSJ=*
*                  PROGRAM.
*                OPERATOR VERIFY FLAG CLEARED IF WRITE ACCESS REQUIRED
*                  BY SYSTEM ORIGIN *SSJ=* PROGRAM.
*                TO *PER* IF ACS TAPE REQUEST WITH NO VSN, JOB NOT
*                  SYSTEM ORIGIN, OR WRITE ACCESS REQUESTED AND CALLER
*                  IS NOT *SSJ=* PROGRAM.
*
*         USES   X - 1, 2, 3, 4, 6.
*                A - 2, 3, 4.
*
*         CALLS  COV.
*
*         MACROS MESSAGE.
 
 
 CAR      SUBR               ENTRY/EXIT
          LX1    0-55
          MX6    -2
          BX6    -X6*X1      TAPE DEVICE TYPE
          LX1    55-55-0+55
          SX6    X6-/COMSMTX/DVAT
          NZ     X6,CARX     IF NOT ACS TAPE REQUEST
          SA2    OT
          SA3    AA
          SA4    /CPA/SPCW
          SB2    /PER/NVS    * NO VSN SPECIFIED ON ACS TAPE REQUEST.*
          SX2    X2-SYOT
          PL     X3,PER      IF VSN NOT SPECIFIED
          SB2    /PER/UAV    * USER ACCESS NOT VALID.*
          NZ     X2,PER      IF NOT SYSTEM ORIGIN JOB
          LX1    59-40
          PL     X1,CAR1     IF WRITE ENABLE NOT REQUIRED
          LX4    59-36
          PL     X4,PER      IF NOT INTERNAL CALL FROM *SSJ=* PROGRAM
          RJ     COV         CLEAR OPERATOR VERIFY FLAG
          LX1    40-40-59+40
          EQ     CARX        RETURN
 
 CAR1     LX3    X1,B1
          LX1    40-40-59+40
          NG     X3,CARX     IF READ ONLY REQUEST
          SX6    B1
          LX6    39-0
          BX4    X1+X6       SET READ ONLY AND SAVE TAPE DESCRIPTORS
          MESSAGE  CARA,3    * WRITE DISABLE FORCED ON NON-TMS ACS...*
          BX1    X4          RESTORE TAPE DESCRIPTORS
          EQ     CARX        RETURN
 
 
 CARA     DATA   C* WRITE DISABLE FORCED ON NON-TMS ACS TAPE REQUEST.*
 CCR      SPACE  4,10
**        CCR - CHECK FOR CONFLICTING RESOURCES.
*
*         ENTRY  RESB = RESOURCE DEMAND ENTRY.
*
*         ERROR   TO *PER*, IF CONFLICTING RESOURCE TYPES.
*
*         USES   X - 0, 1, 2.
*                A - 1, 2.
*                B - 2.
 
 
 CCR      SUBR               ENTRY/EXIT
          SA1    RESB+RNTP   *NT* NOT ALLOWED WITH *HD*, *PE*, *GE*
          MX0    -48
          SA2    A1+B1       SECOND WORD OF TAPE ENTRY
          BX1    X1+X2
          BX1    -X0*X1
          ZR     X1,CCRX     IF NO CONFLICT
          SB2    /PER/CRT    * CONFLICTING RESOURCE TYPES.*
 CCR1     SA1    A2+B1
          SA2    A1+B1
          BX1    X1+X2
          BX1    -X0*X1
          NZ     X1,PER      IF CONFLICT IN RESOURCE TYPES
          SX1    A1-RESB-RGEP
          NZ     X1,CCR1     IF MORE 9-TRACK TAPE RESOURCES
          EQ     CCRX        RETURN
 CJV      SPACE  4,10
**        CJV - CHECK JOB VALIDATION.
*
*         ENTRY  (RT) = REQUEST TYPE.
*
*         ERROR  TO *PER*, IF USER ACCESS NOT VALID.
*
*         USES   A - 1, 2, 5.
*                B - 2.
*                X - 0, 1, 2, 5.
 
 
 CJV      SUBR               ENTRY/EXIT
          SA1    SSJ=+/COMSSSJ/AACS
          SA2    RT
          LX1    -7
          PL     X2,CJV1     IF *LABEL* OR *REQUEST*
          LX1    2
          SA5    OT
          SX5    X5-SYOT
          ZR     X5,CJVX     IF SYSTEM ORIGIN JOB
 CJV1     NG     X1,CJVX     IF VALID PRIVILEGES
          SB2    /PER/UAV    *USER ACCESS NOT VALID.*
          EQ     PER         PROCESS ERROR
 CTD      SPACE  4,10
**        CTD - CHECK *TMS* DEFAULTS.
*
*         ENTRY  (F+FTAP) = TAPE DESCRIPTOR.
*                (F+FVSN) = VSN.
*                (F+FSQN) = FILE SEQUENCE NUMBER.
*
*         EXIT   DEFAULTS SET.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
 
 
 CTD      SUBR               ENTRY/EXIT
          SA1    F+FTAP
          SA3    F+FVSN      CHECK VSN FOR SCRATCH
          SA2    BLANK
          MX0    36
          BX3    X0*X3
          BX2    X2-X3
          MX0    1
          NZ     X2,CTD1     IF NOT SCRATCH
          LX0    40-59       SET *PO=W*
          BX1    X1+X0
          LX0    58-59-40+59 CHECK FOR LABEL
          BX2    X0*X1
          ZR     X2,CTD1     IF NOT LABELED
          LX0    59-58
          BX1    X1+X0       SET *W*
          SA2    MF
          ZR     X2,CTD1     IF NOT MULTI-FILE REQUEST
          SA2    F+FSQN      CHECK IF QN=9999
          SX3    X2-9999D
          NZ     X3,CTD1     IF NOT QN=9999
          MX0    42          SET QN=1
          BX2    X0*X2
          SX7    B1
          BX7    X2+X7
          SA7    A2+
          SA2    MF          FLAG QN NOT .GT. 1
          SX6    X2-10
          SA6    A2
 CTD1     MX0    2           CHECK TAPE DESCRIPTORS
          LX0    40-59
          BX2    -X0*X1
          MX0    1
          LX0    40-59
          NG     X1,CTD2     IF *W* OPTION SET
          BX3    X0*X1
          NZ     X3,CTD2     IF *PO=W*
          LX0    39-59-40+59
 CTD2     BX6    X0+X2       SET *PO=W* OR *PO=R*
          SA6    A1
          SA1    F+FFTO      SET *TO=T* FLAG IN FET
          SX6    20B
          BX6    X1+X6
          SA6    A1
          SX0    1200B       CHECK IF *TO=C* OR *TO=E*
          BX6    X0*X1
          NZ     X6,CTDX     IF USER HAS SPECIFIED *TO=C* OR *TO=E*
          MX0    -1          GET DEFAULT FOR *TO=C*/*TO=E*
          SA2    TMPF
          LX2    0-51
          BX2    -X0*X2
          SA2    X2+CTDA
          BX6    X1+X2
          SA6    A1
          EQ     CTDX        RETURN
 
 
 CTDA     BSS    0           BITS TO SET FOR *TO=C* OR *TO=E*
          LOC    0
          CON    200B        BIT 7 FOR *TO=E*
          CON    1000B       BIT 9 FOR *TO=C*
          LOC    *O
 CTI      SPACE  4,15
**        CTI - CONVERT TAPE DESCRIPTORS TO INTERNAL *COMSMTX* FORMAT.
*
*         ENTRY  (X1) = UNCONVERTED TAPE DESCRIPTORS.
*
*         EXIT   (X1) = TAPE DESCRIPTORS WITH PARAMETERS DEFAULTED IF
*                       NECESSARY AND CONVERTED TO *COMSMTX* FORMAT.
*                TO *PER* IF ERROR IN FET PARAMETERS.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                B - 2.
*                A - 2, 7.
 
 
 CTI      SUBR               ENTRY/EXIT
 
*         GET DEVICE TYPE AND SET DEFAULT DENSITY AND CONVERSION MODE.
 
          SA2    /LWC/IPRL
          MX5    -2
          LX1    0-55
          BX5    -X5*X1      DEVICE TYPE
          MX0    -3
          SX7    /COMSMTX/D380  *CT*/*AT* DEFAULT DENSITY
          SX6    X5-/COMSMTX/DVNT
          ZR     X5,CTI1     IF *MT* REQUEST
          ERRNZ  /COMSMTX/DVMT
          NZ     X6,CTI2     IF NOT *NT* REQUEST
          LX2    -6
 CTI1     BX7    -X0*X2      *MT* OR *NT* DEFAULT DENSITY
          LX2    6
 CTI2     SA7    CTIA+0      SET DEFAULT DENSITY
          LX2    -12
          BX7    -X0*X2
          SA7    CTIB+0      SET DEFAULT CONVERSION MODE
 
*         CONVERT DENSITY.
 
          LX1    0-51-0+55
          BX2    -X0*X1      REQUESTED DENSITY
          SX6    X2-CTIAL
          SA2    CTIA+X2     CONVERT DENSITY
          SB2    /PER/IDN
          PL     X6,PER      IF ERROR IN SPECIFIED DENSITY
          BX1    X0*X1
          BX1    X1+X2       MERGE CONVERTED DENSITY
 
*         CONVERT CONVERSION MODE.
 
          LX1    0-48-0+51
          BX2    -X0*X1      REQUESTED CONVERSION MODE
          NZ     X5,CTI3     IF NOT *MT* REQUEST
          ERRNZ  /COMSMTX/DVMT
          SB2    /PER/ICD    * INCORRECT CONVERSION MODE FOR TAPE ...*
          NZ     X2,PER      IF 8 BIT CONVERSION MODE SPECIFIED
          SX2    /COMSMTX/BCD  SET BCD CONVERSION
          EQ     CTI4        SET CONVERTED MODE
 
 CTI3     SX6    X2-CTIBL
          SA2    CTIB+X2     CONVERT CONVERSION MODE
          SB2    /PER/ICM    * INCORRECT CONVERSION MODE.*
          PL     X6,PER      IF ERROR IN SPECIFIED CONVERSION MODE
 CTI4     BX1    X0*X1
          BX1    X1+X2       MERGE CONVERTED CONVERSION MODE
          LX1    48
          EQ     CTIX        RETURN
 
 
*         DENSITY CONVERSION TABLE.
 
 CTIA     BSS    0
          CON    0           JOB DEFAULT DENSITY
          CON    /COMSMTX/D05
          CON    /COMSMTX/D02
          CON    /COMSMTX/D08
          CON    /COMSMTX/D16
          CON    /COMSMTX/D62
          CON    /COMSMTX/D380
 CTIAL    EQU    *-CTIA
 
*         CONVERSION MODE CONVERSION TABLE.
 
 CTIB     BSS    0
          CON    0           JOB DEFAULT CONVERSION MODE
          CON    /COMSMTX/ANS
          CON    /COMSMTX/EBC
 CTIBL    EQU    *-CTIB
 CTP      SPACE  4,15
**        CTP - CHECK TAPE ACCESS PRIVILEGES.
*
*         EXIT   LABEL ACCESS RESTRICTIONS (PO = X) ENFORCED IF NOT
*                  SYSTEM ORIGIN JOB.
*                WRITE ACCESS DISABLED (PO = R) IF UNLABELED REQUEST,
*                  WRITE ACCESS NOT REQUESTED, AND NOT PERMITTED TO
*                  WRITE UNLABELED TAPES.
*                TO *PER* IF UNLABELED REQUEST, WRITE ACCESS REQUESTED,
*                  AND NOT PERMITTED TO WRITE UNLABELED TAPES.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 7.
*
*         MACROS MESSAGE.
 
 
 CTP      SUBR               ENTRY/EXIT
          SA1    OT
          SA2    F+FTAP
          SX6    B1
          SX1    X1-SYOT
          LX6    44-0
          ZR     X1,CTPX     IF SYSTEM ORIGIN JOB
          BX7    X2+X6       ENFORCE LABEL ACCESS RESTRICTIONS (PO = X)
          LX2    59-58
          NG     X2,CTP2     IF LABELED ACCESS
          SA1    /CPA/SPCW
          SA3    JCWA
          LX2    59-40-59+58
          LX1    59-36
          LX3    59-52
          NG     X1,CTP2     IF INTERNAL CALL FROM *SSJ=* PROGRAM
          NG     X3,CTP2     IF PERMITTED TO WRITE UNLABELED TAPES
          PL     X2,CTP1     IF WRITE ACCESS NOT REQUIRED
          SB2    /PER/NVU    * NOT VALIDATED FOR WRITING UNLABELED ...*
          EQ     PER         PROCESS ERROR
 
 CTP1     LX2    59-39-59+40
          LX6    39-44
          NG     X2,CTP2     IF WRITE ACCESS DISABLED
          BX7    X7+X6       DISABLE WRITE ACCESS (PO = R)
          MESSAGE CTPA,3     * WRITE DISABLE FORCED ON UNLABELED ...*
 CTP2     SA7    A2          UPDATE TAPE DESCRIPTORS
          EQ     CTPX        RETURN
 
 
 CTPA     DATA   C* WRITE DISABLE FORCED ON UNLABELED REQUEST.*
 FDF      SPACE  4,10
**        FDF - FLIP DATE FIELDS.
*
*         EXIT   CREATION AND RETENTION DATE FIELDS REVERSED IN FET.
*
*         USES   X - 0, 1, 6.
*                A - 1, 6.
 
 
 FDF      SUBR               ENTRY/EXIT
          MX0    30          GET RETENTION DATE
          SA1    T+FCRD
          BX6    X0*X1
          BX1    -X0*X1      GET CREATION DATE
          LX6    -30         REVERSE FIELDS
          LX1    30
          BX6    X1+X6
          SA6    A1
          EQ     FDFX        RETURN
 FRA      SPACE  4,25
**        FRA - FIRST REEL ASSIGNMENT.
*
*         BUILDS THE TFM ASSIGNMENT FET AND CALLS
*         TFM TO VALIDATE USER ACCESS OR ASSIGN A
*         SCRATCH VOLUME.
*
*         ENTRY  USER OPTIONS PROCESSED.
*                (X5) = VSN FOUND STATUS SET BY *SVI*.
*
*         EXIT   ASSIGNMENT FET UPDATED FROM *TMS* CATALOG ENTRY IF
*                  *TMS* CONTROLLED REQUEST.
*                (X5) = *SVI* VSN FOUND STATUS IF NOT *TMS* CONTROLLED
*                       REQUEST.
*                TO *RMT* IF *TMS* CONTROLLED REQUEST.
*                TO CALLER IF NOT *TMS* CONTROLLED REQUEST.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2.
*
*         CALLS  CJV, CTD, CTI, CTP, FDF, IDE, IVE, PRO, PVS, SFN, SMF,
*                TBD, VCD, VTD.
*
*         MACROS MESSAGE, MOVE, TMS.
 
 
 FRA13    MX6    1           SET OPERATOR VERIFICATION FLAG
          LX6    56-59
          SA6    TMPF
 
 FRA      SUBR               ENTRY/EXIT
          SA2    TMPF
          NG     X2,FRAX     IF *TMS* DISABLED
          SA1    F+FFTO      CHECK FOR *TO=F*
          LX1    59-1
          NG     X1,FRA13    IF *TO=F*
          LX1    59-4-59+1
          NG     X1,FRA1     IF *TO=T*
          LX2    59-53
          PL     X2,FRA13    IF DEFAULT *TO=F*
 FRA1     SA1    CF
          NZ     X1,FRA2     IF NOT COMMAND CALL
          RJ     VCD         VERIFY COMMAND DEFAULTS
 FRA2     SA1    F+FTAP
          RJ     CTI         CONVERT TAPE DESCRIPTORS
          RJ     VTD         VERIFY USER SPECIFIED TAPE DESCRIPTORS
          NZ     B2,PER      IF ERROR IN TAPE DESCRIPTORS
          BX6    X1          UPDATE TAPE DESCRIPTORS
          SA6    A1
          RJ     CTD         CHECK *TMS* DEFAULTS
          SA1    F           SET LOCAL FILE NAME
          MX0    -18
          BX6    X0*X1
          SA6    T
          MOVE   /TFM/TFPL,F+/TFM/TFFP,T+/TFM/TFFP
          SA2    T+FVSN
          SA1    CF
          NZ     X1,FRA4     IF *LFM* OR *REQ* CALL
          SA1    VC
          NZ     X1,FRA4     IF VSN FROM *VSN* COMMAND
          SA1    VP
          SA2    BLANK       ASSUME SCRATCH
          ZR     X1,FRA4     IF VSN= NOT PROCESSED
          SA2    VSNE+VVSN
 FRA4     MX0    36          CHECK FOR SCRATCH ASSIGNMENT
          BX6    X0*X2
          SA1    BLANK
          SA6    T+FESN
          BX7    X1-X6
          NZ     X7,FRA5     IF NOT VSN=SCRATCH
          BX6    X7
          SA6    A6
 FRA5     SA1    T+FID1      CHECK FILE IDENTIFIER
          NZ     X1,FRA6     IF FILE IDENTIFIER SPECIFIED
          NZ     X6,FRA6     IF VSN SPECIFIED
          RJ     SFN         SPACE FILL NAME
          BX5    X6
          SA2    T           USE LFN FOR FILE NAME
          MX0    -18
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          SA6    T+FID1
          SA2    A6+B1
          BX6    X0*X5
          BX3    -X0*X2
          BX7    X3+X6
          SA7    A2+
 FRA6     SA2    T+FESN      GET VSN
          BX6    X2
          RJ     PVS         PAD VSN WITH *0*
          BX2    X6
          SA1    VP          FLAG IF THE VSN PARAMETER WAS SPECIFIED
          LX1    22-0
          BX6    X2+X1       MERGE IN THE FLAG (IF SET)
          SA6    A2
 FRA7     RJ     FDF         FLIP DATE FIELDS
          TMS    T,RFAS      CALL TAPE MANAGER
          RJ     FDF         FLIP DATE FIELDS
          MX0    -9          CHECK FOR ERROR
          SA1    T
          LX0    17-8
          BX6    -X0*X1
          ZR     X6,FRA9     IF NO ERROR
          LX6    59-17
          PL     X6,FRA8     IF NON-ROLLABLE ERROR
          SX1    EMSG        GET ERROR MESSAGE
          SX5    =0
          RJ     PRO         PROCESS ROLLOUT
          EQ     FRA7        REISSUE REQUEST
 
 FRA8     MESSAGE  EMSG,3,R  ISSUE MESSAGE TO USER DAYFILE
          SB2    /PER/RTM    PROCESS FATAL *TMS* ERROR
          EQ     PER         PROCESS ERROR AND ABORT
 
 FRA9     SA1    VP          CHECK DEMAND FILE INITIALIZATION
          NZ     X1,FRA11    IF VSN= PROCESSED
          SX6    B1          SET VSN= PROCESSED
          SA6    A1
          SA2    /CPA/RFCW
          SX1    X2
          NZ     X1,FRA10    IF DEMAND FILE ENTRY EXISTS
          RJ     IDE         INITIALIZE DEMAND ENTRY
 FRA10    SB2    B1+         SET INITIALIZE ENTIRE ENTRY
          SA3    F
          RJ     IVE         INITIALIZE VSN ENTRY
 FRA11    SA1    TMPF        GET TMS FLAGS
          SA2    T+FESN
          SX0    B1
          LX0    58-0
          BX6    X1+X0       SET TMS CONTROLLED REQUEST
          LX0    20-0-58+0
          BX3    X0*X2       OFFSITE FLAG
          LX0    21-0-20+0
          BX1    X0*X2       USER OWNED FLAG
          LX0    23-0-21+0
          BX2    X0*X2       ASSIGN SCRATCH TAPE FLAG
          LX3    50-20
          LX1    52-21
          LX2    57-23
          BX3    X1+X3
          BX2    X2+X3
          BX6    X6+X2       SET SCRATCH, USER OWNED, OFFSITE STATUS
          SA2    T+FFTO      GET TMS OPTIONS
          SX3    14B
          BX5    X3*X2
          LX5    55-3
          BX6    X6+X5
          SA6    A1
          MOVE   6,T+FTAP,F+FTAP  SET LABEL FET FROM CATALOG ENTRY
          SA1    F+FTAP
          RJ     VTD         VERIFY TAPE DESCRIPTORS FROM CATALOG
          NZ     B2,PER      IF ERROR IN TAPE DESCRIPTORS
          RJ     TBD         BUILD TAPE BLOCK DEFINITION
          RJ     SMF         SET MULTI-FILE PROCESSING FLAGS
          RJ     CJV         CHECK JOB VALIDATION
          RJ     CTP         CHECK TAPE ACCESS PRIVILEGES
          SA1    T+FESN
          SA2    F+FVSN
          MX7    36
          BX6    X7*X1
          BX7    X7*X2
          SA6    EVSN        SET EXTERNAL VSN
          SA7    IVSN        SET INTERNAL VSN
          EQ     RMT         REQUEST MAGNETIC TAPE ASSIGNMENT
 IDF      SPACE  4,15
**        IDF - ISSUE DAYFILE MESSAGE.
*
*         ENTRY  (CCDR) = COMMAND IMAGE.
*
*         EXIT   DAYFILE MESSAGE ISSUED WITH SECURED PARAMETER VALUES
*                REMOVED.
*
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1, 3, 4, 5, 6.
*                B - 2, 3, 4, 5, 6.
*
*         CALLS  RSP.
*
*         MACROS MESSAGE, MOVE.
 
 
 IDF      SUBR               ENTRY/EXIT
          BX6    X0          SAVE X0, X3, X4, X5
          SA6    IDFD
          BX6    X3
          SA6    A6+B1
          BX6    X4
          SA6    A6+B1
          BX6    X5
          SA6    A6+B1
          MX2    -18
          SX1    A3          SAVE A3, A4, A5
          BX6    -X2*X1
          SX1    A4
          LX6    18
          BX1    -X2*X1
          BX6    X6+X1
          SX1    A5
          LX6    18
          BX1    -X2*X1
          BX6    X6+X1
          SA6    A6+B1
          SX1    B3          SAVE B3, B4, B5
          BX6    -X2*X1
          SX1    B4
          LX6    18
          BX1    -X2*X1
          BX6    X6+X1
          SX1    B5
          LX6    18
          BX1    -X2*X1
          BX6    X6+X1
          SA6    A6+B1
          MOVE   8,CCDR,IDFA SET WORKING COMMAND BUFFER
          SA4    IDFB        FWA ARGUMENT TABLE
          SB6    IDFC        FWA KEYWORD/POSITION TABLE
          SA5    IDFA        FWA OF RELOCATED CONTROL STATEMENT
          SB2    1R,         SKIP TO *,*
          RJ     RSP         REMOVE SECURE PARAMETERS
          MESSAGE IDFA,0,R   ISSUE COMMAND TO DAYFILE
          SA1    IDFD+5      RESTORE B3, B4, B5
          SB5    X1
          LX1    -18
          SB4    X1
          LX1    -18
          SB3    X1
          SA1    A1-B1       RESTORE A3, A4, A5
          SA5    X1
          LX1    -18
          SA4    X1
          LX1    -18
          SA3    X1
          SA1    A1-B1       RESTORE X5,X4,X3,X0
          BX5    X1
          SA1    A1-B1
          BX4    X1
          SA1    A1-B1
          BX3    X1
          SA1    A1-B1
          BX0    X1
          EQ     IDFX        RETURN
 
 IDFA     BSS    8           WORKING COMMAND BUFFER
 
 IDFB     BSS    0           ARGUMENT TABLE
 FA       ARG    0,0         FILE ACCESSIBILITY
 PW       ARG    0,0         PASSWORD
          CON    0           END OF TABLE
 
 IDFC     BSS    0           KEYWORD/POSITION TABLE
          VFD    42/0LFA,18/0  FILE ACCESSIBILITY
          VFD    42/0LPW,18/0  PASSWORD
          CON    0           END OF TABLE
 
IDFD      BSS    6           REGISTER SAVE AREA
 MFA      SPACE  4,15
**        MFA - MULTI-FILE ASSIGNMENT.
*
*         ENTRY  (TMPF) = *TMS* STATUS.
*
*         EXIT   MULTI-FILE PROCESSING FLAGS SET.
*
*         ERROR  EXIT TO *PER* IF NON-ROLLABLE *TFM* ERROR.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 2, 6.
*                B - 2.
*
*         CALLS  FDF, PRO, SMF.
*
*         MACROS MESSAGE, MOVE, TMS.
 
 
 MFA      SUBR               ENTRY/EXIT
          SA1    TMPF
          NG     X1,MFAX     IF *TMS* DISABLED
          SA1    TS
          PL     X1,MFAX     IF NOT SYMBOLIC *TMS* TAPE
          SA2    F
          MX0    -18
          BX6    X0*X2
          SA6    T
          MOVE   /TFM/TFPL,F+/TFM/TFFP,T+/TFM/TFFP
          MX0    59          CLEAR SYMBOLIC ACCESS FLAG
          SA1    T+FFTO
          LX0    2-0
          BX6    X0*X1
          SA6    A1
          SX0    1200B       CHECK IF *TO=C* OR *TO=E*
          SA1    T+FFTO
          BX2    X0*X1
          NZ     X2,MFA1     IF USER HAS SPECIFIED *TO=C* OR *TO=E*
          MX0    -1          GET DEFAULT FOR *TO=C*/*TO=E*
          SA2    TMPF
          LX2    0-51
          BX2    -X0*X2
          SA2    X2+MFAA     SET DEFAULT INTO *TMS* FET
          BX6    X1+X2
          SA6    A1
 MFA1     RJ     FDF         FLIP DATE FIELDS
          TMS    T,MFAS      CALL TAPE MANAGER
          RJ     FDF         FLIP DATE FIELDS
          MX0    -9
          SA1    T
          LX0    17-8
          BX6    -X0*X1
          ZR     X6,MFA3     IF NO ERROR
          SA6    MFAB        SAVE ERROR CODE
          LX6    59-17
          PL     X6,MFA2     IF NON-ROLLABLE ERROR
          SX1    EMSG        GET ERROR MESSAGE
          SX5    =0
          RJ     PRO         PROCESS ROLLOUT
          EQ     MFA1        REISSUE REQUEST
 
 MFA2     MESSAGE  EMSG,3,R  ISSUE MESSAGE TO USER DAYFILE
          SB2    /PER/RTM
          EQ     PER         PROCESS ERROR AND ABORT
 
 MFA3     SA1    T+FFTO      CHECK FOR SYMBOLIC ACCESS
          LX1    59-2
          PL     X1,MFA4     IF NOT SYMBOLIC ACCESS
          MOVE   /TFM/TFPL,T+/TFM/TFFP,F+/TFM/TFFP
 MFA4     RJ     SMF         SET MULTI-FILE PROCESSING FLAGS
          EQ     MFAX        RETURN
 
 MFAA     BSS    0           BITS TO SET FOR *TO=C* OR *TO=E*
          LOC    0
          CON    200B        BIT 7 FOR *TO=E*
          CON    1000B       BIT 9 FOR *TO=C*
          LOC    *O
 
 MFAB     CON    0           ERROR CODE FROM TFM
 PAL      SPACE  4,10
**        PAL - PROCESS ACCESS LEVEL.
*
*         ENTRY  (RI) = RESOURCE INDEX AND UNIT COUNT.
*                (RMTL) = LENGTH OF TAPE DRIVE ENTRIES.
*                (SC) = SEPARATOR CHARACTER FROM COMMAND.
*
*         EXIT   (RI) = RESOURCE INDEX AND COUNT ALTERED IF
*                MAGNETIC TAPE RESOURCE REQUEST WITH A SECURE SYSTEM.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 2.
*
*         CALLS  VLC.
 
 
 PAL      SUBR               ENTRY/EXIT
          SA1    SC
          SX1    X1-1R/
          NZ     X1,PAL1     IF ACCESS LEVEL NOT ON COMMAND
          RJ     POP         PICK OUT PARAMETER
          SX1    X1-1R=
          ZR     X1,ERR      IF SEPARATOR IS *=*
          SA2    SSMA        SYSTEM SECURITY MODE
          ZR     X2,PAL1     IF UNSECURED SYSTEM
          SA1    POPA
          SB2    B0
          MX0    -8
          SA5    JCWA        SECURITY CONTROL WORD
          RJ     VLC         VALIDATE ACCESS LEVEL
          SB2    /PER/UAL    * UNKNOWN ACCESS LEVEL NAME.*
          NG     X2,PER      IF ACCESS LEVEL NOT FOUND
          LX5    7-43        RIGHT JUSTIFY ACCESS LEVEL VALIDATIONS
          BX5    -X0*X5
          MX0    -1
          SB2    X2
          LX0    B2
          BX0    -X0*X5
          SB2    /PER/NVA    NOT VALIDATED FOR ACCESS LEVEL
          ZR     X0,PER      IF NOT A VALIDATED ACCESS LEVEL
          EQ     PAL2        CONTINUE PROCESSING
 
 PAL1     SA2    JALA        JOB ACCESS LEVEL
          MX0    -6
          BX2    -X0*X2
 PAL2     SA1    RI
          MX0    -6
          BX3    -X0*X1
          SX3    X3-RMTL
          SX7    X2
          NG     X3,PAL3     IF A TAPE UNIT
          NZ     X3,PALX     IF MASS STORAGE
 PAL3     SX2    X2+B1
          LX2    6
          BX6    X1+X2
          SA6    RI          ADJUSTED RESOURCE INDEX
          SA7    AL
          EQ     PALX        RETURN
 PVS      SPACE  4,20
**        PVS - PAD VSN WITH CHARACTER *0*.
*
*         ENTRY  (X6) = LEFT JUSTIFIED UNPADDED VSN.
*
*         EXIT   (X6) = PADDED VSN.  CHARACTER *0* INSERTED
*                       BEFORE FIRST NUMERIC CHARACTER UNTIL
*                       VSN IS SIX CHARACTERS LONG.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 3.
*                B - 2, 3.
 
 
 PVS      SUBR               ENTRY/EXIT
          SA3    =1L
          MX0    6           GET LENGTH OF UNPADDED VSN
          BX2    X6
          SX4    B0
 PVS1     BX1    X0*X6       CHECK FOR CHARACTER
          BX7    X1-X3
          ZR     X7,PVS2     IF CHARACTER IS A BLANK
          ZR     X1,PVS2     IF END OF CHARACTERS
          SX4    X4+B1
          LX6    6
          EQ     PVS1        CONTINUE
 
 PVS2     ZR     X4,PVSX     IF NO CHARACTERS, RETURN
          SX1    6           GET CORRECT NUMBER OF ZEROS
          IX4    X1*X4
          SB2    X4
          SB3    B2-6        SET UP MASK
          AX0    B3,X0
          BX2    X0*X2
          SA1    =36R000000
          AX1    B2
          SB3    60
          MX0    -6
          SX6    B0
 PVS3     BX7    X2          SAVE END OF VSN
          LX2    6           CHECK CHARACTER
          BX3    -X0*X2
          ZR     X3,PVS4     IF END OF CHARACTERS
          SX4    X3-1R0
          PL     X4,PVS4     IF NUMERIC CHARACTER
          LX6    6           BUILD FIRST PART OF VSN
          BX6    X6+X3
          BX2    X0*X2
          SB3    B3-6
          EQ     PVS3        CHECK NEXT CHARACTER
 
 PVS4     SB2    B2-36       ADD ZEROS TO VSN
          AX6    B2
          BX6    X6+X1
          BX6    X6+X7       ADD END OF VSN
          SB3    B3+B2
          LX6    B3
          EQ     PVSX        RETURN
 SBF      SPACE  4,10
**        SBF - SET MAXIMUM BLOCK SIZE FROM FRAME COUNT.
*
*         ENTRY  (X1) = TAPE DESCRIPTOR WORD.
*                (B2) = TAPE DEVICE TYPE.
*
*         EXIT   (X6) = 36/0,12/ WORD COUNT,12/ OVERFLOW
*                (X1) = TAPE DESCRIPTOR WORD.
*                (B2) = TAPE DEVICE TYPE.
*
*         USES   X - 2, 3, 4, 6, 7.
 
 
 SBF      SUBR               ENTRY/EXIT
 
*         SET BITS PER FRAME.
 
          MX7    -24
          BX2    -X7*X1      SPECIFIED FRAME COUNT
          SX6    6           7 TRACK BITS PER FRAME
          ZR     B2,SBF1     IF 7 TRACK TAPE
          ERRNZ  /COMSMTX/DVMT
          SX7    B2-/COMSMTX/DVNT
          SX6    8           9 TRACK BITS PER FRAME
          ZR     X7,SBF1     IF 9 TRACK TAPE
          SX6    16          CARTRIDGE TAPE BITS PER FRAME
 
*         SET BLOCK SIZE IN CM WORDS.
 
 SBF1     IX2    X2*X6       MAXIMUM BLOCK SIZE IN BITS
          BX3    X2
          SX7    60
          IX6    X3/X7       WHOLE WORDS IN BLOCK
          BX3    X6
          SX7    60
          IX4    X3*X7       BITS IN WHOLE WORDS
          IX4    X2-X4
          ZR     X4,SBF2     IF NO PARTIAL WORD
          SX7    B1
          IX6    X6+X7       TOTAL WORDS IN BLOCK
 
*         COMPUTE OVERFLOW IF BLOCK SIZE .GT. 1000B WORDS.
 
 SBF2     SX7    1000B
          SX2    B0          OVERFLOW = 0
          IX7    X7-X6
          PL     X7,SBF3     IF BLOCK SIZE .LE. 1000B WORDS
          SX3    /COMSMTX/LBWD  WORDS PER CHUNK
          BX2    X6
          IX2    X2/X3       OVERFLOW BLOCK COUNT
          SX3    /COMSMTX/LBWD
          IX3    X2*X3
          IX6    X6-X3       REMAINING WORD COUNT
 
*         SET WORD COUNT AND OVERFLOW FOR EXIT.
 
 SBF3     LX6    12
          BX6    X6+X2       MERGE WORD COUNT AND OVERFLOW
          EQ     SBFX        RETURN
 SMF      SPACE  4,15
**        SMF - SET MULTI-FILE PROCESSING FLAGS.
*
*         ENTRY  (F+FID1) = FILE IDENTIFIER.
*
*         EXIT   (MF) = MULTI-FILE PROCESSING FLAGS.
*                       01 - FILE IDENTIFIER PRESENT.
*                       02 - FILE SEQUENCE PRESENT.
*                       04 - MULTI-FILE POSITIONING.
*                       10 - FILE SEQUENCE .GT. 1.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
 
 
 SMF      SUBR               ENTRY/EXIT
          SA1    F+FID1
          SA2    F+FID2
          SA3    F+FMSI
          SX6    B0+         INITIALIZE MULTI-FILE FLAGS
          ZR     X1,SMF1     IF NO FILE IDENTIFIER (FI)
          SX6    B1+         SET FILE IDENTIFIER FLAG
 SMF1     MX0    36          CHECK SET IDENTIFIER (SI)
          BX1    X0*X3
          ZR     X1,SMF2     IF NO SET IDENTIFIER
          SA1    =6L         CHECK FOR SPACES
          BX1    X1-X3
          BX1    X0*X1
          ZR     X1,SMF2     IF NO SET IDENTIFIER
          SX6    X6+4        SET POSITIONING FLAG
 SMF2     MX0    -18         CHECK FILE SEQUENCE (QN)
          BX1    -X0*X2
          ZR     X1,SMF3     IF NO FILE SEQUENCE
          SX6    X6+2        SET SEQUENCE NUMBER FLAG
          SX2    X1-1
          ZR     X2,SMF3     IF SEQUENCE = 1
          SX6    X6+10B      SET SEQUENCE NUMBER .GT. 1 FLAG
 SMF3     SA6    MF          SET MULTI-FILE PROCESSING FLAGS
          EQ     SMFX        RETURN
 SNF      SPACE  4,20
**        SNF - SET NOISE BLOCK DEFINITION FROM FRAME COUNT.
*
*         ENTRY  (X2) = SPECIFIED NOISE FRAME COUNT.
*                (X1) = TAPE DESCRIPTOR WORD.
*                (B2) = TAPE DEVICE TYPE.
*
*         EXIT   (X6) = NOISE BLOCK DEFINITION.
*                (X1) = TAPE DESCRIPTOR WORD.
*                (B2) = TAPE DEVICE TYPE.
*
*         USES   X - 3, 4, 6, 7.
*
*         SEVEN TRACK NOISE FORMULA -
*                BYTES = (NS+1)/2.
*                FILL ALLOWED IF NS-2(BYTES) IS NEGATIVE.
*
*         NINE TRACK NOISE FORMULA -
*                BYTES = 2(NS+1)/3.
*                FILL ALLOWED IF NS-3(BYTES)/2 IS NEGATIVE.
 
 
 SNF      SUBR               ENTRY/EXIT
          SX4    X2+1        (NS+1)
          NZ     B2,SNF1     IF NOT SEVEN TRACK TAPE
          ERRNZ  /COMSMTX/DVMT
          AX3    X4,B1       BYTES = (NS+1)/2
          LX7    X3,B1       BYTES*2
          EQ     SNF2        DETERMINE FILL ALLOWED STATUS
 
 SNF1     LX4    1           2(NS+1)
          SX7    3
          IX3    X4/X7       BYTES = 2(NS+1)/3
          LX7    X3,B1
          IX7    X7+X3       BYTES*3
          AX7    1           (BYTES*3)/2
 SNF2     IX7    X2-X7
          MX6    1
          BX6    X7*X6       FILL ALLOWED STATUS
          LX6    5-59
          BX6    X6+X3       MERGE BYTE COUNT AND FILL STATUS
          EQ     SNFX        RETURN
 TBD      SPACE  4,15
**        TBD - BUILD TAPE BLOCK DEFINITION.
*
*         ENTRY  (F+FTAP) = CONVERTED TAPE DESCRIPTORS.
*
*         EXIT   (TB) = TAPE BLOCK DEFINITION PARAMETERS.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 5, 6.
*                B - 2, 3.
*
*         CALLS  SBF, SNF.
 
 
 TBD      SUBR               ENTRY/EXIT
          SA1    F+FTAP      GET TAPE DEVICE TYPE
          MX0    -2
          LX1    0-55
          BX6    -X0*X1
          LX1    0-51-0+55   GET TAPE DENSITY
          SB2    X6          TAPE DEVICE TYPE
          MX0    -3
          BX2    -X0*X1
          SB3    X2          DENSITY
          LX1    0-30-0+51
          MX0    -6
          BX6    -X0*X1      TAPE FORMAT
          LX1    59-59-0+30
          SA5    TTFM+X6     GET TAPE FORMAT CHARACTERISTICS
 
*         FORCE ASCII CONVERSION MODE IF UNLABELED *I*, *LI*, OR *SI*
*         FORMAT AND NOT SEVEN TRACK TAPE.
 
          ZR     B2,TBD2     IF SEVEN TRACK TAPE
          ERRNZ  /COMSMTX/DVMT
          LX2    X1,B1
          MX7    57
          NG     X2,TBD2     IF LABELED TAPE REQUEST
          PL     X5,TBD2     IF NOT INTERNAL TAPE FORMAT
          LX1    0-48
          SX2    /COMSMTX/ANS  FORCE ASCII CONVERSION
          BX6    X7*X1
          BX6    X6+X2
          LX6    59-59-0+48
          BX1    X6          UPDATE TAPE DESCRIPTORS
          SA6    A1
 
*         SET MAXIMUM DATA BLOCK SIZE.
 
 TBD2     LX5    23-47
          MX6    -24
          BX6    -X6*X5      BLOCK SIZE AND OVERFLOW
          LX5    59-58-23+47
          PL     X5,TBD3     IF NOT TO SET BLOCK SIZE FROM FRAME COUNT
          RJ     SBF         SET BLOCK SIZE FROM FRAME COUNT
 TBD3     SA6    TB          SET WORD COUNT AND OVERFLOW
 
*         PROCESS NOISE SIZE.
 
          SX6    B3-/COMSMTX/DNMX-1
          LX5    59-59-59+58
          PL     X6,TBDX     IF DENSITY DOES NOT SUPPORT NOISE BLOCKS
          MX0    -6
          LX1    0-24
          NG     X5,TBD4     IF INTERNAL FORMAT
          BX2    -X0*X1      SPECIFIED NOISE SIZE
          ZR     X2,TBD4     IF NOISE SIZE NOT SPECIFIED
          RJ     SNF         SET NOISE BLOCK DEFINITION FROM FRAMES
          EQ     TBD5        SET NOISE FILL
 
 TBD4     LX5    0-18
          BX6    -X0*X5      DEFAULT 7 TRACK NOISE BLOCK DEFINITION
          ZR     B2,TBD5     IF SEVEN TRACK TAPE
          ERRNZ  /COMSMTX/DVMT
          LX5    0-12-0+18
          BX6    -X0*X5      DEFAULT 9 TRACK NOISE BLOCK DEFINITION
 TBD5     SA2    TB
          LX6    24
          BX6    X2+X6       MERGE NOISE BLOCK DEFINITION
          SA6    A2          UPDATE TAPE BLOCK DESCRIPTORS
          EQ     TBDX        RETURN
 VCD      SPACE  4,10
**        VCD - VERIFY TAPE ASSIGNMENT COMMAND DEFAULTS.
*
*         EXIT   *F+FTAP* PARAMETERS DEFAULTED AS REQUIRED.
*                TO *PER* IF ERROR IN COMMAND DEFAULTS.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 7.
*                B - 2.
 
 
 VCD      SUBR               ENTRY/EXIT
 
*         SET IMPLICIT DEVICE TYPE IF REQUIRED.
 
          SA1    F+FTAP
          SA2    TT
          SA4    DM
          ZR     X2,VCD1     IF DEVICE TYPE NOT EXPLICITY SPECIFIED
          ZR     X4,VCD4     IF NO DENSITY SELECTION
          MX6    -2
          LX1    -55
          BX6    -X6*X1      SPECIFIED DEVICE TYPE
          SB2    X6+59-3
          LX1    55
          LX4    B2
          NG     X4,VCD4     IF DENSITY VALID FOR DEVICE TYPE
          SB2    /PER/IDD    * INCORRECT DENSITY FOR TAPE DEVICE TYPE.*
          EQ     PER         PROCESS ERROR
 
 VCD1     ZR     X4,VCD2     IF NO DENSITY SELECTION
          CX2    X4
          LX4    47-3
          SB2    X2+         NUMBER OF DEVICE TYPES VALID FOR SELECTION
          GT     B2,B1,VCD2  IF DEVICE TYPE NOT DETERMINED BY SELECTION
          NX4,B2 X4
          SX2    B2          IMPLICIT DEVICE TYPE
          EQ     VCD3        SET IMPLICIT DEVICE TYPE
 
 VCD2     SA3    AA
          ZR     X3,VCD4     IF OPERATOR TO ASSIGN EQUIPMENT
          SA2    /LWC/IPRL   GET DEFAULT DEVICE TYPE
          LX2    -4
 VCD3     MX6    -2
          BX2    -X6*X2
          LX2    55
          BX1    X1+X2       SET DEVICE TYPE
          SX7    1
          SA7    TT          SET TAPE DEVICE TYPE SPECIFIED
 
*         SET LABEL TYPE IF REQUIRED.
 
 VCD4     SA2    LT
          SA3    RT
          SA4    VP
          NZ     X2,VCD6     IF LABEL TYPE EXPLICITLY SPECIFIED
          ZR     X3,VCD5     IF *LABEL* COMMAND
          ZR     X4,VCD6     IF VSN NOT SPECIFIED
 VCD5     SX7    2           SET STANDARD LABELS
          LX7    57
          BX1    X1+X7       SET LABEL TYPE
 
*         UPDATE FET PARAMETERS.
 
 VCD6     BX7    X1          UPDATE *F+FTAP*
          SA7    A1
          EQ     VCDX        RETURN
 VTD      SPACE  4,15
**        VTD - VERIFY TAPE DESCRIPTORS.
*
*         ENTRY  (X1) = TAPE DESCRIPTOR WORD.
*
*         EXIT   (B2) = ERROR STATUS.
*                (X1) = TAPE DESCRIPTOR WORD.
*                (B3) = TAPE FORMAT.
*                (B4) = TAPE DEVICE TYPE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 3.
*                B - 2, 3, 4.
 
 
 VTD      SUBR               ENTRY/EXIT
          MX6    -6
          LX1    0-30
          MX7    -2
          BX2    -X6*X1      FORMAT
          SB2    /PER/ITF    * INCORRECT TAPE FORMAT.*
          SX3    X2-/COMSMTX/TFMA
          LX1    0-39-0+30
          PL     X3,VTDX     IF ERROR IN FORMAT
          BX4    -X7*X1      PO=R AND PO=W FLAGS
          SB3    X2+         SAVE FORMAT
          CX4    X4
          LX1    0-45-0+39
          SX4    X4-2
          SB2    /PER/WED    * WRITE ENABLE AND DISABLE OPTIONS...*
          PL     X4,VTDX     IF WRITE ENABLE AND DISABLE BOTH SELECTED
          MX6    -3
          BX4    -X6*X1      PO=I, PO=P, AND PO=S FLAGS
          CX3    X4
          AX4    1           REMOVE PO=S FLAG
          SX3    X3-2
          SB2    /PER/MET    * MULTIPLE END OF TAPE OPTIONS SELECTED.*
          PL     X3,VTDX     IF MORE THAN ONE OPTION SELECTED
          SB2    B3+59-17
          SX3    160000B     MASK OF FORMATS SUPPORTING PO=I OR PO=P
          LX1    59-58-0+45
          LX3    B2
          ZR     X4,VTD1     IF NEITHER PO=I NOR PO=P SPECIFIED
          SB2    /PER/IEF    * INCORRECT END OF TAPE OPTION FOR ...*
          PL     X3,VTDX     IF SELECTED OPTION NOT VALID FOR FORMAT
 VTD1     PL     X1,VTD2     IF NOT LABELED TAPE
          SX3    B3-/COMSMTX/TFF
          SB2    /PER/FRU    * FORMAT REQUIRES UNLABELED TAPE.*
          ZR     X3,VTDX     IF *F* FORMAT
 VTD2     LX1    0-48-59+58
          MX6    -3
          BX2    -X6*X1      CONVERSION MODE
          LX1    0-51-0+48
          SB2    /PER/ICM    * INCORRECT CONVERSION MODE.*
          SX3    X2-/COMSMTX/MCCO
          ZR     X2,VTDX     IF ERROR IN CONVERSION MODE
          PL     X3,VTDX     IF ERROR IN CONVERSION MODE
          BX4    -X6*X1      DENSITY
          LX1    0-55-0+51
          SX3    X4-/COMSMTX/DMAX
          SB2    /PER/IDN    * INCORRECT DENSITY*
          ZR     X4,VTDX     IF ERROR IN DENSITY
          PL     X3,VTDX     IF ERROR IN DENSITY
          BX7    -X7*X1      TAPE DEVICE TYPE
          LX1    55          RESTORE TAPE DESCRIPTORS
          SB4    X7+         SAVE DEVICE TYPE
          SX2    X2-/COMSMTX/BCD
          SB2    /PER/ICD    * INCORRECT CONVERSION MODE FOR TAPE...*
          NZ     B4,VTD3     IF NOT 7 TRACK DEVICE TYPE
          ERRNZ  /COMSMTX/DVMT
          NZ     X2,VTDX     IF NOT 7 TRACK CONVERSION MODE
          EQ     VTD4        CHECK DEVICE TYPE AND DENSITY
 
 VTD3     ZR     X2,VTDX     IF 7 TRACK CONVERSION MODE
 VTD4     SA3    VTDA        GET DENSITY LIMITS
          SX2    6
          IX7    X7*X2
          SB2    X7+6
          LX3    B2          POSITION DENSITY LIMITS FOR DEVICE TYPE
          BX2    -X6*X3      MAXIMUM DENSITY
          LX3    -3
          BX3    -X6*X3      MINIMUM DENSITY
          IX2    X2-X4
          IX3    X4-X3
          SB2    /PER/IDD    * INCORRECT DENSITY FOR DEVICE TYPE.*
          NG     X2,VTDX     IF DENSITY .GT. MAXIMUM
          NG     X3,VTDX     IF DENSITY .LT. MINIMUM
          SX3    610000B     MASK OF INTERNAL TAPE FORMATS
          SB2    B3+59-17
          LX3    B2
          NG     X3,VTD6     IF INTERNAL TAPE FORMAT
          SX3    X4-/COMSMTX/DNMX-1
          PL     X3,VTD5     IF DENSITY DOES NOT SUPPORT NOISE BLOCKS
          MX6    -6
          LX1    0-24
          BX2    -X6*X1      NOISE SIZE
          LX1    24-0
          SX6    X2-31-1
          SB2    /PER/NSL    * NOISE SIZE TOO LARGE.*
          PL     X6,VTDX     IF NOISE SIZE TOO LARGE
 VTD5     SX3    B3-/COMSMTX/TFF
          NZ     X3,VTD7     IF NOT *F* FORMAT
          MX6    -24
          BX3    -X6*X1      BLOCK SIZE FRAME COUNT
          SX6    32
          IX6    X3-X6
          SB2    /PER/FCS    * FRAME COUNT TOO SMALL.*
          NG     X6,VTDX     IF FRAME COUNT TOO SMALL
          SA2    VTDB+B4     GET MAXIMUM FRAME COUNT FOR DEVICE TYPE
          IX2    X2-X3
          SB2    /PER/FCL    * FRAME COUNT TOO LARGE.*
          PL     X2,VTD7     IF FRAME COUNT NOT TOO LARGE
          EQ     VTDX        RETURN WITH ERROR
 
 VTD6     SX2    B3-/COMSMTX/TFLI
          NZ     X2,VTD7     IF NOT *LI* FORMAT
          SX3    X4-/COMSMTX/DLIMN
          SB2    /PER/IDF    * INCORRECT DENSITY FOR FORMAT.*
          NG     X3,VTDX     IF DENSITY .LT. *LI* FORMAT MINIMUM
 VTD7     SB2    B0          SET NO ERROR
          EQ     VTDX        RETURN
 
 
 VTDA     BSS    0           DENSITY LIMITS BY TAPE DEVICE TYPE
          VFD    3//COMSMTX/D7MN,3//COMSMTX/D7MX    *MT* LIMITS
          VFD    3//COMSMTX/D18MN,3//COMSMTX/D18MX  *CT* LIMITS
          VFD    3//COMSMTX/D9MN,3//COMSMTX/D9MX    *NT* LIMITS
          VFD    3//COMSMTX/D18MN,3//COMSMTX/D18MX  *AT* LIMITS
          VFD    36/0
 
 VTDB     BSS    0           MAXIMUM FRAME COUNT BY TAPE DEVICE TYPE
          CON    377700B*60/6   MAXIMUM *MT* FRAME COUNT
          CON    377700B*60/16  MAXIMUM *CT* FRAME COUNT
          CON    377700B*60/8   MAXIMUM *NT* FRAME COUNT
          CON    377700B*60/16  MAXIMUM *AT* FRAME COUNT
          SPACE  4,10
**        GLOBAL DATA.
 
 
 AP       CON    0           ASSEMBLY POINTER
 DM       CON    0           DENSITY SELECTION VALID DEVICE TYPE MASK
 LT       CON    0           LABEL TYPE SPECIFIED FLAG
 RC       CON    0           RETENTION CYCLE
 SC       CON    0           SEPARATOR CHARACTER
 TT       CON    0           TAPE DEVICE TYPE SPECIFIED FLAG
 VP       CON    0           VSN PROCESSED
 TDEN     SPACE  4,15
**        TDEN - TABLE OF DENSITY OPTIONS.
*
*         42/ PARM,11/0,4/ TM,3/ DN
*
*         PARM   DENSITY PARAMTER (DISPLAY CODE)
*         TM     TAPE TYPE MASK = *MCNA*
*                *M* BIT SET IF OPTION VALID FOR *MT* DEVICE
*                *C* BIT SET IF OPTION VALID FOR *CT* DEVICE
*                *N* BIT SET IF OPTION VALID FOR *NT* DEVICE
*                *A* BIT SET IF OPTION VALID FOR *AT* DEVICE
*
*         DN     DENSITY SELECTION (1=556,2=200,3=800,4=1600,5=6250,
*                  6=38000)
 
 
 TDEN     BSS    0
          QUAL   TDEN
          LOC    0
 
*         NUMERICAL KEYWORD ENTRIES.  THE ORDER MUST BE BY DENSITY IN
*         *COMSMTX* FORMAT.
 
          VFD    42/0L200,11/0,4/10B,3/2  200 BPI *MT*
          VFD    42/0L556,11/0,4/10B,3/1  556 BPI *MT*
          VFD    42/0L800,11/0,4/12B,3/3  800 BPI *MT* OR *NT*
          VFD    42/0L1600,11/0,4/2,3/4   1600 CPI *NT*
          VFD    42/0L6250,11/0,4/2,3/5   6250 BPI *NT*
          VFD    42/0L38000,11/0,4/5,3/6  38000 CPI *CT* OR *AT*
 
*         SEVEN TRACK DENSITY MNEMONICS.  THE ORDER MUST BE BY DENSITY
*         IN *COMSMTX* FORMAT.
 
 LO       VFD    42/0LLO,11/0,4/10B,3/2   200 BPI *MT*
 HI       VFD    42/0LHI,11/0,4/10B,3/1   556 BPI *MT*
 HY       VFD    42/0LHY,11/0,4/10B,3/3   800 BPI *MT*
 
*         NINE TRACK DENSITY MNEMONICS.  THE ORDER MUST BE BY DENSITY
*         IN *COMSMTX* FORMAT.
 
 HD       VFD    42/0LHD,11/0,4/2,3/3     800 CPI *NT*
 PE       VFD    42/0LPE,11/0,4/2,3/4     1600 CPI *NT*
 GE       VFD    42/0LGE,11/0,4/2,3/5     6250 CPI *NT*
 
*         CARTRIDGE TAPE DENSITY MNEMONIC.
 
 CE       VFD    42/0LCE,11/0,4/4,3/6     38000 CPI *CT*
 
*         ACS CARTRIDGE TAPE DENSITY MNEMONIC.
 
 AE       VFD    42/0LAE,11/0,4/1,3/6     38000 CPI  *AT*
 
          LOC *O
          QUAL   *
          CON    0           END OF TABLE
          SPACE  4,10
**        COMMON DECKS USED IN PRESET.
 
 
 RCC      SET    1           DEFINE COMMAND READ AHEAD FOR *COMCPOP*
*CALL     COMCVLC
 
*         REDEFINE *CONTROL* MACRO TO CALL SUBROUTINE *IDF*.
 
 .CONTRL  OPSYN  CONTROL
          PURGMAC  CONTROL
 CONTROL  MACRO  AD,RS,LF,PS
          .CONTRL  AD,RS,LF,PS
          IFC    EQ,$RS$$,1
          RJ     IDF         ISSUE DAYFILE MESSAGE
 CONTROL  ENDM
 
 LIT      CON    0           DEFINE LITERAL PROCESSING
*CALL     COMCPOP
 
*         RESTORE *CONTROL* MACRO.
 
 CONTROL  OPSYN  .CONTRL
 
*CALL     COMCRSP
*CALL     COMCUSB
          TITLE  LFM *DMP=* CALL PRESET.
 LFM      SPACE  4,10
***       LFM - PROCESS CALL FROM *LFM*.
*
*         ENTRY  (SPPR) = *LFM* CALL.
*T  SPPR  18/ *LFM*, 12/, 6/ CODE, 6/, 18/ FET ADDRESS
*                CODE = LFM FUNCTION CODE
 
 
 LFM      BSS    0           ENTRY
 
*         VALIDATE CALL.
 
          SB1    1           (B1) = 1
          SA1    ACTR        CHECK FOR COMMAND CALL
          SB2    /PER/CCI    *INCORRECT COMMAND.*
          NZ     X1,PER      IF COMMAND CALL
          SX7    1
          SA7    CF          SET CALL FLAG
          RJ     PCV         PRESET CONTROL POINT VALUES
          SA1    SPPR
          MX0    -6
          SX7    B0
          LX1    -24
          BX6    -X0*X1
          SX6    X6-/LFM/RENAME
          ZR     X6,LFM4     IF *RENAME*
          SX6    X6-/LFM/LABEL+/LFM/RENAME
          SB2    /PER/ILC    * INCORRECT LFM CALL.*
          NZ     X6,PER      IF NOT *LABEL*
 
*         PROCESS *LABEL* REQUEST.
 
          SA7    FS          INDICATE FILE NOT PREVIOUSLY ASSIGNED
          RJ     CLF         CONVERT LFM CALL TO FET
          RJ     SVI         SET VSN INDEX
          RJ     FRA         CHECK FOR *TMS* FIRST REEL ASSIGNMENT
          MX1    36
          SA5    F+FVSN      CHECK FOR VSN
          MX0    -11
          BX5    X1*X5
          SX7    B0
          NZ     X5,VTR      IF VSN DEFINED
 
*         CHECK FOR SPECIAL *PFRES* INTERNAL LABEL REQUEST.
 
          RDSB   MTSI,1,/COMSMTX/TAJP,LFMA,X  READ JOB TABLE POINTER
          SA1    SS          READ STATUS WORD
          SA5    LFMA
          SX7    B0+
          PL     X1,LFM3     IF FAILURE IN READ
          ZR     X5,LFM3     IF TAPE ALTERNATE STORAGE NOT ENABLED
          SX7    X5          SET FWA OF BLOCK
          AX5    48
          SB2    X5          NUMBER OF WORDS IN STAGING JOB TABLE
          RDSB   MTSI,X5,X7,ASJT  READ JOB TABLE
          SA1    JSN
          MX2    24
          SX7    B0
 LFM2     SB2    B2-B1
          SA3    ASJT+B2
          BX4    X3-X1
          BX4    X2*X4       ISOLATE JSN COMPARISION
          ZR     X4,GVS      IF JSN MATCHES, GET VSN FOR STAGING TAPE
          GT     B2,LFM2     IF NOT END OF TABLE
 
*         NORMAL REQUEST WITH NO VSN - REQUEST OPERATOR ASSIGNMENT.
 
 LFM3     SA1    F+FDTY      CHECK DEVICE TYPE
          SA7    AA          SET OPERATOR ASSIGNMENT FLAG
          LX1    12
          BX7    -X0*X1
          RJ     CTE         CHECK FOR TAPE EQUIPMENT DEVICE CODE
          ZR     X2,ROE      IF TAPE DEVICE NOT SPECIFIED
          EQ     VTR         VALIDATE TAPE REQUEST
 
*         PROCESS *RENAME*.
 
 LFM4     SA3    SFET        GET FILE NAME
          SB2    B0+         SET UP IDENTIFICATION IN VSN ENTRY
          RJ     IVE
          RJ     SVE
          SB2    /PER/VFE    * VSN FILE ERROR.*
          NZ     X5,PER      IF ENTRY NOT FOUND
          MOVE   VSNL,VSNB,VSNE
          SA1    SFET+FNFN   READ NEW FILE NAME
          MX0    -18
          BX6    X0*X1
          SA6    VSNE+VLFN   ENTER NEW FILE NAME
          BX7    -X0*X1
          BX7    X7+X6
          SA7    SFET        ENTER NEW FILE NAME
          RJ     MVE         UPDATE VSN FILE
          EQ     END1        RETURN OK STATUS AND END
 
 
 LFMA     BSSZ   1           STAGE JOB TABLE POINTER
          TITLE  *REQ* *DMP=* CALL PRESET.
 REQ      SPACE  4,10
***       REQ - PROCESS *NOS/BE* REQUEST BLOCK CALL.
*
*         ENTRY  (SPPR) = *REQ* CALL.
 
 
 REQ      SB1    1
          SA1    ACTR        CHECK FOR COMMAND CALL
          SB2    /PER/CCI    *INCORRECT COMMAND.*
          NZ     X1,PER      IF COMMAND CALL
          SX7    1
          SA7    CF          SET CALL FLAG
          RJ     PCV         PRESET CONTROL POINT VALUES
          RJ     CSF         CONVERT *NOS/BE* CALL TO FET
          RJ     FSC         FILE STATUS CHECK
          NG     X7,REQ1     IF TAPE PRESENT
          NZ     X7,END1     IF ANOTHER TYPE OF FILE PRESENT
          RJ     SVI         SET VSN INDEX
          RJ     FRA         PROCESS FIRST REEL ASSIGNMENT
          SA2    F+FVSN      CHECK FOR VSN
          MX0    36
          BX7    X0*X2
          NZ     X7,REQ2     IF NO VSN DEFINED
          EQ     VTR         VALIDATE TAPE REQUEST
 
 REQ1     RJ     OPN         OPEN TAPE FILE
          EQ     END1        RETURN OK STATUS AND END
 
 REQ2     SA7    AA          SET OPERATOR ASSIGNMENT FLAG
          EQ     VTR         VALIDATE TAPE REQUEST
          TITLE  VSN AND DEMAND FILE PRESET SUBROUTINES.
 BVE      SPACE  4,15
**        BVE - BUILD VSN ENTRY.
*
*         ENTRY  (B6) = ASSEMBLY POINTER.
*                (X3) = FILE NAME.
*
*         EXIT   (AP) = (B6) = UPDATED ASSEMBLY POINTER.
*                VSNE  = NEW VSN FILE ENTRY.
*
*         ERROR  TO *ERR*, IF COMMAND ERROR.
*
*         USES   X - 5, 6, 7.
*                A - 6, 7.
*                B - 2.
*
*         CALLS  CVS, IVE.
 
 
 BVE      SUBR               ENTRY/EXIT
 
*         INITIALIZE VSN PROCESSING.
 
          SB2    B1          INITIALIZE ENTIRE VSN ENTRY
          RJ     IVE
          SA0    VSNE+VVSN   INITIALIZE ENTRY POINTER
          SX6    B1          ENABLE LITERAL PROCESSING
          SX5    B0          INITIALIZE REEL COUNT AND FLAGS
          SA6    LIT
 
*         CHECK FIRST VSN.
 
          RJ     CVS         CHECK VSN
          NG     B2,BVE5     IF ONE VSN SPECIFIED
          ZR     X1,BVE4     IF SCRATCH VSN
          LE     B2,B0,BVE1  IF VSN NOT EQUIVALENCED
          SX5    100B        SET EQUIVALENCED VSN-S FLAG
          EQ     BVE3        PROCESS EQUIVALENCED VSN-S
 
*         PROCESS NON-SCRATCH, NON-EQUIVALENCED VSN-S.
 
 BVE1     RJ     CVS         CHECK VSN
          ZR     X1,ERR      IF SCRATCH VSN
          NG     B2,BVE5     IF END OF VSN-S
          EQ     B2,B0,BVE1  IF VSN NOT EQUIVALENCED
          EQ     ERR         PROCESS ERROR
 
*         PROCESS EQUIVALENCED VSN-S.
 
 BVE2     RJ     CVS         CHECK VSN
          LE     B2,B0,ERR   IF VSN NOT EQUIVALENCED
          SX5    X5-1        ADJUST REEL COUNT
 BVE3     RJ     CVS         CHECK INTERNAL VSN
          ZR     X1,ERR      IF SCRATCH VSN
          NG     B2,BVE5     IF END OF VSN-S
          EQ     B2,B0,BVE2  IF VSN NOT EQUIVALENCED
          EQ     ERR         PROCESS ERROR
 
*         VERIFY SCRATCH VSN-S.
 
 BVE4     RJ     CVS         CHECK VSN
          NZ     X1,ERR      IF NOT SCRATCH VSN
          PL     B2,BVE4     IF NOT END OF VSN-S
 
*         SAVE ASSEMBLY POINTER AND SET REEL COUNT.
 
 BVE5     SX6    B6          SAVE ASSEMBLY POINTER
          BX7    X5          SET REEL COUNT AND EQUIVALENCED VSN STATUS
          SA6    AP
          SA7    VSNE+VRLC
          EQ     BVEX        RETURN
 CVS      SPACE  4,20
**        CVS - CHECK VSN PARAMETER.
*
*         ENTRY  (A0) = *VSNE* BUFFER POINTER.
*                (X5) = REEL COUNT AND EQUIVALENCED VSN STATUS.
*
*         EXIT   (X6) = 36/ SPACE FILLED VSN,24/ 0.
*                (X1) = 0 IF SCRATCH VSN.
*                (X7) .NE. 0 IF NOT SCRATCH VSN.
*                (B2) = .LT. 0 IF END OF PARAMETER OR COMMAND.
*                (B2) = 0 IF SEPARATOR IS */*.
*                (B2) = .GT. 0 IF SEPARATOR IS *=*.
*                (A0) = UPDATED *VSNE* BUFFER POINTER.
*                (X5) = UPDATED REEL COUNT AND EQUIVALENCED VSN STATUS.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 0, 1, 2, 3, 6.
*                B - 2.
*
*         CALLS  POP, SFN.
 
 
 CVS      SUBR               ENTRY/EXIT
          MX0    -24
          SX5    X5+B1       ADVANCE REEL COUNT
          RJ     POP         PICK OUT PARAMETER
          NG     B5,ERR      IF ERROR
          GE     B5,B1,ERR   IF MORE THAN 1 WORD IN PARAMETER
          SA2    SCRATCH     CHECK FOR SCRATCH VSN
          SA3    ZERO
          SX1    B0+
          BX2    X2-X6
          BX3    X3-X6
          ZR     X6,CVS2     IF VSN OMITTED
          ZR     X2,CVS2     IF *SCRATCH* VSN
          ZR     X3,CVS2     IF *0* VSN
 CVS1     BX1    X6
          BX2    -X0*X6
          NZ     X2,ERR      IF VSN TOO LONG
 CVS2     RJ     SFN         SPACE FILL VSN
          SA2    A1          GET SEPARATOR
          SX3    A0-VSNE-VSNL
          BX6    X0*X6
          PL     X3,ERR      IF VSN BUFFER ALREADY FULL
          SA6    A0          STORE VSN
          SA0    A0+B1       ADVANCE BUFFER POINTER
          SB2    -1
          ZR     B6,CVSX     IF END OF COMMAND
          SX3    X2-1R,
          ZR     X3,CVSX     IF END OF PARAMETER
          SX3    X2-1R/
          SB2    B0+
          ZR     X3,CVSX     IF SEPARATOR IS */*
          SX3    X2-1R=
          SB2    1
          NZ     X3,ERR      IF SEPARATOR IS NOT *=*
          ZR     X1,ERR      IF SCRATCH VSN EQUIVALENCED
          EQ     CVSX        RETURN
 FSC      SPACE  4,20
**        FSC - FILE STATUS CHECK.
*
*         ENTRY  VF = FET.
*
*         EXIT   (B7) = (FS) = FILE STATUS.
*                     = -1, IF TAPE FILE IS FOUND.
*                     = 0, IF *TE* FILE IS FOUND, FILE IS NOT FOUND, OR
*                          STATUS ERROR OCCURRED.
*                     = 1, IF FILE FOUND IS NOT TAPE RELATED.
*                (TS) = -1 IF A SYMBOLIC *TMS* TAPE FILE.
*
*         USES   A - 1, 2, 7.
*                B - 7.
*                X - 0, 1, 2, 3, 4, 5, 7.
*
*         CALLS  CTE.
*
*         MACROS RDSB, STATUS.
 
 
 FSC1     SA7    FS          SET FILE STATUS
          SB7    X7+         SET RETURN STATUS
 
 FSC      SUBR               ENTRY/EXIT
          MX0    1           SELECT ERROR PROCESSING
          SA1    VF+FDTY
          LX0    -15
          BX7    X0+X1
          SA7    A1
          STATUS VF,P
          MX0    1           CLEAR ERROR PROCESSING
          SA1    VF+FDTY
          LX0    -15
          BX7    -X0*X1
          SA7    A1
          MX0    -8          CHECK ERROR RESPONSE
          SA2    A1-B1
          LX2    -10
          BX5    -X0*X2
          SX7    B0+
          NZ     X5,FSC1     IF FILE NOT FOUND OR ERRORS
          MX0    -11
          LX1    12
          BX4    -X0*X1
          BX7    -X0*X1
          RJ     CTE         CHECK FOR TAPE DEVICE
          SX7    -1          SET TAPE FILE
          NZ     X2,FSC0.1   IF TAPE DEVICE
          SX7    X4-2RTE
          ZR     X7,FSC1     IF FILE ASSIGNED TO *TE* DEVICE
          SX7    1           SET NON-TAPE FILE FOUND
          EQ     FSC1        RETURN FILE STATUS
 
 FSC0.1   SA1    TMPF
          NG     X1,FSC1     IF *TMS* DISABLED
          MX0    -12         GET UDT ADDRESS
          SA1    VF+6
          LX1    -36
          BX1    -X0*X1
          RDSB   MTSI,/COMSMTX/UNITL,X1,UDT  GET UDT ENTRY
          SA1    UDT+/COMSMTX/UTMS  CHECK IF SYMBOLIC *TMS* TAPE
          LX1    59-8
          BX7    X1
          SA7    TS          FLAG SYMBOLIC *TMS* TAPE
          SX7    -1          SET TAPE FILE FOUND
          EQ     FSC1        FLAG MAGNETIC TAPE
 MFE      SPACE  4,15
**        MFE - MAKE RESOURCE FILE ENTRIES.
*
*         ENTRY  (VP) = 0, IF NO VSN FILE ENTRY TO BE MADE.
*
*         EXIT   VSN AND DEMAND FILE ENTRIES MADE IF NEEDED.
*
*         USES   A - 1, 6.
*                X - 1, 2, 5, 6.
*
*         CALLS  MVE, RDF, SVE, UDF.
*
*         MACROS RETRF.
 
 
 MFE2     RETRF  V           RETURN VSN FILE, RELEASE INTERLOCK
 
 MFE      SUBR               ENTRY/EXIT
          SA1    VP
          ZR     X1,MFEX     IF NO VSN ENTRY TO BE MADE
          SA1    /CPA/RFCW
          SX6    X1+
          NZ     X6,MFE1     IF DEMAND FILE ENTRY EXISTS
          RJ     RDF         READ DEMAND FILE
          SX5    B1          SET RETURN DEMAND FILE FLAG
          RJ     UDF         UPDATE DEMAND FILE
 MFE1     MX2    36
          SA1    VSNE+VDFI   ENTER DEMAND ENTRY RANDOM ADDRESS
          BX1    X2*X1
          BX6    X1+X6
          SA6    A1
          RJ     SVE         SEARCH FOR VSN ENTRY
          ZR     X5,MFE2     IF DUPLICATE VSN ENTRY
          RJ     MVE
          EQ     MFEX        RETURN
 SVE      SPACE  4,15
**        SVE - SEARCH FOR VSN FILE ENTRY.
*
*         ENTRY  VSNE = NEW VSN ENTRY.
*                VSN FILE ALREADY ATTACHED IF CALLED FROM *SVI*.
*
*         EXIT   (X5) = 0, IF ENTRY FOUND.
*                (VA) = RANDOM INDEX IF ENTRY FOUND.
*                VSNB = VSN FILE ENTRY, IF FOUND.
*                VSN FILE INTERLOCKED.
*
*         USES   A - 3, 4, 5, 7.
*                X - 1, 3, 4, 5, 6, 7.
*
*         MACROS FATRF, READ, READW.
 
 
 SVE2     BX7    X7-X7       INDICATE ENTRY NOT FOUND
          MX5    1
          SA7    VA          CLEAR RANDOM ADDRESS
 
 SVE      SUBR               ENTRY/EXIT
          FATRF  V,M         ATTACH VSN FILE
          READ   X2,R
          SX7    B1          INITIALIZE RANDOM INDEX
 SVE1     SA7    VA          SET NEXT VSN INDEX
          READW  X2,VSNB,VSNL
          NZ     X1,SVE2     IF END OF VSN FILE
          SA5    VA
          SA3    VSNB+VLFN   COMPARE FILE NAMES
          SA4    VSNE+VLFN
          SX7    X5+B1       ADVANCE VSN FILE INDEX
          ZR     X3,SVE1     IF EMPTY ENTRY
          BX1    X3-X4
          SA3    VSNB+VDFI
          SA4    VSNE+VDFI
          MX6    -36
          BX4    X3-X4       COMPARE EJT ORDINAL AND DEMAND FILE INDEX
          LX4    12
          BX4    -X6*X4
          BX1    X1+X4
          NZ     X1,SVE1     IF NO MATCH
          MX5    0           INDICATE FOUND
          EQ     SVEX        RETURN
 SVI      SPACE  4,20
**        SVI - SET VSN INDEX.
*
*         ENTRY  FET BUILT.
*
*         EXIT   (X5) = 0, IF ENTRY FOUND.
*                (VC) = 1 IF VSN FILE ENTRY FOUND.
*                (VP) = 1 IF VSN FILE FOUND.
*                (EVSN) = EXTERNAL VSN SET FROM VSN FILE IF FOUND.
*                (IVSN) = INTERNAL VSN SET FROM VSN FILE IF FOUND.
*                (F+FVSN) = INTERNAL VSN SET FROM VSN FILE IF FOUND.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  IVE, SVE.
*
*         MACROS FATRF, RETRF.
 
 
 SVI      SUBR               ENTRY/EXIT
          SB2    B0
          SA3    F           SET UP IDENTIFICATION IN VSN ENTRY
          RJ     IVE
          FATRF  V,RM        ATTACH VSN FILE
          RJ     SVE         SEARCH FOR VSN ENTRY
          RETRF  V           RETURN VSN FILE, RELEASE INTERLOCK
          NZ     X5,SVIX     IF NO VSN FILE ENTRY
          SA1    VSNB+VVSN   GET EXTERNAL VSN
          SA2    A1+1
          SA4    VSNB+VRLC
          MX0    36
          LX4    59-6
          BX6    X0*X1       EXTERNAL VSN
          BX7    X0*X1       PRESET INTERNAL VSN = EXTERNAL VSN
          PL     X4,SVI1     IF NOT EQUIVALENCED VSN-S
          BX7    X0*X2       INTERNAL VSN
 SVI1     SA3    F+FVSN
          SA6    EVSN        SET EXTERNAL VSN
          SA7    IVSN        SET INTERNAL VSN
          BX3    -X0*X3
          BX7    X3+X7
          SX6    B1
          SA7    A3          SET INTERNAL VSN IN FET
          SA6    VP          SET VSN PARAMETER PROCESSED
          SA6    VC          SET VSN FROM *VSN* COMMAND FLAG
          EQ     SVIX        RETURN
 AFO      SPACE  4,10
**        AFO - ASSEMBLE FILE NAME AND TAPE OPTIONS.
*
*         ENTRY  USBB HAS COMMAND (1 CHARACTER PER WORD).
*                (B6) = STRING BUFFER POINTER.
*
*         EXIT   PARAMETERS SET IN FET *F* FOR TAPE ASSIGNMENT.
*
*         CALLS  CLP, CRD, FID, FSC, GAL, GRD, ILF, NMD, POP, RTC, RTD,
*                SAL, SCD, SCI, SCV, SFA, SFC, SFS, SID, SLT, SNS, SPO,
*                STD, STF, STT, VSP, WRL.
 
 
*         GENERATE RETENTION DATE AND GET ACCESS LEVEL.
 
 AFO6     RJ     GRD         GENERATE RETENTION DATE
          RJ     GAL         GET ACCESS LEVEL
 
 AFO      SUBR               ENTRY/EXIT
 
*         ASSEMBLE FILE NAME.
 
          RJ     POP         PICK OUT PARAMETER
          NZ     B5,ERR      IF ASSEMBLY ERROR
          SA3    POPA
          ZR     X3,ERR      IF NO FILE NAME
          MX0    -18
          BX5    -X0*X3
          SX7    B1          COMPLETE FET
          BX6    X7+X3
          NZ     X5,ERR      IF FILE NAME TOO LONG
          SA6    F           ENTER FILE NAME
          SA6    VF          ENTER FILE NAME IN VSN FET
 
*         INITIALIZE TAPE OPTION PROCESSING.
 
          RJ     FSC         FILE STATUS CHECK
          RJ     ILF         INITIALIZE LABEL FET
          SA1    STFA
          MX0    12
          BX7    -X0*X1
          SX2    /COMSMTX/POLM  DEFAULT ERROR MESSAGE PROCESSING OPTION
          SX3    /COMSMTX/POGH  DEFAULT GCR WRITE CORRECTION OPTION
          LX2    43-0
          SA1    OT          CHECK FOR SYSTEM ORIGIN
          LX3    42-0
          BX7    X7+X2
          SX1    X1-SYOT
          BX7    X7+X3
          SX5    B1
          SA7    F+FTAP
          LX5    41
          NZ     X1,AFO1     IF NOT SYOT
          BX7    X7+X5
          SA7    A7
 
*         PROCESS TAPE OPTION KEYWORD.
*         REENTER HERE ON RETURN FROM KEYWORD PROCESSORS.
 
 AFO1     ZR     B6,AFO6     IF ARGUMENTS EXHAUSTED
          SB3    TAOK-1      PARAMETER KEYWORD TABLE ADDRESS
          SX6    B0          DISABLE LITERAL PROCESSING
          SA1    B6-B1       GET LAST SEPARATOR
          SX1    X1-1R=
          ZR     X1,ERR      IF SEPARATOR IS *=*
          RJ     CLP         CALL POP
          GE     B5,B1,ERR   IF KEYWORD TOO LONG
          SA4    TAOS        ASSEMBLY OPTION SYNTAX TABLE
          MX0    18
          BX1    X5
          NG     X5,ERR      IF INCORRECT FIRST CHARACTER
          AX5    56
          LX5    1
          MX3    -6
          SB2    X5
          LX5    1
          SB2    B2+X5
          AX4    X4,B2       POSITION TABLE ADDRESS
          BX4    -X3*X4
 AFO2     SA3    B3+X4
          BX7    X0*X3
          IX6    X1-X7
          SB3    B3+B1
          NG     X6,/TFM/TMO IF KEYWORD NOT FOUND
          NZ     X6,AFO2     IF NOT TO KEYWORD YET
          SA4    A1
          MX0    -6
          SB2    X3
          LX3    24
          BX2    -X0*X3
          SA6    A3+         CLEAR KEYWORD ENTRY
          LX3    18
          ZR     X2,AFO4     IF NO EQUIVALENT PARAMETERS
          SA1    TEQP-1+X2   CLEAR EQUIVALENT KEYWORD ENTRIES
 AFO3     LX1    6
          BX2    -X0*X1
          ZR     X2,AFO4     IF END OF ENTRIES
          SA6    TAOK-1+X2
          EQ     AFO3        CONTINUE CLEARING EQUIVALENT ENTRIES
 
 AFO4     MX0    -18         EXTRACT PROCESSOR PARAMETERS
          BX7    -X0*X3
          PL     B2,AFO5     IF KEYWORD VALUE NOT REQUIRED
          SX1    X4-1R=
          SB2    -B2
          NZ     X1,ERR      IF SEPARATOR NOT *=*
 AFO5     SA5    RT          GET REQUEST TYPE
          JP     B2          EXECUTE KEYWORD PROCESSOR
 
 
 AFOR     EQU    AFO1        KEYWORD PROCESSOR RETURN ADDRESS
 TAOK     SPACE  4,10
**        TAOK - TABLE OF ASSEMBLY OPTION KEYWORDS.
*
*         FOR DOCUMENTATION, REFER TO *MKTE* MACRO.
 
 
 TAOK     BSS    0
          QUAL   TAOK
          LOC    1
 
 AACT     BSS    0           A - C SYNTAX TABLE
 AL       MKTE   -SAL        SECURITY ACCESS LEVEL
 C        MKTE   -SCD        CREATION DATE/CHARACTER COUNT
 CB       MKTE   SCI,/TEQP/CKI,(18//COMSLFD/CBST)  CHECKPOINT BOI
 CK       MKTE   SCI,/TEQP/CKI,(18//COMSLFD/CKST)  CHECKPOINT EOI
 CR       MKTE   -CRD        CREATION DATE
 CV       MKTE   -SCV,/TEQP/CVM  CONVERSION MODE
 
 ADGT     BSS    0           D - G SYNTAX TABLE
 
 D        MKTE   -STD,/TEQP/DEN  TAPE DENSITY
 DT       MKTE   -STT,/TEQP/TDT  TAPE DEVICE TYPE
 E        MKTE   -NMD,,(1/1,1/1,1/0,9/,6/FGVN)  GENERATION VERSION
 F        MKTE   -STF        FORMAT
 FA       MKTE   -SFA        FILE ACCESSIBILITY
 FC       MKTE   -SFS        FRAME SIZE
 FI       MKTE   -FID,/TEQP/FID  FILE IDENTIFIER
 G        MKTE   -NMD,,(1/0,1/0,1/0,9/,6/FGRN)  GENERATION NUMBER
 GE       MKTE   STD3,/TEQP/DEN,(18//TDEN/GE)  6250 CPI 9-TRACK
 
 AHKT     BSS    0           H - K SYNTAX TABLE
 
 HD       MKTE   STD3,/TEQP/DEN,(18//TDEN/HD)  800 BPI 9-TRACK
 HI       MKTE   STD3,/TEQP/DEN,(18//TDEN/HI)  556 BPI 7-TRACK
 HY       MKTE   STD3,/TEQP/DEN,(18//TDEN/HY)  800 BPI 7-TRACK
 
 ALOT     BSS    0           L - O SYNTAX TABLE
 
 L        MKTE   -FID,/TEQP/FID  FILE IDENTIFIER
 LB       MKTE   -SLT        LABEL TYPE
 LO       MKTE   STD3,/TEQP/DEN,(18//TDEN/LO)  200 BPI 7-TRACK
 M        MKTE   -SID,/TEQP/SID  MULTI-FILE SET IDENTIFIER
 MT       MKTE   STT1,/TEQP/TDT,(18/0)  7-TRACK DEVICE TYPE
 N        MKTE   -SCV,/TEQP/CVM  CONVERSION MODE
 NS       MKTE   -SNS        NOISE SIZE
 NT       MKTE   STT1,/TEQP/TDT,(18/2)  9-TRACK DEVICE TYPE
 
 APST     BSS    0           P - S SYNTAX TABLE
 
 P        MKTE   -NMD,/TEQP/SQN,(1/0,1/0,1/1,9/,6/FSQN)  FILE SEQUENCE
 PE       MKTE   STD3,/TEQP/DEN,(18//TDEN/PE)  1600 CPI 9-TRACK
 PO       MKTE   -SPO        PROCESSING OPTIONS
 QN       MKTE   -NMD,/TEQP/SQN,(1/0,1/0,1/1,9/,6/FSQN) FILE SEQUENCE
 R        MKTE   WRL,/TEQP/RWL,(1/0,17/)  LABEL READ
 RT       MKTE   -RTD,/TEQP/RET  RETENTION DATE
 SI       MKTE   -SID,/TEQP/SID  MULTI-FILE SET IDENTIFIER
 SN       MKTE   -NMD,/TEQP/SCN,(1/0,1/0,1/0,9/,6/FSTN)  FILE SECTION
 
 ATWT     BSS    0           T - W SYNTAX TABLE
 
 T        MKTE   -RTC,/TEQP/RET  RETENTION CYCLE
 V        MKTE   -NMD,/TEQP/SCN,(1/0,1/0,1/0,9/,6/FSTN)  FILE SECTION
 VSN      MKTE   -VSP        VOLUME SERIAL NUMBER
 W        MKTE   WRL,/TEQP/RWL,(1/1,17/)  WRITE LABEL
 
 AXZT     BSS    0           X - Z SYNTAX TABLE
 ENDT     BSS    0           END OF SYNTAX TABLE
 
          LOC    *O
          QUAL   *
 
          CON    37777777777777777777B  END OF KEYWORD TABLE
 TAOS     SPACE  4,10
**        TAOS - TABLE OF ASSEMBLY OPTION SYNTAX TABLE ADDRESSES.
 
 
 TAOS     BSS    0
          VFD    6//TAOK/ENDT
          VFD    6//TAOK/ENDT
          VFD    6//TAOK/ENDT
          VFD    6//TAOK/AXZT
          VFD    6//TAOK/ATWT
          VFD    6//TAOK/APST
          VFD    6//TAOK/ALOT
          VFD    6//TAOK/AHKT
          VFD    6//TAOK/ADGT
          VFD    6//TAOK/AACT
 TEQP     SPACE  4,10
**        TEQP - TABLE OF EQUIVALENT PARAMETERS.
*
*T        6/P1, 6/P2, 6/P3, 6/P4, 6/P5, 6/P6, 6/P7, 6/P8, 6/P9, 6/0
*         P(I)   EQUIVALENT PARAMETERS KEYWORD TABLE INDEX
 
 
 TEQP     BSS    0
          QUAL   TEQP
          LOC    1
 CKI      VFD    6//TAOK/CB,6//TAOK/CK,48/0
 CVM      VFD    6//TAOK/CV,6//TAOK/N,48/0
 DEN      VFD    6//TAOK/D,6//TAOK/LO,6//TAOK/HI,6//TAOK/HY
          VFD    6//TAOK/HD,6//TAOK/PE,6//TAOK/GE,18/0
 FID      VFD    6//TAOK/FI,6//TAOK/L,48/0
 RET      VFD    6//TAOK/RT,6//TAOK/T,48/0
 RWL      VFD    6//TAOK/R,6//TAOK/W,48/0
 SCN      VFD    6//TAOK/SN,6//TAOK/V,48/0
 SID      VFD    6//TAOK/SI,6//TAOK/M,48/0
 SQN      VFD    6//TAOK/QN,6//TAOK/P,48/0
 TDT      VFD    6//TAOK/DT,6//TAOK/MT,6//TAOK/NT,42/0
          LOC    *O
          QUAL   *
          TITLE  OPTION PROCESSORS.
          SPACE  4,10
**        KEYWORD PROCESSORS.
*
*         ENTRY  (X5) = REQUEST TYPE (0=LABEL, 1=REQUEST, -1=ASSIGN).
*                (X6) = 0.
*                (X7) = PROCESSOR PARAMETERS FROM KEYWORD TABLE ENTRY.
*                (B6) = STRING BUFFER POINTER.
*
*         EXIT   TO *AFOR*, TO PROCESS NEXT ARGUMENT OR IF ARGUMENTS
*                   EXHAUSTED.
*                TO *ERR*, IF ARGUMENT ERROR.
*
*         NOTE - ALL PROCESSORS MUST PRESERVE THE VALUE OF B6.
 CRD      SPACE  4,10
**        CRD - SET CREATION DATE (JULIAN FORMAT).
*
*         CR=YYDDD.
 
 
 CRD      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          MX0    5*6
          BX4    -X0*X5
          SA2    F+FCRD      READ FET WORD
          NZ     X4,ERR      IF PARAMETER TOO LONG
          LX5    30
          BX7    X2+X5
          SA7    A2+
          EQ     AFOR        PROCESS NEXT ARGUMENT
 FID      SPACE  4,10
**        FID - SET FILE IDENTIFIER.
*
*         FI=AAAAAAAAAAAAAAAAA.
*         L=AAAAAAAAAAAAAAAAA.
 
 
 FID      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          SX6    B1+         ENABLE LITERAL PROCESSING
          SA6    LIT
          RJ     POP         PICK OUT PARAMETER
          NG     B5,ERR      IF ASSEMBLY ERROR
          SA1    POPA+1
          MX0    7*6
          BX5    -X0*X1
          NZ     X5,ERR      IF PARAMETER TOO LONG
          RJ     SFN         SPACE FILL SECOND WORD OF FID
          BX5    X6
          SA1    A1-B1
          RJ     SFN         SPACE FILL 1ST WORD OF FID
          SA6    F+FID1      STORE FIRST WORD FID
          MX0    -18
          SA2    A6+B1       READ FET DATA TO BE MERGED
          BX7    X0*X5
          BX3    -X0*X2
          SA1    MF          SET FI PROCESSED
          BX7    X7+X3
          SX6    X1+B1
          SA7    A2
          SA6    A1
          EQ     AFOR        PROCESS NEXT ARGUMENT
 NMD      SPACE  4,10
**        NMD - SET NUMERIC DATA FIELDS FOR LABEL.
*
*         SN=NNNN.    FILE SECTION NUMBER
*         V=NNNN.
*         QN=NNNN.    FILE SEQUENCE NUMBER
*         P=NNNN.
*         E=NN.       GENERATION VERSION NUMBER.
*         G=NNNN.     GENERATION NUMBER.
 
 
 NMD      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          SA7    NMDA        SAVE PROCESSOR PARMETERS
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          SA4    NMDA
          MX0    4*6
          LX4    59-16
          SB7    B1
          PL     X4,NMD1     IF FOUR DIGIT PARAMETER
          MX0    2*6
 NMD1     BX6    -X0*X5
          NZ     X6,ERR      IF PARAMETER TOO LONG
          RJ     DXB
          NZ     X4,ERR      IF ASSEMBLY ERRORS
          SA4    A4
          LX4    59-15
          PL     X4,NMD3     IF NOT SEQUENCE NUMBER
          SA2    MF
          SX3    X6-2
          SX7    X2+2        SET QN .LT. 2
          NG     X3,NMD2     IF QN .LT. 2
          SX3    X6-9999
          SX7    X2+12B      SET QN PROCESSED AND .GT. 1
          NZ     X3,NMD2     IF QN .NE. 9999
          SA2    F+FTAP      SET WRITE LABEL BIT
          BX3    X7
          MX7    1
          BX2    X2+X7
          LX7    40-59       SET WRITE ENABLE REQUIRED FLAG
          BX7    X7+X2
          SA7    A2
          BX7    X3
 NMD2     SA7    MF          SET MULTI-FILE POSITIONING
 NMD3     MX1    -6
          SA4    A4
          BX1    -X1*X4
          AX4    17
          SX1    F+X1        ADDRESS OF FET WORD
          LX4    -1          SET FIELD POSITION
          BX1    X1+X4
          RJ     ENF         ENTER NUMERIC FIELD
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 NMDA     CON    0           TEMPORARY FOR PROCESSOR PARAMETERS
 RTC      SPACE  4,10
**        RTC - SET RETENTION CYCLE.
*
*         T=NNN.
 
 
 RTC      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          ZR     X5,AFOR     IF NO PARAMETER
          MX0    3*6
          BX6    -X0*X5
          NZ     X6,ERR      IF PARAMETER TOO LONG
          BX7    X5
          SA7    RC          SAVE RETENTION CYCLE
          EQ     AFOR        PROCESS NEXT ARGUMENT
 RTD      SPACE  4,10
**        RTD - SET RETENTION DATE (JULIAN FORMAT).
*
*         RT=YYDDD.
 
 
 RTD      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          MX0    5*6
          SA2    F+FRTD      READ FET WORD
          BX6    -X0*X5
          NZ     X6,ERR      IF PARAMETER TOO LONG
          BX3    -X0*X2
          BX7    X3+X5
          SA7    A2
          LX0    -24
          BX0    X0*X5
          SB7    B1          ASSUME DECIMAL BASE
          ZR     X0,ERR      IF PARAMETER TOO SHORT
          RJ     DXB         CONVERT RETENTION DATE TO NUMERIC
          NZ     X4,ERR      IF NOT NUMERIC VALUE
          SA2    A2          CONVERT DAY OF YEAR
          MX0    18
          LX2    12
          BX5    X0*X2
          RJ     DXB
          ZR     X6,ERR      IF INCORRECT DAY OF YEAR
          SX6    X6-367
          PL     X6,ERR      IF INCORRECT DAY OF YEAR
          EQ     AFOR        PROCESS NEXT ARGUMENT
 SAL      SPACE  4,10
**        SAL - SET ACCESS LEVEL.
*
*         AL = NNNNNNN.
 
 
 SAL      BSS    0           ENTRY
          ZR     B6,AFOR     IF ARGUMENTS EXHAUSTED
          SA1    AL          ACCESS LEVEL PERMISSION
          ZR     X1,ERR      IF NOT ALLOWED ON THIS COMMAND
          RJ     CLP         CALL PICK OUT PARAMETER
          GE     B5,B1,ERR   IF PARAMETER/KEYWORD TOO LONG
          BX1    X5
          SB2    B0
          SA5    SSMA        SYSTEM SECURITY MODE
          RJ     VLC         VALIDATE ACCESS LEVEL
          ZR     X5,SAL1     IF UNSECURED SYSTEM
          SB2    /PER/UAL    * UNKNOWN ACCESS LEVEL NAME.*
          NG     X2,PER      IF ACCESS LEVEL NOT FOUND
          MX0    -8
          SA1    JCWA        SECURITY CONTROL WORD
          LX1    7-43
          BX3    -X0*X1      VALID ACCESS LEVELS
          MX0    -1
          SB2    X2
          LX0    B2
          BX0    -X0*X3
          SB2    /PER/NVA    NOT VALIDATED FOR ACCESS LEVEL
          ZR     X0,PER      IF NOT VALIDATED FOR ACCESS LEVEL
          BX6    X2
          SA6    AL          SAVE REQUESTED ACCESS LEVEL
          SX1    B1
          LX1    39          POSITION BIT FOR *AL* INDICATION FIELD
          SA3    F+1         SECOND WORD OF FET
          BX6    X1+X3
          SA6    A3          SET *AL* INDICATOR
          SA3    VF+1
          BX6    X1+X3
          SA6    A3          SET *AL* INDICATOR IN VSN FET
          LX2    36
          SA3    F+/COMSPFM/CFAL
          MX1    12
          LX1    36-48
          BX3    -X1*X3      CLEAR FILE ACCESS LEVEL
          BX6    X2+X3
          SA6    A3          SET ACCESS LEVEL IN FET
          SA3    VF+/COMSPFM/CFAL
          BX3    -X1*X3      CLEAR FILE ACCESS LEVEL IN VSN FET
          BX6    X2+X3
          SA6    A3          SET ACCESS LEVEL IN VSN FET
          EQ     AFOR        PROCESS NEXT ENTRY
 
 SAL1     SX6    B0+
          SA6    AL
          EQ     AFOR        PROCESS NEXT ENTRY
 SCD      SPACE  4,10
**        SCD - PROCESS *C* OPTION.
*
*                C=NNNNNN.   CHARACTER COUNT
*                C=YYDDD.    CREATION DATE (*LABEL* COMMAND ONLY)
 
 
 SCD      BSS    0           ENTRY
          ZR     X5,SCD1     IF *LABEL* COMMAND
          SA6    TAOK-1+/TAOK/FC  CLEAR FRAME COUNT PARAMETER
          EQ     SFS         PROCESS CHARACTER COUNT
 
 SCD1     SA6    TAOK-1+/TAOK/CR  CLEAR CREATION DATE PARAMETER
          EQ     CRD         SET CREATION DATE
 SCI      SPACE  4,10
**        SCI - SET CHECKPOINT DATA.
*
*         CB
*         CK
 
 
 SCI      SA7    CI          SET CHECKPOINT FILE ID
          EQ     AFOR        PROCESS NEXT ARGUMENT
 SCV      SPACE  4,10
**        SCV - SET CONVERSION MODE.
*
*         CV=(AS,US,EB)
*         N=(AS,US,EB)
 
 
 SCV      BSS    0           ENTRY
          SB3    SCVA        SET OPTION TABLE ADDRESS
          RJ     AOP         ANALYZE CONVERSION OPTIONS (NO LITERALS)
          SA2    F+FTAP
          LX7    48
          BX7    X7+X2       SET CONVERSION MODE
          SA7    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 SCVA     VFD    42/0LAS,18/1  ASCII
          VFD    42/0LUS,18/1  USASII
          VFD    42/0LEB,18/2  EBCDIC
          CON    0
          CON    0
 SFA      SPACE  4,10
**        SFA - SET FILE ACCESSIBILITY.
*
*         FA=A.
 
 
 SFA      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          SX6    B1+         ENABLE LITERAL PROCESSING
          RJ     CLP         GET PARAMETER VALUE
          MX0    6
          BX6    -X0*X5
          NZ     X6,ERR      IF PARAMETER TOO LONG
          LX0    24
          SA2    F+FFAS      READ FET WORD
          LX5    24
          BX3    -X0*X2
          BX7    X3+X5
          SA7    A2+
          EQ     AFOR        PROCESS NEXT ARGUMENT
 SFC      SPACE  4,10
**        SFC - SET MAXIMUM FRAME COUNT FOR TAPE BLOCK.
*
*         FC=NNNNNN.
*         C=NNNNNN.          (EXCEPT ON *LABEL* COMMAND)
 
 
 SFS      BSS    0           ENTRY
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          MX0    6*6
          BX6    -X0*X5
          NZ     X6,ERR      IF PARAMETER TOO LONG
          SB7    B1          ASSUME DECIMAL
          RJ     DXB
          NZ     X4,ERR      IF ASSEMBLY ERROR
          SA2    F+FTAP
          BX6    X2+X6       SET BLOCK SIZE IN FRAMES
          SA6    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 SID      SPACE  4,10
**        SID - SET MULTI-SET IDENTIFIER.
*
*         SI=AAAAAA.
*         M=AAAAAA.
 
 
 SID      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          SX6    B1+         ENABLE LITERAL PROCESSING
          RJ     CLP         GET PARAMETER VALUE
          BX1    X5
          MX0    6*6
          BX5    -X0*X5
          NZ     X5,ERR      IF PARAMETER TOO LONG
          RJ     SFN
          MX0    36
          SA2    F+FMSI      READ FET WORD
          BX7    X0*X6
          SA1    MF
          SX6    X1+4
          BX3    -X0*X2
          SA6    A1          SET MULTI-FILE POSITIONING
          BX7    X7+X3
          SA7    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 SLT      SPACE  4,10
**        SLT - SET LABEL TYPE.
*
*         LB=(KU,KL,NS)
*
*         TYPES ARE MUTUALLY EXCLUSIVE.
 
 
 SLT      BSS    0           ENTRY
          SB3    SLTA        SET OPTION TABLE ADDRESS
          RJ     AOP         ANALYZE LABEL OPTIONS (NO LITERALS)
          SA2    F+FTAP
          SX6    B1
          LX7    57-0
          SA6    LT          SET LABEL TYPE SPECIFIED
          BX7    X2+X7       SET LABEL TYPE
          SA7    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 SLTA     VFD    42/0LKU,18/0     KRONOS UNLABELED
          VFD    42/0LKL,18/2     KRONOS LABELED
          VFD    42/0LNS,18/3     NON-STANDARD LABELED
          CON    0
 SNS      SPACE  4,10
**        SNS - SET NOISE SIZE.
*
*         NS=NN.             NN = NUMERIC LESS THAN 32.
 
 
 SNS      BSS    0           ENTRY
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          MX0    2*6
          BX6    -X0*X5
          NZ     X6,ERR      IF PARAMETER TOO LONG
          SB7    B1          ASSUME DECIMAL
          RJ     DXB
          NZ     X4,ERR      IF ASSEMBLY ERROR
          SA2    F+FTAP
          SX7    X6-32
          PL     X7,ERR      IF NOISE SIZE TOO LARGE
          LX6    24
          BX6    X6+X2       SET NOISE SIZE
          SA6    A2+
          EQ     AFOR        PROCESS NEXT ARGUMENT
 SPO      SPACE  4,10
**        SPO - SET PROCESSING OPTIONS.
*
*         PO=(ACEFGHILMNPRSUWX)
 
 SPO      BSS    0           ENTRY
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          MX0    -6
          SB2    10
          MX7    0
 SPO1     LX5    6
          BX3    -X0*X5
          ZR     X3,SPO2     IF END OF PARAMETERS
          SB2    B2-B1
          SA4    SPOA
          SB3    X3
          AX4    X4,B3
          LX4    -1
          PL     X4,ERR      IF NOT LEGAL OPTION
          CX4    X4
          SA3    X4+SPOA     READ OPTION BIT
          BX7    X7+X3
          NZ     B2,SPO1     IF MORE PARAMETERS IN WORD
          EQ     B5,B1,ERR   IF IMPROPER TERMINATION
          SA5    A5+B1       READ NEXT WORD OF PARAMETERS
          SB5    B5-B1
          SB2    10
          EQ     SPO1
 
 SPO2     MX0    24          MERGE PROCESSING OPTIONS
          SA2    F+FTAP
          BX3    -X0*X7
          BX7    X0*X7
          LX3    36
          BX7    X7+X2
          BX7    -X3*X7
          SA7    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 SPOA     DATA   153271752B
          DATA   1BS44       X OPTION
          DATA   1BS40       W OPTION
          DATA   1BS41       U OPTION
          DATA   1BS45       S OPTION
          DATA   1BS39       R OPTION
          DATA   1BS46       P OPTION
          DATA   1BS37       N OPTION
          DATA   1BS43       M OPTION
          DATA   1BS7        L OPTION
          DATA   1BS47       I OPTION
          DATA   1BS6        H OPTION
          DATA   1BS42       G OPTION
          DATA   1BS5        F OPTION
          DATA   1BS38       E OPTION
          DATA   1BS42       C OPTION
          DATA   1BS36       A OPTION
 STD      SPACE  4,10
**        STD - SET TAPE DENSITY.
*
*         D=(LO,HI,HY,HD,PE,GE,CE,AE)
*         D=(200,556,800,1600,6250,38000)
*
*         THE FOLLOWING KEYWORDS ARE OBSOLETE AND ARE SUPPORTED BY THE
*         *ASSIGN* AND *REQUEST* COMMANDS FOR COMPATIBILITY ONLY -
*
*         LO
*         HI
*         HY
*         HD
*         PE
*         GE
 
 
 STD      BSS    0           ENTRY
          SB3    TDEN        SET OPTION TABLE ADDRESS
          RJ     AOP         ANALYZE DENSITY OPTION (NO LITERALS)
 STD1     SA2    F+FTAP
          MX0    -3
          BX6    -X0*X7      SPECIFIED DENSITY
          AX7    3
          LX6    51-0
          SA7    DM          SET DEVICE TYPE VALIDATION MASK
          BX6    X2+X6       SET DENSITY
          SA6    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
*         ENTRY FOR *LO*, *HI*, *HY*, *HD*, *PE*, AND *GE* KEYWORDS.
 
 STD3     ZR     X5,ERR      IF *LABEL* CALL
          SA1    TDEN+X7
          BX7    X1
          EQ     STD1        PROCESS DENSITY
 STF      SPACE  4,10
**        STF - SET FORMAT.
*
*         F=(I,SI,F,S,L,LI)
 
 
 STF      BSS    0           ENTRY
          SB3    STFA        SET OPTION TABLE ADDRESS
          SX6    B0+         DISABLE LITERAL PROCESSING
          RJ     AOP         ANALYZE FORMAT OPTIONS
          SA2    F+FTAP
          LX7    30
          BX7    X2+X7       SET FORMAT
          SA7    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 STFA     VFD    42/0LI,18//COMSMTX/TFI    INTERNAL BINARY
          VFD    42/0LSI,18//COMSMTX/TFSI  SYSTEM INTERNAL
          VFD    42/0LF,18//COMSMTX/TFF    FOREIGN
          VFD    42/0LS,18//COMSMTX/TFS    STRANGER
          VFD    42/0LL,18//COMSMTX/TFL    LONG BLOCK STRANGER
          VFD    42/0LLI,18//COMSMTX/TFLI  LONG BLOCK INTERNAL
          CON    0
 STT      SPACE  4,10
**        STT - SET TAPE DEVICE TYPE.
*
*         DT=(MT,NT,CT,AT)
*
*         THE FOLLOWING KEYWORDS ARE OBSOLETE AND ARE SUPPORTED FOR
*         COMPATIBILITY ONLY -
*
*         MT
*         NT
 
 
 STT      BSS    0           ENTRY
          SB3    STTA        SET OPTION TABLE ADDRESS
          SX6    B0+         DISABLE LITERAL PROCESSING
          RJ     AOP         ANALYZE DEVICE TYPE OPTIONS
 
*         ENTRY FOR *MT* AND *NT* KEYWORDS.
 
 STT1     SA1    F+FTAP
          SX6    B1
          LX7    55-0
          SA6    TT          SET DEVICE TYPE SPECIFIED FLAG
          BX7    X1+X7       SET DEVICE TYPE
          SA7    A1
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 STTA     BSS    0
          VFD    42/0LMT,18//COMSMTX/DVMT
          VFD    42/0LNT,18//COMSMTX/DVNT
          VFD    42/0LCT,18//COMSMTX/DVCT
          VFD    42/0LAT,18//COMSMTX/DVAT
          CON    0
 VSP      SPACE  4,10
**        VSP - SET VOLUME SERIAL NUMBERS.
*
*         VSN=NNNN/NNNN=NNNN/NNNN=...=NNNN/NNNN.
 
 
 VSP      BSS    0           ENTRY
          SA1    /CPA/RFCW   GET DEMAND FILE INDEX
          SX7    B1
          SX1    X1
          SA7    VP          SET VSN= PROCESSED
          NZ     X1,VSP1     IF DEMAND ENTRY EXISTS
          RJ     IDE         INITIALIZE DEMAND ENTRY
 VSP1     SA3    F           SET FILE NAME
          RJ     BVE         BUILD VSN ENTRY
          EQ     AFOR        PROCESS NEXT ARGUMENT
 WRL      SPACE  4,10
**        WRL - SET LABEL READ/WRITE.
*
*         R
*         W
*
*         FORCES WRITE ENABLE REQUIRED IF *W*.
 
 
 WRL      BSS    0           ENTRY
          NZ     X5,ERR      IF NOT *LABEL* CALL
          ZR     X7,AFOR     IF LABEL TO BE READ
          SA2    F+FTAP      SET WRITE LABELS BIT
          LX7    59-17
          BX6    X2+X7
          LX7    40-17-59+17
          BX6    X6+X7       SET WRITE ENABLE REQUIRED (PO = W)
          SA6    A2+
          EQ     AFOR        PROCESS NEXT ARGUMENT
          TITLE  COMMAND PROCESSING SUBROUTINES.
 AOP      SPACE  4,25
**        AOP - ANALYZE OPTIONAL PARAMETERS.
*
*         ENTRY  (B6) = ADDRESS TO BEGIN PARAMETER ASSEMBLY
*                (B3) = PARAMETER OPTION TABLE ADDRESS
*                (X6) = 0, IF DISABLE LITERAL PROCESSING.
*                       .NE. 0, IF ENABLE LITERAL PROCESSING.
*
*         EXIT   (X5) = SEPARATOR.
*                (X1) = OPTION TABLE ENTRY.
*                (X7) = LOWER 18 BITS OF ENTRY.
*                TO *AFOR*, IF ARGUMENTS EXHAUSTED.
*
*         ERROR  TO *ERR*, IF COMMAND ERROR.
*
*         KEYWORDS MUST BE LESS THAN OR EQUAL TO SEVEN CHARACTERS.
*
*         USES   A - 1, 5.
*                B - 7.
*                X - 0, 1, 5, 6, 7.
*
*         CALLS  CLP.
 
 
 AOP      SUBR               ENTRY/EXIT
          ZR     B6,AFOR     IF ARGUMENTS EXHAUSTED
          RJ     CLP         CALL PICK OUT PARAMETER
          GE     B5,B1,ERR   IF PARAMETER/KEYWORD TOO LONG
          SB7    A1          RETAIN SEPARATOR ADDRESS
          MX0    7*6
          SA1    B3-1        READ OPTION TABLE
 AOP1     SA1    A1+B1
          BX6    X0*X1       KEYWORD
          ZR     X1,ERR      IF END OF OPTIONS
          BX6    X6-X5
          BX7    -X0*X1      SET PARAMETERS
          NZ     X6,AOP1     IF NO MATCH
          SA5    B7          READ SEPARATOR
          EQ     AOPX
 CLP      SPACE  4,20
**        CLP - CALL POP.
*
*         ENTRY  (B6) = ASSEMBLY POINTER.
*                (X6) = 0, IF DISABLE LITERAL PROCESSING.
*                       .NE. 0, IF ENABLE LITERAL PROCESSING.
*
*         EXIT   (B6) = NEXT ASSEMBLY POINTER.
*                (X5) = FIRST PART OF PARAMETER.
*                TO *AFOR*, IF ARGUMENTS EXHAUSTED.
*
*         ERROR  TO *ERR*, IF COMMAND ERROR.
*
*         USES   A - 5, 6.
*                X - 5.
*
*         CALLS  POP.
 
 CLP      SUBR               ENTRY/EXIT
          ZR     B6,AFOR     IF COMMAND EXHAUSTED
          SA6    LIT         SET PROPER OPTION FOR LITERAL PROCESSING
          RJ     POP         PICK OUT PARAMETER
          NG     B5,ERR      IF NO PARAMETER
          ZR     X2,ERR      IF INCORRECT TERMINATION
          SA5    POPA        READ FIRST PART PARAMETER
          EQ     CLPX        EXIT
 ENF      SPACE  4,15
**        ENF - ENTER NUMERIC LABEL FIELD.
*
*         ENTRY  (X1) = FET WORD CONTROL
*                            LOWER 18 BITS = FET WORD ADDRESS
*                            SIGN BIT SET = FIELD BITS 23-15
*                            SIGN BIT CLEAR = FIELD BITS 14-00
*                (X6) = NUMBER IN OCTAL.
*
*         EXIT   FIELD ENTERED IN FET WORD.
*
*         ERROR  TO *ERR*, IF COMMAND ERROR.
*
*         USES   A - 2, 6.
*                X - 0, 1, 5, 6.
 
 
 ENF1     SX5    X6-100
          PL     X5,ERR      IF VALUE TOO LARGE
          MX0    -9
          LX6    15
          LX0    15
 ENF2     SA2    X1          ENTER VALUE IN FET WORD
          BX2    X0*X2
          BX6    X6+X2
          SA6    A2
 
 ENF      SUBR               ENTRY/EXIT
          MX0    -15
          BX6    -X0*X6
          NG     X1,ENF1     IF UPPER FIELD
          ZR     X6,ERR      IF INCORRECT VALUE
          SX5    X6-10000
          PL     X5,ERR      IF VALUE TOO LARGE
          EQ     ENF2        ENTER VALUE IN FET WORD
 GRD      SPACE  4,15
**        GRD - GENERATE RETENTION DATE.
*
*         ENTRY  (RC) = RETENTION CYCLE (LEFT-JUSTIFIED, DISPLAY CODE)
*
*         EXIT   RETENTION DATE SET IN FET+15B.
*
*         ERROR  TO *ERR*, IF COMMAND ERROR.
*
*         USES   A - 0, 1, 2, 4, 7.
*                B - 2, 3, 4, 7.
*                X - 0, 1, 2, 4, 5, 6, 7.
*
*         CALLS  CDD, DXB.
*
*         MACROS JDATE.
 
 
 GRD      SUBR               ENTRY/EXIT
          JDATE  GRDA        SET CURRENT DATE
          SA1    F+FCRD      CHECK CREATION DATE
          ZR     X1,GRD1     IF NO CREATION DATE
          BX7    X1
          SA7    GRDA
 GRD1     SA1    RC          CHECK RETENTION CYCLE
          ZR     X1,GRDX     IF NO RETENTION CYCLE
          BX5    X1
          SB7    B1
          RJ     DXB
          SX5    999         CHECK PARAMETER VALIDITY
          NZ     X4,ERR      IF ASSEMBLY ERRORS
          IX7    X5-X6
          SA2    GRDA
          MX0    18
          SA4    =5L99999    SET UNLIMITED EXPIRATION DATE
          ZR     X7,GRD4     IF INFINITE RETENTION CYCLE
          SA0    X6          SAVE RETENTION DAYS
          LX2    42
          NG     X7,ERR      IF RETENTION CYCLE GREATER THAN 999
          BX5    X0*X2
          RJ     DXB         CONVERT CURRENT JULIAN DAYS
          SA2    GRDA
          NZ     X4,ERR      IF ASSEMBLY ERRORS
          MX0    12
          LX2    30
          SB4    X6+
          BX5    X0*X2
          SA0    A0+B4       EXTEND DAYS TO END OF RETENTION CYCLE
          RJ     DXB         CONVERT CURRENT JULIAN YEARS
          SX0    3
          NZ     X4,ERR      IF ASSEMBLY ERRORS
 GRD2     BX5    X0*X6
          SX6    X6+B1
          SB7    366
          ZR     X5,GRD3     IF LEAP YEAR
          SB7    365
 GRD3     SA0    A0-B7
          SB2    A0
          ZR     B2,GRD3.1   IF NO MORE DAYS
          PL     B2,GRD2     IF MORE DAYS
 GRD3.1   SX1    X6+99       ADJUST AND BIAS TO ENSURE ENOUGH DIGITS
          RJ     CDD         CONVERT NEW YEAR
          MX7    -12
          BX5    -X7*X6      ISOLATE AND SAVE YEAR
          LX5    48          POSITION YEAR
          SA0    A0+B7
          SX1    A0+1000     BIAS DAYS TO ENSURE ENOUGH DIGITS
          RJ     CDD         CONVERT NEW DAY
          MX0    -18
          BX7    -X0*X6      ISOLATE DAY
          LX7    30          POSITION DAY
          BX4    X5+X7
 GRD4     SA2    F+FRTD      ENTER RETENTION DATE
          MX0    30
          BX2    -X0*X2
          BX7    X2+X4
          SA7    A2
          EQ     GRDX        RETURN
 
 
 GRDA     CON    0           CREATION DATE TEMPORARY
          TITLE  *TMS* COMMAND PROCESSING.
 TMS      SPACE  4
          QUAL   TFM
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMSTCM
 FETS     SPACE  4,10
**        PASSWORD FETS.
 
 
 I        BSS    0           INPUT FILE FET
 INPUT    FILEC  IBUF,BUFL,FET=6
 
 O        BSS    0           OUTPUT FILE FET
 OUTPUT   FILEB  PMSG,PMSGL+1,FET=6
 TMO      SPACE  4,15
**        TMO - TAPE MANAGER OPTIONS.
*
*         ENTRY  USBB HAS CONTROL CARD (1 CHARACTER PER WORD).
*                (X1) = PARAMETER.
*                (A1) = ADDRESS OF SEPARATOR.
*                (B6) = STRING BUFFER POINTER.
*
*         EXIT   TO KEYWORD PROCESSOR.
*                (X5) = REQUEST TYPE.
*                (X7) = PROCESSOR PARAMETERS.
*
*         USES   X - 0, 1, 3, 4, 5, 6, 7.
*                A - 3, 4, 5, 6.
*                B - 2, 3.
 
 
 TMO      BSS    0           ENTRY
          SA3    TMPF        TAPE MANAGER OPTION PROCESSOR
          NG     X3,ERR      IF *TMS* DISABLED
          SX4    TMOA        PARAMETER KEYWORD TABLE ADDRESS
          MX0    18
          SB3    B0
 TMO1     SA3    B3+X4
          BX7    X0*X3
          IX6    X1-X7
          SB3    B3+B1
          NG     X6,ERR      IF KEYWORD NOT FOUND
          NZ     X6,TMO1     IF NOT TO KEYWORD YET
          SA4    A1
          SB2    X3
          SA6    A3+         CLEAR KEYWORD ENTRY
          LX3    42
          MX0    -18         EXTRACT PROCESSOR PARAMETERS
          BX7    -X0*X3
          PL     B2,TMO2     IF KEYWORD VALUE NOT REQUIRED
          SX1    X4-1R=
          SB2    -B2
          NZ     X1,ERR      IF SEPARATOR NOT *=*
 TMO2     SA5    RT          GET REQUEST TYPE
          JP     B2          EXECUTE KEYWORD PROCESSOR
 
 TMOA     BSS    0           TAPE MANAGER ASSEMBLY OPTIONS.
 
 AC       MKTE   -SAC        AUDIT ACCESSIBILITY
 CT       MKTE   -SCT        CATEGORY TYPE
 MD       MKTE   -SMD        FILE MODE
 PW       MKTE   AUA,,(18/F+FPSW)  ALTERNATE USER PASSWORD
 TO       MKTE   STO         TAPE MANAGER OPTIONS
 UN       MKTE   AUA,,(18/F+FAUN)  ALTERNATE USERNAME
 
          CON    37777777777777777777B
          EJECT
 AUA      SPACE  4,10
**        AUA - ALTERNATE USER ACCESS.
*
*                PW.
*                PW=PASSWRD.
*                UN=USERNAM.
 
 
 AUA      BSS    0           ENTRY
          SA7    AUAA        SAVE ARGUMENT ADDRESS
          SX1    X4-1R=
          ZR     X1,AUA1     IF KEYWORD EQUATED
          ZR     B6,AUA2     IF CONTROL CARD EXHAUSTED
          SX1    X4-1R,
          ZR     X1,AUA2     IF NO ARGUMENT GIVEN
 AUA1     SX6    B0+         DISABLE LITERAL PROCESSING
          RJ     CLP         CALL *POP*
          MX0    7*6
          BX4    -X0*X5
          NZ     X4,ERR      IF PARAMETER TOO LONG
          BX6    X0*X5
          EQ     AUA3        STORE ARGUMENT
 
 AUA2     SX7    B6          SAVE (B6)
          SA7    A7+B1
          RJ     ESP         ENTER SECURE PASSWORD
          SA1    AUAB
          SB6    X1+         RESTORE (B6)
 AUA3     SA1    AUAA
          SA1    X1
          BX2    -X0*X1
          BX7    X2+X6
          SA7    A1
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 AUAA     CON    0           TEMPORARY
 AUAB     CON    0           TEMPORARY
 ESP      SPACE  4,20
**        ESP - ENTER SECURE PASSWORD.
*
*         THIS SUBROUTINE PROCESSES SECURELY ENTERED PASSWORDS.
*         IF OUTPUT FILE IS ASSIGNED TO A TERMINAL THE MESSAGE
*         *PASSWORD:* ALONG WITH BLANK OUT CHARACTERS FOR SECURE
*         ENTRY OF PASSWORD WILL BE SENT TO THE TERMINAL.
*         FILE *INPUT* WILL THEN BE READ FOR THE PASSWORD.
*         FOR BATCH JOBS FILE *INPUT* IS READ FOR THE PASSWORD.
*
*         EXIT   (X6) = PASSWORD.
*                ABORT WITH *INCORRECT PASSWORD* IF INCORRECT PASSWORD
*                ENCOUNTERED.
*
*         USES   X - ALL.
*                A - 1, 2, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  STF.
*
*         MACROS CSET, MESSAGE, READSKP, WRITE.
 
 
 ESP      SUBR               ENTRY/EXIT
          SX2    O           SET ADDRESS OF FET
          RJ     STF         CHECK IF OUTPUT ASSIGNED TO TERMINAL
          NZ     X6,ESP1     IF OUTPUT NOT ASSIGNED TO TERMINAL
          SA1    X2+B1       SET BUFFER FULL
          SX7    X1
          SX6    X1+PMSGL
          SA6    A1+B1       SET IN BELOW DATA FOR MESSAGE
          SA7    A6+B1       SET OUT = FIRST
          WRITE  X2,*        FORCE WRITE BIT SET
          SA1    O
          MX0    42
          BX2    X0*X1       FILE NAME FOR OUTPUT POINTER
          SX1    A1          SET ADDRESS OF FET FOR POINTER
          BX6    X1+X2
          SA6    ARGR        FORCE WRITE BEFORE READ ON ROLLOUT
 ESP1     SX2    I           SET ADDRESS OF FET
          RJ     STF         CHECK IF INPUT ASSIGNED TO TERMINAL
          NZ     X6,ESP2     IF INPUT NOT ASSIGNED TO TERMINAL
          CSET   NORMAL      ENSURE TERMINAL IN NORMAL MODE
 ESP2     READSKP I,,R       READ INPUT FOR PASSWORD
          SA1    I+2         DETERMINE NUMBER OF WORDS READ
          SA2    A1+B1
          IX6    X1-X2
          ZR     X6,ESP10    IF NO DATA ENTERED (NULL PASSWORD)
          SB5    X6
          SB3    B0
          BX5    X5-X5
          MX6    0
          SB4    60
          SB7    B0
          MX0    -6
 ESP3     SA2    IBUF+B3     PICK UP NEXT DATA WORD
          SB2    B0+
 ESP4     LX2    6
          BX1    -X0*X2      PICK UP CHARACTER TO CHECK
          NZ     X1,ESP5     IF CHARACTER NOT ZERO
          NZ     X5,ESP10    IF 00 ENCOUNTERED
          SX5    B1+         SET FLAG TO INDICATE 0 ENCOUNTERED
          EQ     ESP9        GET NEXT CHARACTER
 
 ESP5     NZ     X5,ESP11    IF PREVIOUS CHARACTER = COLON
 ESP6     SB6    X1-1R9
          GT     B6,ESP8     IF NOT ALPHANUMERIC CHARACTER
 ESP7     SB4    B4-6
          LX7    X1,B4
          BX6    X7+X6
          SB7    B7+1
          SB6    B7-7
          GT     B6,ESP11    IF PASSWORD .GT. SEVEN CHARACTERS
          EQ     ESP9        GET NEXT CHARACTER
 
 ESP8     SX4    X1-1R*
          ZR     X4,ESP7     IF CHARACTER = *
          SX3    X1-1R
          NZ     X3,ESP11    IF CHARACTER NOT BLANK
 ESP9     SB2    B2+B1
          SB6    B2-10
          LT     B6,ESP4     IF NOT END OF WORD
          SB3    B3+B1
          SB6    B5-B3
          EQ     B6,ESP11    IF TOO MUCH DATA ENTERED
          EQ     ESP3        CONTINUE PASSWORD CHECK
 
 ESP10    SA1    I+1
          BX7    X1
          SA7    A1+B1       SET IN = FIRST FOR INPUT BUFFER
          EQ     ESPX        RETURN
 
 ESP11    MESSAGE ESPA,3,R   *INCORRECT PASSWORD.*
          SB2    /PER/ARG    *ARGUMENT ERROR*
          EQ     PER         PROCESS ERROR
 
 ESPA     DATA   C* INCORRECT PASSWORD.*
 
*         MESSAGE FOR SECURE ENTRY OF PASSWORD.
 
 PMSG     DATA   10H"EM"  PASSWO
          DATA   10HRD:"NL"  (((
          DATA   10H((((("CR"  )
          DATA   10H)))))))"CR"
          DATA   10H MMMMMMMM
          DATA   10H"CR"  QQQQQQ
          DATA   10HQQ"CR"  XXXX
          DATA   10HXXXX"CR""CB""EL"
 PMSGL    EQU    *-PMSG
 SAC      SPACE  4,10
**        SAC - SET AUDIT CHARACTERISTIC.
*
*         AC=ACCESSIBILITY.
 
 
 SAC      BSS    0           ENTRY
          SB3    SACA        SET OPTION TABLE ADDRESS
          RJ     AOP         ANALYZE OPTION PARAMETER
          SA1    F+FFAC
          LX7    17-5
          BX7    X1+X7
          SA7    A1
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 SACA     BSS    0           AUDIT ACCESSIBILITY TABLE
          VFD    42/0LN,18//TFM/FANO
          VFD    42/0LY,18//TFM/FAYS
          CON    0           END OF TABLE
 SCT      SPACE  4,10
**        SCT - SET CATEGORY TYPE.
*
*         CT=TYPE.
 
 
 SCT      BSS    0           ENTRY
          SB3    SCTA        SET OPTION TABLE ADDRESS
          RJ     AOP         ANALYZE OPTION PARAMETER
          SA1    F+FFCT
          LX7    11-5
          BX7    X1+X7
          SA7    A1
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 SCTA     BSS    0           CATEGORY TYPE CONVERSION TABLE
          VFD    42/0LP,18//TFM/FCPR
          VFD    42/0LPR,18//TFM/FCPR
          VFD    42/0LPU,18//TFM/FCPU
          VFD    42/0LS,18//TFM/FCSP
          CON    0           END OF TABLE
 SMD      SPACE  4,10
**        SMD - SET FILE MODE.
*
*         MD=MODE.
 
 
 SMD      BSS    0           ENTRY
          SB3    SMDA        SET OPTION TABLE ADDRESS
          RJ     AOP         ANALYZE OPTION PARAMETER
          SA1    F+FFMD
          BX7    X1+X7
          SA7    A1
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 SMDA     BSS    0           FILE MODE CONVERSION TABLE
          VFD    42/0LR,18//TFM/FMRE
          VFD    42/0LW,18//TFM/FMWR
          CON    0           END OF TABLE
 STO      SPACE  4,15
**        STO - SET TAPE MANAGER OPTIONS.
*
*         TO=(ACDEFRST)
*
*                A = APPEND FILE (MULTI-FILE).
*                C = CHECK FOR CATALOG ERROR FLAG.
*                D = INHIBIT DEFAULTED TAPE ATTRIBUTES.
*                E = IGNORE CATALOG ERROR FLAG.
*                F = FOREIGN FILE (NON-*TMS*).
*                R = RESERVE FILE.
*                S = SYMBOLIC ACCESS TYPE.
*                T = *TMS* CONTROLLED FILE.
 
 
 STO      BSS    0           ENTRY
          RJ     CLP         GET PARAMETER VALUE (NO LITERALS)
          MX0    -6
          SB2    10
          MX7    0
 STO1     LX5    6
          BX3    -X0*X5
          ZR     X3,STO2     IF END OF PARAMETERS
          SB2    B2-B1
          SA4    STOA
          SB3    X3
          AX4    X4,B3
          LX4    -1
          PL     X4,ERR      IF NOT LEGAL OPTION
          CX4    X4
          SA3    X4+STOA     READ OPTION BIT
          BX7    X7+X3
          NZ     B2,STO1     IF MORE PARAMETERS IN WORD
          EQ     B5,B1,ERR   IF IMPROPER TERMINATION
          SA5    A5+B1       READ NEXT WORD OF PARAMETERS
          SB5    B5-B1
          SB2    10
          EQ     STO1        CHECK NEXT OPTION
 
 STO2     MX0    42          MERGE TAPE MANAGER OPTIONS
          SA2    F+FFTO
          BX3    -X0*X7
          BX7    X0*X2
          BX7    X7+X3
          SA7    A2
          LX7    59-5
          PL     X7,AFOR     IF NOT *TO=A*
          SA2    F+FSQN      SET *QN = 9999*
          MX7    46
          BX2    X7*X2
          SX7    9999D
          BX7    X2+X7
          SA7    A2
          SA2    F+FTAP      SET *WRITE LABEL*
          MX7    1
          BX7    X7+X2
          SA7    A2+
          SA2    MF          SET *QN .GT. 1*
          SX3    16B
          BX7    X3+X2
          SA7    A2
          EQ     AFOR        PROCESS NEXT ARGUMENT
 
 
 STOA     DATA   7000172B    VALIDATION BITS FOR OPTIONS (ACDEFRST)
          DATA   1BS4        T - *TMS* CONTROLLED FILE (SYOT)
          DATA   1BS2        S - SYMBOLIC ACCESS FILE
          DATA   1BS3        R - RESERVE TAPE FILE
          DATA   1BS1        F - FOREIGN TAPE (NOT IN *TMS*)
          DATA   1S7         E - IGNORE CATALOG ERROR FLAG
          DATA   1BS0        D - INHIBIT DEFAULTED ATTRIBUTES
          DATA   1S9         C - CHECK CATALOG ERROR FLAG
          DATA   1S5         A - APPEND FILE (MULTI-FILE)
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCSTF
*CALL     COMCWTH
          SPACE  4,10
***       BUFFERS.
 
 
 IBUF     BSS    BUFL        INPUT FILE BUFFER
          SPACE  4
          QUAL   *
 SPVT     SPACE  4,10
**        SPVT - SPECIAL VALIDATION TABLE.
*
*T        42/0,18/ DC
*
*         DC     DEVICE CODE
 
 
 SPVT     BSS    0
 
*         SPECIAL DEVICE CODES.
 
          CON    2RMS
          CON    2RNE
 
*         MASS STORAGE DEVICE CODES.
 
          PURGMAC TBLM
 TBLM     MACRO  DC
          MACREF TBLM
          CON    2R_DC
 TBLM     ENDM
 
          LIST   G
          TBL    "MSEQ"
          LIST   *
 
          CON    0           END OF TABLE
          TITLE  *PFM* *DMP=* CALL PRESET.
 PFM      SPACE  4,10
***       PFM - PROCESS CALL FROM *PFM*.
*
*         ENTRY  (SPPR) = *PFM* CALL.
*
*         ERROR  TO *PER*, IF RESOURCE TYPE ERROR OR CONTROL
*                COMMAND.
 
 
 PFM      BSS    0           ENTRY
          SB1    1           (B1) = 1
          SA1    ACTR        CHECK FOR COMMAND CALL
          SB2    /PER/CCI    *INCORRECT COMMAND.*
          NZ     X1,PER      IF COMMAND CALL
          SX7    B1+
          SA7    CF          SET CALL FLAG
          RJ     PCV         PRESET CONTROL POINT VALUES
          SA2    SFET+FDTY   READ FET DETAILS
          MX0    -6
          LX2    -18
          BX5    -X0*X2
          SX5    X5+5-/COMSPFM/CFPK-1
          MX0    42
          SA3    /CPA/PKNW   DEFAULT PACK NAME
          PL     X5,PFM1     IF FET NOT TOO SHORT
          BX1    -X0*X3      GET DEVICE TYPE
          BX5    X0*X3
          NZ     X1,PFM4     IF DEVICE TYPE SPECIFIED
          SA1    DFPT
          EQ     PFM4        SET RESOURCE REQUEST BLOCK
 
 PFM1     SA1    SFET+/COMSPFM/CFPK  READ PACK INFORMATION
          MX6    -3
          BX5    X0*X1
          BX6    -X6*X1      NUMBER OF UNITS
          NZ     X5,PFM2     IF NOT USING DEFAULT PACKNAME
          BX5    X0*X3
 PFM2     LX2    18
          NZ     X6,PFM3     IF NUMBER OF UNITS SPECIFIED
          SX6    B1
 PFM3     MX0    12
          SX6    X6+1R0
          BX2    X0*X2       DEVICE TYPE
          LX2    18
          BX1    X6+X2       RESOURCE TYPE
          NZ     X2,PFM4     IF NOT USING DEFAULT EQUIPMENT
          MX0    -18
          BX1    -X0*X3
          NZ     X1,PFM4     IF DEVICE TYPE SPECIFIED
          SA1    DFPT
 PFM4     LX6    X1
          BX6    X6+X5
          SA6    RQ          ENTER USER REQUEST (RQ)
          LX1    -18
          RJ     GRI         GET RESOURCE INDEX
          ZR     B2,PFM5     IF RESOURCE NOT FOUND
          SA6    RI          ENTER RESOURCE INDEX (RI)
          RJ     GTM         GET CURRENT TIME
          EQ     RRP         REQUEST REMOVABLE PACK
 
 PFM5     SB2    /PER/IRT    * INCORRECT RESOURCE TYPE.*
          EQ     PER         PROCESS ERROR
          TITLE  PRESET PRE-PROCESSORS.
 CCP      SPACE  4,15
**        CCP - COMMAND PRE-PROCESSOR.
*
*         ENTRY  (X5) = ADDRESS OF PROCESSOR NAME.
*
*         EXIT   (USBB) = UNPACKED COMMAND.
*                (AP) = (B6) = ASSEMBLY POINTER.
*                (LIT) .NE. 0.
*
*         ERROR  TO *ERR*, IF COMMAND ERROR.
*
*         USES   A - 5, 7.
*                B - 1, 2.
*                X - 0, 5, 7.
*
*         CALLS  IDF, PCV, POP, USB.
 
 
 CCP      SUBR               ENTRY/EXIT
          SA5    X5          READ PROGRAM NAME
          SB1    1           (B1) = 1
          BX7    X5
          SA7    CCPA        SAVE PROGRAM NAME
          RJ     IDF         ISSUE DAYFILE MESSAGE
          RJ     PCV         PRESET CONTROL POINT VALUES
          SB2    CCDR        UNPACK COMMAND
          RJ     USB
          SX7    B0+
          SA7    LIT         CLEAR LITERAL PROCESSING
 CCP1     SA5    CCPA        VERIFY PROGRAM NAME
          RJ     POP
          NG     B5,ERR      IF COMMAND ERROR
          BX0    X6-X5
          SX7    B6
          NZ     X0,CCP1     IF NOT CORRECT PROGRAM NAME
          SX1    X1-1R=
          ZR     X1,ERR      IF SEPARATOR IS *=*
          SA7    AP          SAVE COMMAND ASSEMBLY POINTER
          EQ     CCPX        RETURN
 
 
 CCPA     CON    0           PROGRAM NAME
 
 
**        TABLE OF PROGRAM NAMES.
 
 ASSIGNC  VFD    60/0LASSIGN
 LABELC   VFD    60/0LLABEL
 REQUESC  VFD    60/0LREQUEST
 RESOURS  VFD    60/0LRESOURC
 VSNC     VFD    60/0LVSN
 CLF      SPACE  4,20
**        CLF - CONVERT LFM CALL TO FET.
*
*         ENTRY  (SPPR) = ADDRESS OF CALLING BLOCK.
*
*         EXIT   FET AND TAPE DEFINITION BLOCK BUILT.
*                AUTOMATIC ASSIGNMENT FLAG SET WHEN NEEDED.
*
*         ERROR  TO *PER*, IF ERROR.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6, 7.
*                B - 2.
*
*         CALLS  ILF.
*
*         MACROS MOVE.
 
 
 CLF      SUBR               ENTRY/EXIT
 
*         COPY LABEL FET.
 
          RJ     ILF         INITIALIZE LABEL FET
          SA1    SFET+FDTY   COPY TAPE DESCRIPTOR AND LABEL VALUES
          MX0    -6
          LX1    -18
          BX5    -X0*X1
          SX1    X5-FCID-1+5
          NG     X1,CLF2     IF FET TOO SHORT
          SA3    SFET+FTAP   SET DEFAULT OR TOGGLE INSTALLTION OPTION
          SX2    /COMSMTX/POLM  DEFAULT ERROR MESSAGE OPTION
          SX6    /COMSMTX/POGH  DEFAULT GCR WRITE CORRECTION OPTION
          LX2    43-0
          SX5    FMAX
          LX6    42-0
          BX3    X3-X2
          SX1    X1+B1
          BX6    X3-X6
          IX4    X5-X1
          SA6    A3
          PL     X4,CLF1     IF FET NOT TOO LONG
          BX1    X5
 CLF1     MOVE   X1,SFET+FCID,F+FCID
 CLF2     SA1    SFET        SET FILE NAME AND GUARANTEE COMPLETE FET
          MX0    12
          SA2    A1+B1
          SX7    B1
          BX7    X1+X7
          SA3    F+FDTY
          BX2    X0*X2
          SA7    A3-B1       ENTER FILE NAME
          BX3    -X0*X3
          BX7    X2+X3
          SA7    A3          ENTER DEVICE FIELD
          MX0    -11
          SA3    F+FTAP      GET TAPE DESCRIPTORS
          LX2    12          CHECK DEVICE TYPE
          MX7    1           GET *OPEN/WRITE* FLAG
          BX6    X7*X3
          LX6    40-59
          BX6    X6+X3       SET WRITE ENABLE REQUIRED FOR *OPEN/WRITE*
          BX7    -X0*X2      DEVICE CODE
          LX6    -55
          MX0    -2
          ZR     X7,CLF4     IF NO DEVICE CODE SPECIFIED
          RJ     CTE         CHECK FOR TAPE DEVICE CODE
          ZR     X2,CLF4     IF NOT TAPE DEVICE CODE
          BX1    -X0*X6      SPECIFIED DEVICE TYPE
          BX0    X1-X7
          ZR     X0,CLF4     IF DEVICE CODE MATCHES TAPE DEVICE TYPE
          SB2    /PER/TDC    * TAPE DEVICE TYPE CONFLICT.*
          NZ     X1,PER      IF *MT* DEVICE TYPE NOT SPECIFIED
          ERRNZ  /COMSMTX/DVMT
          BX6    X6+X7       SET DEVICE TYPE FROM DEVICE CODE
 CLF4     SA1    F+FCID      GET CHECKPOINT ID FROM FET+7
          LX6    55
          SA6    A3
          MX0    -6
          LX1    6
          BX6    -X0*X1
          SX5    X6-/COMSLFM/CKID  CHECK FOR SPECIAL ID = 76B
          SX6    /COMSLFD/CKST  CHECKPOINT AT EOI
          ZR     X5,CLF6     IF VALID ID
          SX5    X5-/COMSLFM/CBID+/COMSLFM/CKID
          SX6    /COMSLFD/CBST  CHECKPOINT AT BOI
          ZR     X5,CLF6     IF VALID ID
          SA1    SPPR        CHECK FOR *SSJ=* CALLING PROGRAM
          SA3    /CPA/JCIW   CHECK FOR PRIVACY STATUS ON NEW FILES
          LX1    59-36
          PL     X1,CLF5     IF NOT *SSJ=* JOB
          LX1    59-37-59+36
          SX6    /COMSLFD/SSST  SPECIAL SYSTEM JOB FILE STATUS
          NG     X1,CLF6     IF *SSJ=* BLOCK DEFINED
 CLF5     SX6    /COMSLFD/UPST  USER FILE PRIVACY STATUS
          LX3    59-19
          NG     X3,CLF6     IF USER PRIVACY REQUESTED ON NEW FILES
          SX6    B0+
 CLF6     SA6    CI          SET CHECKPOINT ID
 
*         CHECK FOR MULTI-FILE POSITIONING.
 
          SA1    F+FMSI      CHECK MULTI-FILE SET ID
          MX0    36
          BX6    X6-X6
          SA3    BLANK
          BX1    X0*X1
          BX4    X3-X1
          ZR     X1,CLF7     IF SET ID NOT SPECIFIED
          ZR     X4,CLF7     IF BLANK SET ID SPECIFIED
          SX6    X6+4        INDICATE SET ID SPECIFIED
 CLF7     MX0    42
          BX4    X3
          SA1    F+FID1      CHECK FILE IDENTIFIER
          LX4    24
          SA2    F+FID2
          BX3    X3+X4
          BX2    X0*X2
          IX4    X1+X2
          ZR     X4,CLF8     IF FILE ID NOT SPECIFIED
          IX1    X1-X3
          BX4    X0*X3
          BX2    X2-X4
          IX1    X1+X2
          ZR     X1,CLF8     IF BLANK FILE ID SPECIFIED
          SX6    X6+1        INDICATE FILE ID SPECIFIED
 CLF8     SA1    F+FSQN      CHECK FILE SEQUENCE NUMBER
          MX0    -15
          BX1    -X0*X1
          ZR     X1,CLF9     IF SEQUENCE NUMBER NOT SPECIFIED
          SX6    X6+2        INDICATE SEQUENCE NUMBER SPECIFIED
          SX2    X1-1
          ZR     X2,CLF9     IF NOT MULTI-FILE SET SEQUENCE NUMBER
          SX6    X6+10B      INDICATE SEQUENCE NUMBER .GT. 1
          SX2    X1-9999
          NZ     X2,CLF9     IF NOT FILE SET EXTENSION
          SA3    F+FTAP      SET WRITE LABEL BIT
          MX7    1
          BX3    X3+X7
          LX7    40-59       SET WRITE ENABLE REQUIRED FLAG
          BX7    X7+X3
          SA7    A3+
 CLF9     SA6    MF          SET MULTI-FILE POSITIONING FLAG
          SA1    F+FVSN      GET VSN
          MX6    42
          BX6    X6*X1
          SA6    EVSN        SET EXTERNAL VSN
          SA6    IVSN        SET INTERNAL VSN
          EQ     CLFX
 CSF      SPACE  4,15
**        CSF - CONVERT NOS/BE REQUEST BLOCK TO FET.
*
*         ENTRY  (SPPR+1 - SPPR+9) = NOS/BE REQ MACRO PARAMETER BLOCK.
*
*         EXIT   FET AND TAPE DEFINITION BLOCK BUILT.
*
*         ERROR  TO *ERR*, IF CONTENT ERROR IN *REQ* BLOCK.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - ALL.
*
*         MACROS MOVE.
 
 
 CSF      SUBR               ENTRY/EXIT
          SA1    SPPR+1      ENTER FILE NAME
          MX0    42
          BX1    X0*X1
          SX2    3
          BX6    X1+X2
          SA1    A1+B1
          SA6    F
          MX0    -2          BUILD TAPE DESCRIPTORS
          BX6    -X0*X1      DENSITY
          LX1    -2
          BX5    -X0*X1      LABEL
          LX1    -2
          BX4    -X0*X1      FORMAT
          MX0    -1
          LX1    -2
          BX3    -X0*X1      TRACK TYPE
          MX0    -2
          LX1    -23
          SX6    X6+B1
          BX2    -X0*X1      CONVERSION (US, EB)
          LX6    -9
          CX5    X5
          LX3    -4
          SA4    X4+CSFA
          LX5    1
          BX5    -X0*X5
          LX1    5
          MX0    -1
          ZR     X2,CSF1     IF NO CONVERSION SPECIFIED
          SX2    X2-3
          ZR     X2,CSF1     IGNORE IF BOTH US AND EB SPECIFIED
          BX2    -X2
 CSF1     LX5    -4
          BX7    X6+X4
          LX2    -12
          BX7    X7+X3
          BX2    X5+X2
          BX6    -X0*X1      READ LABEL (E)
          BX7    X7+X2
          LX1    1
          BX5    -X0*X1      NON-STANDARD (NS)
          LX1    1
          BX4    -X0*X1      ERROR INHIBIT (NR)
          LX1    9
          BX3    -X0*X1      INHIBIT UNLOAD (IU)
          LX6    -1
          BX7    X7+X6
          LX5    -3
          BX7    X7+X5
          LX4    -22
          BX7    X7+X4
          LX3    -19
          BX7    X7+X3
          LX1    -3
          MX0    3
          PL     X1,CSF2     IF NOT SYSTEM DEFAULT DENSITY
          LX0    -6
          BX7    -X0*X7
 CSF2     SA7    F+FTAP      ENTER TAPE DESCRIPTORS
          LX1    -10
          MX0    36
          PL     X1,CSF3     IF NO VSN
          SA2    A1+B1       ENTER VSN
          SA3    A7+B1
          BX2    X0*X2
          BX3    -X0*X3
          BX7    X2+X3
          SA7    A3
 CSF3     LX1    -24
          SX7    B1
          NG     X1,CSF4     IF EXTENDED LABELS
          SX7    -B1
          LX1    1
          PL     X1,CSF5     IF NOT STANDARD LABELS
 CSF4     SA7    OO          SELECT OPEN OPTION
 
          MOVE   5,SFET+FRTL,LABL  COPY LABEL DESCRIPTORS
 
 
 CSF5     SA1    F+FTAP      VALIDATE FET
          MX0    -6
          LX1    -30
          BX5    -X0*X1
          SX5    X5-/COMSMTX/TFMA
          LX1    30
          ZR     X5,ERR      IF INCORRECT FORMAT
          SA1    F
          BX7    X1
          SA7    VF
          EQ     CSFX        RETURN
          SPACE  4,10
*         TABLE OF NOS/BE TAPE FORMATS.
 
 CSFA     VFD    30//COMSMTX/TFSI,30/5120     SYSTEM INTERNAL
          VFD    30//COMSMTX/TFMA,30/0        INCORRECT
          VFD    30//COMSMTX/TFS,30/5120      STRANGER
          VFD    30//COMSMTX/TFL,30/5120      LONG BLOCK STRANGER
 GAL      SPACE  4,15
**        GAL - GET ACCESS LEVEL.
*
*         *GAL* CHECKS TO SEE IF AN ACCESS LEVEL HAS BEEN SET,
*         IF NOT IT WILL DEFAULT TO THE JOB ACCESS LEVEL IF A
*         SECURED SYSTEM IS ENABLED.
*
*         ENTRY  (AL) = ACCESS LEVEL REQUESTED.
*                     .LT. 0, IF NO REQUEST MADE.
*
*         EXIT   (AL) = ACCESS LEVEL.
*
*         USES   X - 0, 1, 6.
*                A - 1, 6.
 
 
 GAL      SUBR               ENTRY/EXIT
          SA1    AL
          PL     X1,GALX     IF ACCESS LEVEL ENTERED
          SA1    SSMA        SYSTEM SECURITY MODE
          ZR     X1,GAL1     IF UNSECURED SYSTEM
          SA1    JALA        JOB ACCESS LEVEL
          MX0    -6
          BX1    -X0*X1      JOB ACCESS LEVEL
 GAL1     BX6    X1
          SA6    AL          SAVE ACCESS LEVEL
          EQ     GALX        RETURN
 ILF      SPACE  4,10
**        ILF - INITIALIZE LABEL FET.
*
*         EXIT   (FET+10B) = DEFAULT TAPE DESCRIPTORS.
*                (FET+11B - FET+17B) = 0.
*
*         USES   A - 7.
*                B - 7.
*                X - 7.
 
 
 ILF      SUBR               ENTRY/EXIT
          SX7    B0+
          SB7    7
 ILF1     SA7    B7+F+FTAP   CLEAR FET+10B - FET+17B
          SB7    B7-1
          PL     B7,ILF1     IF NOT LAST WORD
          EQ     ILFX        RETURN
 PCV      SPACE  4,15
**        PCV - PRESET CONTROL POINT VALUES.
*
*         EXIT   JOB AND SYSTEM CONTROL PARAMETERS SET.
*                SYSTEM RESOURCE FILE NAMES INITIALIZED.
*
*         USES   A - 1, 2, 3, 6, 7.
*                X - 0, 1, 2, 3, 6, 7.
*
*         MACROS DISSR, GETFO, GETJAL, GETJN, GETJO, GETSSL, GETUSV,
*                MACHID, RDSB, REPRIEVE, SYSTEM.
 
 
 PCV      SUBR               ENTRY/EXIT
 
*         DISABLE SRU ACCUMULATION AND INITIALIZE REPRIVE PROCESSING.
 
          DISSR              DISABLE SRU ACCUMULATION
          REPRIEVE  RPVB,SET,237B  SET EXTENDED REPRIEVE PROCESSING
 
*         GET JOB INFORMATION.
 
          RDSB   0,/CPA/CPAL,0,/CPA/CPA
          GETJO  OT          GET JOB ORIGIN TYPE
          GETFO  FAMO        GET FAMILY ORDINAL
          SA1    FAMO
          SX6    X1
          SA6    A1          SET FAMILY ORDINAL
          GETJN  JSN         GET JSN
          SA2    /CPA/TFSW   GET JOB EJT ORDINAL
          MX0    -12
          LX2    12
          BX6    -X0*X2
          SA6    JEEO        SET EJT ORDINAL
          GETJAL JALA        GET JOB ACCESS LEVEL
          GETUSV JCWA        GET JOB CONTROL WORD
 
*         GET SYSTEM INFORMATION.
 
          RDSB   0,1,EJTP,/LWC/EJTP  EJT POINTER
          RDSB   0,1,ESTP,/LWC/ESTP  EST POINTER
          RDSB   0,1,IPRL,/LWC/IPRL  INSTALLATION PARAMETER
          RDSB   0,1,PFNL,/LWC/PFNL  PERMANENT FILE CONTROL
          SYSTEM SFM,R,TMPF,GTSF*100B  GET *TMS* STATUS
          SA2    TMPF        CHECK *TMS* SYSTEM STATUS
          MX6    1
          PL     X2,PCV0.1   IF *TMS* DISABLED
          LX2    59-58
          PL     X2,PCV0.1   IF NO *TMS* BINARIES IN SYSTEM
          MX0    1           CHECK IF DEFAULT *TO=T* OR *TO=F*
          LX2    53-0-59+58
          LX0    53-59
          BX6    X0*X2
          BX6    X0-X6       SET DEFAULT *TO=T* OR *TO=F*
          LX0    51-53       CHECK IF DEFAULT *TO=C* OR *TO=E*
          LX2    51-1-53+0
          BX1    X0*X2
          BX1    X0-X1
          BX6    X6+X1       SET DEFAULT *TO=C* OR *TO=E*
 PCV0.1   SA6    A2
          MACHID PCVA        RETRIEVE MACHINE ID
          SA3    PCVA
          SA1    D           SET ID IN FILE NAMES
          SA2    V
          LX3    24
          SA4    R
          BX6    X3+X1
          SA6    A1
          BX7    X3+X2
          SA7    A2
          BX6    X3+X4
          SA6    A4
          GETSSL SSMA        SYSTEM SECURITY MODE
          SA1    SSMA
          MX0    -6
          LX1    0-48
          BX6    -X0*X1
          SA6    A1          SYSTEM SECURITY MODE
          SA1    /LWC/PFNL   SET SYSTEM DEFAULT PACK TYPE
          MX0    -18
          LX1    -42
          BX6    -X0*X1
          SA6    DFPT
          SA1    /CPA/PKNW   SET JOB DEFAULT PACK TYPE
          BX6    -X0*X1
          ZR     X6,PCVX     IF PACK TYPE NOT SET IN CPA
          SA6    DFPT
          EQ     PCVX        RETURN
 
 
 PCVA     BSSZ   1           MACHINE ID RECEIVING AREA
          SPACE  4,10
*         PRESET BUFFERS.
 
 
 ASJT     BSSZ   100B        ACTIVE STAGE JOB TABLE
 
 
 RFL2     EQU    *           END OF PRESET CODE
 
 .RFL     MAX    RFL1,RFL2
 RFL=     EQU    .RFL
          END