TFILES
          IDENT  TFILES,FWA 
          ABS 
          SST 
          ENTRY  ADMIT
          ENTRY  AMEND
          ENTRY  AUDIT
          ENTRY  RESERVE
          ENTRY  RELEASE
          ENTRY  TMSDEF 
          ENTRY  ARG= 
          ENTRY  RFL= 
          ENTRY  SDM= 
          SYSCOM B1 
          TITLE  TFILES - TAPE FILE REQUEST PROCESSOR 
*COMMENT  TAPE FILE REQUEST PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 TFILES   SPACE  4,10 
*****     TFILES - TAPE FILE REQUEST PROCESSOR
* 
*         L.A. GILBERTSON.     82/08/04.
          SPACE  4,10 
***       TFILES PROCESSES THE FOLLOWING TAPE FILE REQUESTS:  
*         *ADMIT*, *AMEND*, *AUDIT*, *RELEASE* AND *RESERVE*. 
          SPACE  4,10 
***       COMMAND CALL. 
* 
*         THE *ADMIT* COMMAND GRANTS PERMISSION FOR USERS 
*         OTHER THAN THE FILE ORIGINATOR (ALTERNATE USERS) TO ACCESS
*         AND EMPLOY A PRIVATE FILE.  BESIDES SPECIFYING WHAT 
*         ALTERNATE USER NAMES CAN EMPLOY A PRIVATE FILE, THE *ADMIT* 
*         COMMAND CAN INDICATE THE WAY IN WHICH EACH ALTERNATE
*         USER IS ALLOWED TO EMPLOY THE FILE (A FILE MODE RESTRICTION 
*         MUST BE PLACED ON EACH ALTERNATE USER). 
*         IN ADDITION, THE *ADMIT* COMMAND CAN BE SUPPLIED TO 
*         OVERRIDE THE FILE MODE THAT WAS ESTABLISHED WHEN A SEMI-
*         PRIVATE FILE WAS ORIGINALLY RESERVED.  FOR EXAMPLE, ASSUME
*         THAT THE USER RESERVED A FILE IN THE SEMIPRIVATE FILE 
*         CATEGORY UNDER WRITE MODE.  IF THE FILE ORIGINATOR WANTS
*         TO GRANT READ PERMISSION (READ MODE) TO ONE SPECIFIC
*         USER (CD4567E), HE OR SHE CAN DO SO BY SUPPLYING THE
*         FOLLOWING *ADMIT* COMMAND 
* 
*                        ADMIT,TFN,CD4567E=R. 
* 
*         ALL OTHER USERS CONTINUE TO BE CONTROLLED BY THE WRITE MODE 
*         THAT WAS ESTABLISHED WHEN THE SEMIPRIVATE FILE WAS ORIGINALLY 
*         SAVED.
* 
*         THE *AMEND* COMMAND ALLOWS THE ORIGINATOR OF A TAPE FILE
*         TO CHANGE SOME OF THE PARAMETERS ASSOCIATED WITH THAT FILE, 
*         WITHOUT HAVING TO REWRITE THE FILE. 
* 
*         THE *AUDIT* COMMAND ENABLES A USER TO OBTAIN INFORMATION
*         ABOUT THE FILES THAT RESIDE IN HIS OR HER TAPE FILE CATALOG.
*         IN ADDITION, ALTERNATE USERS CAN REQUEST *AUDIT* INFORMATION
*         ABOUT THE SPECIFIC FILES THEY ARE PERMITTED TO ACCESS 
*         IN ALTERNATE USER CATALOGS. 
* 
*         THE *RELEASE* COMMAND RELEASES ONE OR MORE SPECIFIED TAPE 
*         FILES FROM THE USERS CATALOG.  USERS CAN ONLY RELEASE 
*         CENTER-OWNED RESERVED TAPES AND TAPES THAT ARE RETAINED 
*         UNDER THE SAME USER NAME. 
* 
*         THE *RESERVE* COMMAND ENABLES A USER TO RESERVE 
*         A CENTER-OWNED SCRATCH TAPE UNDER THE NOS TAPE MANAGEMENT 
*         SYSTEM (TMS).  THE NOS FAMILY RETAINS THE TAPE UNDER THE
*         USERNAME OF THE USER WHO SUPPLIES THE *RESERVE* COMMAND.
* 
*         THE *TMSDEF* COMMAND ALLOWS THE USER TO DEFINE THE DEFAULT
*         VALUES FOR *TMS* PARAMETERS ON THE *LABEL* AND *REQUEST*
*         COMMANDS. 
* 
*         TWO TYPES OF ACCESS ARE AVAILABLE FOR TAPE FILES. 
* 
*         1. TAPE LOGICAL FILE NAME.  TAPE FILE NAMES CAN BE
*            1 TO 17 CHARACTERS IN LENGTH AND MUST BE UNIQUE
*            WITHIN A USERS CATALOG. (ANALOGOUS TO PERMANENT
*            FILE NAMES.)  A SPECIFIC TAPE FILE MAY BE FROM 
*            1 TO 60 REELS LONG.
* 
*         2. VOLUME SERIAL NUMBER.  THIS IS THE EXTERNAL
*            CENTER-DEFINED SERIAL NUMBER ASSIGNED TO EACH TAPE 
*            IN THE TAPE POOL.  (ONLY THE FIRST VOLUME SERIAL 
*            NUMBER IN A MULTI-VOLUME SET IS VALID IF THIS TYPE 
*            OF ACCESS IS CHOSEN.)
* 
*         COMMAND FORMATS - 
* 
*         ADMIT,TFN,USERNAM1=M1,...,USERNAMN=MN/,S,NA.
* 
*         AMEND,NFN1=OFN1,...NFNN=OFNN/PW=PSWD,CT=CT,M=MD,UC=UCW,AC=AC, 
*               CE,AN,S,NA. 
* 
*         AUDIT,TFN,LO=OPT,UN=USERNAM,L=LFN1,SS=LFN2,S. 
*         AUDIT,LO=OPT,UN=USERNUM,L=LFN1,SS=LFN2. 
* 
*         RELEASE,TFN1,...TFNN/NA.
* 
*         RESERVE,LFN1,...,LFNN/SS=LFNX,PW=PSWD,CT=CT,M=MD,UC=UCW,NA. 
* 
*         TMSDEF,TO=TOPT. 
* 
*         WHERE:  
* 
*         AC=  INDICATES WHETHER OR NOT ALTERNATE USERS CAN 
*              OBTAIN *AUDIT* INFORMATION ABOUT THE FILE. 
*              VALID ENTRIES:  Y - (YES)
*                              N - (NO) DEFAULT.
* 
*         AN   IF SPECIFIED, CHANGES THE SPECIFIED TAPES
*              CHARGE/PROJECT NUMBER TO THE CURRENT CHARGE/ 
*              PROJECT NUMBER THE USER IS RUNNING UNDER.
* 
*         CE   CLEAR ERROR OPTION.  IF TMS DETECTS AN ERROR 
*              WHEN A USER TRIES TO ACCESS A FILE, A DIAGNOSTIC 
*              IS ISSUED.  IN ADDITION, *AUDIT* OUTPUT WILL PLACE 
*              AN ASTERISK IN FRONT OF THE NAME OF EACH ERRON-
*              EOUS FILE.  USERS SHOULD CONTACT *CYBERNET*
*              CUSTOMER SERVICE TO DETERMINE THE EXTENT OF
*              DAMAGE ON THE ERRONEOUS FILE.  IF THE USER STILL 
*              WANTS TO EMPLOY THE DAMAGED FILE, HE OR SHE
*              SHOULD SUPPLY AN *AMEND* COMMAND WITH THE *CE* 
*              OPTION AND TMS WILL CLEAR THE ERROR BIT. 
*              SUBSEQUENTLY, USERS WILL BE ALLOWED TO ACCESS THE
*              TAPE FILE. 
* 
*         CT   FILE ACCESS CATEGORY.  IF CT=CT IS OMITTED WHEN THE FILE 
*              IS CREATED, THE FILE IS PRIVATE.  THE FILE CATEGORY
*              CAN BE CHANGED LATER.
* 
*              P OR PR          PRIVATE FILES; AVAILABLE FOR ACCESS 
*                               ONLY BY THEIR CREATOR AND BY THOSE
*                               GRANTED EXPLICIT ACCESS PERMISSION BY 
*                               THE FILE CREATOR(REFER TO THE *ADMIT* 
*                               COMMAND). 
* 
*              S                SEMIPRIVATE FILES; AVAILABLE FOR ACCESS 
*                               BY A USER WHO KNOWS THE FILE NAME, USER 
*                               NUMBER, AND FILE PASSWORD AND WHO HAS 
*                               NOT BEEN EXPLICITLY DENIED PERMISSION TO
*                               THE FILE(I.E. M=N OPTION ON THE *ADMIT* 
*                               COMMAND). 
* 
*              PU               PUBLIC FILES; AVAILABLE FOR ACCESS BY AL
*                               USERS WHO KNOW THE FILE NAME, USER NUMBE
*                               AND PASSWORD.  THE SYSTEM RECORDS THE 
*                               NUMBER OF TIMES THE FILE WAS ACCESSED AN
*                               THE DATE AND TIME OF THE LAST ACCESS, BU
*                               DOES NOT RECORD USER NUMBERS. 
* 
*         LFN  (*RESERVE* COMMAND) LOCAL FILE NAME. 
* 
*         LFNX (*RESERVE* COMMAND) FILE NAME TO RECEIVE THE 
*              MACHINE READABLE TAPE FILE STATUS INFORMATION. 
* 
*         MD   FILE ACCESS MODE PERMITTED TO OTHER USERS IF THE FILE
*              IS PUBLIC OR SEMIPRIVATE, AND IF EXPLICIT ACCESS 
*              PERMISSION HAS NOT BEEN GRANTED TO THAT USER. IF 
*              M=M IS OMITTED, M=WRITE IS ASSUMED, EXCEPT FOR *ADMIT*,
*              WHERE READ IS THE DEFAULT. 
* 
*              R       THIS FILE CAN BE READ. 
* 
*              W       THIS FILE CAN BE READ OR WRITTEN ON. 
* 
*              N       NO ACCESS IS ALLOWED.
* 
*         S    IF SPECIFIED, THE SYMBOLIC TAPE FILE NAME WAS GIVEN. 
* 
*         NA   NO ABORT OPTION.  BY DEFAULT, IF NOS ENCOUNTERS
*              AN ERROR WHILE PROCESSING A COMMAND, 
*              IT INITIATES ERROR PROCESSING.  HOWEVER, IF THE
*              NO-ABORT OPTION IS IN EFFECT AND THE SYSTEM FINDS
*              AN ERROR, THE SYSTEM SKIPS THE COMMAND AND 
*              PROCESSES THE REMAINING COMMANDS IN THE JOB. 
* 
*         OPT  *AUDIT* LIST OPTION. 
*              VALID ENTRIES:  F - (FULL LIST)
*                              M - (FULL MULTIFILE LIST)
*                              0 - (ZERO, SHORT LIST) DEFAULT.
*                              FP- (FULL ADMIT LIST)
*                              P - (SHORT ADMIT LIST) 
* 
*         TFN  TAPE FILE NAME OR VOLUME SERIAL NUMBER.
* 
*         TOPT THE DEFAULT VALUE FOR THE TAPE OPTION (*TO*) PARAMETER 
*              ON THE *LABEL* OR *REQUEST* COMMAND. 
* 
*              T       SET DEFAULT TO *TO=T* (*TMS* PROCESSING).
* 
*              F       SET DEFAULT TO *TO=F* (NON-*TMS* PROCESSING).
* 
*              C       IF DEFAULT TO *TO=C* (CHECK FOR CATALOG ERROR.)
* 
*              E       IF DEFAULT TO *TO=E* (IGNORE CATALOG ERROR.) 
* 
*         UCW  USER CONTROL WORD. (1 TO 10 CHARACTERS)
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         *ERROR IN TFILES ARGUMENT.* = AN ARGUMENT TO TAPE FILE
*                REQUEST WAS INCORRECT. 
* 
*         *ERROR IN VSN.* = THE SYNTAX OF A SPECIFIED VSN WAS 
*                INCORRECT. 
* 
*         *NO USERNAME SPECIFIED.* = NO USERNAME WAS SPECIFIED WHEN 
*                ONE WAS REQUIRED.
* 
*         *EXCEEDED USERNAME LIMIT.* = TOO MANY USERNAMES ON AN 
*                *ADMIT* REQUEST. (MAXIMUM OF SEVEN)
* 
*         *ERROR IN USERNAME.* = SYNTAX ERROR.
* 
*         *INCORRECT SEPARATOR.*
* 
*         *INCORRECT FILE MODE.*
* 
*         *ERROR IN FILENAME.* = SYNTAX ERROR.
* 
*         *EXCEEDED FILENAME LIMIT.* = EXCEEDED LIMIT OF SEVEN. 
* 
*         *FILENAME MISSING.* = NO FILENAME SPECIFIED WHEN
*                ONE WAS REQUIRED.
* 
*         *INCORRECT FILE CATEGORY.*
* 
*         *INCORRECT AC PARAMETER.* 
* 
*         *EXCEEDED VSN LIMIT.* = EXCEEDED LIMIT OF SEVEN.
* 
*         *INCORRECT PASSWORD.* 
* 
*         *CANNOT AMEND VSN NAME.*
* 
*         *EMPTY CATALOG.*
* 
*         *REMARK= NOT SUPPORTED AT 1.4D, USE UC=.* 
* 
*         *PFN= NOT SUPPORTED AT 1.4D, IS NOW A NO-OP.* 
          SPACE  4,10 
***       COMMON DECKS. 
  
*CALL     COMCCMD 
*CALL     COMCMAC 
*CALL     COMSSFM 
*CALL     COMSTCM 
*CALL     COMSTFM 
          QUAL   TFU
*CALL     COMSTFU 
          QUAL   *
          SPACE  4
****      ASSEMBLY CONSTANTS. 
  
 SDM=     EQU    0           SUPPRESS DAYFILE MESSAGE 
 ARG=     EQU    0           SUPPRESS SYSTEM CRACKING 
 OBFL     EQU    1001        OUTPUT BUFFER SIZE 
 IBFL     EQU    101B        INPUT BUFFER LENGTH
 SBFL     EQU    300B        INITIAL SORT BUFFER LENGTH 
 FLIN     EQU    1000B       FL INCREMENT FOR SORT BUFFER 
 MSBL     EQU    SBFL+5*FLIN MAXIMUM SORT BUFFER LENGTH 
 TWBL     EQU    TSVL*60D+TCEL+2 AUDIT BUFFER SIZE
 NWRD     EQU    8D          FOR 80 CHARACTER OUTPUT
 CHDR     EQU    3           NUMBER OF HEADER LINES 
          TITLE  TAPE FILE REQUEST MACROS 
          TITLE  MACROS 
 MOVEIT   SPACE  4,15 
**        MOVEIT. 
* 
*         THE MOVEIT MACRO IS USED TO CONSTRUCT DIRECTIVES FOR THE MCS
*         SUBROUTINE.  THE FORMAT AND THE PURPOSE OF THE DIRECTIVE IS 
*         EXPLAINED IN THE MCS DOCUMENTATION. 
* 
  
  
          PURGMAC  MOVEIT 
  
 MOVEIT   MACRO  N,L1,C1,L2,C2
  VFD    12/N,18/L1,6/C1,6/C2,18/L2 
  ENDM
 SETEA    SPACE  4,15 
**        SETEA - SET ERROR ADDRESS.
* 
*              AD = WORD EA OF FET. 
*              VA = ERROR MESSAGE RETURN BUFFER ADDRESS.
  
  
          PURGMAC  SETEA
  
 SETEA    MACRO  AD,VA
  LOCAL A,B 
A BSS 0 
B EQU  *O 
  ORG  AD 
  VFD  VA 
  ORG  B
  ENDM
 XFER     SPACE  4,10 
**        XFER - TRANSFER CHARACTER STRING. 
* 
*         THE *XFER* MACRO ASSEMBLES THE MACRO PARAMETERS INTO
*         (X1) AND (X2) FOR THE CALL TO *XFR*.  SEE *XFR* FOR 
*         FOR MORE INFORMATION. 
  
  
          PURGMAC XFER
  
 XFER     MACRO  SFWA,OFWA,BWP,BCP,SCC,OCC
  SX1 SFWA        FWA OF SOURCE 
  SX2 OFWA        FWA OF OBJECT 
  LX1 3 
  LX2 3 
  SX3 7B          VALIDATE ALL CHARACTERS 
  BX1 X1+X3 
  BX2 X2+X3 
  LX1 9 
  LX2 9 
  SX3 BWP         BEGINNING WORD POSITION 
  BX2 X2+X3 
  LX1 9 
  LX2 9 
  SX3 BCP         BEGINNING CHARACTER POSITION
  BX2 X2+X3 
  LX1 9 
  LX2 9 
  SX3 SCC         XFER CHARACTER COUNT
  BX1 X1+X3 
  IFC NE,$OCC$$ 
  SX3 OCC 
  ELSE
  ENDIF 
  BX2 X2+X3 
  RJ  XFR         TRANSFER CHARACTER STRING 
  ENDM
 TFILES   TITLE  FUNCTION PROCESSORS. 
**        FETS. 
  
          ORG    121B 
 FWA      BSS    0           DEFINE LOAD ADDRESS
  
 F        BSS    0
 TFET     FILEB  TFWB,TWBL,(FET=20B),EPR
  
 TFMSG    BSSZ   4           ERROR MESSAGE RETURN 
 TFWB     BSSZ   TWBL        BUFFER 
  
          SETEA  F+5,(42/0,18/TFMSG)
  
 I        BSS    0
 INPUT    FILEB  IBUF,101B,FET=6
  
 O        BSS    0
 OUTPUT   FILEB  OBUF,OBFL,EPR,FET=10B
  
 P        BSS    0
 POUT     FILEB  PMSG,PMSGL+1,FET=6 
          SPACE  4
**        WORKING STORAGE.
  
 LIT      CON    0           PROCESS LITERALS FLAG
 INDX     BSSZ   1           TABLE POINTER
 NARG     BSSZ   1           NUMBER OF ARGUMENTS
 SAVE     BSSZ   1           POSITION IN COMMAND
 VSNC     VFD    60/3CVSN    NON-SYMBOLIC ACCESS FLAG 
 VSNB     CON    4R 
 NABT     CON    0           NO ABORT OPTION
 USER     CON    0           SELECTED USER NUMBER 
 PSWD     CON    0           PASSWORD 
 CATG     CON    0           FILE CATEGORY
 ALAD     CON    0           ALTERNATE AUDIT ATTRIBUTE
 MODE     CON    0           FILE MODE
 USCW     CON    0           USER CONTROL WORD
 CLER     CON    0           CLEAR ERROR OPTION 
 ANCP     CON    0           CURRENT CHARGE/PROJECT NUMBER
 MCRD     CON    0           MACHINE READABLE FILE OPTION 
 TPFG     CON    0           TITLE PAGE FLAG FOR TERMINAL 
 ENTD     CON    0           ENTRY NUMBER(DISPLAY)
 LOPT     CON    0           LIST OPTION
 DTYP     CON    0           DEVICE TYPE
 PAGE     CON    0           PAGE NUMBER
 ENTN     CON    0           ENTRY NUMBER 
 SYMB     CON    0           SYMBOLIC ACCESS
 LINE     CON    LINP        LINE NUMBER
 BLNK     CON    1L          BLANK LINE 
 CODE     CON    0           AUDIT LIST CODE
 MULT     CON    0           MULTIFILE LIST IDENTIFIER
 MXBS     CON    MSBL        MAXIMUM SORT BUFFER SIZE 
 CSBS     CON    SBFL        CURRENT SORT BUFFER SIZE 
 CRFL     CON    RFL=        CURRENT FL 
 PERM     CON    0           PFN NO-OP FOR OLD *RESERVE*
 REMK     CON    0           REMARK PARAMETER FROM OLD *RESERVE*
          SPACE  4
**        TABLES. 
  
 TADM     BSS    0           TABLE OF ADMIT PARAMETERS
 S        ARG    -*,SYMB
 NA       ARG    -*,NABT
          ARG                END OF TABLE 
  
 TAMD     BSS    0           TABLE OF AMEND PARAMETERS
 S        ARG    -*,SYMB
 NA       ARG    -*,NABT
 PW       ARG    =1,PSWD,400B 
 CT       ARG    CATG,CATG
 AC       ARG    ALAD,ALAD
 M        ARG    MODE,MODE
 UC       ARG    USCW,USCW,400B,1 
 CE       ARG    -*,CLER
 AN       ARG    -*,ANCP
          ARG                END OF TABLE 
  
 TAUD     BSS    0           TABLE OF AUDIT PARAMETERS
 S        ARG    -*,SYMB
 LO       ARG    LOPT,LOPT
 UN       ARG    USER,USER,400B 
 L        ARG    O,O,400B 
 SS       ARG    MCRD,MCRD,400B 
          ARG                END OF TABLE 
  
 TREL     BSS    0           TABLE OF RELEASE PARAMETERS
 S        ARG    -*,SYMB
 NA       ARG    -*,NABT
          ARG                END OF TABLE 
  
 TRES     BSS    0           TABLE OF RESERVE PARAMETERS
 PW       ARG    =1,PSWD,400B 
 CT       ARG    CATG,CATG
 AC       ARG    ALAD,ALAD
 M        ARG    MODE,MODE
 UC       ARG    USCW,USCW,400B,1 
 NA       ARG    -*,NABT
 SS       ARG    MCRD,MCRD,400B 
 PF       ARG    PERM,PERM,400B 
 RE       ARG    REMK,REMK,400B,1 
          ARG                END OF TABLE 
  
 TFIN     BSS    0           TABLE OF FILE IDENTIFIERS
          BSSZ   14D
 TFINL    EQU    *-TFIN 
  
 TVSN     BSS    0           TABLE OF VOLUME SERIAL NUMBERS 
          BSSZ   7
 TVSNL    EQU    *-TVSN 
  
 TARG     BSS    0           ARGUMENT TABLE 
          BSSZ   63B
 TARGL    EQU    *-TARG      ARGUMENT TABLE LENGTH
  
**        DEFINE REMOVE SECURE PARAMETERS.
  
 RSP1$    BSS    0           TABLE OF KEYWORD EQUIVALENCES
  
 RSP2$    BSS    0           TABLE OF SECURE KEYWORDS 
          VFD    12/0LPW,48/ ALTERNATE USER PASSWORD
          VFD    60/0        END OF TABLE 
 ADMIT    SPACE  4,25 
***       ADMIT,TFN,USERNAM1=M1,...,USERNAMN=MN/S,NA. 
* 
*         ADMIT GRANTS PERMISSION TO USERS OTHER THAN THE FILE
*         ORIGINATOR, TO ACCESS AND EMPLOY A PRIVATE TAPE FILE. 
* 
*               TFN = TAPE FILE IDENTIFIER OR VOLUME SERIAL NUMBER. 
*               USERNAM = USER THAT WILL BE ALLOWED ACCESS. 
*               M   = MODE IN WHICH THE ALTERNATE USER CAN ACCESS.
*               S   = SYMBOLIC ACCESS.
* 
*         ENTRY     ADMIT COMMAND HAS BEEN ISSUED.
* 
*         EXIT      ADMIT(S) COMPLETED OR APPROPRIATE ERROR ISSUED. 
* 
*         CALLS  BAT, CER, PAR, USB.
* 
*         MACROS    ADMIT, MESSAGE, ENDRUN. 
  
  
 ADMIT    BSS    0
          SB1    1
          RJ     IDF         ISSUE DAYFILE MESSAGE
          SB2    CCDR        LOCATE COMMAND IMAGE 
          RJ     USB         UNPACK DATA TO STRING BUFFER 
          RJ     POP         PICK OUT *ADMIT* WORD
          NZ     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     B6,ERR1     IF NO ARGUMENTS
          SX7    1
          SA7    LIT         SET PROCESS LITERALS FLAG
          SX6    B6 
          SA6    SAVE 
          RJ     POP         PICK OUT NEXT WORD 
          NG     B5,ERR      IF ERROR ENCOUNTERED 
          SB3    X1-1R= 
          ZR     B3,ERR      IF *=*, ERROR
          SB3    B0 
          SA5    TFIN 
          RJ     PCK         STORE FILE IDENTIFIER
          NG     X2,ERR3     IF NO USERNAME SPECIFIED 
 ADM1     RJ     POP         PICK UP USERNAME 
          NZ     B5,ERR5     IF ERROR ENCOUNTERED 
          SA3    INDX 
          SB3    X3 
          SB7    ADMAL
          EQ     B3,B7,ERR4  EXCEEDED USERNAME LIMIT
          MX0    42 
          BX3    -X0*X6 
          NZ     X3,ERR5     IF USERNAME .GT. 7 CHARACTERS
          SA6    ADMA+B3
          SX6    FMRE        DEFAULT MODE READ
          SB4    X1-1R, 
          EQ     B4,ADM3     IF DELIMITER IS COMMA
          SB4    X1-1R/ 
          EQ     B4,ADM3     IF DELIMITER IS SLASH
          NG     X2,ADM3     IF NO MORE ARGUMENTS 
          SB4    X1-1R= 
          NZ     B4,ERR      IF INCORRECT DELIMITER 
          RJ     POP         PICK OUT FILE MODE 
          NZ     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     X6,ERR      IF NO ARGUMENT 
          SB3    3
          SB2    B0 
 ADM2     SA4    CNVC+B2     CONVERT MODE 
          MX0    12 
          BX4    X4*X0
          SB2    B2+B1
          GT     B2,B3,ERR7  IF INCORRECT MODE SPECIFIED
          BX4    X6-X4
          NZ     X4,ADM2     IF MODE NOT FOUND
          SB2    B2-B1
          SA4    CNVC+B2
          MX0    -12
          BX6    -X0*X4 
 ADM3     SA3    INDX 
          SB3    X3 
          SA6    ADMB+B3     SAVE FILE MODE 
          SX6    B3+B1       INCREMENT INDX 
          SA6    INDX 
          SB3    X1-1R,      CHECK DELIMITER
          ZR     B3,ADM1     IF MORE USERNAMES SPECIFIED
          NG     X2,ADM4     IF NO MORE ARGUMENTS 
          SB3    X1-1R/ 
          NZ     B3,ERR6     IF DELIMITER ERROR 
          RJ     BAT         BUILD ARGUMENT TABLE 
          SA2    BATA 
          SB4    X2 
          SA4    TARG 
          SB5    TADM 
          RJ     PAR         PROCESS REMAINING ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
          NZ     B6,ERR      IF MORE ARGUMENTS
 ADM4     SA1    SYMB 
          NZ     X1,ADM5     IF SYMBOLIC ACCESS 
          SX6    B0 
          SA6    VSNC        SET VSN ACCESS FLAG
          MX0    36 
          SA1    TFIN        GET VSN NAME 
          BX2    -X0*X1 
          SA3    VSNB 
          BX2    X2-X3
          NZ     X2,ERR2     IF VSN .GT. 6 CHARACTERS 
          BX6    X0*X1
          RJ     PVS         PAD *VSN* WITH *0* 
          SA6    TVSN 
 ADM5     SB7    B0 
          SA3    INDX 
          SB6    X3 
          SA3    VSNC 
          ZR     X3,ADM7     IF VSN SPECIFIED 
 ADM6     ADMIT  F,TFIN,,ADMA+B7,ADMB+B7
          RJ     CER         CHECK FOR RETURNED ERRORS
          SB7    B7+B1
          LT     B7,B6,ADM6  IF MORE FILE NAMES 
          EQ     ADM8        PROCESSING COMPLETED 
  
 ADM7     ADMIT  F,,TVSN,ADMA+B7,ADMB+B7
          RJ     CER         CHECK FOR RETURNED ERRORS
          SB7    B7+B1
          LT     B7,B6,ADM7  IF MORE VSNS 
 ADM8     ENDRUN
  
 ADMA     BSS    0           STORAGE FOR USERNAMES
          BSSZ   7
 ADMAL    EQU   *-ADMA
  
 ADMB     BSS    0           STORAGE FOR FILE MODES 
          BSSZ   7
 AMEND    SPACE  4,25 
***       AMEND,NFN1=OFN1,...,NFNN=OFNN/PW,CT,AC,M,UC,CE,AN,S,NA. 
* 
*         THE AMEND COMMAND ALLOWS THE ORIGINATOR OF A TAPE 
*         FILE TO AMEND SOME OF THE FILE-S PARAMETERS WITHOUT 
*         HAVING TO REWRITE THE FILE. 
* 
*               NFN = NEW TAPE FILE NAME. 
*               OFN = OLD TAPE FILE NAME OR VOLUME SERIAL NUMBER. 
*               PW = FILE PASSWORD. 
*               CT = FILE CATEGORY. 
*               AC = ALTERNATE USER AUDITABILITY. 
*               M = FILE MODE.
*               UC = USER CONTROL WORD. 
*               CE = CLEAR ERROR OPTION.
*               AN = CHANGE TO CURRENT CHARGE/PROJECT NO. 
*               S = SYMBOLIC ACCESS.
*               NA = NO ABORT OPTION. 
* 
*         ENTRY     AMEND COMMAND HAS BEEN ISSUED.
* 
*         EXIT      ALTER(S) COMPLETED OR APPROPRIATE ERROR ISSUED. 
* 
*         CALLS  BAT, CER, CNV, ESP, IDF, PAR, PCK, POP, PVT, USB.
* 
*         MACROS    AMEND, ENDRUN, MESSAGE. 
  
  
 AMEND    BSS    0
          SB1    1
          RJ     IDF         ISSUE DAYFILE MESSAGE
          SB2    CCDR        LOCATE COMMAND IMAGE 
          RJ     USB         UNPACK DATA TO STRING BUFFER 
          RJ     POP         PICK OUT *AMEND* WORD. 
          NZ     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     B6,ERR1     IF NO MORE ARGUMENTS 
          SX7    1
          SA7    LIT         SET PROCESS LITERALS FLAG
          SX6    B6 
          SA6    SAVE 
          RJ     POP         PICK OUT PARAMETER 
          NG     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     B6,ERR1     IF NO MORE ARGUMENTS 
          SA3    SAVE 
          SB6    X3 
          SB3    X1-1R= 
          ZR     B3,AMD1     IF *=* 
          RJ     PVT         PROCESS VSN/TFN LIST 
          NG     X2,ERR1     IF NO MORE ARGUMENTS 
          EQ     AMD2        PROCESS REMAINING ARGUMENTS
  
 AMD1     RJ     POP         PICK UP *NFN*
          NG     B5,ERR8     IF ERROR ENCOUNTERED 
          SB3    X1-1R= 
          NZ     B3,ERR6     IF DELIMITER NOT *=* 
          SA3    INDX 
          SB3    X3 
          SB7    AMDBL
          EQ     B3,B7,ERR9  EXCEEDED FILENAM LIMIT 
          SA5    AMDB 
          RJ     PCK         STORE FILENAM
          SX6    B6 
          SA6    SAVE 
          RJ     POP         PICK UP *OFN*
          NG     B5,ERR8     IF ERROR ENCOUNTERED 
          SA3    INDX 
          SB3    X3 
          SA5    TFIN 
          RJ     PCK         STORE FILENAM
          SX6    B3+B1
          SA6    INDX 
          ZR     B6,ERR16    IF NO MORE ARGUMENTS 
          SB3    X1-1R, 
          ZR     B3,AMD1     IF MORE FILENAMES SPECIFIED
 AMD2     SB3    X1-1R/ 
          NZ     B3,ERR6     DELIMITER ERROR
          SB3    TAMD 
          RJ     BAT         BUILD ARGUMENT TABLE 
          SA2    BATA 
          SB4    X2 
          SA4    TARG 
          SB5    TAMD 
          RJ     PAR         PROCESS REMAINING ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
          SA1    SYMB 
          NZ     X1,AMD4     IF SYMBOLIC ACCESS 
          SA1    AMDB 
          NZ     X1,ERR16    IF NEW VSN NAME SPECIFIED
          SX6    B0 
          SA6    VSNC        SET VSN ACCESS FLAG
          SA3    INDX        GET NUMBER OF VSNS 
          SB7    X3 
          SB6    B0 
          SB5    B0 
 AMD3     SA3    TFIN+B5     GET VSN
          SA1    VSNB 
          MX0    36 
          BX2    -X0*X3 
          BX2    X2-X1
          NZ     X2,ERR2     IF VSN .GT. 6 CHARACTERS 
          BX6    X0*X3
          RJ     PVS         PAD *VSN* WITH *0* 
          SA6    TVSN+B6     STORE VSN NAME 
          SB6    B6+B1
          SB5    B5+2 
          LT     B5,B7,AMD3  IF MORE VSNS TO STORE
          SX6    B6 
          SA6    INDX 
 AMD4     RJ     CNV         CONVERT PARAMETERS TO VALUES 
          SA5    PSWD        CHECK FOR SECURE PASSWORD
          SB2    X5 
          SB2    B2-B1
          NZ     B2,AMD6     IF *PW* NOT ENTERED
          MX0    42 
          BX5    X0*X5
          NZ     X5,AMD5     IF PASSWORD NOT ENTERED SECURELY 
          RJ     ESP         ENTER SECURE PASSWORD
          SA6    PSWD        SET PASSWORD 
          BX5    X6 
 AMD5     SA1    AMDA        CHECK FOR *PW=0* 
          BX3    X1-X5
          MX6    42 
          NZ     X3,AMD6     IF PW=0 WAS NOT SPECIFIED
          SA6    PSWD        NO MORE FILE PASSWORD
 AMD6     SA2    USCW 
          SA1    AMDA        CHECK FOR *UC=0* 
          BX3    X1-X2
          NZ     X3,AMD7     IF UC=0 WAS NOT SPECIFIED
          MX6    60 
          SA6    USCW 
 AMD7     SA1    CLER 
          ZR     X1,AMD8     IF CE NOT SPECIFIED
          SX6    B1 
          LX6    6-0
          SA6    F+TFCE 
 AMD8     SA1    ANCP 
          ZR     X1,AMD9     IF AN NOT SPECIFIED
          SX6    B1 
          SA2    F+TFCE 
          MX0    -6 
          BX2    X0*X2
          BX6    X6+X2
          SA6    A2 
 AMD9     SB7    B0 
          SA3    INDX 
          SB6    X3 
          SA3    VSNC 
          ZR     X3,AMD12    IF VSN SPECIFIED 
 AMD10    AMEND  F,AMDB+B7,TFIN+B7,,PSWD,CATG,MODE,USCW,ALAD
          RJ     CER         CHECK FOR RETURNED ERRORS
          ZR     X7,AMD11    IF NO ROLLOUT
          SB7    B7-B1
 AMD11    SB7    B7+2        INCREMENT FILE NAME POINTER
          LT     B7,B6,AMD10 IF MORE FILES TO AMEND 
          EQ     AMD13       PROCESSING COMPLETE
  
 AMD12    AMEND  F,,,TVSN+B7,PSWD,CATG,MODE,USCW,ALAD 
          RJ     CER         CHECK FOR RETURNED ERRORS
          SB7    B7+B1
          LT     B7,B6,AMD12 IF MORE VSNS TO AMEND
 AMD13    ENDRUN
  
  
 AMDA     CON    1L0         USED TO CHECK FOR PW=0 OPTION
 AMDB     BSS    0           STORAGE FOR NEW FILENAMES
          BSSZ   14D
 AMDBL    EQU    *-AMDB 
 AUDIT    SPACE    4,25 
***       AUDIT,TFN,LO,UN,L,SS,S. 
*         AUDIT,LO,UN,L,SS,S. 
* 
*         THE AUDIT COMMAND ENABLES A USER TO OBTAIN
*         INFORMATION ABOUT THE FILES THAT RESIDE IN HIS OR 
*         HER TAPE FILE CATALOG, OR ALTERNATE CATALOGS TO WHICH 
*         THEY HAVE BEEN ADMITTED.
* 
*               TFN = TAPE FILE NAME OR VOLUME SERIAL NUMBER. 
*               LO = LIST OPTION. 
*               UN = USERNAME.
*               L = LOCAL FILE TO RECEIVE OUTPUT. 
*               SS = MACHINE READABLE OUTPUT FILE.
*               S = SYMBOLIC ACCESS.
* 
*         ENTRY     AUDIT COMMAND HAS BEEN ISSUED.
* 
*         EXIT      TO MAIN LOOP(ADT) 
*                   FETS AND BUFFERS SET UP AND COMMAND 
*                   ARGUMENTS PROCESSED.
*                   (CODE) = LIST OPTION
*                            0 = SHORT FILE LIST
*                            1 = FULL FILE LIST 
*                            2 = SHORT ALTERNATE CATALOG LIST 
*                            3 = FULL ALTERNATE CATALOG LIST
*                            4 = SHORT ADMIT DATA LIST
*                            5 = FULL ADMIT DATA LIST 
*                   B1 = 1. 
*                   DTYP = 0 IF OUTPUT TO TERMINAL FILE.
*                   TITLE LINES PRESET
*                   TFM CALL FET PRESET.
*                   (ADTA) SET IF SELECTED ENTRY DESIRED. 
*                   (O)=0 IF L=0 IS SPECIFIED 
*                   (MCRD)=FILE NAME FOR MACHINE READABLE OUTPUT
*                   (AUDC)=0 IF NO ADMIT DATA REQUESTED 
* 
*         CALLS  ADT, BAT, PAR, PCK, POP, SFN, STF, USB.
* 
*         MACROS    GETPFP, MESSAGE, ABORT, CHARGE, PROJECT,
*                   DATE, CLOCK, USERNUM. 
  
  
 AUDIT    BSS    0           ENTRY POINT
          SB1    1
          SX6    1
          SA6    NABT        SET NO ABORT OPTION
          RJ     IDF         ISSUE DAYFILE MESSAGE
          GETPFP AUDG        GET FAMILY NAME
          SB2    CCDR        LOCATE COMMAND IMAGE 
          RJ     USB         UNPACK DATA TO STRING BUFFER 
          RJ     POP         PICK OUT *AUDIT* WORD
          NZ     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     B6,AUD6     IF NO MORE ARGUMENTS 
          SX7    1
          SA7    LIT         SET PROCESS LITERALS FLAG
          SX6    B6 
          SA6    SAVE 
          RJ     POP         PICK OUT NEXT WORD 
          NG     B5,ERR      IF ERROR ENCOUNTERED 
          SB3    X1-1R= 
          ZR     B3,AUD1     IF *=* 
          SB3    B0 
          SA5    AUDE 
          RJ     PCK         STORE TAPE FILE NAME 
          ZR     B6,AUD5     IF NO MORE ARGUMENTS 
          EQ     AUD2        PROCESS REMAINING ARGUMENTS
  
 AUD1     SA3    SAVE 
          SB6    X3 
 AUD2     RJ     BAT         BUILD ARGUMENT TABLE 
          SA2    BATA 
          SB4    X2 
          SA4    TARG 
          SB5    TAUD 
          RJ     PAR         PROCESS REMAINING ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
          SA1    USER 
          ZR     X1,AUD3     IF NO USERNAME SPECIFIED 
          MX0    42 
          BX1    -X0*X1 
          NZ     X1,ERR5     IF USER NAME TOO LONG
 AUD3     SA1    MCRD 
          ZR     X1,AUD4     IF NO SS FILE SPECIFIED
          MX0    42 
          BX1    -X0*X1 
          NZ     X1,ERR      IF SS FILENAME TOO LONG
 AUD4     SA1    AUDE 
          NZ     X1,AUD5     IF FILE NAME SPECIFIED 
          SA1    SYMB 
          NZ     X1,ERR14    IF *S* SPECIFIED, BUT NOT FILE NAME
          EQ     AUD6        CONTINUE PROCESSING
  
 AUD5     SA1    SYMB 
          NZ     X1,AUD6     IF SYMBOLIC ACCESS 
          SA1    AUDE 
          MX0    36 
          BX2    -X0*X1 
          SA3    VSNB 
          BX2    X2-X3
          NZ     X2,ERR2     IF VSN .GT. 6 CHARACTERS 
          BX6    X0*X1
          RJ     PVS         PAD *VSN* WITH *0* 
          SA6    AUDE        SET PADDED VSN 
          SA6    F+TFES      SET VSN IN FET 
 AUD6     SA1    O
          SB2    B0 
          LX1    6
          SX2    1R0
          BX6    X1-X2
          NZ     X6,AUD7     IF NOT L=0 
          SA6    A1          SET FLAG FOR NO LISTABLE OUTPUT DESIRED
          SA1    MCRD 
          ZR     X1,ADT7     IF NOT MACHINE READABLE
          EQ     AUD8        SET JOB ORIGIN 
  
 AUD7     SA1    O
          MX0    42 
          BX2    -X0*X1 
          MX0    -3 
          BX2    X0*X2
          NZ     X2,ERR      IF LIST FILENAME TOO LONG
          SX6    B1 
          BX2    X0*X1
          ZR     X2,ERR14    IF NO FILE NAME
          IX6    X6+X2
          SA6    A1 
          SX2    A1          CHECK FOR TERMINAL FILE
          RJ     STF         SET TERMINAL FILE
          SA6    DTYP        SET DEVICE TYPE FLAG (0 FOR TYPE *TT*) 
 AUD8     SA2    LOPT 
          SX4    1RM
          LX4    54 
          IX0    X4-X2
          NZ     X0,AUD9     IF NOT MULTIFILE 
          SX6    B1 
          SA6    MULT 
          SX6    1RF         CHANGE TO FULL LIST FLAG 
          LX6    54 
          SA6    LOPT 
          BX2    X6 
          SX6    FCEV        SET UP MULTIFILE HEADERS 
          SA6    HDRD+2 
          SX6    FCET 
          SA6    HDRF+2 
 AUD9     MX0    59 
          SA1    AUDL 
          SB2    B0 
          SB3    AUDLL
          SX5    B0 
 AUD10    BX4    -X0*X1      PICK SHORT LIST FLAG 
          BX1    X0*X1
          IX6    X1-X2
          ZR     X6,AUD11    IF OPTION FOUND
          SA1    A1+B1
          SB2    B2+B1
          LE     B2,B3,AUD10 IF NOT END OF TABLE
          EQ     ERR13       ISSUE ERROR MESSAGE
  
 AUD11    SA1    USER 
          SA2    AUDE 
          BX3    X2          SET SELECTED ENTRY FLAG
          SB3    AUDP        SET PROPER MODE
          SX6    B0 
          SX7    PTPK        SET SUBTITLE FLAG
          LT     B2,B3,AUD12 IF NOT ACCESS DATA REQUEST 
          SX5    B1          SET ADMIT LIST FLAG
          SX7    PTPI        SUBTITLE FLAG
          BX3    X1          SET SELECTED ENTRY FLAG
          NZ     X2,AUD13    IF FILE NAME SPECIFIED 
          EQ     ERR14       ISSUE ERROR MESSAGE
  
 AUD12    ZR     X1,AUD14    IF USER NUMBER NOT SPECIFIED 
          SX6    B1+B1       ADVANCE MODE 
 AUD13    SA7    PTPH        SET SUBTITLE FLAG
 AUD14    SX6    X6+B2
          SA6    CODE 
          ZR     X4,AUD15    IF NOT SHORT FILE LIST 
          BX6    X3          SET SELECTIVE ENTRY FLAG 
          SA6    ADTA 
          SA3    AUDE+B1
          BX6    X3 
          SA6    ADTA+B1
  
*         SET *TFM* FET PARAMETERS. 
  
 AUD15    ZR     X2,AUD16    IF FILENAME NOT SPECIFIED
          MX0    42 
          BX6    X2 
          SA6    PTPJ 
          SA6    F+TFID 
          SA2    A2+B1
          BX6    X0*X2
          SA6    PTPJ+B1     SET FILE NAME IN SUBTITLE LINE 
          SA6    F+TFSQ 
          BX6    X5 
          SA6    AUDC        SET ADMIT FLAG 
 AUD16    SA1    USER 
          BX7    X0*X1       SET OPTIONAL USER NUMBER 
          SA7    F+TFUN 
          SA7    PTPL 
          SA1    CODE        SET TFM AUDIT CODE 
          SB2    X1 
          SB3    3
          GT     B2,B3,AUD17 IF ADMIT REQUEST 
          SA2    AUDE 
          ZR     X2,AUD19    IF NOT SELECTIVE REQUEST 
          SX1    7
          EQ     AUD19       SET CODE IN FET
  
 AUD17    SA2    USER 
          ZR     X2,AUD19    IF NO USERNAME SPECIFIED 
          SA4    CODE 
          SX4    X4-5 
          ZR     X4,AUD18    IF NOT SHORT ADMIT LIST
          BX1    X2 
          RJ     SFN         SPACE FILL USER NAME 
          SA6    ADTA 
          BX6    X6-X6
          SA6    ADTA+B1     CLEAR SECOND WORD
 AUD18    SX1    8
 AUD19    SA2    X1+AUDD
          BX6    X2 
          SA6    F+TFPW      SET AUDIT TYPE CODE IN FET 
          SA1    AUDG        GET FAMILY NAME
          BX6    X1 
          SX4    3RFM/
          LX6    42 
          LX4    42 
          BX1    X6+X4
          RJ     SFN         SPACE FILL NAME
          SA6    PTPD 
          SA1    MCRD 
          ZR     X1,ADT      IF NOT MACHINE READABLE
          DATE   PTPE 
          CLOCK  PTPF 
          USERNUM CUSR       GET CURRENT USERNAME 
          SA1    USER 
          ZR     X1,ADT      IF NOT ALTERNATE USER
          BX6    X1 
          SA6    CUSR        SET ALTERNATE USERNAME 
          JP     ADT         RETURN TO MAIN LOOP
  
 AUDC     CON    0
  
 AUDD     BSS    0           TFM AUDIT CODES
          LOC    0
          CON    FCST 
          CON    FCST 
          CON    FCST 
          CON    FCST 
          CON    FAST 
          CON    FAST 
          CON    FCST 
          CON    SCST 
          CON    SAST 
          LOC    *O 
  
 AUDE     BSSZ   2           FILE IDENTIFIER
  
 AUDG     BSS    3           *GETPFP* PARAMETER BLOCK 
  
**        LIST OPTIONS
*         BIT 0 SET IF SHORT LIST OPTION. 
  
 AUDL     BSS    0           LIST OPTIONS 
          LOC    0
          VFD    59/0,1/1    NORMAL CATALOGS
          CON    1LF
          CON    0           ALTERNATE CATALOGS 
          CON    0
  
 AUDP     EQU    *           LIMIT OF CATALOG OPTIONS 
  
          VFD    6/0LP,54/1  ADMIT DATA 
          CON    2LFP 
 AUDLL    EQU    *
          LOC    *O 
  
 RELEASE  SPACE  4,25 
***       RELEASE,TFN1,TFN2,...,TFNN/S,NA.
*         RELEASE,VSN1,VSN2,...,VSNN/NA.
* 
*         RELEASE LOGICAL TAPE FILE OR VSN. 
* 
*                 TFN = LOGICAL TAPE FILE NAME. 
*                 VSN = FIRST-REEL VOLUME SERIAL NUMBER.
*                 NA  = NO ABORT OPTION IF ERROR ENCOUNTERED. 
*                 S   = SYMBOLIC ACCESS.
* 
* 
*         CALLS  BAT, CER, PAR, POP, PVT, USB.
* 
*         MACROS     ENDRUN, MESSAGE, RELEASE.
  
  
 RELEASE  BSS    0
          SB1    1
          RJ     IDF         ISSUE DAYFILE MESSAGE
          SB2    CCDR        LOCATE COMMAND IMAGE 
          RJ     USB         UNPACK DATA TO STRING BUFFER 
          RJ     POP         PICK OUT *RELEASE* WORD
          NZ     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     B6,ERR1     IF NO MORE ARGUMENTS 
          SX7    1
          SA7    LIT         SET PROCESS LITERALS FLAG
          SX6    B6 
          SA6    SAVE 
          RJ     PVT         PROCESS TFN/VSN LIST 
          NG     X2,REL1     IF NO MORE ARGUMENTS 
          SB3    X1-1R/ 
          NZ     B3,ERR6     ERROR IN DELIMITER 
          RJ     BAT         BUILD ARGUMENT TABLE 
          SA2    BATA 
          SB4    X2 
          SA4    TARG 
          SB5    TREL 
          RJ     PAR         PROCESS REMAINING ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
          NZ     B6,ERR      IF MORE ARGUMENTS
 REL1     SA1    SYMB 
          NZ     X1,REL3     IF SYMBOLIC ACCESS 
          SA1    AMDB 
          NZ     X1,ERR16    IF NEW VSN NAME SPECIFIED
          SX6    B0 
          SA6    VSNC        SET VSN ACCESS FLAG
          SA3    INDX        GET NUMBER OF VSNS 
          SB7    X3 
          SB6    B0 
          SB5    B0 
 REL2     SA3    TFIN+B5     GET VSN
          SA1    VSNB 
          MX0    36 
          BX2    -X0*X3 
          BX2    X2-X1
          NZ     X2,ERR2     IF VSN .GT. 6 CHARACTERS 
          BX6    X0*X3
          RJ     PVS         PAD *VSN* WITH *0* 
          SA6    TVSN+B6     STORE VSN NAME 
          SB6    B6+B1
          SB5    B5+2 
          LT     B5,B7,REL2  IF MORE VSNS TO STORE
          SX6    B6 
          SA6    INDX        CHANGE INDX FOR VSNS 
 REL3     SB7    B0 
          SA3    INDX 
          SB6    X3 
          SA3    VSNC 
          ZR     X3,REL6     IF VSN SPECIFIED 
 REL4     RELEASE  F,TFIN+B7
          RJ     CER         CHECK FOR RETURNED ERRORS
          ZR     X7,REL5     IF NO ROLLOUT
          SB7    B7-B1
 REL5     SB7    B7+2 
          LT     B7,B6,REL4  IF MORE TO RELEASE 
          EQ     REL7        PROCESSING COMPLETE
  
 REL6     RELEASE F,,TVSN+B7
          RJ     CER         CHECK FOR RETURNED ERRORS
          SB7    B7+B1
          LT     B7,B6,REL6  IF MORE TO RELEASE 
 REL7     ENDRUN
 RESERVE  SPACE  4,25 
***       RESERVE,LFN1,LFN2,...,LFNN/SS,PW,CT,AC,M,UC,NA. 
* 
*         RESERVE SCRATCH TAPE. 
* 
*                 LFN = LOCAL FILE NAME OF TAPE FILE. 
*                 PW  = FILE PASSWORD.
*                 SS  = MACHINE READABLE OUTPUT FILE. 
*                 CT  = FILE CATEGORY.
*                 AC  = AUDIT LISTABILITY BY ALTERNATE USERS. 
*                 M   = FILE ACCESS MODE. 
*                 UC  = USER CONTROL WORD.
*                 NA  = NO ABORT IF ERROR ENCOUNTERED.
* 
*                 DEFAULT VALUES. 
*                             PW = 0. NO PASSWORD 
*                             CT = P. PRIVATE 
*                             AC = N. ALTERNATE USER CANNOT 
*                                      OBTAIN AUDIT INFORMATION 
*                             M  = R. READ ONLY ACCESS
*                             UC = 0. NO USER CONTROL WORD. 
* 
*         CALLS     ARG, BAT, CER, CNV, ESP, POP, PRA, USB. 
* 
*         MACROS     RESERVE, MESSAGE, ENDRUN.
  
 RESERVE  BSS    0
          SB1    1
          RJ     IDF         ISSUE DAYFILE MESSAGE
          SB2    CCDR        LOCATE COMMAND IMAGE 
          RJ     USB         UNPACK DATA TO STRING BUFFER 
          RJ     POP         PICK OUT *RESERVE* WORD
          NG     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     B6,ERR1     IF NO ARGUMENTS
          SX7    1
          SA7    LIT         SET PROCESS LITERALS FLAG
 RES1     RJ     POP         PICK OUT LFN NAME
          NG     B5,ERR8     IF ERROR ENCOUNTERED 
          SA3    INDX 
          SB3    X3 
          SB7    TVSNL
          EQ     B3,B7,ERR9  EXCEEDED LFN LIMIT 
          MX0    42 
          BX3    -X0*X6 
          NZ     X3,ERR8     IF LFN .GT. 7 CHARACTERS 
          SA6    TVSN+B3     STORE LFN NAME 
          SB3    B3+B1       INCREMENT LFN TABLE POINTER
          SX6    B3 
          SA6    INDX 
          NG     X2,RES5     IF NO MORE ARGUMENTS 
          SB3    X1-1R,      CHECK FOR COMMA
          ZR     B3,RES1     GET NEXT LFN NAME
          SB3    X1-1R/ 
          NZ     B3,ERR6     IF DELIMITER ERROR 
          RJ     BAT         BUILD ARGUMENT TABLE 
          SA2    BATA 
          SB4    X2 
          SA4    TARG 
          SB5    TRES 
          RJ     PAR         PROCESS ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
          RJ     CNV         CONVERT PARAMETER TO VALUE 
          SA5   REMK
          ZR    X5,RES2      IF NO USER REMARK SPECIFIED
          MESSAGE (=C*REMARK= NOT SUPPORTED AT 1.4D, USE UC=.*),0 
          SA4   USCW
          NZ    X4,ERR       IF REM= AND UC= SPECIFIED
          BX6   X5
          SA6   USCW
 RES2     SA5   PERM
          ZR    X5,RES3      IF PFN= NOT SPECIFIED
          MESSAGE (=C*PFN= NOT SUPPORTED AT 1.4D, IS NOW A NO-OP.*),0 
 RES3     SA5    PSWD        CHECK FOR SECURE PASSWORD
          SB2    X5 
          SB2    B2-B1
          NZ     B2,RES4     IF *PW* NOT ENTERED
          MX0    42 
          BX5    X0*X5
          NZ     X5,RES4     IF PASSWORD NOT ENTERED SECURELY 
          RJ     ESP         ENTER SECURE PASSWORD
          SA6    PSWD        SET PASSWORD 
 RES4     SA1    MCRD        CHECK MACHINE READABLE FILE OPTION 
          ZR     X1,RES5     IF NOT SPECIFIED 
          SA1    MCRD        SET MACHINE READABLE FILE NAME 
          SX2    3
          BX6    X1+X2
          SA6    O
          SA1    O+1         SET OUTPUT BUFFER EMPTY
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          SX2    O           SET DEVICE TYPE
          RJ     STF         SET TERMINAL FILE
          SA6    DTYP 
          GETPFP AUDG        GET FAMILY NAME
          USERNUM CUSR       GET CURRENT USER 
 RES5     SB7    B0 
          SA3    INDX 
          SB6    X3 
 RES6     RESERVE  F,TVSN+B7,PSWD,CATG,ALAD,MODE,USCW 
          RJ     CER         CHECK FOR RETURNED ERRORS
          SB7    B7+B1
          NZ     X7,RES6     IF ROLLABLE ERROR OCCURRED 
          SA1    MCRD 
          ZR     X1,RES9     IF NO MACHINE READABLE FILE
          SX6    B7 
          SA6    RESB        SAVE LFN POINTER 
          SA1    F           RESET INPUT FET(1) 
          MX0    51 
          BX1    -X0*X1 
          MX0    -3 
          BX6    X0*X1
          SA6    A1 
          MX0    -18
          SA1    A1+B1       GET *FIRST* POINTER
          BX6    -X0*X1 
          SA6    A1+B1       SET IN = FIRST 
          SA6    A6+B1       SET OUT = FIRST
          SX6    B0          INITIALIZE INPUT FET(6)
          SA6    F+TFRR 
          SA6    F+TFPW 
          SA6    F+TFUC 
          SB7    B7-B1
 RES7     GETVSN F,TVSN+B7   GET TAPE CATALOG IMAGE 
          RJ     CER         CHECK FOR RETURNED ERRORS
          SB7    B7+1 
          NZ     X7,RES7     IF ROLLABLE ERROR OCCURRED 
          SA1    F+2
          SB3    X1          (B3) = IN
          SA1    F+3
          SB4    X1          (B4) = OUT 
          EQ     B3,B4,ERR17 IF OUT = IN, EMPTY CATALOG 
          MOVE   TWBL,TFWB,CBUF 
          SA1    RESA 
          SX6    B1 
          SA6    A1          SET RESERVE SS FLAG
          JP     MRF4        GENERATE MACHINE READABLE FILE 
  
 RES8     SA1    RESB        GET LFN POINTER
          SB7    X1 
          SA1    INDX        GET NUMBER OF LFN(S) 
          SB6    X1 
 RES9     LT     B7,B6,RES6  IF MORE TO RESERVE 
          SA1    MCRD 
          ZR     X1,RES10    IF NO MACHINE READABLE FILE
          WRITER O           FLUSH BUFFER 
 RES10    ENDRUN
  
 RESA     CON    0            MACHINE READABLE FLAG 
 RESB     CON    0            LFN POINTER 
 TMSDEF   SPACE  4,20 
***       TMSDEF,TO=OPTION. 
* 
*         DEFINE DEFAULT *TMS* PARAMETERS FOR *LABEL/REQUEST*.
* 
*                TO = DEFAULT TAPE OPTIONS.  STRING CONTAINING ONE OR 
*                     MORE OF THE FOLLOWING CHARACTERS -
*                     *T* IF DEFAULT TO *TO=T* (*TMS* PROCESSING).
*                     *F* IF DEFAULT TO *TO=F* (NON-*TMS* PROCESSING).
*                     *C* IF DEFAULT TO *TO=C* (CHECK FOR CATALOG 
*                         ERROR.) 
*                     *E* IF DEFAULT TO *TO=E* (IGNORE CATALOG ERROR.)
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  ARM, IDF, POP, USB.
* 
*         MACROS ENDRUN, SYSTEM.
  
  
 TMSDEF   SB1    1           ENTRY
          RJ     IDF         ISSUE COMMAND TO DAYFILE 
          SB2    CCDR 
          RJ     USB         UNPACK STRING BUFFER 
          RJ     POP         PICK OFF PARAMETER 
          NG     B5,ERR      IF ARGUMENT ERROR
          ZR     B6,TMD5     IF NO ARGUMENTS
          SB3    TMDA 
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
  
*         PROCESS *TO* PARAMETER. 
  
          SYSTEM SFM,R,TMDD,GTSF*100B  GET TMS STATUS 
          SB2    TMDB 
          RJ     USB         UNPACK STRING BUFFER 
          SX6    B0          FLAG LAST OPTION 
          SA6    B7+B1
          SA1    B6          GET FIRST COMMAND OPTION 
          MX0    -12
          SA3    TMDD        GET DEFAULT OPTIONS
          SX7    3
          BX7    X7-X3
 TMD1     ZR     X1,TMD4     IF NO MORE OPTIONS 
          SA2    TMDC        GET FIRST OPTION IN TABLE
 TMD2     ZR     X2,ERR      IF UNKNOWN OPTION
          BX6    -X0*X2 
          BX6    X6-X1
          ZR     X6,TMD3     IF OPTIONS MATCH 
          SA2    A2+B1
          EQ     TMD2        CHECK NEXT OPTION IN TABLE 
  
 TMD3     LX2    18          GET SHIFT COUNT
          SB2    X2 
          LX2    12          GET SET/CLEAR STATUS 
          BX2    -X0*X2 
          SX6    B1 
          LX2    B2          SET/CLEAR DEFAULT OPTION 
          LX6    B2 
          BX7    -X6*X7 
          BX7    X7+X2
          SA1    A1+B1
          EQ     TMD1        CHECK NEXT OPTION ON COMMAND 
  
 TMD4     SA7    A3          SET DEFAULT TAPE OPTION
          SYSTEM TFU,R,TMDD,/TFU/STOF*100B
 TMD5     ENDRUN             TERMINATE PROGRAM
  
 TMDA     BSS    0           *TMSDEF* ARGUMENT TABLE
 TO       ARG    TMDB,TMDB,400B  TAPE OPTION
          CON    0           END OF TABLE 
  
 TMDB     CON    0           DEFAULT TAPE OPTIONS 
  
 TMDC     BSS    0           TABLE OF VALID TAPE OPTIONS
          VFD    18/0,12/0,30/1RF  BIT POSITION 0, CLEAR BIT, *TO=F*
          VFD    18/0,12/1,30/1RT  BIT POSITION 0, SET BIT, *TO=T*
          VFD    18/1,12/0,30/1RE  BIT POSITION 1, CLEAR BIT, *TO=E*
          VFD    18/1,12/1,30/1RC  BIT POSITION 1, SET BIT, *TO=C*
          CON    0           END OF TABLE 
  
 TMDD     CON    0           DEFAULT TAPE OPTIONS FOR *TFU* CALL
          TITLE  AUDIT ROUTINES.
 ADT      SPACE  4,25 
**        ADT - AUDIT MAIN CONTROL ROUTINE. 
* 
*         ENTRY     (CODE) = CODE FOR THE TYPE OF LIST. 
*                   (MCRD) = FILE NAME FOR MACHINE READABLE OUTPUT. 
*                   (ADTA) =  SET IF SELECTED ENTRY DESIRED.
* 
*         EXIT      TO APPROPRIATE LIST ROUTINE.
* 
*         USES      ALL.
* 
*         CALLS     CBE, CER, CSU, FCB, SFN.
* 
*         MACROS    AUDIT, ENDRUN, MESSAGE, WRITEC, WRITER. 
  
  
 ADT      BSS    0           ENTRY
          SA1    O
          ZR     X1,MRF      IF LISTABLE OUTPUT NOT REQUESTED 
 ADT0     AUDIT  F
          RJ     CER         CHECK FOR RETURNED ERRORS
          NZ     X7,ADT0     IF ROLLABLE ERROR OCCURRED 
          SA1    F+2
          SB3    X1          (B3) = IN
          SA1    F+3
          SB4    X1          (B4) = OUT 
          EQ     B3,B4,ERR17 IF OUT = IN, PP ERROR
          SA1    ADTA 
          NZ     X1,ADT8     IF SELECTED FILE LIST
          RJ     CSU         CHECK FOR SPECIAL USER 
 ADT1     SA2    CODE        GET LIST CODE
          SA2    X2+ADTB
          SB2    X2 
          JP     B2          PROCESS LIST OPTION
  
 ADT2     RJ     FCB         FILL CATALOG BUFFER
          NG     X6,ADT6     IF ERROR RETURN STATUS 
          NZ     X6,ADT1     IF MORE CATALOGS 
 ADT3     SA1    MCRD 
          NZ     X1,ADT12    IF MACHINE READABLE OPTION 
 ADT4     SA1    DTYP 
          ZR     X1,ADT5     IF TERMINAL FILE 
          EQ     ADT6 
  
 ADT5     MESSAGE (=C**),1
 ADT6     WRITER O           FLUSH OUTPUT 
 ADT7     ENDRUN
 ADT8     BX6    X1 
          RJ     CBE         CLEAR BLANKS FROM WORD 
          SA6    ADTA 
          SA1    ADTA+B1
          BX6    X1 
          RJ     CBE         CLEAR BLANKS FROM WORD 
          SA6    ADTA+B1
          RJ     SVM          SET VARIABLE MESSAGE
          SA1    MCRD 
          NZ     X1,ADT9     IF MACHINE READABLE FILE 
          SA1    DTYP 
          ZR     X1,ADT11    IF TERMINAL FILE 
          MESSAGE ADTA,3     *(ENTRY) FOUND.* 
          EQ     ADT7 
  
  
 ADT9     SA1    DTYP 
          ZR     X1,ADT10    IF TERMINAL FILE 
          MESSAGE ADTA,3     *(ENTRY) FOUND.* 
          EQ     MRF         GENERATE THE MACHINE READABLE FILE 
  
 ADT10    WRITEC O,ADTA 
          MESSAGE (=C**),1   CLEAR MESSAGE BUFFER 
          EQ     ADT12       FLUSH OUTPUT BUFFER
  
 ADT11    WRITEC O,ADTA 
          EQ     ADT5 
  
 ADT12    WRITER O           FLUSH OUTPUT 
          EQ     MRF         MACHINE READABLE FILE
  
  
 ADTA     BSSZ   4           SELECTED ENTRY 
  
 ADTB     BSS    0           TABLE OF LIST OPTIONS
          LOC    0
          CON    SSL         SHORT SORTED FILE LIST 
          CON    FFL         FULL FILE LIST 
          CON    SSL         SHORT SORTED ALTERNATE FILE LIST 
          CON    FFL         FULL ALTERNATE FILE LIST 
          CON    SAD         SHORT ADMIT DATA LIST
          CON    FAD         FULL LIST OF ADMIT DATA
          CON    MRF         MACHINE READABLE FILE
          LOC    *O 
  
  
 ADTC     BSS    0           TABLE OF OVERFLOW PROCESSORS 
          LOC    0
          CON    SFL         SHORT FILE LIST
          CON    FFL         FULL FILE LIST 
          CON    SFL         SHORT ALTERNATE FILE LIST
          CON    FFL         FULL ALTERNATE FILE LIST 
          CON    SAD         SHORT ADMIT DATA LIST
          CON    FAD         FULL LIST OF ADMIT DATA
          LOC    *O 
  
 FAD      SPACE  4,25 
**        FAD - FULL LIST OF ADMIT DATA 
* 
*         THIS ROUTINE PROCESSES THE *LO=FP* AUDIT LIST OPTION. 
*         FAD GENERATES OUTPUT INFORMATION ABOUT THE ALTERNATE
*         USERS WHO HAVE ACCESSED A SPECIFIC FILE.  THE LIST
*         INDICATES HOW MANY TIMES A SPECIFIC ALTERNATE USER
*         HAS ACCESSED THE FILE, WHEN THE LAST ACCESS WAS 
*         PERFORMED, AND THE MODE IN WHICH IT CAN BE ACCESSED 
*         BY THAT USER.  THIS ROUTINE IS CALLED BY *ADT*. 
* 
*         ENTRY  THE AUDIT COMMAND HAS BEEN CRACKED 
*                AND PARAMETERS ARE STORED. 
* 
*         EXIT   OUTPUT LIST IS COMPLETED.
*                RETURN TO MAIN LOOP (ADT). 
* 
*         USES   ALL. 
* 
*         CALLS  AEN, ALN, CDD, CDT, FBA, SFN.
* 
*         MACROS WRITEC, WRITEH.
  
  
 FAD      BSS    0           ENTRY
          RJ     FBA         FILL BUFFER FOR ADMIT LIST 
          ZR     X6,FAD1     IF END OF BUFFER 
          RJ     AEN         ADVANCE ENTRY NUMBER 
          SB2    B1          ADVANCE LINE NUMBER BY 1 
          RJ     ALN         ADVANCE LINE NUMBER
          MX0    42          PICK USER NUMBER 
          SA5    CBUF+AEUN
          BX1    X0*X5
          RJ     SFN         SPACE FILL NAME
          SA1    ENTD        SET USER NUMBER COUNT
          MX0    30 
          LX1    30 
          BX1    X0*X1       PICK FIRST PART OF USER NUMBER 
          LX6    24 
          BX7    -X0*X6 
          BX7    X7+X1
          SA7    LBUF 
          SA5    CBUF+AEAC   SET USER PERMISSION
          MX0    4
          LX0    40 
          BX1    X0*X5
          LX1    24 
          SB2    X1 
          SB3    3
          GT     B2,B3,FAD2  IF SPECIAL PERMISSION
          SA1    FADB+X1
          LX1    35-59
          MX0    18 
          BX6    X0*X6       PICK LAST 3 CHAR OF USER NUMBER
          BX1    -X0*X1      MERGE WITH PERMISSION
          BX6    X6+X1
          SA6    LBUF+1 
          MX0    18          CONVERT ACCESS COUNT 
          BX1    X0*X5
          LX1    18 
          RJ     CDD         CONVERT TO DECIMAL 
          SA6    LBUF+2      SET ACCESS COUNT/ADMIT TYPE
          BX3    X5 
          RJ     CDT         CONVERT TIME AND DATE
          SA6    LBUF+3 
          BX7    X5 
          SA7    LBUF+4 
          WRITEC O,LBUF 
          EQ     FAD
  
 FAD1     SA1    ENTN        NUMBER OF ENTRIES
          RJ     CDD         CONVERT TO DISPLAY CODE
          MX0    -18
          BX6    -X0*X6 
          LX6    36D
          MX0    -18
          LX0    36D
          SA2    FADA        SET COMPLETION MESSAGE 
          BX2    X0*X2
          BX6    X6+X2
          SA6    FADA 
          SB2    3
          RJ     ALN         ADVANCE LINE NUMBER
          WRITEC O,BLNK 
          WRITEH O,FADA,FADAL 
          WRITEC O,BLNK 
          EQ     ADT2        RETURN TO MAIN LOOP
  
 FAD2     SA1    ENTN        GET ENTRY NUMBER 
          SX6    X1-1 
          SA6    A1          RESET ENTRY NUMBER 
          SA1    LINE 
          SX6    X1-1 
          SA6    A1          RESET LINE NUMBER
          EQ     FAD         PICK UP NEXT ADMIT ENTRY 
  
 FADA     DATA   C* XXX USER(S).* 
 FADAL    EQU    *-FADA 
  
 FADB     BSS    0           DISPLAY CODE OF PERMISSION TYPES 
          LOC    0
          CON    10H   IMP
          CON    10H  READ
          CON    10H WRITE
          CON    10H  NULL
          LOC    *O 
 FFL      SPACE  4,20 
**        FFL - FULL LISTING
* 
*         THIS ROUTINE PROCESSES THE *LO=F* AUDIT LIST OPTION.
*         *FFL* GENERATES PERTINENT INFORMATION ABOUT EACH FILE IN
*         THE CATALOG BEING INTERROGATED.  THIS  ROUTINE IS 
*         CALLED BY *ADT*.
* 
*         ENTRY  AUDIT COMMAND HAS BEEN CRACKED AND PARAMETERS
*                 HAVE BEEN STORED. 
* 
*         EXIT    LIST IS GENERATED, THEN BACK TO *ADT*.
* 
*         USES    ALL.
* 
*         CALLS   AEN, ALN, FCB, SCB, SFN.
* 
*         MACROS  EDCAT, WRITEH, WRITEC.
  
  
 FFL      BSS    0           ENTRY
          SB2    B1          SET LIST FLAG
          RJ     FCB         FILL BUFFER FOR FULL LIST
          ZR     X6,FFL14    IF END OF INFORMATION
          RJ     AEN         ADVANCE ENTRY NUMBER 
          SB2    CHDR 
          SA5    MULT        MULTIFILE LIST INDICATOR 
          ZR     X5,FFL1     IF NOT MULTIFILE 
          SB2    B2+1 
 FFL1     RJ     ALN         ADVANCE LINE NUMBER
          SA1    ENTN 
          EDCAT  CBUF,LBUF,X1,B1
          WRITEH O,LBUF,NWRD           FIRST LINE 
          WRITEH O,LBUF+NWRD,NWRD      SECOND LINE
          SA5    MULT        MULTIFILE LIST INDICATOR 
          ZR     X5,FFL2     IF NOT MULTIFILE 
          WRITEH O,LBUF+NWRD*2,NWRD    OPTIONAL LINE
 FFL2     SA1    CBUF+TCEL+1
          MX0    -18
          BX1    -X0*X1 
          SX0    TVVS        CHECK SITE STATUS
          BX0    X0*X1
          ZR     X0,FFL3     IF SITE NOT SET SKIP 
          SB2    1
          RJ     ALN         ADVANCE LINE NUMBER
          WRITEH O,FFLD,FFLDL OPTIONAL LINE 
 FFL3     SA1    CBUF+TCEL+1
          MX0    -18
          BX1    -X0*X1      GET VSN STATUS FLAG
          SX0    RTVS        CHECK RESERVE STATUS 
          BX0    X0*X1
          NZ     X0,FFL4     IF RESERVED SKIP 
          SB2    1
          RJ     ALN
          WRITEH O,FFLE,FFLEL OPTIONAL LINE 
 FFL4     SA1    CBUF+CEST
          LX1    59-10
          PL     X1,FFL5     IF RECOVER NOT SET 
          SB2    1
          RJ     ALN
          WRITEH O,FFLF,FFLFL OPTIONAL LINE 
 FFL5     SA1    CBUF+CEST
          LX1    59-1 
          PL     X1,FFL6     IF ERROR NOT SET 
          SB2    1
          RJ     ALN
          WRITEH O,FFLG,FFLGL OPTIONAL LINE 
  
*         GENERATE VSN OUTPUT LINES 
  
 FFL6     SA2    FCBA 
          SB3    B0 
          SA1    CBUF+TCEL
 FFL7     MX0    36 
          BX1    X1*X0
          BX3    X1-X2
          ZR     X3,FFL8     IF EOF 
          RJ     SFN         SPACE FILL VSN 
          SA6    FFLT+B3     STORE VSN
          SA1    A1+TSVL
          SB3    B3+B1
          EQ     FFL7        GET NEXT VSN 
  
 FFL8     ZR     B3,FFL13    IF NO VSN ENTRIES
          SX6    B3 
          SA6    FFLN        SAVE NO. OF VSNS TO BE WRITTEN 
          SX6    B0 
          SA6    FFLC 
 FFL9     SB2    B1 
          RJ     ALN         ADVANCE LINE NUMBER
          SA2    FFLC 
          SA3    X2 
          SB2    8
          SB6    B0 
          SB7    LBUF 
          SA2    FCEB 
          BX6    X2 
 FFL10    SA6    LBUF+B2     BLANK FILL THE BUFFER
          SB2    B2-B1
          PL     B2,FFL10 
 FFL11    SA1    FFLT+A3
          BX6    X1 
          SB3    VSN0+B6
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SB6    B6+B1
          SA3    A3+B1
          SB4    A3 
          SA1    FFLN 
          SB2    X1 
          EQ     B4,B2,FFL12 IF END OF VSN LIST 
          SB3    8
          NE     B6,B3,FFL11 IF LINE BUFFER IS NOT FULL 
          SX6    A3 
          SA6    FFLC        SAVE FFLT POINTER
          WRITEH O,LBUF,7 
          EQ     FFL9        GENERATE NEXT OUTPUT LINE
  
 FFL12    WRITEH O,LBUF,7 
          WRITEC O,BLNK 
          EQ     FFL         LOOP FOR NEXT CATALOG ENTRY
  
 FFL13    SB2    2
          RJ     ALN         ADVANCE LINE NUMBER
          WRITEH O,FFLB,FFLBL 
          WRITEC O,BLNK 
          EQ     FFL         LOOP FOR NEXT CATALOG ENTRY
  
 FFL14    SA1    ENTN        NUMBER OF TAPE FILES 
          RJ     CDD         CONVERT TO DISPLAY CODE
          MX0    -24         SAVE 4 DIGITS
          BX6    -X0*X6 
          LX6    30 
          LX0    30 
          SA2    FFLA        GENERATE TERMINATION MESSAGE 
          BX2    X0*X2
          BX6    X6+X2
          SA6    FFLA 
          SB2    2
          RJ     ALN         ADVANCE LINE NUMBER
          WRITEH O,FFLA,FFLAL 
          WRITEC O,BLNK 
          EQ     ADT3        RETURN TO MAIN LOOP
  
 FFLA     DATA   C* XXXX TAPE FILE(S).* 
 FFLAL    EQU    *-FFLA 
 FFLB     DATA   C*              NO VSN ENTRIES.* 
 FFLBL    EQU    *-FFLB 
 FFLC     CON    0           FFLT POINTER 
 FFLD     DATA   C/  *** TAPE FILE IS OFF-SITE ***/ 
 FFLDL    EQU    *-FFLD 
 FFLE     DATA   C/  *** TAPE FILE NOT YET RESERVED ***/
 FFLEL    EQU    *-FFLE 
 FFLF     DATA   C/  *** TAPE FILE CATALOG RECOVERED ***/ 
 FFLFL    EQU    *-FFLF 
 FFLG     DATA   C/  *** TAPE FILE CATALOG ERROR SET ***/ 
 FFLGL    EQU    *-FFLG 
 FFLN     CON    0           NUMBER OF VSNS 
 FFLT     BSSZ   63D         MAX. NUMBER OF VSNS
  
*         VSN LINE DEFINITION TABLE 
  
 VSNS     EQU    0
 VSN0     CFORM  VSNS+14,6
          CFORM  VSNS+21,6
          CFORM  VSNS+28,6
          CFORM  VSNS+35,6
          CFORM  VSNS+42,6
          CFORM  VSNS+49,6
          CFORM  VSNS+56,6
          CFORM  VSNS+63,6
 MRF      SPACE  4,25 
**        MRF - MACHINE READABLE FILE.
* 
*         *MRF* GENERATES THE MACHINE READABLE FILE SPECIFIED BY THE
*         *SS=* OPTION ON THE AUDIT COMMAND.  THIS ROUTINE IS 
*         CALLED BY *ADT*.
* 
*         ENTRY  AUDIT COMMAND IS CRACKED AND PARAMETERS STORED.
*                 (AUDC) = 0 IF NO ADMIT DATA REQUESTED.
*                 (MCRD) =  FILE NAME FOR MACHINE READABLE OUTPUT.
* 
*         EXIT    MACHINE READABLE FILE GENERATED.
* 
*         USES    ALL.
* 
*         CALLS   CBE, CDD, EDT, FBA, FCB, MCS, SFN, STF, ZFD.
* 
*         MACROS  RECALL, WRITEC. 
  
  
 MRF      BSS    0
          SA1    F           RESET FET(1) 
          MX0    51 
          BX1    -X0*X1 
          MX0    -3 
          BX6    X0*X1
          SA6    A1 
          MX0    -18
          SA1    A1+B1       GET *FIRST* POINTER
          BX6    -X0*X1 
          SA6    A1+B1       SET IN = FIRST 
          SA6    A6+B1       SET OUT = FIRST
          SX6    B0          INITIALIZE INPUT FET(6)
          SA6    F+TFRR 
          SA1    AUDC        INSURE ADMIT FLAG OFF
          ZR     X1,MRF1     ADMIT DATA NOT REQUESTED 
          BX6    X6-X6
          SA6    F+TFUN 
          SX6    SCST 
          SA6    F+TFPW 
 MRF1     SA1    O
          ZR     X1,MRF2     IF NO NEED TO WAIT 
          RECALL O           WAIT FOR I/O COMPLETION
 MRF2     SA1    MCRD        SET MACHINE READABLE FILE NAME 
          SX2    3
          BX6    X1+X2
          SA6    O
          SA1    O+1         SET OUTPUT BUFFER EMPTY
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          SX2    O           SET DEVICE TYPE
          RJ     STF         SET TERMINAL FILE
          SA6    DTYP 
 MRF3     SA1    RESA        CHECK FOR RESERVE SS FILE REQUEST
          NZ     X1,RES8     IF RESERVE REQUEST, RETURN 
          SB2    B1          SET LIST FLAG
          RJ     FCB         FILL BUFFER FOR FULL LIST
          ZR     X6,ADT4     EXIT 
 MRF4     SA1    AUDG        GET FAMILY NAME
          RJ     SFN         SPACE FILL NAME
          SA6    AUDG 
          SA1    CUSR        GET USER NAME
          RJ     SFN         SPACE FILL NAME
          SA6    CUSR 
          SA2    CBUF+CEST   CHECK FOR SYMBOLIC NAME
          LX2    59-2 
          PL     X2,MRF5     IF NOT SYMBOLIC ACCESS 
          SA1    CBUF+CELI   GET PERMANENT FILE NAME
          RJ     SFN         SPACE FILL NAME
          SA6    TPFN        SET TAPE FILE NAME 
          SA1    CBUF+CEST
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    TPFN+B1
          EQ     MRF6 
  
 MRF5     SA1    CBUF+CEES   GET VSN NAME 
          MX0    36 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    TPFN        SET VSN NAME 
          SA1    FCEQ 
          BX6    X1 
          SA6    TPFN+B1     STORE *NON-SYM*
 MRF6     SA1    CBUF+CEPI   GET PHYSICAL FILE NAME 
          RJ     SFN         SPACE FILL NAME
          SA6    PHID 
          SA1    CBUF+CESQ
          MX2    42 
          BX1    X2*X1
          RJ     SFN         SPACE FILL NAME
          SA6    PHID+B1     SET PHYSICAL FILE NAME 
          SA1    CBUF+CECN   GET CHARGE NUMBER
          RJ     SFN         SPACE FILL 
          SA6    CHRG        SET CHARGE NUMBER
          SA1    CBUF+CEPN   GET PROJECT NUMBER 
          RJ     SFN         SPACE FILL 
          SA6    PROJ        SET PROJECT NUMBER 
          SA1    A1+B1
          RJ     SFN         SPACE FILL 
          SA6    PROJ+1      SET PROJECT NUMBER 
          MX0    54 
          SA2    CBUF+CEPW   GET FILE CATEGORY
          AX2    6
          BX0    -X0*X2 
          SX0    X0-1 
          SA2    MRFB+X0
          BX6    X2 
          SA6    FTYP        SET FILE CATEGORY
          SA1    CBUF+CECD   GET CREATION DATE
          AX1    18 
          SX1    X1 
          SA2    =70S12      ADD 1970 
          IX1    X1+X2
          SX2    1R/
          RJ     EDT         EDIT DATE/TIME 
          SA6    CDAT        SET CREATION DATE
          SA1    CBUF+CECD   GET CREATION TIME
          SX1    X1 
          SX3    120000B     PAD TO ELIMINATE LEAD BLANK
          IX1    X1+X3       TO INSURE LEAD ZERO
          SX2    1R.
          RJ     EDT         EDIT DATE/TIME 
          SA1    =1S48       REMOVE PADDING 
          IX6    X6-X1
          SA6    CTIM 
          SA1    CBUF+CEMD   GET LAST MODIFICATION DATE 
          AX1    18 
          SX1    X1 
          SA2    =70S12      ADD 1970 
          IX1    X1+X2
          SX2    1R/
          RJ     EDT         EDIT DATE/TIME 
          SA6    MDAT        SET LAST MODIFICATION DATE 
          SA1    CBUF+CEMD   GET LAST MODIFICATION TIME 
          SX1    X1 
          SX3    120000B     PAD TO ELIMINATE LEAD BLANK
          IX1    X1+X3       TO INSURE LEAD ZERO
          SX2    1R.
          RJ     EDT         EDIT DATE/TIME 
          SA1    =1S48       REMOVE PADDING 
          IX6    X6-X1
          SA6    MTIM        SET LAST MODIFICATION TIME 
          SA1    CBUF+CEAD   GET LAST ACCESS DATE 
          AX1    18 
          SX1    X1 
          SA2    =70S12      ADD 1970 
          IX1    X1+X2
          SX2    1R/
          RJ     EDT         EDIT DATE/TIME 
          SA6    ADAT        SET LAST ACCESS DATE 
          SA1    CBUF+CEAD   GET LAST ACCESS TIME 
          SX1    X1 
          SX3    120000B     PAD TO ELIMINATE LEAD BLANK
          IX1    X1+X3       TO INSURE LEAD ZERO
          SX2    1R.
          RJ     EDT         EDIT DATE/TIME 
          SA1    =1S48       REMOVE PADDING 
          IX6    X6-X1
          SA6    ATIM        SET LAST ACCESS TIME 
          MX0    54 
          SA2    CBUF+CEPW   GET PERMISSION MODE
          BX0    -X0*X2 
          SX0    X0-1 
          SA2    MRFA+X0
          BX6    X2 
          SA6    PMOD        SET PERMISSION MODE
          SA1    CBUF+CEAD   GET ACCESS COUNT 
          MX3    24 
          BX1    X3*X1
          LX1    24 
          RJ     CDD         CONVERT TO DECIMAL 
          RJ     CBE         CLEAR BLANKS 
          RJ     ZFD         SET DISPLAY CODE ZEROES
          SA6    ACNT        SET ACCESS COUNT 
          SA1    CBUF+CETD   LABEL STATUS 
          LX1    1
          MX0    2
          BX1    X0*X1
          LX1    2
          SA2    X1+FCEP
          BX6    X2 
          SA6    LBST        SET LABEL STATUS 
          SA1    CBUF+CETD   GET DATA FORMAT
          MX0    54 
          AX1    30 
          BX0    -X0*X1 
          SA1    X0+FCEL
          BX6    X1 
          SA6    FRMT        SET DATA FRMT
          SA1    CBUF+CETD   GET CONVERSION MODE
          MX0    57 
          AX1    48 
          BX0    -X0*X1 
          SA2    X0+FCEN
          BX6    X2 
          SA6    CVMD        SET CONVERSION MODE
          SA1    CBUF+CETD   GET TAPE TYPE
          MX0    -2 
          AX1    55 
          BX0    -X0*X1 
          BX6    X0 
          SA6    FCEF        SAVE TAPE TYPE FOR DENSITY GENERATION
          SA2    X0+FCEK
          BX6    X2 
          SA6    TTYP        SET TAPE TYPE MNEMONIC 
          SA1    CBUF+CETD   GET DENSITY
          MX0    57 
          AX1    51 
          BX0    -X0*X1 
          SA1    FCEF        CHECK TAPE TYPE
          ZR     X1,MRF7     IF *MT*
          SX0    X0+1        ADJUST FOR DUAL 800-BPI TABLE ENTRIES
 MRF7     SX2    X1-3 
          NZ     X2,MRF7.1   IF NOT *AT*
          SX0    X0+1        ADJUST FOR DUAL 38000-CPI TABLE ENTRIES
 MRF7.1   SA2    X0+FCEM
          BX6    X2 
          SA6    TDEN        SAVE DENSITY 
          SA1    CBUF+CEPW   GET FILE PASSWORD
          MX0    42 
          BX1    X0*X1
          RJ     SFN         BLANK FILL IT
          SA6    PWRD 
          SA1    CBUF+CEST   CHECK ERROR INDICATOR
          SX3    2
          BX2    X1*X3
          AX2    1
          SA3    MRFE+X2
          BX6    X3 
          SA6    ERRI 
          SX3    2000B       CHECK CATALOG ERROR STATUS 
          BX2    X1*X3
          AX2    12B
          SA3    MRFC+X2
          BX6    X3 
          SA6    CERR        STORE CATALOG ERROR STATUS 
          SA1    CBUF+CEUC   GET USER CONTROL WORD
          RJ     SFN         SPACE FILL NAME
          SA6    UWRD 
          SA1    DIR1        MOVE DATA TO BASIC FILE BLOCK
          RJ     MCS         MOVE CHARACTER STRING
          SA1    DIR2 
          RJ     MCS         MOVE CHARACTER STRING
          SA1    CBUF+TCEL   GET VSN INFORMATION
 MRF8     SA2    FCBA        EOF INDICATOR OF VSN LIST
          MX0    36 
          BX1    X0*X1
          BX3    X2-X1
          ZR     X3,MRF3     IF END OF VSNS 
          RJ     SFN         SPACE FILL NAME
          SA6    MVSN        SAVE VSN 
          SA1    A1+B1       GET PHYSICAL REEL NUMBER 
          MX2    -18
          BX6    -X2*X1 
          SA6    MRFV        SAVE STATUS INFORMATION
          MX2    6
          LX2    24D
          BX6    X2*X1       SAVE REEL NUMBER 
          AX6    18D
          SA6    MRFK 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    MPRN        SAVE PHYSICAL REEL NUMBER
          SA1    A1+B1       GET FIRST VSN
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    FVSN        SAVE FIRST VSN 
          SA1    A1+B1
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    NVSN        SAVE NEXT VSN
          SA1    A1 
          MX2    6
          LX2    24D
          BX6    X2*X1       SAVE USAGE COUNT 
          AX6    18D
          SA6    MRFL 
          SA3    MRFV 
          BX1    X3 
          SX0    ERVS        CHECK ERROR STATUS 
          BX2    X0*X1
          AX2    1
          SA3    MRFE+X2
          BX6    X3 
          SA6    VERR 
          SX0    TVVS        CHECK SITE STATUS
          BX2    X0*X1
          AX2    3
          SA3    MRFF+X2
          BX6    X3 
          SA6     STAT        STORE SITE  STATUS
          SX0    RTVS        CHECK RESERVE STATUS 
          BX2    X0*X1
          AX2    17 
          SA3    MRFD+X2
          BX6    X3 
          SA6    RESV        STORE RESERVE STATUS 
          SX0    UOVS        CHECK OWNERSHIP STATUS 
          BX2    X0*X1
          AX2    12 
          SA3    MRFH+X2
          BX6    X3 
          SA6    OWNS        STORE OWNERSHIP STATUS 
          SX0    HMVS        CHECK MAINTENANCE FLAG 
          BX2    X0*X1
          AX2    16 
          SA3    MRFG+X2
          BX6    X3 
          SA6    MAIN        STORE MAINTENANCE FLAG 
          SX6    A1          SAVE VSN POINTER 
          SA6    MRFS 
          SA1    MRFK        CONVERT REEL COUNT 
          RJ     CDD         CONVERT TO DECIMAL 
          RJ     CBE         CLEAR BLANKS 
          RJ     ZFD         SET DISPLAY CODE ZEROS 
          SA6    RCNT        STORE REEL COUNT 
          SA1    MRFL        CONVERT USAGE COUNT
          RJ     CDD         CONVERT TO DECIMAL 
          RJ     CBE         CLEAR BLANKS 
          RJ     ZFD         SET DISPLAY CODE ZEROS 
          SA6    USGC        STORE USAGE COUNT
          SA1    DIR3 
          RJ     MCS         MOVE CHARACTER STRING
          WRITEC O,BLOCK,23D WRITE DATA BLOCK 
          SA1    MRFS 
          SA1    X1+B1
          EQ     MRF8        GET NEXT VSN 
  
  
          SPACE  5
*         MACHINE READABLE FILE DATA STORAGE ITEMS
  
  
 MRFA     CON    6LREAD 
          CON    6LWRITE
          CON    6LNULL 
  
 MRFB     CON    7LPUBLIC 
          CON    7LPRIVATE
          CON    7LSEMI-PR
          CON    7L 
  
 MRFC     CON    1LN         RECOVERED STATUS 
          CON    1LS
  
 MRFD     CON    1LN         RESERVED STATUS
          CON    1LR
  
 MRFE     CON    1LC         VSN ERROR STATUS 
          CON    1LS
  
 MRFF     CON    3LON 
          CON    3LOFF
  
 MRFG     CON    5LAVAIL
          CON    5LHOLD 
  
 MRFH     CON    6LCENTER 
          CON    6LUSER 
  
 MRFK     CON    0           REEL COUNT 
 MRFL     CON    0           USAGE COUNT
 MRFS     CON    0           VSN POINTER
 MRFV     CON    0           STATUS INFORMATION 
          SPACE  4
*         THE FOLLOWING MACRO *MOVEIT* CALLS ARE USED TO SET UP 
*         THE OUTPUT BLOCK FOR THE *SS* FILE. 
  
  
*         DIRECTIVE SET TO FORM COLUMNS 1-60. 
  
 DIR1     MOVEIT 1,VERS,10,BLOCK,1
          MOVEIT 7,AUDG,1,BLOCK,2 
          MOVEIT 7,CUSR,1,BLOCK,9 
          MOVEIT 7,CHRG,1,BLOCK,16
          MOVEIT 23,PROJ,1,BLOCK,23 
          MOVEIT 17,TPFN,1,BLOCK,43 
          VFD    60/0 
  
*         DIRECTIVE SET FOR COLUMNS 60-155. 
  
 DIR2     MOVEIT 7,FTYP,1,BLOCK,60
          MOVEIT 2,CDAT,2,BLOCK+6,7 
          MOVEIT 2,CDAT,5,BLOCK+6,9 
          MOVEIT 2,CDAT,8,BLOCK+6,11
          MOVEIT 2,CTIM,2,BLOCK+6,13
          MOVEIT 2,CTIM,5,BLOCK+6,15
          MOVEIT 2,CTIM,8,BLOCK+6,17
          MOVEIT 2,ADAT,2,BLOCK+6,19
          MOVEIT 2,ADAT,5,BLOCK+6,21
          MOVEIT 2,ADAT,8,BLOCK+6,23
          MOVEIT 2,ATIM,2,BLOCK+6,25
          MOVEIT 2,ATIM,5,BLOCK+6,27
          MOVEIT 2,ATIM,8,BLOCK+6,29
          MOVEIT 2,MDAT,2,BLOCK+6,31
          MOVEIT 2,MDAT,5,BLOCK+6,33
          MOVEIT 2,MDAT,8,BLOCK+6,35
          MOVEIT 2,MTIM,2,BLOCK+6,37
          MOVEIT 2,MTIM,5,BLOCK+6,39
          MOVEIT 2,MTIM,8,BLOCK+6,41
          MOVEIT 6,PMOD,1,BLOCK+6,43
          MOVEIT 10,ACNT,1,BLOCK+6,49 
          MOVEIT 2,FRMT,1,BLOCK+6,59
          MOVEIT 2,CVMD,1,BLOCK+12,1
          MOVEIT 2,TTYP,1,BLOCK+12,3
          MOVEIT 2,TDEN,1,BLOCK+12,5
          MOVEIT 3,BLANKS,1,BLOCK+12,7
          MOVEIT 10,UWRD,1,BLOCK+12,10
          MOVEIT 4,BLANKS,1,BLOCK+12,20 
          MOVEIT 1,ERRI,1,BLOCK+12,24 
          MOVEIT 1,BLANKS,1,BLOCK+12,25 
          MOVEIT 7,PWRD,1,BLOCK+12,26 
          MOVEIT 3,BLANKS,1,BLOCK+12,33 
          VFD    60/0 
  
*         DIRECTIVE SET FOR COLUMNS 159 - 225 
  
 DIR3     MOVEIT 6,MVSN,1,BLOCK+12,36 
          MOVEIT 6,MPRN,1,BLOCK+12,42 
          MOVEIT 6,FVSN,1,BLOCK+12,48 
          MOVEIT 6,NVSN,1,BLOCK+12,54 
          MOVEIT 5,MAIN,1,BLOCK+12,60 
          MOVEIT 3,STAT,1,BLOCK+18,5
          MOVEIT 6,OWNS,1,BLOCK+18,8
          MOVEIT 1,VERR,1,BLOCK+18,14 
          MOVEIT 2,RCNT,9,BLOCK+18,15 
          MOVEIT 2,LBST,1,BLOCK+18,17 
          MOVEIT 17,PHID,1,BLOCK+18,19
          MOVEIT 2,USGC,9,BLOCK+20,16 
          MOVEIT 6,BLANKS,1,BLOCK+20,18 
          MOVEIT 1,RESV,1,BLOCK+20,24 
          MOVEIT 1,CERR,1,BLOCK+20,25 
          MOVEIT 1,BLANKS,1,BLOCK+20,26 
          VFD    60/0 
  
*         FOLLOWING ARE THE STORAGE CELLS WHICH ARE FILLED BY *MRF* 
*         AND FORMATTED FOR OUTPUT BY THE PREVIOUS *MOVEIT* CALLS.
  
 VERS     VFD    54/0,6/1R2  VERSION
 CHRG     BSS    1           CHARGE NUMBER
 PROJ     BSS    2           PROJECT NUMBER 
 CUSR     BSS    1           USER NAME
 TPFN     BSS    2           TAPE FILE NAME 
 FTYP     BSS    1           FILE CATEGORY
 CDAT     BSS    1           CREATION DATE
 CTIM     BSS    1           CREATION TIME
 ADAT     BSS    1           LAST ACCESS DATE 
 ATIM     BSS    1           LAST ACCESS TIME 
 MDAT     BSS    1           LAST MODIFY DATE 
 MTIM     BSS    1           LAST MODIFY TIME 
 PMOD     BSS    1           FILE PERMISSION MODE 
 ACNT     BSS    1           ACCESS COUNT 
 FRMT     BSS    1           FILE FORMAT
 PWRD     BSS    1           FILE PASSWORD
 CVMD     BSS    1           CONVERSION MODE
 ERRI     BSS    1           TAPE FILE ERROR INDICATOR
 TTYP     BSS    1           PHYSICAL TAPE TYPE 
 TDEN     BSS    1           TAPE DENSITY 
 UWRD     BSS    1           USER CONTROL WORD
 MVSN     BSS    1           VOLUME SERIAL NUMBER 
 MPRN     BSS    1           PHYSICAL REEL NUMBER 
 FVSN     BSS    1           FIRST VSN
 NVSN     BSS    1           NEXT VSN 
 MAIN     BSS    1           MAINTENANCE FLAG 
 STAT     BSS    1           SITE STATUS
 OWNS     BSS    1           OWNERSHIP TYPE 
 VERR     BSS    1           VSN ERROR INDICATOR
 RCNT     BSS    1           REEL COUNT 
 LBST     BSS    1           LABEL STATUS 
 PHID     BSS    2           PHYSICAL ID
 RESV     BSS    1           TAPE RESERVED INDICATOR
 CERR     BSS    1           CATALOG ERROR INDICATOR
 USGC     BSS    1           USAGE COUNT
  
  
  
 BLOCK    BSS    23 
          VFD    30/0,30/5L 
          CON    10H
          CON    10H
          VFD    36/6L      ,12/2L  ,12/0 
 BLANKS   CON    10H
          CON    10H
 SAD      SPACE  4,15 
**        SAD - SHORT ADMIT DATA
* 
*         THIS ROUTINE PROCESS THE *LO=P* AUDIT LIST OPTION.
*         *SAD* GENERATES A LIST OF ONLY THE USERNAMES OF ALTERNATE 
*         USERS WHO HAVE ACCESSED A SPECIFIC FILE.  THIS ROUTINE IS 
*         CALLED BY *ADT*.
* 
*         ENTRY  AUDIT COMMAND HAS BEEN CRACKED AND PARAMETERS STORED.
* 
*         EXIT    SHORT ADMIT LIST GENERATED. 
*                 EXIT TO MAIN LOOP (ADT).
* 
*         USES    ALL.
* 
*         CALLS   ALN, CDD, FBA, GAL. 
* 
*         MACROS  WRITEC, WRITEH. 
  
  
 SAD      BSS    0           ENTRY
          RJ     FBA         FILL BUFFER FOR ADMIT LIST 
          ZR     X6,SAD1     IF EOI 
          RJ     GAL         GENERATE ADMIT LIST
          EQ     SAD
  
 SAD1     WRITEC O,LBUF 
          SA1    ENTN        SET NUMBER OF USERS
          RJ     CDD         CONVERT TO DECIMAL 
          MX0    -18
          BX6    -X0*X6 
          LX6    36D
          LX0    36D
          SA2    SADA 
          BX2    X0*X2
          BX6    X6+X2
          SA6    SADA 
          SB2    3
          RJ     ALN         ADVANCE LINE NUMBER
          WRITEC O,BLNK 
          WRITEH O,SADA,SADAL 
          WRITEC O,BLNK 
          EQ     ADT3        RETURN BACK TO MAIN LOOP 
  
 SADA     DATA   C* XXX USER(S).* 
 SADAL    EQU    *-SADA 
 SFL      SPACE 4,15
**        SFL - SHORT FILE LIST 
* 
*         *SFL* IS THE OVERFLOW PROCESSOR FOR THE SHORT SORTED FILE 
*         LIST (SSL).  THIS ROUTINE IS CALLED BY *SSL* THE *LO=0* 
*         AUDIT LIST PROCESSOR. 
* 
*         ENTRY  *SSL* HAS DETERMINED THERE ARE TOO MANY FILE NAMES 
*                FOR THE SORT BUFFER. 
* 
*         EXIT   UNSORTED SHORT LIST HAS BEEN GENERATED.
*                EXIT TO MAIN LOOP (ADT). 
* 
*         USES   A - 2, 6.
*                B - 2. 
*                X - 0, 1, 2, 3, 5, 6.
* 
*         CALLS  FCB, GSL, SEC. 
* 
*         MACRO  WRITEC.
  
  
 SFL      BSS    0           ENTRY
          SB2    B1          SET LIST FLAG
          RJ     FCB         FILL BUFFER FOR SHORT LIST 
          ZR     X6,SFL3     IF EOI ENCOUNTERED 
          RJ     SEC         SHORT LIST ERROR CHECK 
          LX2    59-2 
          PL     X2,SFL1     IF NOT SYMBOLIC ACCESS 
          LX2    3           STORE FILE IDENTIFIER
          MX0    42 
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          BX6    X5*X6       SET POSSIBLE RECOVER FLAG
          SA6    A2 
          EQ     SFL2 
  
 SFL1     SA2    CBUF+CEES   EXTRACT VSN
          MX0    36 
          BX1    X0*X2
          SA2    FCEQ 
          RJ     SFN         SPACE FILL VSN 
          SA6    CBUF 
          BX6    X5*X2       SET POSSIBLE RECOVER FLAG
          SA6    A6+B1
 SFL2     RJ     GSL         GENERATE SHORT LIST
          EQ     SFL         GET THE NEXT FILE NAME 
  
 SFL3     WRITEC O,LBUF 
          WRITEC O,BLNK 
          EQ     ADT3        RETURN TO MAIN LOOP
 SSL      SPACE  4,15 
**        SSL - SHORT SORTED LIST.
* 
*         THIS ROUTINE PROCESSES THE *LO=0* AUDIT LIST OPTION.
*         *SSL* GENERATES A LIST OF THE TAPE FILENAMES IN THE 
*         CATALOG BEING INTERROGATED (NO OTHER INFORMATION IS LISTED).
*         IF THE USER IS REQUESTING FILE NAMES IN AN ALTERNATE USER 
*         CATALOG, THE USER IS GIVEN ONLY THE NAMES OF FILES THAT 
*         HE OR SHE IS ALLOWED ACCESS.  THIS ROUTINE IS CALLED BY 
*         *ADT*.
* 
*         ENTRY  AUDIT COMMAND HAS BEEN CRACKED AND PARAMETERS STORED.
* 
*         EXIT   TO OVERFLOW PROCESSOR IF BUFFER IS NOT LARGE 
*                ENOUGH TO HOLD ALL ENTRIES.  OTHERWISE BACK
*                TO THE MAIN LOOP (ADT).
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 0, 1, 2, 3, 6, 7.
*                B - 2, 3, 7. 
* 
*         CALLS  AFS, CSM, FCB, GNI, GSL, HDR, NIP, PAS, RQS, SEC, SST. 
* 
*         MACROS READW, WRITEC, WRITEH. 
  
  
 SSL      BSS    0           ENTRY
          SA0    B0          INITIALIZE BUFFER POINTER
 SSL1     SB2    B1          SET LIST FLAG
          RJ     FCB         FILL BUFFER FOR SHORT LIST 
          ZR     X6,SSL6     PROCESS SORT OF BUFFER 
          RJ     SEC         SHORT LIST ERROR CHECK 
          LX2    59-2 
          PL     X2,SSL2     IF NOT SYMBOLIC ACCESS 
          SA1    CBUF+CELI   STORE FILE IDENTIFIER
          BX6    X1 
          SA6    A0+SBUF
          SA0    A0+B1
          SA1    CBUF+CEST
          MX0    42D
          BX1    X0*X1
          RJ     SFN         SPACE FILE NAME
          BX6    X5*X6       SET POSSIBLE RECOVER FLAG
          SA6    A0+SBUF
          EQ     SSL3 
  
 SSL2     SA2    CBUF+CEES   STORE VSN IN SBUF
          MX0    36D
          BX1    X0*X2
          RJ     SFN         SPACE FILE NAME
          SA6    A0+SBUF
          SA2    FCEQ 
          SA0    A0+B1
          BX6    X5*X2       SET POSSIBLE RECOVER FLAG
          SA6    A0+SBUF
 SSL3     SA1    CSBS        GET CURRENT BUFFER MAXIMUM 
          SA0    A0+B1
          SX3    A0+B1
          IX2    X1-X3
          PL     X2,SSL1     IF BUFFER NOT FULL 
          RJ     RQS         REQUEST MORE BUFFER SPACE
          PL     X1,SSL1     IF MORE AVAILABLE
  
*         SORT BUFFER OVERFLOW. 
  
          SX6    A0+
          AX6    1
          SA6    SSLA        STORE COUNT
          SB2    B1+
          RJ     ALN         ADVANCE LINE NUMBER
          WRITEC O,SSLD      OUTPUT WARNING MESSAGE 
          WRITEC O,BLNK 
          RJ     HDR         PRINT HEADER 
          SB7    B0+
          SA1    SSLA        PRESET TERMINATION MESSAGE 
          RJ     CDD         CONVERT TO DISPLAY 
          MX0    -24         SAVE 4 DIGITS
          BX6    -X0*X6 
          LX6    30 
          LX0    30 
          SA2    SSLE 
          BX2    X0*X2
          BX6    X6+X2
          SA6    SSLE 
 SSL4     SA3    SSLA 
          SX6    X3-1 
          SA6    A3 
          NG     X6,SSL5     IF END OF ENTRIES
          SA1    SBUF+B7
          BX6    X1 
          SA6    CBUF 
          SA1    A1+B1
          BX6    X1 
          SA6    CBUF+B1
          SX6    B7+         SAVE SORT BUFFER INDEX 
          SA6    SSLF 
          RJ     GSL         GENERATE SHORT LIST
          SA2    SSLF        RESET SORT BUFFER INDEX
          SB7    X2+2 
          EQ     SSL4        GET NEXT ENTRY 
  
 SSL5     SA2    CODE 
          SA2    X2+ADTC
          SB2    X2 
          JP     B2          GO TO OVERFLOW PROCESSOR 
  
*         SORT TAPE FILES ALPHABETICALLY. 
  
 SSL6     SX1    A0          NUMBER OF ENTRIES*2
          AX1    1
          BX6    X1 
          SA6    SSLA        NUMBER OF TAPE FILE ENTRIES
          SB2    B1 
          RJ     ALN         ADVANCE LINE NUMBER
          SX1    A0 
          SB7    SBUF        ADDRESS OF BUFFER
          RJ     SST         SORT ENTRIES 
          SA1    SSLA        PRESET TERMINATION MESSAGE 
          RJ     CDD         CONVERT TO DISPLAY 
          MX0    -24         SAVE 4 DIGITS
          BX6    -X0*X6 
          LX6    30 
          LX0    30 
          SA2    SSLE 
          BX2    X0*X2
          BX6    X6+X2
          SA6    SSLE 
          SB7    B0 
  
*         LIST TAPE FILES 
  
 SSL7     SA3    SSLA 
          SX6    X3-1 
          SA6    A3+
          NG     X6,SSL8     IF END OF ENTRIES
          SA1    B7+SBUF     GET ACTUAL ENTRY 
          BX6    X1 
          SA6    CBUF 
          SA1    A1+B1
          BX6    X1 
          SA6    CBUF+B1
          SX6    B7+         SAVE SORT BUFFER INDEX 
          SA6    SSLF 
          RJ     GSL         GENERATE SHORT LIST
          SA2    SSLF 
          SB7    X2+2 
          EQ     SSL7        GET NEXT FILENAME
  
 SSL8     WRITEC O,LBUF      LAST LINE OF TAPE FILES
          WRITEC O,BLNK 
          SB2    2
          RJ     ALN         ADVANCE LINE NUMBER
          WRITEH  O,SSLE,SSLEL
          WRITEC  O,BLNK
          EQ     ADT3        CONTINUE PROCESSING
  
 SSLA     CON    0           NUMBER OF TAPE FILES 
 SSLD     DATA   C* ALL FILES LISTED BUT NOT SORTED.* 
 SSLE     DATA   C* XXXX TAPE FILE(S).* 
 SSLEL    EQU    *-SSLE 
 SSLF     CON    0
          TITLE  SUBROUTINES. 
 AEN      SPACE  4,25 
**        AEN - ADVANCE ENTRY NUMBER. 
* 
*         ENTRY  (ENTN) = NUMBER OF FILES.
* 
*         EXIT   (ENTN) = ADVANCED. 
*                (ENTD) = ADVANCED FILE NUMBER IN DISPLAY CODE
* 
*         USES   X   0, 1, 6. 
*                A   1, 6.
* 
*         CALLS  CDD. 
  
  
 AEN      SUBR               ENTRY/EXIT 
          SA1    ENTN        ADVANCE FILE NUMBER
          SX1    X1+B1
          BX6    X1 
          SA6    A1 
          RJ     CDD         CONVERT TO DISPLAY 
          SX1    1R.         SET PERIOD 
          MX0    54 
          LX6    6
          BX6    X0*X6
          BX6    X1+X6
          SA6    ENTD 
          EQ     AENX        RETURN 
 ALN      SPACE  4,25 
**        ALN - ADVANCE LINE NUMBER 
* 
*         ENTRY  (LINE) = CURRENT PAGE LINE NUMBER
*                (B2) = NUMBER OF LINES TO ADVANCE
* 
*         EXIT   FILE NUMBER UPDATED IN OUTPUT LINE 
*                LINE BUFFER CLEARED
* 
*         USES   X   1, 6.
*                B   2. 
*                A   1, 6.
* 
*         CALLS  HDR, PTP.
  
  
 ALN      SUBR               ENTRY/EXIT 
          SA1    LINE        ADVANCE LINE NUMBER
          SX6    X1+B2
          SA6    A1 
          SX1    X6-LINP
          NG     X1,ALN2     IF NOT END OF PAGE 
          SA1    DTYP        CHECK DEVICE TYPE
          NZ     X1,ALN1     IF FILE NOT ASSIGNED TO A TERMINAL 
          SA1    TPFG        CHECK IF TITLE PAGE ALREADY PRINTED
          NZ     X1,ALN2     IF TITLE ALREADY PRINTED 
 ALN1     RJ     PTP         PRINT TITLE PAGE 
          SX6    B1          SET TITLE PAGE FLAG FOR TERMINAL 
          SA6    TPFG 
          SA1    CODE 
          ZR     X1,ALN2     IF SHORT FILE LIST 
          RJ     HDR         PRINT HEADER 
 ALN2     SB2    7           CLEAR LINE BUFFER
          SX6    B0 
 ALN3     ZR     B2,ALNX     IF END OF LINE BUFFER
          SA6    LBUF+B2
          SB2    B2-B1
          EQ     ALN3        CONTINUE CLEARING LINE BUFFER
 BAT      SPACE  4,15 
***       BAT - BUILD ARGUMENT TABLE. 
* 
*         BAT BUILDS THE ARGUMENT TABLE WHICH *ARG* USES TO 
*         EXTRACT KEYWORDS.  THE ARGUMENT TABLE IS NORMALLY 
*         DONE BY THE SYSTEM BUT IS SUPPRESSED IN TFILES DUE
*         TO THE 17 CHARACTER FILENAMES AND STRUCTURES OF THE 
*         COMMANDS. 
* 
*         ENTRY     B6 SPECIFIES NEXT POSITION IN THE USB STRING
*                   BUFFER TO BE CRACKED. 
* 
*         EXIT      TARG STORAGE AREA CONTAINS THE ARGUMENT TABLE.
* 
*         USES   A - 3, 4, 6, 7.
*                B - 3, 7.
*                X - 3, 4, 5, 6, 7. 
* 
*         CALLS     POP.
* 
*         MACROS    ABORT, MESSAGE. 
  
  
 BAT      SUBR               ENTRY/EXIT 
          BX6    X6-X6
          SA6    BATA        INITIALIZE INDEX TO TARG 
          SA6    NARG        INITIALIZE ARGUMENT COUNT
 BAT1     RJ     POP         PICK OUT NEXT PARAMETER
          NG     B5,ERR      IF ERROR ENCOUNTERED 
          ZR     B5,BAT2     IF PARAMETER DOES NOT EXCEED ONE WORD
          SA3    BATB 
          SA4    TARG+B3-1
          IX6    X3-X4
          NZ     X6,ERR      IF NOT *REMARK=* 
 BAT2     SA3    POPA        GET PARAMETER
          BX6    X3 
          NG     X2,BAT5     IF LAST PARAMETER
          SB3    X1-1R= 
          ZR     B3,BAT3     PROCESS EQUIVALENCED PARAMETER 
          SB3    X1-1R, 
          NZ     B3,ERR6     IF INCORRECT SEPARATOR 
          EQ     BAT4        PROCESS NON-EQUIVALENCED PARAMETER 
  
 BAT3     MX5    -6          ZERO-OUT LOWER -6BITS OF PARAMETER WORD
          BX4    X5*X6
          BX6    X4+X1       COMBINE KEYWORD AND *=*
 BAT4     SA3    NARG        INCREMENT ARGUMENT COUNT 
          SX7    X3+B1
          SA7    NARG 
 BAT5     SA3    BATA        INCREMENT INDEX TO TARG
          SB3    X3 
          SB7    TARGL
          EQ     B3,B7,ERR   IF EXCEEDED MAX. TARG LENGTH 
          SA6    TARG+B3     STORE PARAMETER
          SB3    B3+B1       INCREMENT INDEX TO TARG
          SX6    B3 
          SA6    BATA 
          NG     X2,BAT      NO MORE ARGUMENTS
          EQ     BAT1        GET NEXT PARAMETER 
  
 BATA     CON    0           INDEX TO ARGUMENT TABLE
 BATB     VFD    36/0LREMARK,18/0,6/0L= 
 PAR      SPACE  4,20 
**        PAR - PROCESS ARGUMENTS 
* 
*         ENTRY  (B1) = 1.
*                (B4) = ARGUMENT COUNT. 
*                (A4) = ADDRESS OF FIRST ARGUMENT.
*                (X4) = FIRST ARGUMENT. 
*                (B5) = ADDRESS OF ARGUMENT TABLE IN FOLLOWING FORM - 
*                       12/OP,18/ASV,9/ST,3/WC,18/ADDR
*                       OP = 2 CHARACTER OPTION.
*                       ASV = ADDRESS OF ASSUMED VALUE. 
*                             IF .LT. 0, ARGUMENT MUST BE EQUIVALENCED. 
*                       ST = STATUS, IF = 400B, A ZERO *0* PARAMETER IS 
*                            RETAINED AS A DISPLAY ZERO, OTHERWISE A
*                            VALUE OF ZERO IS STORED. 
*                       WC = FULL WORD COUNT. 
*                       ADDR = ADDRESS TO STORE PARAMETER.
* 
*         EXIT   (X1) = ZERO IF NO ERROR DETECTED.
*                (X1) = NON-ZERO IF ANY OF THE FOLLOWING ERRORS 
*                       ARE FOUND.
*                       1.  OPTION NOT FOUND IN TABLE.
*                       2.  SINGLE ARGUMENT EQUIVALENCED. 
*                       3.  INCORRECT RE-ENTRY OF ARGUMENT. 
*                       4.  PARAMETER TOO LONG. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4. 
*                A - 2, 3, 4, 7.
  
  
 PAR      SUBR
          MX0    42 
          SX1    B0 
          ZR     B4,PARX     IF NO ARGUMENTS
          SX1    B1 
  
*         SEARCH FOR MATCH IN ARGUMENT TABLE. 
  
 PAR1     ZR     X4,PARX     IF NULL ARGUMENT 
          SA2    B5-B1
          MX3    12 
 PAR2     SA2    A2+B1       GET NEXT OPTION
          ZR     X2,PARX     IF END OF OPTION TABLE 
          BX6    X2*X3       CHECK FOR KEYWORD MATCH
          BX5    X3*X4
          BX7    X5-X6
          NZ     X7,PAR2     IF NO MATCH
  
*         CHECK FOR EQUIVALENCE ALLOWED.
  
          SX7    X4-1R=      CHECK FOR EQUIVALENCE SEPARATOR
          SB2    X2          SET ADDRESS VALUE
          LX2    30          GET ASSUMED STATUS 
          SB3    X2 
          PL     B3,PAR3     IF EQUIVALENCE ALLOWED 
          SA3    -B3         SET ASSUMED STATUS ADDRESS 
          BX6    -X0*X3      GET ASSUMED STATUS 
          SB3    -B3
          NZ     X7,PAR5     IF ARGUMENT NOT EQUIVALENCED 
          EQ     PARX        RETURN WITH ERROR
  
*         PROCESS EQUIVALENCE.
  
 PAR3     SA3    B3          SET ASSUMED VALUE ADDRESS
          BX6    -X0*X3      SET ASSUMED VALUE
          NZ     X7,PAR5     IF ARGUMENT NOT EQUIVALENCED 
          SA4    A4+B1       GET PARAMETER
          SB4    B4-B1
          BX3    X4 
          AX4    42 
          NG     X2,PAR4     IF DISPLAY ZERO REQUESTED
          SX2    X4-1L0 
 PAR4     ZR     X3,PARX     IF NULL PARAMETER
          NZ     X2,PAR5     IF NOT *0* 
          SX3    B0          CLEAR EQUIVALENCE
          SX6    B0          CLEAR STATUS 
  
*         ENTER ARGUMENT. 
  
 PAR5     SA2    A2          GET WORD COUNT OF PARAMETER
          MX0    -3 
          AX2    18 
          BX2    -X0*X2 
          BX7    X3 
          NZ     X2,PAR6     IF PARAMETER MAY BE FULL WORD
          SA4    A4          GET CURRENT ARGUMENT 
          MX0    -6 
          LX0    12 
          BX2    -X0*X4 
          NZ     X2,ERR      IF PARAMETER TOO LONG
          MX0    42 
          BX7    X0*X7
          IX7    X6+X7       MERGE ARGUMENT AND STATUS
 PAR6     SA7    B2          STORE ARGUMENT 
          SB3    B2-B3
          NZ     B3,PAR7     IF MORE THAN 1 ENTRY ALLOWED 
          SA2    A2          GET ENTRY IN ARGUMENT TABLE
          MX3    12 
          BX4    -X3*X2 
          BX7    X3+X4
          SA7    A2          MASK THIS ENTRY OUT
 PAR7     SB4    B4-B1       DECREMENT ARGUMENT COUNT 
          SA4    A4+B1       GET NEXT ARGUMENT
          NZ     B4,PAR1     IF MORE ARGUMENTS TO PROCESS 
          SX1    B0          CLEAR ERROR
          EQ     PARX        RETURN WITH ERROR
 CBE      SPACE  4,10 
**        CBE - CLEAR BLANKS FROM WORD. 
* 
*         ENTRY  (X6) = WORD TO BE CLEARED. 
* 
*         EXIT   (X6) = WORD WITH BLANKS CLEARED. 
* 
*         USES   X - 0, 2, 3, 4, 5, 6.
  
  
 CBE      SUBR               ENTRY/EXIT 
          BX3    X6 
          SX2    12B
          MX0    -6 
          SX4    55B
 CBE1     BX5    -X0*X3 
          BX5    X5-X4
          ZR     X5,CBE3     IF BLANK 
          LX3    54 
 CBE2     SX2    X2-1        DECREMENT CHARACTER COUNT
          NZ     X2,CBE1     IF NOT DONE WITH WORD
          BX6    X3 
          EQ     CBEX        RETURN 
  
 CBE3     BX3    X0*X3
          LX3    54 
          EQ     CBE2        CONTINUE CONVERSION
 CER      SPACE  4,15 
**        CER - CHECK FOR RETURNED ERRORS 
* 
*         *CER* CHECKS THE ERROR BITS IN THE FET.  IF SET,
*         *CER* ISSUES THE MESSAGE SENT BY *TFM*, THEN EITHER 
*         ENDS PROCESSING OR ROLLS OUT AND RETURNS TO THE 
*         CALLING PROGRAM.  UPON ROLLIN, THE CALLING PROGRAM
*         WILL RE-ISSUE THE REQUEST.
* 
*         ENTRY  TFM HAS JUST BEEN CALLED.
* 
*         EXIT   X7 .NE. 0 IF ROLLOUT.
*                IF OTHER THAN ROLLOUT ERROR, MESSAGE IS ISSUED AND 
*                PROCESSING IS STOPPED. 
* 
*         USES   A - 1. 
*                B - 7. 
*                X - 0, 1, 6, 7.
* 
*         MACROS ABORT, ENDRUN, MESSAGE, ROLLOUT. 
  
  
 CER      SUBR               ENTRY/EXIT 
          BX7    X7-X7
          MX0    -8 
          LX0    10D
          SA1    F
          BX0    -X0*X1 
          ZR     X0,CER      IF NO ERRORS 
          SA2    TFMSG
          MESSAGE A2,0
          SA1    F
          MX0    42 
          BX6    X0*X1
          LX1    59-17
          PL     X1,CER1     IF NOT ROLLABLE ERROR
          SA6    A1 
          SX7    B1 
          ROLLOUT 
          MESSAGE  CERA,1    CLEAR B-DISPLAY MESSAGE
          SB7    B7-B1
          EQ     CERX        RETURN 
  
 CER1     SA1    NABT        CHECK NO-ABORT OPTION
          ZR     X1,CER2     IF NA NOT SET
          ENDRUN
  
 CER2     ABORT 
  
 CERA     CON    0           CLEAR B-DISPLAY MESSAGE
 CDT      SPACE  4,15 
**        CDT - CONVERT TIMES AND DATES TO DISPLAY FORMAT.
* 
*         ENTRY  (X3) =  CODED DATE AND TIME. 
* 
*         EXIT   (X6) =  DISPLAY CODED DATE.
*                (X5) =  DISPLAY CODED TIME.
* 
*         USES   X   0, 1, 6. 
*                A   1, 6.
* 
*         CALLS  EDT. 
* 
*         MACROS EDATE, ETIME.
  
  
 CDT      SUBR               ENTRY/EXIT 
          MX0    -18
          BX1    -X0*X3      CONVERT TIME 
          BX6    -X0-X1 
          BX5    X3 
          ZR     X6,CDT1     IF BLANK TIME REQUEST
          ETIME  X1 
 CDT1     AX5    18 
          BX1    -X0*X5      CONVERT DATE 
          BX5    X6 
          BX6    -X0-X1 
          ZR     X6,CDTX     IF BLANK DATE REQUEST
          EDATE  X1 
          EQ     CDTX        EXIT 
 CNV      SPACE  4,20 
**        CNV - CONVERT PARAMETER TO VALUE
* 
*         *CNV* CONVERTS THE ALPHA PARAMETER EQUIVALENCES TO THEIR
*         CORRESPONDING NUMERIC TFM VALUES.  THESE VALUES ARE 
*         STORED IN THE PARAMETER AREA. 
* 
*         ENTRY  THE USER GIVEN PARAMETER EQUIVALENCES HAVE BEEN
*                CRACKED AND STORED.
* 
*         EXIT   GIVEN PARAMETERS HAVE BEEN CONVERTED. IF ANY WERE
*                INCORRECT, ERROR PROCESSING IS INITIATED.
* 
*         USES   A - 1, 2, 6. 
*                B - 2, 4.
*                X - 1, 2, 3, 6.
* 
*         CALLS  NONE.
  
  
 CNV      SUBR               ENTRY/EXIT 
          MX0    12 
          SA2    CATG        GET FILE CATEGORY
          ZR     X2,CNV3     IF NO CATEGORY SPECIFIED 
          SB4    4
          SB2    B0 
 CNV1     SA1    CNVA+B2
          BX1    X0*X1
          BX3    X2-X1
          SB2    B2+B1
          GT     B2,B4,CNV2  IF END OF POSSIBLE CATEGORIES
          NZ     X3,CNV1     IF CATEGORY NOT FOUND
 CNV2     NZ     X3,ERR10    IF INCORRECT CATEGORY
          SB2    B2-B1
          SA1    CNVA+B2
          MX0    -12
          BX6    -X0*X1 
          SA6    A2 
          MX0    12 
 CNV3     SA2    ALAD        GET AC PARAMETER 
          ZR     X2,CNV6     IF AC PARAMETER NOT SPECIFIED
          SB2    B0 
          SB4    2
 CNV4     SA1    CNVB+B2
          BX1    X0*X1
          BX3    X2-X1
          SB2    B2+B1
          GT     B2,B4,CNV5  IF END OF AC POSSIBILITIES 
          NZ     X3,CNV4     IF AC VALUE NOT FOUND
 CNV5     NZ     X3,ERR11    IF INCORRECT AC PARAMETER
          SB2    B2-B1
          SA1    CNVB+B2
          MX0    -12
          BX6    -X0*X1 
          SA6    A2 
          MX0    12 
 CNV6     SA2    MODE        GET FILE MODE
          ZR     X2,CNV9     IF FILE MODE NOT SPECIFIED 
          SB2    B0 
          SB4    3
 CNV7     SA1    CNVC+B2
          BX1    X0*X1
          BX3    X2-X1
          SB2    B2+B1
          GT     B2,B4,CNV8  IF END OF POSSIBLE MODES 
          NZ     X3,CNV7     IF MODE NOT FOUND
 CNV8     NZ     X3,ERR7     IF INCORRECT MODE
          SB2    B2-B1
          SA1    CNVC+B2
          MX0    -12
          BX6    -X0*X1 
          SA6    A2 
 CNV9     EQ     CNVX        RETURN 
  
 CNVA     VFD    12/0LPU,36/0,12/FCPU 
          VFD    6/0LP,42/0,12/FCPR 
          VFD    12/0LPR,36/0,12/FCPR 
          VFD    6/0LS,42/0,12/FCSP 
  
 CNVB     VFD    6/0LY,42/0,12/FAYS 
          VFD    6/0LN,42/0,12/FANO 
  
 CNVC     VFD    6/0LW,42/0,12/FMWR 
          VFD    6/0LR,42/0,12/FMRE 
          VFD    6/0LN,42/0,12/FMNA 
 CSU      SPACE  4,10 
**        CSU - CHECK FOR SPECIAL USER. 
* 
*         ENTRY  (PTPL) = ALTERNATE USER. 
* 
*         EXIT   (CODE) UPDATED TO NON-ALTERNATE CATALOG IF 
*                USER REQUESTING AUDIT IS THE SAME AS THE ALTERNATE 
*                USER.  SUBTITLE FOR OUTPUT IS COMPLETED. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                B - 2. 
*                A - 1, 2, 6. 
* 
*         CALLS  SFN. 
  
  
 CSU      SUBR               ENTRY/EXIT 
          USERNUM CSUA       GET CURRENT USER NAME
          SA1    CSUA 
          RJ     SFN         SPACE FILL USER NAME 
          MX0    6
          LX6    48 
          SX4    1RF         SET LAST PART OF *OF*
          LX4    54 
          BX6    -X0*X6 
          BX6    X6+X4
          SA6    PTPC 
          SA2    CODE 
          SX2    X2-AUDP
          PL     X2,CSUX     IF ADMIT DATA REQUEST
          SA2    PTPL 
          ZR     X2,CSUX     IF NO ALTERNATE USER 
          MX0    -6 
          SB2    8
 CSU1     LX1    6           POSITION NEXT CHARACTER
          LX2    6
          SB2    B2-B1
          ZR     B2,CSU2     IF USER NUMBERS MATCH
          BX3    -X0*X1      USER 
          BX6    -X0*X2      ALTERNATE USER 
          IX6    X3-X6
          ZR     X6,CSU1     IF CHARACTERS COMPARE
          EQ     CSUX        RETURN 
  
 CSU2     SA1    MODE        PROCEED AS NON-ALTERNATE CATALOG 
          SX6    X1-2 
          SA6    A1 
          EQ     CSUX        RETURN 
  
 CSUA     CON    0           CURRENT USER NAME
 ERR      SPACE  4,25 
**        ERR - ERROR MESSAGES. 
  
  
 ERR      MESSAGE (=C*ERROR IN ARGUMENT.*)
          ABORT 
 ERR1     MESSAGE (=C*NO ARGUMENTS SPECIFIED.*) 
          ABORT 
 ERR2     MESSAGE (=C*ERROR IN VSN.*) 
          ABORT 
 ERR3     MESSAGE (=C*NO USERNAME SPECIFIED.*)
          ABORT 
 ERR4     MESSAGE (=C*EXCEEDED USERNAME LIMIT.*)
          ABORT 
 ERR5     MESSAGE (=C*ERROR IN USERNAME.*)
          ABORT 
 ERR6     MESSAGE (=C*INCORRECT SEPARATOR.*)
          ABORT 
 ERR7     MESSAGE (=C*INCORRECT FILE MODE.*)
          ABORT 
 ERR8     MESSAGE (=C*ERROR IN FILENAME.*)
          ABORT 
 ERR9     MESSAGE (=C*EXCEEDED FILENAME LIMIT.*)
          ABORT 
 ERR10    MESSAGE (=C*INCORRECT FILE CATEGORY.*)
          ABORT 
 ERR11    MESSAGE (=C*INCORRECT AC PARAMETER.*) 
          ABORT 
 ERR12    MESSAGE (=C*EXCEEDED VSN LIMIT.*) 
          ABORT 
 ERR13    MESSAGE (=C*INCORRECT LIST OPTION.*)
          ABORT 
 ERR14    MESSAGE (=C*FILE NAME MISSING.*)
          ABORT 
 ERR15    MESSAGE (=C*INCORRECT PASSWORD.*) 
          ABORT 
 ERR16    MESSAGE (=C*CANNOT AMEND VSN NAME.*)
          ABORT 
 ERR17    MESSAGE (=C*EMPTY CATALOG.*)
          ABORT 
 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. 
* 
*         ENTRY  NONE.
* 
*         EXIT   (X6) = PASSWORD. 
*                TO *ABT* IF INCORRECT PASSWORD ENCOUNTERED.
* 
*         USES   A - 1, 2, 4, 6.
*                B - 2, 3, 4, 5, 6, 7.
*                X - 0, 1, 2, 3, 5, 6, 7. 
* 
*         CALLS  STF. 
* 
*         MACROS CSET, READSKP, WRITE.
  
  
 ESP      SUBR               ENTRY/EXIT 
          SETFET POUT,(LFN==6LOUTPUT) 
          SX2    P           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    P
          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
          IX3    X1-X2
          ZR     X3,ERR15    IF NO DATA ENTERED 
          SB5    X3 
          SB3    B0 
          BX6    X6-X6
          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,ESP9     IF 00 ENCOUNTERED
          SX5    B1+         SET FLAG TO INDICATE 0 ENCOUNTERED 
          EQ     ESP8        PROCESS CHARACTER
  
 ESP5     NZ     X5,ERR15    IF PREVIOUS CHARACTER = COLON
          SB6    X1-1R9 
          GT     B6,ESP7     IF NOT ALPHANUMERIC CHARACTER
 ESP6     SB4    B4-6 
          LX7    X1,B4
          BX6    X7+X6
          SB7    B7+1 
          SB6    B7-7 
          GT     B6,ERR15    IF PASSWORD .GT. SEVEN CHARACTERS
          EQ     ESP8        PROCESS CHARACTER
  
 ESP7     SX4    X1-1R* 
          ZR     X4,ESP6     IF CHARACTER = * 
          SX3    X1-1R
          NZ     X3,ERR15    IF CHARACTER NOT BLANK 
 ESP8     SB2    B2+B1
          SB6    B2-10
          LT     B6,ESP4     IF NOT END OF WORD 
          SB3    B3+B1
          SB6    B5-B3
          EQ     B6,ERR15    IF TOO MUCH DATA ENTERED 
          EQ     ESP3        PICK UP NEXT WORD
  
 ESP9     SA1    I+1
          BX7    X1 
          SA7    A1+B1       SET IN = FIRST FOR INPUT BUFFER
          EQ     ESPX        RETURN 
  
 FBA      SPACE   4,25
***       FBA - FILL CBUF BUFFER FOR ADMIT LIST.
* 
*         ENTRY  NONE.
* 
*         EXIT   (X6) = 0 IF EOI ENCOUNTERED
* 
*         USES   A - 1, 3, 6. 
*                B - 2, 3, 4, 5.
*                X - 0, 1, 3, 6.
* 
*         CALLS  CER. 
* 
*         MACRO  AUDIT. 
  
  
 FBA      SUBR               ENTRY/EXIT 
 FBA1     SX6    B1          PRESET EOI FLAG
          SA1    F+1
          SB2    X1          (B2) = FIRST 
          SA1    F+2
          SB3    X1          (B3) = IN
          SA1    F+3
          SB4    X1          (B4) = OUT 
          SA1    F+4
          SB5    X1-1        (B5) = LIMIT 
          NE     B4,B3,FBA3  IF OUT .NE. IN 
          SA1    F           CHECK FOR EOI ON LAST REQUEST
          MX0    -1 
          LX0    1
          BX0    -X0*X1 
          ZR     X0,FBA2     IF NOT *EOI* 
          BX6    X6-X6       SET EOI FLAG 
          EQ     FBAX        RETURN 
  
 FBA2     AUDIT  F           REQUEST MORE INFORMATION 
          RJ     CER         CHECK FOR RETURNED ERRORS
          NZ     X7,FBA2     IF ROLLABLE ERROR OCCURRED 
          EQ     FBA1        FILL CBUF BUFFER 
  
*         MOVE DATA TO CBUF FROM CIRCULAR BUFFER. 
  
 FBA3     SA3    B4          (X3) = DATA WORD 
          BX6    X3 
          SA6    CBUF        STORE FIRST WORD 
          NE     B4,B5,FBA4  IF OUT .NE. LIMIT
          SB4    B2-B1       SET OUT = FIRST - 1
 FBA4     SB4    B4+B1       INCREMENT OUT
          SA3    B4 
          BX6    X3 
          SA6    CBUF+B1     STORE SECOND WORD
          NE     B4,B5,FBA5  IF OUT .NE. LIMIT
          SB4    B2-B1       SET OUT = FIRST - 1
 FBA5     SX6    B4+B1       RESET OUT
          SA6    F+3
          EQ     FBAX        RETURN 
 FCB      SPACE  4,25 
***       FCB - FILL CBUF BUFFER FOR FULL LIST. 
* 
*         ENTRY  (B2) = 0 SHORT LIST. 
*                   = 1 FULL LIST.
* 
*         EXIT   (X6) = 0 IF EOI ENCOUNTERED
* 
*         USES   A - 1, 3, 4, 5, 6. 
*                B - 2, 3, 4, 5, 6. 
*                X - 0, 1, 3, 4, 5, 6.
* 
*         CALLS  CER. 
* 
*         MACRO  AUDIT. 
  
  
 FCB      SUBR               ENTRY/EXIT 
          SX6    B2          SAVE LIST FLAG 
          SA6    FCBF 
 FCB1     SX6    B1          PRESET X6
          SA1    F+1
          SB2    X1          (B2) = FIRST 
          SA1    F+2
          SB3    X1          (B3) = IN
          SA1    F+3
          SB4    X1          (B4) = OUT 
          SA1    F+4
          SB5    X1-1        (B5) = LIMIT 
          NE     B4,B3,FCB3  IF OUT .NE. IN 
          SA1    F           CHECK FOR EOI ON LAST REQUEST
          MX0    -1 
          LX0    1
          BX0    -X0*X1 
          ZR     X0,FCB2     IF NOT *EOI* 
          BX6    X6-X6       SET EOI FLAG 
          EQ     FCBX        RETURN 
  
 FCB2     AUDIT  F           REQUEST MORE INFORMATION 
          RJ     CER         CHECK FOR RETURNED ERRORS
          NZ     X7,FCB2     IF ROLLABLE ERROR OCCURRED 
          EQ     FCB1        FILL CBUF BUFFER 
  
*         MOVE DATA TO CBUF FROM CIRCULAR BUFFER. 
  
 FCB3     SB6    B0          INITIALIZE CBUF POINTER
          SB7    TCEL        TAPE CATALOG SIZE
 FCB4     SA3    B4          (X3) = DATA WORD 
          BX6    X3 
          SA6    CBUF+B6     STORE DATA WORD
          SB6    B6+B1       INCREMENT CBUF POINTER 
          NE     B4,B5,FCB5  IF OUT .NE. LIMIT
          SB4    B2-B1       SET OUT = FIRST - 1
 FCB5     SB4    B4+B1       INCREMENT OUT
          NE     B6,B7,FCB4  IF 23 WORDS OF TAPE CATALOG NOT MOVED
          SA4    FCBA        GET EOF POINTER
          SA5    FCBF        (X5) = LIST FLAG 
 FCB6     SA3    B4          BYPASS VSN LIST
          NE     B4,B5,FCB7  IF OUT .NE. LIMIT
          SB4    B2-B1       OUT = FIRST - 1
 FCB7     SB4    B4+B1
          ZR     X5,FCB8     IF FULL ADMIT LIST 
          BX6    X3 
          SA6    CBUF+B6
          SB6    B6+B1
 FCB8     MX0    36 
          BX3    X3*X0
          BX0    X3-X4
          NZ     X0,FCB6     IF NOT EOF 
          MI     X0,FCB6     IF NOT EOF 
          SX6    B4          RESET OUT
          SA6    F+3
          EQ     FCBX        RETURN 
  
 FCBA     VFD    36/-0,24/0  EOI WORD 
 FCBF     CON    0           LIST FLAG
          SPACE 2 
 FCE      SPACE  4,25 
***       FCE - FORMAT CATALOG ENTRY FOR OUTPUT.
* 
*         FCE CONVERTS THE FIELDS OF A TAPE CATALOG ENTRY TO
*         DISPLAY AND FORMATS IT INTO 3 - 80 CHARACTER LINES FOR
*         OUTPUT.  HEADER LINES ARE DEFINED WHICH THE CALLING 
*         PROGRAM CAN RETRIEVE (FCEY, FCEZ).
* 
*         ENTRY  (X7) = LINE NUMBER (4 DECIMAL DIGITS) TO BE
*                       ATTACHED TO BEGINNING OF LINE.
*                     = 0 - DO NOT ATTACH ANY LINE NUMBER.
*                (B6) = ADDRESS OF CATALOG ENTRY. 
*                (B7) = WORK AREA FOR STORAGE OF OUTPUT LINES.
*                       BUFFER SIZE IS DETERMINED BY SYMBOLS
*                       *CHDR* = NUMBER OF LINES, 
*                       *NWRD* = NUMBER OF WORDS PER LINE.
*                       NO END-OF-LINES ARE INSERTED.  USE WRITEH 
*                       FOR OUTPUT. 
* 
*         EXIT   OUTPUT LINES WRITTEN TO WORK AREA. 
* 
*         USES   ALL. 
* 
*         CALLS  CDD, CDT, COD, EDT, SCB, SFN.
  
  
 FCE      SUBR               ENTRY/EXIT 
          SA7    FCED        STORE LINE NUMBER
  
*         INITIALIZE THE OUTPUT WORKING BUFFER. 
  
          SB2    NWRD*3-1    NUMBER OF WORDS TO FILL - 1
          SA1    FCEB        BLANK FILL THE BUFFER
          BX6    X1 
 FCE1     SA6    B7+B2       BLANK FILL NEXT CELL 
          SB2    B2-B1
          PL     B2,FCE1     IF NOT BLANK FILLED
  
*         CONVERT CATALOG FIELDS
  
          SA3    B6+CEMD     MODIFICATION DATE AND TIME 
          RJ     CDT         CONVERT DATE AND TIME
          SB3    MDPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          BX6    X5 
          SB3    MTPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA3    B6+CEAD     LAST ACCESS DATE AND TIME
          RJ     CDT         CONVERT DATE AND TIME
          SB3    ADPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          BX6    X5 
          SB3    ATPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA3    B6+CECD     CREATION DATE AND TIME 
          RJ     CDT         CONVERT DATE AND TIME
          SB3    CDPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          BX6    X5 
          SB3    CTPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          MX0    54          FILE TYPE
          SA2    B6+CEPW
          AX2    6
          BX0    -X0*X2 
          SX0    X0-1 
          SA2    X0+FCEI
          BX6    X2 
          SB3    FTPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA2    B6+CEST     LOGICAL FILE NAME
          LX2    59-2 
          PL     X2,FCE2     IF NOT SYMBOLIC ACCESS 
          SA1    B6+CELI     STORE FILE NAME
          RJ     SFN         SPACE FILL NAME
          SB3    FNPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CEST
          MX2    42 
          BX1    X2*X1
          RJ     SFN         SPACE FILL NAME
          SB3    F2PS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          EQ     FCE3 
  
 FCE2     SA1    B6+CEES     STORE VSN
          MX0    36 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SB3    FNPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    FCEQ 
          BX6    X1 
          SB3    F2PS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
 FCE3     SA1    FCED        LINE NUMBER
          ZR     X1,FCE4     IF NO LINE NUMBER
          RJ     CDD         CONVERT TO DISPLAY 
          LX6    59-23       LEFT-JUSTIFY LINE NUMBER 
          SB3    NMPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
 FCE4     MX0    54 
          SA2    B6+CEPW
          BX0    -X0*X2 
          SX0    X0-1 
          SA2    X0+FCEJ     PERMISSION MODE
          BX6    X2 
          SB3    FPPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA5    MULT        MULTIFILE LIST INDICATOR 
          ZR     X5,FSE5     IF NOT MULTIFILE 
          SA1    B6+CEVS     SECTION NUMBER 
          MX2    -18
          BX1    -X2*X1 
          RJ     CDD         CONVERT TO DISPLAY 
          LX6    59-23       LEFT-JUSTIFY LINE NUMBER 
          SB3    SNPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CESQ     SEQUENCE NUMBER
          MX2    -18
          BX1    -X2*X1 
          RJ     CDD         CONVERT TO DISPLAY 
          LX6    59-23       LEFT-JUSTIFY LINE NUMBER 
          SB3    QNPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CESI     MULTI-SET I.D. 
          MX2    36 
          BX1    X2*X1
          RJ     SFN         SPACE FILL NAME
          SB3    SIPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
 FSE5     SA1    B6+CEPI     PHYSICAL FILE NAME 
          RJ     SFN         SPACE FILL NAME
          SB3    PNPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CESQ
          MX2    42 
          BX1    X2*X1
          RJ     SFN         SPACE FILL NAME
          SB3    P2PS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA2    B6+CEAD     ACCESS COUNT 
          MX1    24 
          BX1    X1*X2
          LX1    24 
          SA2    FCEG 
          BX0    X2-X1
          PL     X0,FCE6     IF NOT OVERFLOW ACCESS COUNT 
          SA3    FCEH        OVERFLOW FLAG
          BX6    X3 
          SB3    AFPS 
          RJ     SCB         SET CHARACTER IN BUFFER
          SA1    FCEG 
 FCE6     RJ     CDD         CONVERT TO DISPLAY 
          LX6    36D
          SB3    ACPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA2    B6+CEPW     PASSWORD 
          MX1    42 
          BX1    X1*X2
          RJ     SFN         SPACE FILL NAME
          SB3    PWPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CETD     DATA FORMAT
          MX0    54 
          AX1    30 
          BX0    -X0*X1 
          SA1    X0+FCEL
          BX6    X1 
          SB3    DFPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CETD     LABEL STATUS 
          LX1    1
          MX0    2
          BX1    X0*X1
          LX1    2
          SA2    X1+FCEP
          BX6    X2 
          SB3    LBPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CETD     CONVERSION MODE
          LX1    12D
          MX0    -3 
          BX1    -X0*X1 
          SA2    X1+FCEN
          BX6    X2 
          SB3    CVPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CETD     GET TAPE TYPE
          MX0    -2 
          AX1    55 
          BX0    -X0*X1 
          BX6    X0          SAVE TAPE TYPE FOR DENSITY GENERATION
          SA6    FCEF 
          SA2    X0+FCEK     SET TAPE TYPE MNEMONIC 
          BX6    X2 
          SB3    TYPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CEST     ALTERNATE USER LISTABLE
          MX0    59 
          AX1    11 
          BX0    -X0*X1 
          SA2    X0+FCEO
          BX6    X2 
          SB3    AUPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          SA1    B6+CETD     DENSITY
          LX1    9D 
          MX0    -3 
          BX0    -X0*X1 
          SA1    FCEF        CHECK TAPE TYPE
          ZR     X1,FCE7     IF *MT*
          SX0    X0+1        ADJUST FOR DUAL 800-BPI TABLE ENTRIES
 FCE7     SX2    X1-3 
          NZ     X2,FCE7.1   IF NOT *AT*
          SX0    X0+1        ADJUST FOR DUAL 38000-CPI TABLE ENTRIES
 FCE7.1   SA2    X0+FCEM
          BX6    X2 
          SB3    DNPS 
          RJ     SCB         SET CHARACTERS IN BUFFER 
          EQ     FCEX        RETURN 
  
 FCEB     CON    10H
 FCED     BSS    1           LINE NUMBER
 FCEF     BSSZ   1           TAPE TYPE
 FCEG     CON    9999D
 FCEH     CON    1L*         ACCESS COUNT OVERFLOW FLAG 
  
*         HEADER LINES. 
  
 FCEY     DATA   40H         FILE-NAME      PASSWORD CT MD A
          DATA   C*CNT CREATION   ACCESS   LAST MOD*
 FCEU     DATA   30H      LOGICAL/PHYSICAL  LB TT 
          DATA   C*F  DN CV AC  DATE/TIME DATE/TIME DATE/TIME*
 FCEV     DATA   30H                        QN
          DATA   C*SN    SET ID*
  
 FCEZ     DATA   40H         FILE-NAME               CT MD A
          DATA   C*CNT CREATION   ACCESS   LAST MOD*
 FCES     DATA   30H      LOGICAL/PHYSICAL  LB TT 
          DATA   C*F  DN CV AC  DATE/TIME DATE/TIME DATE/TIME*
 FCET     DATA   30H                        QN
          DATA   C*SN    SET ID*
  
  
*         FIELD EQUIVALENCED CODES
  
  
  
 FCEI     BSS    0           FILE TYPES 
          LOC    0
          CON    2LPU 
          CON    2LPR 
          CON    2LSP 
          LOC    *O 
  
 FCEJ     BSS    0           PERMISSION MODES 
          LOC    0
          CON    2LRE 
          CON    2LWR 
          CON    2LNU 
          LOC    *O 
  
 FCEK     BSS    0           TAPE TYPES 
          LOC    0
          CON    2LMT        SEVEN TRACK TAPE 
          CON    2LCT        CARTRIDGE TAPE 
          CON    2LNT        NINE TRACK TAPE
          CON    2LAT        ACS CARTRIDGE TAPE 
          LOC    *O 
  
 FCEL     BSS    0           DATA FORMATS 
          LOC    0
          CON    2LI         INTERNAL 
          CON    2LSI        SYSTEM INTERNAL
          CON    2LF         FOREIGN
          CON    2LS         STRANGER 
          CON    2LSL        LONG STRANGER
          CON    2LLI        LONG BLOCK INTERNAL
          LOC    *O 
  
 FCEM     BSS    0           TAPE DENSITIES 
          LOC    0
          CON    0
          CON    2LLO        200-BPI SEVEN TRACK TAPE 
          CON    2LHI        556-BPI SEVEN TRACK TAPE 
          CON    2LHY        800-BPI SEVEN TRACK TAPE 
          CON    2LHD        800-CPI NINE TRACK TAPE
          CON    2LPE        1600-CPI NINE TRACK TAPE 
          CON    2LGE        6250-CPI NINE TRACK TAPE 
          CON    2LCE        38000-CPI CARTRIDGE TAPE 
          CON    2LAE        38000-CPI ACS CARTRIDGE TAPE 
          LOC    *O 
  
 FCEN     BSS    0           CONVERSION MODE
          LOC    0
          CON    0
          CON    2L          BCD CONVERSION (7 TRACK) 
          CON    2LAS        ASCII
          CON    2LEB        EBCDIC 
          LOC    *O 
  
 FCEO     BSS    0           ALTERNATE USER AUDIT ATTRIBUTE 
          LOC    0
          CON    1LN         NOT AUDITABLE BY ALTERNATE USER
          CON    1LY         AUDITABLE BY ALTERNATE USER
          LOC    *O 
  
 FCEP     BSS    0           LABEL STATUS 
          LOC    0
          CON    2LKU        UNLABELED
          CON    2LNS        NON-STANDARD LABEL 
          CON    2LKL        LABELED
          LOC    *O 
  
 FCEQ     CON    10HNON-SYM 
 FCER     CON    1L*
  
  
  
*         LINE DEFINITION TABLE.
*         THE CHARACTER FORMAT OF THE OUTPUT BUFFER IS DEFINED HERE.
  
 LINE1    EQU    0           STARTING CHARACTER POSITION
 NMPS     CFORM  LINE1+1,4   NUMBER 
 FNPS     CFORM  LINE1+6,10  FILE NAME
 F2PS     CFORM  LINE1+16,7  FILE NAME
 PWPS     CFORM  LINE1+24,7  PASSWORD 
 FTPS     CFORM  LINE1+33,2  FILE CATEGORY
 FPPS     CFORM  LINE1+36,2  PERMISSION MODE
 ACPS     CFORM  LINE1+39,4  ACCESS COUNT 
 AFPS     CFORM  LINE1+43,1  ACCESS COUNT FLAG
 CDPS     CFORM  LINE1+43,9  CREATION DATE
 ADPS     CFORM  LINE1+53,9  ACCESS DATE
 MDPS     CFORM  LINE1+63,9  MODIFY DATE
  
 LINE2    EQU    NWRD*10     STARTING CHARACTER POSITION
 PNPS     CFORM  LINE2+6,10  PHYSICAL FILE NAME 
 P2PS     CFORM  LINE2+16,7  PHYSICAL FILE NAME 
 LBPS     CFORM  LINE2+24,2  LABEL STATUS 
 TYPS     CFORM  LINE2+27,2  TAPE TYPE
 DFPS     CFORM  LINE2+30,2  DATA FORMAT
 DNPS     CFORM  LINE2+33,2  DENSITY
 CVPS     CFORM  LINE2+36,2  CONVERSION MODE
 AUPS     CFORM  LINE2+39,1  ALTERNATE USER AUDITABILITY
 CTPS     CFORM  LINE2+43,9  CREATION TIME
 ATPS     CFORM  LINE2+53,9  ACCESS TIME
 MTPS     CFORM  LINE2+63,9  MODIFY TIME
  
 LINE3    EQU    NWRD*10*2   STARTING CHARACTER POSITION
 QNPS     CFORM  LINE3+22,4  SEQUENCE NUMBER
 SNPS     CFORM  LINE3+28,4  SECTION NUMBER 
 SIPS     CFORM  LINE3+36,6  SET IDENTIFIER 
 GAL      SPACE 4,25
**        GAL - GENERATE ADMIT LIST.
* 
*         *GAL* POSITIONS THE USERNAMES IN *LBUF* FOR THE 
*         SHORT ADMIT LIST OPTION.  *LBUF* IS THEN WRITTEN. 
* 
*         ENTRY  (CBUF) = ADMIT ENTRY.
* 
*         EXIT   THE USERNAME IS IN THE CORRECT POSITION. 
*                *LBUF* IS WRITTEN IF LINE IS FULL. 
* 
*         USES   A - 1, 5, 6. 
*                B - 2. 
*                X - 0, 1, 2, 5, 6. 
* 
*         CALLS  AEN, ALN, SFN. 
* 
*         MACRO  WRITEC.
  
 GAL      SUBR               ENTRY/EXIT 
          SA5    GALA        CHECK LINE FILE COUNT
          SX2    7
          IX2    X2-X5
          NG     X2,GAL1     IF FIRST ENTRY 
          NZ     X2,GAL2     IF NOT END OF LINE 
          WRITEC O,LBUF 
 GAL1     SB2    B1          ADVANCE LINE NUMBER BY 1 
          RJ     ALN         ADVANCE LINE NUMBER
          SX5    B0          RESET LINE COUNT 
 GAL2     RJ     AEN         ADVANCE ENTRY NUMBER 
          SA1    CBUF+AEUN   PICK ENTRY 
          MX0    42 
          BX1    X0*X1
          ZR     X1,GALX     IF NO NAME 
          RJ     SFN         SPACE FILL NAME
          LX6    48 
          SA1    CBUF+AEAC   CHECK FOR EXPLICIT USER
          MX0    4
          LX0    40 
          BX1    X0*X1
          ZR     X1,GAL3     IF IMPLICIT USER 
          MX0    54 
          BX6    X0*X6
          SA1    GALB 
          BX6    X1+X6
 GAL3     SA6    LBUF+X5
          SX6    X5+B1       ADVANCE LINE FILE COUNT
          SA6    GALA 
          EQ     GALX        RETURN 
  
 GALA     CON    8           LINE POSITION
  
 GALB     CON    1R*
 GSL      SPACE  4,25 
**        GSL - GENERATE SHORT LIST.
* 
*         *GSL* POSITIONS THE 17 CHARACTER FILENAMES IN 
*         *LBUF* FOR THE SHORT LIST OPTION.  *LBUF* IS
*         WRITTEN WHEN THE LINE IS FULL.
* 
*         ENTRY  (CBUF) = CATALOG ENTRY 
* 
*         EXIT   *LBUF* IS WRITTEN WHEN LINE IS FULL. 
* 
*         USES   A - 1, 2, 3, 5, 6. 
*                B - 2. 
*                X - 0, 1, 2, 3, 5, 6.
* 
*         CALLS  AEN, ALN, SFN. 
* 
*         MACROS WRITEC, XFER.
  
  
 GSL      SUBR               ENTRY/EXIT 
          SA5    GSLA        CHECK LINE FILE COUNT
          SX2    6
          IX2    X2-X5
          NG     X2,GSL1     IF FIRST ENTRY 
          NZ     X2,GSL2     IF NOT END OF LINE 
          WRITEC O,LBUF 
 GSL1     SB2    B1          ADVANCE LINE NUMBER BY 1 
          RJ     ALN         ADVANCE LINE NUMBER
          SX5    B0          RESET LINE COUNT 
 GSL2     RJ     AEN         ADVANCE ENTRY NUMBER 
          SA1    CBUF        PICK ENTRY 
          ZR     X1,GSLX     IF NO NAME 
          BX6    X1 
          SA6    GSLB 
          SX2    X5+B1
          SA1    CBUF+B1
          BX6    X1 
          SA6    GSLB+B1
          SX6    X2+B1       ADVANCE LINE FILE COUNT
          SA6    GSLA 
          XFER   GSLB,LBUF+X5,0,2,18,18 
          SA2    GSLA 
          SX2    X2-2 
          SA3    LBUF+X2
          MX0    6
          BX3    -X0*X3 
          SA1    BLNK 
          BX6    X1+X3
          SA6    A3 
          SA1    GSLB+B1     CHECK FOR SPECIAL CONDITION
          MX0    54 
          BX0    -X0*X1 
          NZ     X0,GSL3     IF SPECIAL CONDITION 
          SA1    GSLC 
          LX1    54 
          MX0    6
          LX0    54 
          SA3    LBUF+X2
          BX3    -X0*X3 
          BX6    X3+X1
          SA6    A3 
          EQ     GSLX        RETURN 
  
 GSL3     SA1    BLNK 
          LX1    54 
          MX0    6
          LX0    54 
          SA3    LBUF+X2
          BX3    -X0*X3 
          BX6    X3+X1
          SA6    A3 
          EQ     GSLX        EXIT 
  
 GSLA     CON    8           LINE POSITION
 GSLB     BSSZ   2           FILE IDENTIFIER STORAGE
 GSLC     CON    1L*         SPECIAL CONDITION FLAG 
 HDR      SPACE  4,15 
**        HDR - GENERATES HEADERS.
* 
*         ENTRY  (CODE) = CODE OF LISTING.
* 
*         EXIT   HEADER LINE PLACED IN OUTPUT BUFFER. 
* 
*         USES   A - 1, 6.
*                B - NONE.
*                X - 0, 1, 6. 
* 
*         CALLS  NONE.
* 
*         MACRO  WRITEC.
  
  
 HDR      SUBR               ENTRY/EXIT 
          SA1    CODE        INDEX INTO HEADER POINTER TABLE
          SA1    X1+HDRB
          BX0    X0-X0       INITIALIZE FOR LINE COUNT
          BX6    X1 
          SA6    HDRA        SET INDEX BASE OF HEADER MESSAGES FOR MODE 
  
*         LOOP PRINTING HEADER MESSAGE LINES. 
  
 HDR1     SA1    HDRA        EXAMINE CURRENT MESSAGE POINTER
          SA1    X1 
          ZR     X1,HDR2     IF END OF HEADER MESSAGES
          SX6    A1+B1       SET NEXT MESSAGE POINTER 
          SA6    HDRA 
          SX0    X0+B1       INCREMENT LINE COUNT 
          WRITEC O,X1 
          EQ     HDR1        CONTINUE LOOP
  
*         COMPLETE HEADER PROCESSING. 
  
 HDR2     WRITEC O,BLNK 
          WRITEC O,BLNK 
          SA1    LINE        INCREMENT LINE COUNT 
          IX6    X1+X0
          SX6    X6+2 
          SA6    A1 
          EQ     HDRX        RETURN 
  
*         HEADER MESSAGE BASE POINTERS. 
  
 HDRA     CON    0
 HDRB     CON    HDRC,HDRD,HDRE,HDRF,HDRG,HDRH
  
*         HEADER MESSAGE POINTERS.
  
 HDRC     CON    HDRI        SHORT FILE LIST
          CON    0
  
 HDRD     CON    FCEY        FULL FILE LIST 
          CON    FCEU 
          CON    0
          CON    0
  
 HDRE     CON    HDRI        SHORT ALTERNATE CATALOG
          CON    0
  
 HDRF     CON    FCEZ        FULL ALTERNATE CATALOG 
          CON    FCES 
          CON    0
          CON    0
  
 HDRG     CON    HDRJ        SHORT ADMIT ENTRIES
          CON    0
  
 HDRH     CON    HDRK        FULL ADMIT ENTRIES 
          CON    0
  
**        HEADERS 
  
 HDRI     DATA   C*  TAPE FILE NAME(S)* 
  
  
 HDRJ     DATA   C*  USER NAME(S)*
  
 HDRK     DATA   C*    USER NAME   MODE  ACCESSES DATE      TIME* 
          CON    0
 IDF      SPACE  4,15 
**        IDF - ISSUE DAYFILE MESSAGE.
* 
*         ENTRY  (CCDR) COMMAND IMAGE.
* 
*         EXIT   DAYFILE MESSAGE ISSUED.
* 
*         USES   A - 1, 4, 5. 
*                B - 2, 6.
*                X - 0, 1, 2, 4, 5. 
* 
*         CALLS  RSP. 
* 
*         MACROS MESSAGE, MOVE. 
  
  
 IDF      SUBR               ENTRY/EXIT 
          MOVE   8,CCDR,IDFA
          SA4    RSP1$       FWA ARGUMENT TABLE 
          SB6    RSP2$       FWA KEYWORD/POSITION TABLE 
          SA5    IDFA        FWA OF RELOCATED COMMAND 
          SB2    1R,         SKIP TO *,*
          RJ     RSP         REMOVE SECURE PARAMETERS 
          MESSAGE IDFA,0,R   ISSUE COMMAND TO DAYFILE 
          SA1    JOPR 
          LX1    -24
          MX0    -12
          BX1    -X0*X1 
          SX2    X1-IAOT
          NZ     X2,IDFX     IF NOT AN INTERACTIVE JOB
          MESSAGE IDFB,1     CLEAR LINE 1 OF CPA
          EQ     IDFX        RETURN 
  
 IDFA     BSS    8           SECURE PARAMETER BUFFER
 IDFB     CON    0           ZERO WORD
 MCS      SPACE  4,25 
**        MCS - MOVE CHARACTER STRING.
* 
*         ENTRY  (X1) = FIRST DIRECTIVE.
*                (A1) = LOCATION OF FIRST DIRECTIVE.
* 
*            THE CHARACTER STRING TO BE MOVED IS SPECIFIED VIA A
*            DIRECTIVE.  THE CONTENT OF A DIRECTIVE HAS THE FOLLOWING 
*            FORMAT:  
* 
*              BITS 59 - 48  - N
*              BITS 47 - 30  - INPUT WORD LOCATION
*              BITS 29 - 24  - INPUT CHARACTER POSITION (1,2,...,10)
*              BITS 23 - 18  - OUTPUT CHARACTER POSITION (1,2,...,63) 
*              BITS 17 - 0   - OUTPUT WORD LOCATION 
* 
*            ADDITIONAL CHARACTER STRINGS MAY BE MOVED BY PROVIDING 
*            ADDITIONAL DIRECTIVES. A ZERO-WORD TERMINATES THE LIST 
*            OF DIRECTIVES. IF THE INDICATED OUTPUT CHARACTER 
*            INDEX IS GREATER THAN 10 THE OUTPUT WORD LOCATION
*            IS AUTOMATICALLY ADJUSTED. 
* 
*         EXIT   SPECIFIED CHARACTER STRING IS MOVED. 
* 
*         USES   A - 1, 2, 3, 6.
*                B - 1, 2, 3, 4, 5, 6, 7. 
*                X - 0, 1, 2, 3, 4, 6, 7. 
  
  
 MCS      SUBR               ENTRY/EXIT 
          MX0    -6          7777 7777 7777 7777 7700 
          MX7    -18         7777 7777 7777 7700 0000 
          SB1    1
 MCS1     SX3    6
          SB2    60 
          ZR     X1,MCS      IF END OF DIRECTIVE LIST 
          SB7    X1          SET B7 = DESTINATION WORD LOCATION 
          AX1    18 
          BX2    -X0*X1 
          IX2    X2*X3
          SB5    X2 
 MCS2     SB5    B5-B2       ADJUST DESTINATION CHARACTER POSITION
          SB7    B7+B1
          NG     B5,MCS3     IF ADJUSTED
          ZR     B5,MCS3     IF ADJUSTED
          EQ     MCS2        CONTINUE 
  
 MCS3     SB5    B5+B2
          SB7    B7-B1
          SB5    B2-B5       SET B5 = DESTINATION CHARACTER POSITION
          AX1    6
          BX2    -X0*X1 
          IX2    X2*X3
          SB4    X2          SET B4 = SOURCE CHARACTER POSITION 
          AX1    6
          SB6    X1          SET B6 = SOURCE WORD LOCATION
          AX1    18 
          MX7    60-12
          BX2    -X7*X1 
          SB3    X2+B1       SET B3 = N+1 
          SA1    A1+B1       GET NEXT MOVE DIRECTIVE
 MCS4     SB3    B3-B1       DECREMENT N
          ZR     B3,MCS1     IF N=0 GET NEXT MOVE DIRECTIVE 
          SA2    B6          GET SOURCE WORD
          LX2    X2,B4       POSITION CHARACTER TO LOW ORDER
          BX2    -X0*X2      EXTRACT CHARACTER
          SB4    B4+6        INCREMENT SOURCE CHARACTER POSITION
          SB2    B4-66
          NZ     B2,MCS5     IF SAME WORD 
          SB4    6           RESET SOURCE CHARACTER POSITION
          SB6    B6+B1       INCREMENT SOURCE WORD LOCATION 
 MCS5     SA3    B7          GET DESTINATION WORD 
          LX2    X2,B5       POSITION NEW CHARACTER 
          LX4    X0,B5       POSITION MASK
          BX3    X4*X3       ERASE OLD CHARACTER
          BX6    X2+X3       INSERT NEW CHARACTER 
          SA6    B7          STORE DESTINATION WORD 
          SB5    B5-6        DECREMENT DESTINATION CHARACTER POSITION 
          PL     B5,MCS4     IF SAME WORD 
          SB5    54          RESET DESTINATION CHARACTER POSITION 
          SB7    B7+B1       INCREMENT DESTINATION WORD LOCATION
          EQ     MCS4        CONTINUE MOVE
 PCK      SPACE  4,25 
**        PCK - PACK FILE IDENTIFIER (17 CHARACTERS). 
* 
*         PCK PICKS UP THE FIRST WORD OF THE FILE IDENTIFIER FROM 
*         THE *USB* TABLE.  THE FIRST CHARACTER POSITION OF THIS
*         WORD IS STORED IN SAVE.  PCK STORES THE TWO WORD FILE 
*         IDENTIFIER IN THE STORAGE AREA SPECIFIED BY A5. 
* 
*         ENTRY  SAVE- FIRST CHARACTER POSITION OF FILENAM. 
*                B3  - CURRENT EMPTY POSITION OF TFIN.
*                X6  - LAST WORD OF FILENAME AS RETURNED FROM *POP*.
*                A5  - ADDRESS OF STORAGE AREA
* 
*         EXIT   B3 IS INCREMENTED BY ONE WORD AND THE TWO-WORD 
*                FILENAME HAS BEEN STORED.
* 
*         USES   A - 1, 3, 4, 6, 7. 
*                B - 2, 3, 4. 
*                X - 1, 3, 4, 6, 7. 
* 
*         CALLS SFN.
  
 PCK5     SA1    PCKB 
  
 PCK      SUBR               ENTRY/EXIT 
          BX7    X1          SAVE DELIMITER 
          SA7    PCKB 
          GT     B5,B1,ERR   IF FILENAME .GT. 2 WORDS 
          NZ     X6,PCK1     IF FILENAME .NE. 20 CHARACTERS 
          NZ     B5,ERR      IF FILENAME .EQ. 20 CHARACTERS 
 PCK1     SB2    54D
          BX7    X7-X7
          SB4    B0 
          SA4    SAVE 
          SA3    PCKD        CHECK FOR LITERAL
          SA1    X4 
          BX3    X3-X1
          NZ     X3,PCK2     IF NOT LITERAL 
          SX4    X4+1 
 PCK2     ZR     X6,PCK3     IF FILENAME .GE. 10 CHARACTERS 
          ZR     B5,PCK4     IF FILENAME .LT. 10 CHARACTERS 
 PCK3     SA3    X4+B4
          LX3    B2 
          BX7    X3+X7
          SB2    B2-6 
          SB4    B4+B1
          NZ     B2,PCK3     IF 10 CHARACTERS NOT YET PACKED
          SA3    X4+B4
          BX7    X3+X7
          SA7    A5+B3
          SB3    B3+B1
          MX0    42 
          BX3    -X0*X6 
          NZ     X3,ERR8
          BX1    X6 
          RJ     SFN         SPACE FILL NAME
          SA6    A5+B3
          EQ     PCK5        RESTORE DELIMITER WORD AND RETURN
  
 PCK4     BX1    X6 
          RJ     SFN         SPACE FILL NAME
          SA6    A5+B3
          SB3    B3+B1
          SA1    PCKA 
          BX6    X1 
          SA6    A5+B3
          EQ     PCK5        RESTORE DELIMITER WORD AND RETURN
  
 PCKA     CON    10L
 PCKB     CON    0           STORAGE FOR DELIMITER
 PCKD     CON    1R$         LITERAL DESIGNATOR 
 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   A - 1, 3.
*                B - 2, 3.
*                X - 0, 1, 2, 3, 4, 6, 7. 
  
  
 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     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 
 PVT      SPACE  4,25 
**        PVT - PROCESS *VSN* OR *TFN* LIST.
* 
*         ENTRY  B6 - NEXT CHARACTER POSITION OF *USB* BUFFER 
* 
*         EXIT   VSN(S) OR TFN(S) ARE STORED IN *TFIN*. 
* 
*         USES   A - 3, 5, 6. 
*                B - 3, 7.
*                X - 3, 5, 6. 
* 
*         CALLS  PCK, POP.
* 
 PVT      SUBR               ENTRY/EXIT 
          RJ     POP         PICK OUT NEXT WORD 
          NG     B5,ERR      IF ERROR ENCOUNTERED 
 PVT1     SA3    INDX 
          SB3    X3 
          SB7    TFINL
          EQ     B3,B7,ERR9  EXCEEDED FILENAME LIMIT
          SA5    TFIN 
          RJ     PCK         STORE FILENAME 
          SX6    B3+B1
          SA6    INDX 
          NG     X2,PVTX     IF NO MORE ARGUMENTS 
          SB3    X1-1R,      CHECK FOR COMMAS 
          NZ     B3,PVTX     IF END OF FILE NAME LIST 
          SX6    B6 
          SA6    SAVE 
          RJ     POP         PICK OUT NEXT PARAMETER
          NG     B5,ERR8     IF ERROR ENCOUNTERED 
          EQ     PVT1 
 PTP      SPACE  4,25 
**        PTP - PRINT TITLE PAGE. 
* 
*         ENTRY  (PAGE) = PAGE NUMBER 
* 
*         EXIT   TITLE PAGE PRINTED 
*                (LINE) RESET TO 2. 
* 
*         USES   A - 1, 6.
*                B - 2. 
*                X - 0, 1, 6. 
* 
*         CALLS  CDD. 
* 
*         MACROS CLOCK, DATE, WRITEC, WRITEH. 
  
  
 PTP      SUBR               ENTRY/EXIT 
          SA1    PAGE        ADVANCE TO NEXT PAGE 
          SX1    X1+B1
          BX6    X1 
          SA6    A1 
          RJ     CDD         CONVERT TO DECIMAL 
          MX0    48 
          BX6    -X0*X6 
          SA1    PTPG 
          BX1    X0*X1
          BX6    X1+X6
          SA6    PTPG 
          DATE   PTPE 
          CLOCK  PTPF 
          SB2    6           FOR TELEX ORIGIN JOBS
          SA1    DTYP 
          ZR     X1,PTP1     IF TERMINAL FILE 
          WRITEH O,PTPA,B1
          SB2    7           FOR NON-TELEX ORIGIN JOBS
 PTP1     WRITEH O,PTPB,B2+  WRITE TITLE LINE 
          SA1    PTPH        WRITE SUB TITLE
          WRITEC O,X1 
          SX6    3           RESET LINE NUMBER
          SA6    LINE 
          EQ     PTPX        RETURN 
  
 PTPA     CON    1H1
 PTPB     CON    10H CATALOG O
 PTPC     CON    0
 PTPD     CON    10H
          CON    10H
 PTPE     CON    0
 PTPF     CON    0
 PTPG     DATA   8L  PAGE 
 PTPH     CON    BLNK 
 PTPI     CON    1H 
          CON    10HFILE NAME 
 PTPJ     BSSZ   2
  
 PTPK     CON    1H 
          CON    10HALTERNATE 
          CON    10HCATALOG 
 PTPL     CON    0
 RQS      SPACE  4,25 
**        RQS - REQUEST STORAGE.
* 
*         ENTRY  (X1) = CURRENT BUFFER SIZE.
* 
*         EXIT   (X1) = NEGATIVE IF NO MORE STORAGE AVAILABLE.
*                (CFL) = NEW CURRENT FL.
*                (CBS) = NEW CURRENT BUFFER SIZE. 
* 
*         USES   X - 1, 3, 6. 
*                A - 1, 3, 6. 
* 
*         MACROS MEMORY.
  
  
 RQS      SUBR               ENTRY/EXIT 
          SA3    MXBS        GET MAXIMUM BUFFER SIZE
          SX6    X1+FLIN     ADD POSSIBLE INCREMENT 
          IX1    X3-X6
          NG     X1,RQSX     IF NO MORE SPACE 
          SA3    CRFL        SET POSSIBLE NEW FL
          SX6    X3+FLIN
          SA6    A3 
          LX6    30 
          SA6    RQSA 
          MEMORY CM,RQSA,R,,NA
          SA3    RQSA 
          SA1    CRFL 
          AX3    30 
          IX1    X3-X1
          NG     X1,RQSX     IF NO MORE ALLOCATED 
          SA1    CSBS        UPDATE CURRENT SORT BUFFER SIZE
          SX6    X1+FLIN
          SA6    A1 
          EQ     RQSX        RETURN 
  
 RQSA     CON    0           FL CONTROL WORD
 SEC      SPACE 4,15
**        SEC - SHORT LIST ERROR CHECK
* 
*         THIS ROUTINE CHECKS FOR OFF-SITE STATUS, NOT RESERVED 
*         STATUS, CATALOG IN RECOVERED MODE, AND CATALOG ERROR
*         SET.  THIS ROUTINE IS CALLED BY *SFL* AND *SSL* TO CHECK
*         FOR THESE ERRORS. 
* 
*         ENTRY  SHORT LIST FLAG SET AND BUFFER FILLED. 
* 
*         EXIT   (X2) = (CBUF+CEST) 
*                (X5) = FILE NAME MASK. 
* 
*         USES   A - 2. 
*                X - 1. 
* 
  
 SEC      SUBR               ENTRY/EXIT 
          MX5    60          PRESET SPECIAL CONDITION FLAG
          SA2    CBUF+TCEL+1
          MX1    -18
          BX2    -X1*X2 
          SX1    TVVS        CHECK SITE STATUS
          BX1    X2*X1
          ZR     X1,SEC1     IF SITE NOT SET SKIP 
          MX5    -6 
          SA2    CBUF+CEST   GET STATUS 
          EQ     SECX        RETURN 
  
 SEC1     SX1    RTVS        CHECK RESERVE STATUS 
          BX1    X2*X1
          NZ     X1,SEC2     IF RESERVE SET SKIP
          MX5    -6 
          SA2    CBUF+CEST   GET STATUS 
          EQ     SECX        RETURN 
  
 SEC2     SA2    CBUF+CEST   GET STATUS 
          SX1    2000B
          BX1    X1*X2
          ZR     X1,SEC3     IF RECOVER NOT SET 
          MX5    -6 
          EQ     SECX        RETURN 
  
 SEC3     SX1    2
          BX1    X1*X2
          ZR     X1,SECX     IF ERROR NOT SET 
          MX5    -6 
          EQ     SECX        RETURN 
 SST      SPACE  4,15 
**        SST - SHELL SORT TABLE. 
* 
*         SST SORTS A TABLE USING A SHELL SORTING TECHNIQUE.
*         THE TABLE IS SORTED IN PLACE INTO ASCENDING ORDER.
*         ALL ELEMENTS SHOULD BE OF THE SAME SIGN.
* 
*         ORIGIN OF TECHNIQUE IS CACM VOL 6 NUMBER 5  MAY 1963, P209. 
*         FIRST CODED BY R. HOTCHKISS IN *SORT1*. 
*         REVISED BY L. A. LIDDIARD.
*         REVISED BY L. A. GILBERTSON, FOR 17 CHAR. WORD. 
* 
*         ENTRY  (B1) = 1.
*                (B7) = ADDRESS OF TABLE TO BE SORTED.
*                (X1) = NUMBER OF WORDS IN ARRAY. 
* 
*         EXIT   TABLE SORTED.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 1, 2, 6, 7.
* 
*         CALLS NONE. 
  
  
 SST1     SA7    B5-B4       T(J+K) = S 
          BX7    X5 
          SA7    A7+B1
          SB2    B2+2        I = I+2
          EQ     B2,B3,SST4  IF END OF TABLE
 SST2     SA2    B2          S = T(I) 
          SA5    B2+B1
          SB5    B2+B4       J = I-K
          BX7    X2 
 SST3     SA1    B5          T(J) 
          IX3    X2-X1       COMPARE S AND T(J) 
          PL     X3,SST1     IF ELEMENTS IN ORDER 
          BX6    X1          T(J+K) = T(J)
          SB5    B5+B4       J = J-K
          SA6    A1-B4
          SA1    A1+B1
          BX6    X1 
          SA6    A1-B4
          GE     B5,B7,SST3  IF J " FIRST 
          EQ     SST1        MOVE ELEMENT 
  
 SST4     AX4    1           K = K/2
          MX0    -1 
          BX4    -X0+X4 
          SX3    X4+1 
          NZ     X3,SST5
          SB4    B0 
          EQ     SST6 
  
 SST5     SB4    X4          (B4) = -K
 SST6     SB2    B7-B4       I = FIRST+K
          NZ     X4,SST2     IF K " 0 
  
 SST      SUBR               ENTRY/EXIT 
          SB3    B7+X1       (B3) = LAST+1
          BX4    -X1
          EQ     SST4        ENTER SORT LOOP
 SVM      SPACE  4,25 
***       SVM - SET VARIABLE MESSAGE
* 
*         SVM SETS THE VARIABLE AUDIT MESSAGE *XXX FOUND*.
* 
*         ENTRY  ADTA = CONTAINS THE NAME, ZERO FILLED. 
* 
*         EXIT   ADTA CONTAINS THE MESSAGE. 
* 
*         USES   A - 1. 
*                X - 0, 1, 2. 
*                B - 2, 3, 4, 5.
* 
*         CALLS  NONE.
* 
*         MACROS XFER.
  
  
 SVM      SUBR               ENTRY/EXIT 
          MX0    -6 
          SB2    B0          WORD COUNT 
          SB3    B0          CHARACTER COUNT
          SB4    10D         MAXIMUM CHARACTERS 
          SA1    ADTA+B1
          ZR     X1,SVM1     IF NAME .LE. 10 CHARACTERS 
          SB2    B1 
 SVM1     SA1    ADTA+B2
          BX2    -X0*X1 
          LX0    6
          SB3    B3+B1
          EQ     B3,B4,SVM2  IF 10 CHARACTERS PROCESSED 
          ZR     X2,SVM1     IF ZERO CHARACTER
          NE     B1,B3,SVM2  IF NOT AT A WORD BOUNDARY
          SB2    B2+B1       INCREMENT WORD COUNT OFFSET
          SB3    B4+B1       SET ZERO CHARACTER COUNT OFFSET
 SVM2     SB5    B4-B3       SHIFT COUNT
          SB5    B5+B1
          XFER   SVMF,ADTA+B2,0,B5,7,7
          EQ     SVMX 
  
 SVMF     CON    7L FOUND.
 XFR      SPACE  4,25 
***       XFR - TRANSFER/VALIDATE CHARACTER STRING. 
* 
*         *XFR* PERFORMS A CHARACTER STRING TRANSFER AND VALIDATES
*         EACH CHARACTER MOVED ACCORDING TO THE SETTINGS OF THE 
*         VALIDATION FLAGS OF THE SOURCE CONTROL WORD. THE TRANSFER 
*         CAN BEGIN AT ANY CHARACTER OF THE SOURCE AND OBJECT FIELDS
*         AND WILL CONTINUE UNTIL *XCC* CHARACTERS OF THE SOURCE
*         HAVE BEEN TRANSFERRED. THE DISPOSITION OF THE LAST OBJECT 
*         WORD IS SPACE FILLED IF *XCC* OF THE SOURCE FIELD IS
*         LESS THEN *XCC* OF THE OBJECT FIELD. THE SOURCE CHARACTER 
*         STRING WILL BE TRUNCATED IF THE *XCC* OF THE OBJECT IS
*         LESS THEN *XCC* OF THE SOURCE. THE ROUTINE WILL NOT 
*         DESTROY ANY OF THE EXISTING INFORMATION OUTSIDE OF THE
*         DEFINED RANGE OF THE TRANSFER.
* 
*         ENTRY  (X1) = SOURCE CONTROL WORD.
*                (X2) = OBJECT CONTROL WORD.
* 
*         EXIT   (X1) = 0 IF NO ERRORS. 
*                (X1) NOT = 0 IF ERRORS.
* 
*         CONTROL WORD FORMAT.
* 
*         VFD    12/0,18/FWA,3/FLG,9/BWP,9/BCP,9/XCC
* 
*         FWA    FIRST WORD ADDRESS OF BUFFER.
*         FLG    VALIDATION FLAG. 
*           2    VALIDATE NUMERIC CHARACTERS. 
*           4    VALIDATE ALPHABETIC CHARACTERS.
*           6    VALIDATE ALPA/NUMERIC CHARACTERS.
*           7    NO VALIDATION. 
*         BWP    BEGINNING WORD POSITION IN FWA.
*         BCP    BEGINNING CHARACTER POSITION IN BWP. 
*         XCC    TRANSFER CHARACTER COUNT.
* 
*         USES   A - 1, 2, 3, 4, 5, 6.
*                X - ALL. 
*                B - ALL. 
* 
  
  
 XFR12    SB4    B7-B4       REMAINING SHIFT COUNT
          LX6    X2,B4       REALIGN LAST WORD
          BX1    X6 
          RJ     SFN         SPACE FILL NAME
          SA6    A2          STORE LAST OBJECT WORD 
          ZR     X4,XFRX     IF NO VALIDATION CHECK 
          NG     X5,XFRX     IF NOT DATA TRANSFER ERROR 
          SX1    B1+         SET ERROR FLAG 
  
 XFR      SUBR               ENTRY/EXIT 
          MX0    -9 
          BX6    -X0*X1      SOURCE CHARACTER COUNT 
          AX1    9
          BX7    -X0*X2      OBJECT CHARACTER COUNT 
          SB2    X6          (B2) = SOURCE CHARACTER COUNT
          AX2    9
          IX6    X7-X6
          SB3    X6 
          GT     B3,XFR0     IF SOURCE < OR = OBJECT
          SX6    B0 
          SB2    X7          SOURCE = OBJECT CHARACTER COUNT
 XFR0     SA6    XFRA        OBJECT OVERFLOW COUNT
          BX3    -X0*X1 
          SB3    X3          (B3)= SOURCE BCP 
          AX1    9
          BX3    -X0*X2 
          SB4    X3          (B4)= OBJECT BCP 
          AX2    9
          BX3    -X0*X1 
          SB5    X3          (B5)= SOURCE BWP 
          AX1    9
          BX3    -X0*X2 
          SB6    X3          (B6)= OBJECT BWP 
          BX3    X1 
          LX3    59-2 
          MX4    0
          PL     X3,XFR1     IF NOT ALPHANUMERIC FORMAT 
          SA4    XFRB        GET ALPHANUMERIC VALIDATION WORD 
 XFR1     SA5    XFRC        GET NUMERIC VALIDATION WORD. 
          LX3    59-58
          PL     X3,XFR2     IF NOT NUMERIC FORMAT
          BX4    X4+X5
 XFR2     LX3    59-57-59+58
          PL     X3,XFR3     IF NO SPECIAL CHARACTERS ALLOWED 
          MX4    60 
 XFR3     MX0    -18
          AX1    3
          BX1    -X0*X1 
          SA1    X1+B5       (A1)= SOURCE FWA 
          AX2    12 
          BX2    -X0*X2 
          SX6    6           CHARACTER COUNT MULTIPLIER 
          SA2    X2+B6       (A2)= OBJECT FWA 
          SX7    B3          SOURCE CHARACTER POSITION
          IX7    X6*X7
          SB3    X7          RESET (B3) 
          SX7    B4          OBJECT CHARACTER POSITION
          IX7    X6*X7
          SB4    X7          RESET (B4) 
          LX1    X1,B3       ALIGN TO FIRST CHARACTER(SOURCE) 
          LX2    X2,B4       ALIGN TO FIRST CHARACTER(OBJECT) 
          MX0    6           CHARACTER MASK 
          SB7    60          SHIFT LIMIT
 XFR4     BX3    X0*X1       SAVE UPPER 6 BITS OF SOURCE
          ZR     X4,XFR5     IF NO VALIDATION CHECK 
          SB5    6
          LX5    X3,B5
          SB5    X5 
          LX5    X4,B5
          PL     X5,XFR9     IF INCORRECT CHARACTER 
 XFR5     BX2    -X0*X2      CLEAR UPPER 6 BITS OF OBJECT 
          BX2    X2+X3       MASK INTO OBJECT WORD
          LX1    59-53
          SB3    B3+6 
          EQ     B3,B7,XFR7  IF SOURCE SHIFT LIMIT
  
 XFR6     LX2    59-53
          SB4    B4+6 
          SB2    B2-B1
          ZR     B2,XFR9     IF LAST CHARACTER TRANSFERRED
          EQ     B4,B7,XFR8  IF OBJECT SHIFT LIMIT
          EQ     XFR4        GET NEXT CHARACTER 
  
 XFR7     SA1    A1+B1       GET NEXT SOURCE WORD 
          SB3    B0          CLEAR SOURCE BCP 
          EQ     XFR6        CHECK OBJECT SHIFT LIMIT 
  
 XFR8     BX6    X2 
          SA6    A2          STORE OBJECT WORD
          SA2    A2+B1       GET NEXT OBJECT WORD 
          SB4    B0          CLEAR OBJECT BCP 
          EQ     XFR4        GET NEXT CHARACTER 
  
 XFR9     SA3    XFRA        CHECK FOR UNDERFLOW
          SB2    X3+0        (B2) = UNDERFLOW COUNTER 
          SX3    1R 
          SX1    B0 
          LX3    59-5 
 XFR10    ZR     B2,XFR12    IF LAST FILL CHARACTER 
          EQ     B4,B7,XFR11 IF OBJECT SHIFT LIMIT
          BX2    -X0*X2 
          SB4    B4+6 
          BX2    X2+X3       MASK IN SPACE
          SB2    B2-B1
          LX2    59-53
          EQ     XFR10       SPACE FILL NEXT CHARACTER
  
 XFR11    BX6    X2 
          SA6    A2          STORE OBJECT WORD
          SB4    B0          CLEAR OBJECT BCP 
          SA2    A2+B1       GET NEXT OBJECT WORD 
          EQ     XFR10       GET NEXT CHARACTER 
  
  
*         *XFRB* AND *XFRC* ARE THE ALPHABETIC AND NUMERIC VALIDATION 
*         WORDS. EACH BIT SET CORRESPONDS TO THE NUMERICAL DISPLAY
*         CODE VALUE FOR EACH VALID CHARACTER. EACH CHARACTER CAN BE
*         TESTED BY SHIFTING THE VALIDATION WORD LEFT BY THE DISPLAY
*         CODE VALUE AND TESTING FOR THE BIT BEING SET. 
*         *XFRB* HAS BEEN PRESET FOR A - Z AND *SPACE*. 
*         *XFRC* HAS BEEN PRESET FOR 0 - 9. 
  
 XFRA     CON    0           OVERFLOW COUNTER 
 XFRB     DATA   37777777700000040000B
 XFRC     DATA   00000000077760000000B
  
 ZFD      SPACE  4,15 
**        ZFD - DISPLAY CODE ZERO FILL WORD. (EXTRACTED FROM PFTRACK) 
* 
*         ENTRY  (X6) = WORD WITH BINARY ZEROES.
* 
*         EXIT   (X6) = WORD WITH REPLACED DISPLAY CODE ZEROES
* 
*         USES   X - 0, 2, 3, 4, 5, 6.
  
  
 ZFD      SUBR               ENTRY/EXIT 
          BX3    X6 
          SX2    12B
          MX0    -6 
 ZFD1     BX5    -X0*X3 
          ZR     X5,ZFD3     IF BINARY ZERO 
          LX3    54 
 ZFD2     SX2    X2-1        DECREMENT CHARACTER COUNT
          NZ     X2,ZFD1     IF NOT DONE WITH WORD
          BX6    X3 
          EQ     ZFDX        RETURN 
  
 ZFD3     BX3    X0*X3
          SX4    33B
          BX3    X4+X3
          LX3    54 
          EQ     ZFD2        CONTINUE CONVERSION
  
  
          SPACE  4
*CALL     COMCARM 
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCPM 
*CALL     COMCEDT 
*CALL     COMCMVE 
*CALL     COMCPOP 
*CALL     COMCRSP 
*CALL     COMCSCB 
*CALL     COMCSFN 
*CALL     COMCSNM 
*CALL     COMCSTF 
*CALL     COMCSYS 
*CALL     COMCUSB 
*CALL     COMCWTC 
*CALL     COMCWTH 
*CALL     COMCWTW 
          SPACE  4
**      BUFFERS.
  
  
          USE    LITERALS 
 LBUF     EQU    *           OUTPUT LINE BUFFER 
 CBUF     EQU    LBUF+CHDR*NWRD   CATALOG READ BUFFER 
 IBUF     EQU    CBUF+301D   INPUT BUFFER 
 OBUF     EQU    IBUF+IBFL   OUTPUT BUFFER
 SBUF     EQU    OBUF+OBFL   CATALOG SORT BUFFER
 RFL=     EQU    SBUF+SBFL   DEFAULT FL 
  
  
 PMSG     BSS    0
          DATA   10H"EM"  PASSWO
          DATA   10HRD:"NL"  HHH
          DATA   10HHHHHH"CR"  I
          DATA   10HIIIIIII"CR" 
          DATA   10H ######## 
          DATA   10H"CR""CB""EL"''''
 PMSGL    EQU    *-PMSG 
  
          END 
