Retro1.org codex

          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