RESEX 
          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 
