Retro1.org codex

          IDENT  TFSP,ORIG 
          ABS
          SST
          SYSCOM B1
          ENTRY  TFSP
          ENTRY  TFSPE
          ENTRY  TFSPR
          ENTRY  RFL=
          ENTRY  SSJ=
          TITLE  TFSP - TAPE FILE SUPERVISOR PROCESSOR.
*COMMENT  TAPE FILE SUPERVISOR PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 TFSP     SPACE  4,10
***       TFSP - TAPE FILE SUPERVISOR PROCESSOR.
*
*         J. D. HOLMBECK.    82/10/01.
 TFSP     SPACE  4,10
***       TFSP COMMAND.
*
*         THE TAPE FILE SUPERVISOR, TFSP, CREATES AND MANAGES THE TAPE
*         CATALOG FILE.
*
*         TFSP CAN MANIPULATE EITHER THE FAMILY TAPE CATALOG FILE (A
*         FAST-ATTACHED FILE NAMED *ZZZZZFC* ON USER INDEX 377777) OR
*         LOCAL FILE IMAGES OF THE TAPE CATALOG FILE.
*
*         TFSP CAN ONLY ACCESS THE FAMILY TAPE CATALOG FILE IF IT IS
*         CALLED FROM A SYSTEM ORIGIN JOB OR IT IS CALLED FROM A JOB
*         THAT HAS A USER NAME THAT HAS BEEN VALIDATED TO ACCESS THE
*         FILE.
*
*         ONLY ONE TFSP JOB CAN ACCESS A TAPE CATALOG FILE OF A FAMILY
*         AT ONE TIME.  HOWEVER, SEVERAL TFSP JOBS CAN BE ACCESSING
*         TAPE CATALOG FILES OF DIFFERENT FAMILIES AT THE SAME TIME.
 TFSPE    SPACE  4,10
***       TFSPE COMMAND.
*
*         TFSPE IS CALLED BY THE SYSTEM WHEN AN ERROR IS DISCOVERED IN
*         A VSN OR TAPE FILE ENTRY.
*
*         TFSPE CAN BE USED BY SITE PERSONNEL TO CLEAR INTERLOCKS IN
*         THE TAPE CATALOG FILE THAT PREVENT NORMAL TFSP JOBS FROM
*         ACCESSING THE TAPE CATALOG FILE.
*
*         WHEN TFSPE IS EXECUTED, ANY OTHER TFSP JOB THAT IS ACCESSING
*         THE TAPE CATALOG FILE OF THE SAME FAMILY WILL BE ABORTED.
*
*         TFSPE CAN ONLY BE USED FROM A SYSTEM ORIGIN JOB.
*
*         TFSPE IS EQUIVALENT TO THE TFSP(OP=K) COMMAND WITH
*         THE FOLLOWING THREE EXCEPTIONS -
*
*         1. THE INITIAL LEFT SCREEN K-DISPLAY INCLUDES THE FOLLOWING
*            INFORMATION -
*
*            TAPE CATALOG ERROR DISCOVERED AT - YY/MM/DD, HH.MM.SS.
*
*            THE ERROR IS EXPLAINED IN THE MESSAGE BUFFER.
*
*         2. THE INTERLOCK THAT PREVENTS MULTIPLE TFSP JOBS FROM
*            ACCESSING A TAPE CATALOG FILE IS CLEARED AND THEN RESET SO
*            THAT ONLY THE TFSPE JOB CAN ACCESS THE FILE.  ANY OTHER
*            TFSP JOB ATTEMPTING TO ACCESS THE TAPE CATALOG FILE WILL
*            BE ABORTED.
*
*         3. IF THE RF PARAMETER IS SPECIFIED, TFSPE WILL REMOVE THE
*            FAST-ATTACHED STATUS OF THE TAPE CATALOG FILE.  THIS CAN
*            BE USED TO PREVENT ACCESS TO THE TAPE CATALOG FILE AFTER
*            TFSPE HAS COMPLETED.  WHEN THE FILE IS MADE FAST-ATTACHED
*            AGAIN VIA THE *TMSON* COMMAND, ALL BUSY INTERLOCKS
*            IN THE TAPE CATALOG FILE WILL BE CLEARED.
          SPACE  4,10
***       TFSP AND TFSPE COMMAND FORMATS.
*
*         TFSP( P1 , P2 , ... PN ) Z OPTION DIRECTIVES
*         TFSPE( P1 , P2 , ... PN )
*
*         WHERE P1 , ... , PN CAN BE THE FOLLOWING -
*
*         I = FILENAM
*                INPUT FILE WITH TFSP DIRECTIVES.  IGNORED BY OP=K AND
*                OP=Z OPTIONS.  IF I=0, NO INPUT FILE IS USED.  DEFAULT
*                IS INPUT.  VALID FOR TFSP ONLY.
*
*         L = FILENAM
*                OUTPUT FILE.  TFSP LISTS INPUT DIRECTIVES, ERRORS
*                ENCOUNTERED, AND INFORMATION AS SPECIFIED BY THE AUDIT
*                DIRECTIVES (AUDITUN, AUDITVS, AUDITCN, AUDITFI,
*                AUDITFV, AUDITCH, AND AUDITAU).  IF L=0, NO OUTPUT
*                FILE IS GENERATED.  DEFAULT IS OUTPUT.
*
*         P = FILENAM
*                OLD TAPE CATALOG FILE.  IGNORED EXCEPT FOR LOCAL FILE
*                (LF) MODE.  IF P=0, A NEW TAPE CATALOG FILE WILL BE
*                CREATED.  DEFAULT IS OLD.  VALID FOR TFSP ONLY.
*
*         N = FILENAM
*                NEW OR UPDATED TAPE CATALOG FILE.  IGNORED EXCEPT FOR
*                LOCAL FILE (LF) MODE.  DEFAULT IS NEW IF P=0.  DEFAULT
*                IS *FILENAM* IF P=*FILENAM*.  VALID FOR TFSP ONLY.
*
*         S = FILENAM
*                SOURCE FILE TO RECEIVE TFSP INPUT DIRECTIVES GENERATED
*                FROM INFORMATION ON THE TAPE CATALOG FILE.  THE SOURCE
*                FILE IS GENERATED BY THE SOURCE DIRECTIVES (SOURCE,
*                SOURCUN, SOURCVS, SOURCCH, SOURCCN, SOURCFI, AND
*                SOURCFV).  IF S=0, NO SOURCE FILE IS GENERATED.
*                DEFAULT IS SOURCE.
*
*         SS = FILENAM
*                MACHINE READABLE FILE.  TFSP LISTS INFORMATION TO
*                *FILENAM* IN MACHINE READABLE FORMAT AS SPECIFIED BY
*                THE MACHINE READABLE AUDIT DIRECTIVES (MREADUN,
*                MREADVS, MREADCH, MREADCN, MREADFI, AND MREADFV). IF
*                SS=0, NO MACHINE READABLE FILE IS GENERATED.  DEFAULT
*                IS NO MACHINE READABLE FILE.
*
*         OP = OPTION
*                TFSP OPTION.  VALID VALUES ARE -
*
*                I - READ TFSP DIRECTIVES FROM THE FILE SPECIFIED BY
*                    THE I PARAMETER.
*
*                K - READ TFSP DIRECTIVES FROM K-DISPLAY INPUT.
*                    DISPLAY TAPE CATALOG FILE INFORMATION AT THE
*                    K-DISPLAY.  VALID ONLY FOR SYSTEM ORIGIN JOBS.
*
*                Z - READ TFSP DIRECTIVES FROM THE DELIMITED STRING
*                    FOLLOWING THE COMMAND TERMINATOR.  THE
*                    FIRST CHARACTER FOLLOWING THE TERMINATOR IS
*                    ASSUMED TO BE THE DELIMITER.
*
*                DEFAULT IS OP=I.  VALID FOR TFSP ONLY.
*
*         LF
*                LOCAL FILE MODE.  IF SPECIFIED, TFSP WILL ACCESS AND
*                UPDATE THE LOCAL FILES SPECIFIED BY THE P AND N
*                PARAMETERS.  IF NOT SPECIFIED, TFSP WILL ACCESS AND
*                POSSIBLY UPDATE THE FAST-ATTACHED FILE *ZZZZZFC* ON
*                USER INDEX 377777.  FOR NON-SYSTEM ORIGIN JOBS, IF THE
*                LF PARAMETER IS NOT SPECIFIED, TFSP WILL ABORT IF THE
*                USER HAS NOT BEEN VALIDATED TO ACCESS THE FAMILY TAPE
*                CATALOG FILE VIA THE VALIDAT DIRECTIVE.
*                VALID FOR TFSP ONLY.
*
*         A
*                ABORT MODE.  IF SPECIFIED, TFSP WILL ABORT WHEN THE
*                FIRST ERROR IS ENCOUNTERED WHILE PROCESSING THE
*                DIRECTIVES.  IF NOT SPECIFIED, TFSP WILL ISSUE AN
*                ERROR MESSAGE TO THE OUTPUT FILE AND DAYFILE, BUT WILL
*                CONTINUE PROCESSING WITH THE DIRECTIVES ON THE NEXT
*                LINE OF INPUT.  ABORT MODE IS USUALLY SELECTED WHEN
*                TFSP IS RUN WITH NON-INTERACTIVE INPUT SUCH AS RUNNING
*                TFSP IN A BATCH ORIGIN JOB.  ABORT MODE IS USUALLY NOT
*                SELECTED WHEN TFSP IS RUN WITH INTERACTIVE INPUT SUCH
*                AS RUNNING TFSP WITH THE K-DISPLAY OR FROM A
*                TIME-SHARING TERMINAL.  VALID FOR TFSP ONLY.
*
*         NV
*                NO VERIFY MODE.  IGNORED IF NOT LOCAL FILE (LF) MODE.
*                IGNORED IF NOT CREATING NEW TAPE CATALOG FILE (P=0).
*                IF SPECIFIED, TFSP WILL NOT CHECK THE STATUS OF VSNS
*                SPECIFIED BY THE VSN DIRECTIVE, TAPE FILES SPECIFIED
*                BY THE FILE OR FILEV DIRECTIVE, OR ALTERNATE USERS
*                SPECIFIED BY THE AUSER DIRECTIVE.  THIS CAN SPEED
*                PROCESSING OF LARGE TFSP INPUT FILES.  HOWEVER, THIS
*                CAN ALSO CREATE ERRORS IN THE TAPE CATALOG FILE IF THE
*                INPUT FILE IS SET UP INCORRECTLY.  VALID FOR TFSP
*                ONLY.
*
*         RT
*                RETRY ON CATALOG INTERLOCK OPTION.  IGNORED FOR LOCAL
*                FILE (LF) MODE.  IF SPECIFIED, TFSP WILL NOT ABORT IF
*                THE FAST-ATTACHED TAPE CATALOG FILE IS INTERLOCKED BY
*                ANOTHER TFSP JOB.  TFSP WILL WAIT UNTIL THE OTHER JOB
*                IS COMPLETE SO IT CAN ACCESS THE TAPE CATALOG FILE.
*                GENERALLY, THE RETRY OPTION IS SELECTED WHEN TFSP IS
*                RUN IN A PROCEDURE FILE OR IN A BATCH ORIGIN JOB.
*                VALID FOR TFSP ONLY.
*
*         FM = FAMILY
*                FAMILY THAT THE TAPE CATALOG FILE RESIDES ON.
*                INCORRECT ENTRY IF NOT A SYSTEM ORIGIN JOB.  INCORRECT
*                ENTRY IF IN LOCAL FILE (LF) MODE.  DEFAULT IS THE
*                FAMILY OF THE CALLING JOB.  A NON-SYSTEM ORIGIN JOB IS
*                FORCED TO ACCESS THE TAPE CATALOG FILE FOR ITS FAMILY.
*
*         CF = FILENAM
*                COPY FILE FOR TFSPE.  IF THIS PARAMETER IS SPECIFIED
*                ON THE TFSPE COMMAND, TFSPE WILL ATTEMPT TO DEFINE A
*                DIRECT-ACCESS FILE ON USER NAME *SYSTEMX* WITH THE
*                PERMANENT FILE NAME *FILENAM*.  TFSPE WILL THEN COPY
*                THE CURRENT TAPE CATALOG FILE TO *FILENAM*.  IF THIS
*                PARAMETER IS NOT SPECIFIED, NO COPY WILL TAKE PLACE.
*                IF *CF* IS SPECIFIED WITHOUT A FILE NAME, *ZFCCOPY* IS
*                ASSUMED.
*
*         CLEAR
*                CLEAR INFORMATION FROM TAPE CATALOG FILE FOR TFSPE.
*                IF THIS PARAMETER IS SPECIFIED ON THE TFSPE COMMAND,
*                TFSPE WILL OVERWRITE THE TAPE CATALOG FILE AS AN EMPTY
*                TAPE CATALOG FILE.  THE FOREIGN CATALOG AND CATALOG
*                ERROR STATUSES ARE SET.  THE *CLEAR* PARAMETER CAN
*                ONLY BE SPECIFIED IF THERE IS A CATALOG ERROR ON THE
*                CURRENT TAPE CATALOG FILE AND THE *CF* PARAMETER IS
*                ALSO SPECIFIED ON THE TFSPE COMMAND.
 TFSPR    SPACE  4,15
***       TFSPR COMMAND.
*
*         TFSPR(FM=FAMILY)
*
*                FAMILY = NAME OF FAMILY TO PROCESS.
*
*         THE TFSPR COMMAND WILL CLEAR ALL TAPE CATALOG INTERLOCKS
*         HELD BY OTHER MACHINES SHARING THE CATALOG AT THE TIME OF A
*         SYSTEM FAILURE.  TFSPR NEED ONLY BE RUN IF THE FAILED
*         MACHINE(S) WILL NOT REDEADSTARTED.  THE MREC UTILITY MUST BE
*         RUN ON THE CATALOG DEVICE FOR EACH MACHINE TO BE RECOVERED
*         PRIOR TO RUNNING TFSPR.  FAILURE TO DO SO WILL PREVENT THE
*         CATALOG INTERLOCKS FOR THAT MACHINE FROM BEING RELEASED.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         FOLLOWING ARE THE DAYFILE MESSAGES ISSUED BY TFSP.
*         ADDITIONAL MESSAGES MAY BE ISSUED BY THE SYSTEM OR BY THE PP
*         ROUTINES CALLED BY TFSP.  CONSULT THE DOCUMENTATION FOR THE
*         PP *TFM* FOR A LISTING OF ITS DAYFILE MESSAGES.
*
*         TFSP COMPLETE.
*                TFSP NORMAL COMPLETION.
*
*         TFSP ABORTED.
*                CONTROL POINT ERROR FLAG IS SET.  CONSULT DAYFILE
*                LISTING FOR REASON.
*
*         TFSP ABORTED BY USER.
*                TFSP RUNNING IN AN INTERACTIVE JOB WAS ABORTED VIA
*                USER BREAK PROCESSING.
*
*         PARAMETER ERROR - PARAM.
*                THE SPECIFIED PARAMETER IS NOT A TFSP PARAMETER.
*
*         INCORRECT OPTION - OP.
*                THE SPECIFIED OPTION IS NOT ALLOWED WITH THE OP
*                PARAMETER.
*
*         DIRECTIVE ERRORS.
*                ERRORS WERE ENCOUNTERED WHILE PROCESSING THE
*                DIRECTIVES.  CONSULT THE OUTPUT LISTING FOR REASON.
*
*         INCORRECT ACCESS.
*                USER WHO WAS NOT VALIDATED ATTEMPTED TO ACCESS THE
*                FAMILY TAPE CATALOG FILE.
*
*         FAMILY NOT ACTIVE.
*                A FAST-ATTACHED FILE NAMED *ZZZZZFC* WAS NOT FOUND ON
*                THE FAMILY.
*
*         FILE NAME CONFLICT - LFN.
*                SPECIFIED FILE USED FOR MORE THAN ONE PURPOSE.  ONLY
*                THE P AND N PARAMETERS CAN SPECIFY THE SAME FILE NAME.
*
*         TAPE CATALOG FILE INTERLOCKED.
*                ANOTHER TFSP JOB IS ACCESSING THE TAPE CATALOG FILE OF
*                THE FAMILY.
*
*         EMPTY TAPE CATALOG FILE.
*                THE FILE SPECIFIED BY THE P PARAMETER IS A ZERO-LENGTH
*                FILE.
*
*         UNEXPECTED TAPE CATALOG ERROR.
*                THE PP PROGRAM *TFM* RETURNED AN ERROR CODE THAT TFSP
*                WAS NOT EXPECTING.  IF THIS MESSAGE IS ISSUED WHILE
*                WORKING ON A FAST-ATTACHED TAPE CATALOG FILE, CONTACT
*                SITE ANALYST.
*
*         ABNORMAL TERMINATION, ERROR CODE = NN.
*                THE SYSTEM RETURNED AN ERROR THAT TFSP COULD NOT
*                RECOGNIZE.  IF THIS MESSAGE IS ISSUED, CONTACT SITE
*                ANALYST.
*
*         *CF* PARAMETER REQUIRED WITH *CLEAR*.
*                THE TFSPE COMMAND WAS ISSUED WITH THE *CLEAR*
*                PARAMETER BUT WITHOUT THE *CF* PARAMETER.
*
*         CATALOG ERROR REQUIRED WITH *CLEAR*.
*                THE TFSPE COMMAND WAS ISSUED WITH THE *CLEAR*
*                PARAMETER FOR A TAPE CATALOG FILE THAT DID NOT HAVE A
*                TAPE CATALOG ERROR.
          SPACE  4,10
***       ACCOUNT FILE MESSAGES.
*
*         THE FOLLOWING ARE THE ACCOUNT FILE MESSAGES ISSUED BY TFSP.
*         THESE MESSAGES ARE ONLY ISSUED WHEN TFSP IS ACCESSING THE
*         FAST-ATTACHED TAPE CATALOG FILE.
*
*         SDAU, FAMNAME/USERNAM/QNZZZ/VSNFFF, VSNCCC.
*                ISSUED FOR EACH VSN ASSIGNED TO A TAPE FILE.
*
*         SDCR, FAMNAME/USERNAM/QNZZZ/VSNFFF,  YY/MM/DD.
*                ISSUED WHEN CONDITIONAL RELEASE IS SET.
*
*         SDCR, FAMNAME/USERNAM/QNZZZ/VSNFFF, .
*                ISSUED WHEN CONDITIONAL RELEASE IS CLEARED.
*
*         SDAD, FAMILY , VSN   , PRN   , SSSSSS.
*                ISSUED FOR EACH VSN ADDED TO CATALOG.
*
*         SDRM, FAMILY , VSN   .
*                ISSUED FOR EACH VSN REMOVED FROM CATALOG.
*
*         SDRV, FAMILY , VSN   , PRN   , SSSSSS.
*                ISSUED FOR EACH VSN REVISED IN CATALOG.
*
*         SDAM, FAMILY , USERNAM, FVSN  , SSSSSS.
*                ISSUED FOR EACH TAPE FILE AMENDED IN CATALOG.
*
*         SDRA, FAMNAME/USERNAM/QNZZZ/VSNFFF, TFD.
*                ISSUED BY *TFM* TO PROVIDE MORE INFORMATION ABOUT
*                A TAPE FILE FOR DATABASE RECOVERY PURPOSES.
*
*         SDRB, FAMNAMEXLOGICAL*FILE*IDNTYPHYSICAL*FILE*IDT.
*                ISSUED BY *TFM* TO PROVIDE MORE INFORMATION ABOUT
*                A TAPE FILE FOR DATABASE RECOVERY PURPOSES.
*                THIS MESSAGE ONLY APPEARS FOR A SYMBOLIC ACCESS TAPE.
*
*         SDRC, FAMNAME/CONTROLWRDX/CHRGNUMBER, MULSIDY.
*                ISSUED BY *TFM* TO PROVIDE MORE INFORMATION ABOUT
*                A TAPE FILE FOR DATABASE RECOVERY PURPOSES.
          SPACE  4,10
***       GENERAL RULES FOR INPUT DIRECTIVES.
*
*         SOME TFSP DIRECTIVES CAN CONSIST OF AN IDENTIFIER AND A DATA
*         FIELD SEPARATED BY AN EQUAL SIGN.  FOR EXAMPLE -
*
*                VSN=V1
*
*         OTHER TFSP DIRECTIVES CONSIST ONLY OF AN IDENTIFIER AND ARE
*         NOT EQUIVALENCED.  FOR EXAMPLE -
*
*                HELP
*
*         IN GENERAL, TFSP DIRECTIVES CAN BE SEPARATED BY A
*         NON-ALPHA-NUMERIC CHARACTER, AN END-OF-LINE OR AN
*         END-OF-CARD.  FOR EXAMPLE -
*
*                VSN=V1
*                ERRFLAG=SET+OWNER=USER;ADD
*
*         IN GENERAL, BLANKS ON A TFSP DIRECTIVE INPUT LINE ARE
*         IGNORED.  FOR EXAMPLE -
*
*                VS  N =  V 1
*
*         IS THE SAME AS -
*
*                VSN=V1
*
*         HOWEVER, THE PRN, SI, AND UC DIRECTIVES ACCEPT BLANKS AND ALL
*         OTHER NON-ALPHA-NUMERIC CHARACTERS IN THEIR DATA FIELDS.  THE
*         SEPARAT DIRECTIVE IS AVAILABLE TO FORCE ONE NON-BLANK,
*         NON-ALPHA-NUMERIC CHARACTER TO ALWAYS BE INTERPRETED AS A
*         SEPARATOR.  FOR EXAMPLE -
*
*                SEPARAT=*
*                UC=A B,SI=*FA=A
*                SEPARAT=,
*                UC=A B,SI=*FA=A
*
*         IS THE SAME AS -
*
*                UC=A B,SI=
*                FA=A
*                UC=A B
*                SI=*FA=A
*
*         ENTRY OF A COLON CHARACTER IN THE INPUT FILE CAN CAUSE
*         UNPREDICTABLE RESULTS.  THE COLON DIRECTIVE IS AVAILABLE TO
*         FORCE A NON-ALPHA-NUMERIC CHARACTER TO BE INTERPRETED AS A
*         COLON.  FOR EXAMPLE -
*
*                COLON=)
*                UC=AB)XX
*
*         IS THE SAME AS -
*
*                UC=AB:XX
*
*         IF A DIRECTIVE IDENTIFIER IS ONE, TWO, OR THREE CHARACTERS
*         LONG, THE ENTIRE IDENTIFIER MUST BE SPELLED OUT.  IF AN
*         IDENTIFIER IS MORE THAN THREE CHARACTERS LONG, AT LEAST THE
*         FIRST THREE CHARACTERS MUST BE SPECIFIED PLUS ANY ADDITIONAL
*         CHARACTERS NEEDED TO MAKE THE DIRECTIVE UNIQUE.  FOR
*         EXAMPLE -
*
*                AUDITV=V1
*                AUDITU=USER1
*                VAL=USER2
*
*         IS THE SAME AS -
*
*                AUDITVS=V1
*                AUDITUN=USER1
*                VALIDAT=USER2
*
*         HOWEVER, ENTRY OF VA=USER2 WOULD BE INCORRECT BECAUSE THE
*         IDENTIFIER IS LESS THAN THREE CHARACTERS.  ENTRY OF AUDIT=V1
*         WOULD BE INCORRECT BECAUSE THE IDENTIFIER WOULD NOT BE
*         UNIQUE.
*
*         SOME DIRECTIVES HAVE A SPECIFIC SET OF OPTIONS THAT CAN BE
*         ENTERED IN THE DATA FIELD.  ONLY ENOUGH CHARACTERS TO
*         UNIQUELY IDENTIFY THE OPTION MUST BE SPECIFIED IN THE DATA
*         FIELD.  FOR EXAMPLE -
*
*                CT=PR
*                CT=S
*                CT=PU
*
*         IS THE SAME AS -
*
*                CT=PRIVATE
*                CT=SPRIV
*                CT=PUBLIC
*
*         HOWEVER, CT=P WOULD BE INCORRECT BECAUSE THE DATA FIELD WOULD
*         NOT BE UNIQUE.
*
*         EACH DIRECTIVE LINE OF INPUT IS FREE FORMAT THROUGH COLUMN
*         72.  ANY DATA AFTER COLUMN 72 IS IGNORED.
*
*         ALL NUMERIC DATA IS ASSUMED TO BE DECIMAL UNLESS A B
*         POST-RADIX IS USED TO FORCE OCTAL.
*
*         FOR EQUIVALENCED DIRECTIVES, IF THE DATA FIELD IS NOT
*         SPECIFIED, THE DEFAULT VALUE WILL BE SET IF THE DIRECTIVE HAS
*         A DEFAULT.  FOR EXAMPLE -
*
*                NS=
*
*         IS THE SAME AS -
*
*                NS=18
*
*         TFSP DIRECTIVES ARE DIVIDED INTO SIX CATEGORIES - UNIVERSAL,
*         FAMILY LEVEL, VSN LEVEL, USER LEVEL, FILE LEVEL, AND
*         ALTERNATE USER LEVEL.  FAMILY LEVEL IS CONSIDERED THE HIGHEST
*         LEVEL AND ALTERNATE USER THE LOWEST LEVEL.
*
*         EACH LEVEL HAS ITS OWN SET OF VALID DIRECTIVES.  CERTAIN
*         DIRECTIVES IN A HIGHER LEVEL MAY BE ENTERED FROM ANY LOWER
*         LEVEL.  IF TFSP IS AT A LOWER LEVEL AND A HIGHER LEVEL
*         DIRECTIVE IS ISSUED, TFSP WILL EITHER EXECUTE THE DIRECTIVE
*         AND REMAIN AT THE CURRENT LEVEL OR PERFORM AN *IMPLIED DROP*
*         TO THE HIGHER LEVEL. AN *IMPLIED* DROP SIMPLY MEANS
*         THAT TFSP TERMINATES THE CURRENT LEVEL WITHOUT AN UPDATE
*         AND GOES TO THE LEVEL FOR THE DIRECTIVE THAT WAS ENTERED.
*         MOST DIRECTIVES MAY BE ISSUED FOR A *HIGHER* LEVEL FROM A
*         LOWER TFSP LEVEL.  *IMPLIED DROPS* OCCUR IF THE DIRECTIVE
*         REQUIRES A CHANGE IN A TFSP LEVEL.
*
*         AN EXAMPLE FOLLOWS.
*
*                USER=USERNAM
*                FILEVS=VSN1
*                VSN=VSN2
*
*         IN THE EXAMPLE, WHEN THE VSN=VSN2 DIRECTIVE WAS ISSUED, TFSP
*         PERFORMED AN *IMPLIED DROP* OUT OF THE FILE LEVEL FOR *VSN1*,
*         AND AN *IMPLIED DROP* OUT OF THE USER LEVEL FOR *USERNAM*.
*         NO UPDATE WAS PERFORMED FOR THE FILE LEVEL AND TFSP WILL BE
*         AT THE VSN LEVEL FOR VOLUME SERIAL NUMBER *VSN2*.
*
*         ANOTHER EXAMPLE OF A *IMPLIED DROP* FOLLOWS.
*
*                USER=USERNAM
*                FILEV=VSN1
*                FILEV=VSN2
*
*         IN THIS EXAMPLE, WHEN THE *FILEV=VSN2* DIRECTIVE WAS ISSUED,
*         TFSP TERMINATES THE FILE LEVEL FOR *VSN1* WITHOUT UPDATING
*         *VSN1*.  THE FILE LEVEL FOR *VSN2* IS THEN DISPLAYED AND ANY
*         INQUIRIES OR UPDATES WILL NOW BE FOR VSN2.
*
*         AN EXAMPLE OF DIRECTIVES THAT MAY BE ENTERED THAT WILL NOT
*         REQUIRE A *IMPLIED DROP* FOLLOW.
*
*                USER=USERNAM
*                FILEV=VSN1
*                AUDITVS=VSN2
*                AVSN=VSN2
*                AMEND
*
*         IN THIS EXAMPLE, THE *AUDITVS=VSN2* DIRECTIVE WAS ISSUED
*         AND TFSP PERFORMED THE AUDIT WITHOUT HAVING TO SWITCH FROM
*         THE FILE LEVEL.  THE *AUDITVS* WAS PERFORMED AND TFSP STAYS
*         AT THE FILE LEVEL.
*
*         EXAMPLES OF DIRECTIVES FOR DIFFERENT LEVELS THAT ARE NOT
*         VALID FROM ANOTHER LEVEL.
*
*                USER=USERNAM
*                FILEV=VSN1
*                PRN=IVSN1
*
*         THE *PRN=IVSN1* IS INCORRECT BECAUSE IT IS A VSN LEVEL
*         DIRECTIVE.  SINCE THERE IS NO VSN LEVEL SPECIFIED, THERE
*         WOULD BE NO WAY OF KNOWING WHICH TAPE FILE THE *PRN=IVSN1*
*         DIRECTIVE WAS REALLY INTENDED TO BE FOR.
*
*         ANOTHER EXAMPLE OF INCORRECT DIRECTIVE ENTRY FOLLOWS.
*
*                USER=USERNAM
*                AUSER=USERNO
*
*         THE *AUSER* DIRECTIVE WOULD BE INCORRECT AT THIS POINT
*         BECAUSE THERE HAS BEEN NO FILE LEVEL SPECIFIED.  THE AUSER
*         ENTRY DEALS SPECIFICALLY WITH A TAPE FILE ENTRY.
*
*         SOME DIRECTIVES MAY NOT BE ENTERED FROM OTHER LEVELS.
*         THESE DIRECTIVES CONSIST OF DIRECTIVES THAT WOULD
*         REQUIRE THE TAPE CATALOG TO BE UPDATED IF THE DIRECTIVE
*         WAS TO BE PROCESSED.
*
*         AN EXAMPLE FOLLOWS.
*
*         USER=USERNUM
*         PURGE=VSN1
*
*         IN THIS EXAMPLE, THE *PURGE* DIRECTIVE WOULD BE
*         INCORRECT BECAUSE IT REQUIRES THE TAPE CATALOG
*         TO BE UPDATED.  SINCE THE *PURGE* DIRECTIVE IS
*         A FAMILY LEVEL DIRECTIVE IT WILL ONLY BE VALID
*         FROM THE FAMILY LEVEL.
*
*         THE DIRECTIVES THAT MAY NOT BE ENTERED FROM ANOTHER
*         LEVEL ARE LISTED BELOW.
*
*                ISV, PURGALL, PURGE, RELEASE, REMOVE,
*                RELEASF, AND RELEASV.
          SPACE  4,10
***       UNIVERSAL DIRECTIVES.
*
*         UNIVERSAL DIRECTIVES DO NOT REFERENCE SPECIFIC TAPE FILE
*         ENTRIES OR VSNS IN THE TAPE CATALOG FILE.  UNIVERSAL
*         DIRECTIVES MAY OCCUR ANYWHERE IN THE DIRECTIVE STREAM.
*
*         SEPARAT = CHAR
*                THE NON-BLANK, NON-ALPHA-NUMERIC CHARACTER *CHAR* WILL
*                BE INTERPRETED AS A SEPARATOR, EVEN BY THE PRN, UC,
*                AND SI DIRECTIVES.  DEFAULT IS COMMA.
*
*         COLON = CHAR
*                THE NON-BLANK, NON-ALPHA-NUMERIC CHARACTER *CHAR* WILL
*                BE INTERPRETED AS A COLON IN THE DIRECTIVE STREAM.
*                DEFAULT IS NO CHARACTER.
*
*         HELP
*                DISPLAY A LIST OF VALID DIRECTIVES.  HELP IS ALSO
*                AVAILABLE ON THE RIGHT SCREEN OF THE K-DISPLAY FOR THE
*                OP=K OPTION.  THE DISPLAY IS COPIED TO THE OUTPUT FILE
*                IF NOT THE OP=K OPTION.
*
*         DISPLAY
*                TOGGLES OUT OF THE HELP DISPLAY TO THE NORMAL LEFT
*                SCREEN DISPLAY FOR THE OP=K OPTION.  THE DISPLAY IS
*                COPIED TO THE OUTPUT FILE IF NOT THE OP=K OPTION.
*
*         REWIND = FILENAM
*                REWINDS THE LOCAL FILE *FILENAM*.  THIS DIRECTIVE IS
*                USUALLY USED WITH THE SOURCE, AUDIT, AND READ
*                DIRECTIVES.  A NULL *FILENAM* IS INCORRECT.
*
*         READ = FILENAM
*                READS TFSP DIRECTIVES OFF OF LOCAL FILE *FILENAM*
*                UNTIL AN END-OF-RECORD, END-OF-FILE, OR
*                END-OF-INFORMATION IS REACHED.  TFSP PROCESSES THE
*                DIRECTIVES UNTIL AN ERROR IS ENCOUNTERED OR THE END OF
*                THE DIRECTIVES IS REACHED.  THE READ DIRECTIVE CANNOT
*                BE INCLUDED IN THE FILE THAT IS READ.  THE FILE IS NOT
*                REWOUND BEFORE OR AFTER IT IS READ.  A NULL *FILENAM*
*                IS INCORRECT.
*
*         STOP
*                TERMINATE TFSP.  CHANGES SPECIFIED AT THE CURRENT
*                LEVEL WILL BE IGNORED.
*
*         BRIEF
*                CAUSES *DISPLAY* HEADERS AND INFORMATIVE OUTPUT TO
*                BE SUPPRESSED.  ALL MESSAGES PREFIXED BY *INFORM*
*                WILL NOT BE COPIED TO THE OUTPUT FILE. THE FIRST
*                EIGHT LINES OF OUTPUT GENERATED BY THE *DISPLAY*
*                DIRECTIVE WILL NOT BE COPIED TO THE OUTPUT FILE.
*                VALID DIRECTIVE IMAGES WILL ALSO BE SUPPRESSED.
*
*         NOBRIEF
*                REVERSES THE AFFECT OF A *BRIEF* COMMAND.  ALL
*                INFORMATIVE AND *DISPLAY* HEADER INFORMATION IS
*                WRITTEN TO THE OUTPUT FILE.  *NOBRIEF* IS THE DEFAULT.
          SPACE  4,10
***       FAMILY LEVEL DIRECTIVES.
*
*         FAMILY LEVEL DIRECTIVES REFERENCE ALL TAPE FILE ENTRIES AND
*         VSNS IN THE TAPE CATALOG FILE.  FAMILY LEVEL DIRECTIVES MAY
*         OCCUR ANYWHERE IN THE DATA STREAM.  ENTRY OF A FAMILY
*         LEVEL DIRECTIVE FROM A LOWER LEVEL MAY CAUSE TFSP TO
*         ISSUE A *DROP* FOR EACH LEVEL AND PROCESSING CONTINUES
*         AT THE FAMILY LEVEL.  NO UPDATES WILL OCCUR.  FAMILY LEVEL
*         DIRECTIVES NOT VALID WHILE PROCESSING AT ANOTHER LEVEL ARE
*         ISV, PURGALL, PURGE, RELEASE AND REMOVE.
*
*         DROP
*                TERMINATE TFSP.
*
*         GO
*                MAKES UPDATES ENTERED AT FAMILY LEVEL AND THEN
*                TERMINATES TFSP.
*
*         ISV
*                INITIALIZES SCRATCH VSN POINTERS.  THIS DIRECTIVE CAN
*                BE USED TO INSURE ALL UNASSIGNED VSNS ARE IN THE
*                SCRATCH POOL.
*
*         FAMNAME = FAMILY
*                SETS *FAMILY* AS THE FAMILY NAME OF THE TAPE CATALOG
*                FILE.  IF *FAMILY* IS NULL, THE FAMILY NAME OF THE JOB
*                IS USED.
*
*         LINKFAM = FAMILY
*                SETS *FAMILY* AS THE FAMILY ON WHICH THE TAPE CATALOG
*                RESIDES FOR PROCESSING USER JOB REQUESTS FROM THE
*                CURRENT FAMILY.  THIS DIRECTIVE CAN ONLY BE USED IN
*                LOCAL FILE MODE.
*
*         ALTFAM = FAMILY
*                ALLOWS USER JOBS ON FAMILY *FAMILY* TO ACCESS THIS
*                TAPE CATALOG.  THE *LINKFAM* DIRECTIVE MUST BE USED
*                ON THE *FAMILY* TAPE CATALOG TO DIRECT PROCESSING TO
*                THIS CATALOG.  THIS DIRECTIVE CAN ONLY BE USED IN
*                LOCAL FILE MODE.
*
*         CALTFAM = FAMILY
*                CLEARS THE EFFECT OF A PREVIOUS *ALTFAM* DIRECTIVE
*                ON THE SPECIFIED FAMILY.  THIS DIRECTIVE CAN ONLY BE
*                USED IN LOCAL FILE MODE.
*
*         MID = ID
*                SETS *ID* AS THE MACHINE ID OF THE TAPE CATALOG FILE.
*                IF *ID* IS NULL, THE MACHINE ID OF THE RUNNING SYSTEM
*                IS USED.
*
*         CATERR = STATUS
*                SETS *STATUS* AS THE ERROR STATUS OF THE TAPE CATALOG
*                FILE.  VALID VALUES FOR *STATUS* ARE -
*
*                CLEAR - CLEAR ERROR STATUS AND MESSAGE BUFFER.
*
*                SET - SET ERROR STATUS AND ISSUE MESSAGE TO MESSAGE
*                    BUFFER.
*
*                DEFAULT IS CLEAR.
*
*         GLOBAL = STATUS
*                SETS *STATUS* TO DETERMINE IF THE SCRATCH TAPES OF
*                THIS FAMILY ARE AVAILABLE FOR OTHER FAMILIES.  VALID
*                VALUES FOR *STATUS* ARE -
*
*                NO - SCRATCH TAPES ARE UNAVAILABLE FOR OTHER FAMILIES.
*
*                YES - SCRATCH TAPES ARE AVAILABLE FOR OTHER FAMILIES.
*
*                DEFAULT IS NO.
*
*         FOREIGN = STATUS
*                SETS *STATUS* TO DETERMINE IF THE SCRATCH TAPES OF
*                THIS FAMILY ARE FOREIGN TO THE RUNNING SYSTEM.  VALID
*                VALUES FOR *STATUS* ARE -
*
*                NO - FAMILY IS NOT FOREIGN TO SYSTEM.
*
*                YES - FAMILY IS FOREIGN TO SYSTEM.
*
*                DEFAULT IS NO.
*
*         AUDITCH = CHARGNO
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES FOR
*                CHARGE NUMBER *CHARGNO* TO THE OUTPUT FILE.  A
*                NULL *CHARGNO* IS INCORRECT.
*
*         AUDITUN = USERNAM
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES FOR
*                USER NAME *USERNAM* TO THE OUTPUT FILE.  IF *USERNAM*
*                IS NULL, ALL TAPE FILE ENTRIES IN THE TAPE CATALOG
*                FILE ARE PROCESSED.
*
*         AUDITVS = VSN
*                COPIES INFORMATION ABOUT VOLUME SERIAL NUMBER *VSN* TO
*                THE OUTPUT FILE.  THE INFORMATION INCLUDES WHETHER THE
*                VSN IS INCLUDED IN THE TAPE CATALOG FILE AND ITS
*                POSITION IN A MULTI-VOLUME TAPE FILE.  IF *VSN* IS
*                NULL, EVERY VSN IN THE TAPE CATALOG FILE IS PROCESSED.
*
*         MREADCH = CHARGNO
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES FOR
*                CHARGE NUMBER *CHARGNO* TO THE MACHINE READABLE FILE.
*                A NULL *CHARGNO* IS INCORRECT.
*
*         MREADUN = USERNAM
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES FOR
*                USER NAME *USERNAM* TO THE MACHINE READABLE FILE.  IF
*                *USERNAM* IS NULL, ALL TAPE FILE ENTRIES IN THE TAPE
*                CATALOG FILE ARE PROCESSED.
*
*         MREADVS = VSN
*                COPIES INFORMATION ABOUT VOLUME SERIAL NUMBER *VSN* TO
*                THE MACHINE READABLE FILE.  THE INFORMATION INCLUDES
*                WHETHER THE VSN IS INCLUDED IN THE TAPE CATALOG FILE
*                AND ITS POSITION IN A MULTI-VOLUME TAPE FILE.  IF
*                *VSN* IS NULL, EVERY VSN IN THE TAPE CATALOG FILE IS
*                PROCESSED.
*
*         SOURCE
*                COPIES THE DIRECTIVES REQUIRED TO RECREATE THE TAPE
*                CATALOG FILE TO THE SOURCE FILE.
*
*         SOURCCH = CHARGNO
*                COPIES THE DIRECTIVES REQUIRED TO CREATE THE TAPE FILE
*                ENTRIES FOR CHARGE NUMBER *CHARGNO* TO THE SOURCE
*                FILE.  A NULL *CHARGNO* IS INCORRECT.
*
*         SOURCUN = USERNAM
*                COPIES THE DIRECTIVES REQUIRED TO CREATE THE TAPE FILE
*                ENTRIES FOR USER NAME *USERNAM* TO THE SOURCE FILE.
*                IF *USERNAM* IS NULL, ALL TAPE FILE ENTRIES IN THE
*                TAPE CATALOG FILE ARE PROCESSED.
*
*         SOURCVS = VSN
*                COPIES THE DIRECTIVES REQUIRED TO ADD VOLUME SERIAL
*                NUMBER *VSN* AS A SCRATCH TAPE TO THE SOURCE FILE.  IF
*                *VSN* IS NULL, EVERY VSN IN THE TAPE CATALOG FILE IS
*                PROCESSED.
*
*         REMOVE = VSN
*                REMOVES VOLUME SERIAL NUMBER *VSN* FROM THE TAPE
*                CATALOG FILE.  ONCE REMOVED, *VSN* CANNOT BE ASSIGNED
*                TO A TAPE FILE ENTRY UNTIL VSN DIRECTIVE HAS BEEN
*                ISSUED.  THE *VSN* SPECIFIED BY THE REMOVE DIRECTIVE
*                CANNOT BE ASSIGNED TO A TAPE FILE ENTRY.  THE *PURGE*
*                DIRECTIVE MAY BE USED TO REMOVE A RESERVED TAPE FROM
*                THE CATALOG.  A NULL *VSN* IS INCORRECT.
*
*         RELEASE = VSN
*                PURGES THE TAPE FILE ENTRIES THAT HAVE AN ASSIGNED VSN
*                OF *VSN* FROM THE TAPE CATALOG FILE.  EVERY VSN
*                ASSOCIATED WITH THAT TAPE FILE IS RELEASED.  A NULL
*                *VSN* IS INCORRECT.
*
*         VSN = VSN
*                BEGINS VSN LEVEL DIRECTIVES.  ALL DIRECTIVES FOLLOWING
*                THE VSN DIRECTIVE AND BEFORE THE NEXT ADD, REVISE,
*                GO, OR DROP DIRECTIVE ARE ASSOCIATED WITH VOLUME
*                SERIAL NUMBER *VSN*.  IF THE *VSN* IS ASSIGNED, THE
*                MAINTENANCE AND PHYSICAL REEL NUMBER FOR THE *VSN*
*                MAY BE REVISED AT THIS LEVEL.  VALID FROM ANY LEVEL.
*                IF THE VSN DIRECTIVE IS ISSUED FROM OTHER THAN
*                THE FAMILY LEVEL, AN *IMPLIED DROP* WILL FIRST BE
*                PERFORMED TO THE FAMILY LEVEL.  A NULL *VSN* IS
*                INCORRECT.
*
*         VALIDAT = USERNAM
*                ADDS *USERNAM* AS A USER THAT IS VALIDATED TO USE TFSP
*                TO ACCESS AND UPDATE THE FAMILY TAPE CATALOG FILE FROM
*                A NON-SYSTEM ORIGIN JOB.  UP TO EIGHT USER NAMES CAN
*                BE ADDED.  A NULL *USERNAM* IS INCORRECT.
*
*         INVALID = USERNAM
*                REMOVES *USERNAM* AS A USER VALIDATED BY THE VALIDAT
*                DIRECTIVE.  A NULL *USERNAM* IS INCORRECT.
*
*         PURGALL = USERNAM
*                PURGES ALL TAPE FILE ENTRIES THAT BELONG TO *USERNAM*
*                FROM THE TAPE CATALOG FILE.  RELEASES ALL VSNS THAT
*                WERE ASSIGNED TO THE TAPE FILE ENTRIES OF *USERNAM*.
*                THE RELEASED VSNS ARE REMOVED FROM THE TAPE CATALOG
*                FILE.  A NULL *USERNAM* IS INCORRECT.
*
*         PURGE = VSN
*                THIS DIRECTIVE IS USED TO DELETE TAPE FILE ENTRIES
*                CONTAINING *VSN* FROM THE TAPE CATALOG FILE.  EVERY
*                VSN BELONGING TO ONE OF THE PURGED TAPE FILES IS
*                FIRST RELEASED FROM THE TAPE CATALOG AND THEN
*                REMOVED.  IF THE VSN IS NOT ASSIGNED TO A TAPE FILE,
*                IT IS REMOVED FROM THE TAPE CATALOG FILE. A NULL
*                *VSN* IS INCORRECT.
*
*         USER = USERNAM
*                BEGINS USER LEVEL DIRECTIVES.  ALL DIRECTIVES
*                FOLLOWING THE USER DIRECTIVE AND BEFORE THE NEXT USER
*                LEVEL DROP OR GO DIRECTIVE ARE ASSOCIATED WITH TAPE
*                FILE ENTRIES BELONGING TO USER NAME *USERNAM*.
*                VALID FROM ANY LEVEL.  IF THE USER DIRECTIVE IS ISSUED
*                FROM OTHER THAN THE FAMILY LEVEL, AN *IMPLIED DROP*
*                WILL FIRST BE PERFORMED TO THE FAMILY LEVEL.  A NULL
*                *USERNAM* IS INCORRECT.
          SPACE  4,10
***       VSN LEVEL DIRECTIVES.
*
*         VSN LEVEL DIRECTIVES REFERENCE ONE VSN THAT IS NOT ASSIGNED
*         TO ANY TAPE FILE ENTRY ON THE TAPE CATALOG FILE.  VSN LEVEL
*         DIRECTIVES MAY OCCUR ANYWHERE AFTER A VSN DIRECTIVE AND
*         BEFORE AN ADD, REVISE, GO, OR DROP DIRECTIVE.
*
*         ADD
*                END PROCESSING OF VSN LEVEL DIRECTIVES.  THE VSN WILL
*                BE ADDED TO THE TAPE CATALOG.  INCORRECT IF THE VSN IS
*                ALREADY IN THE TAPE CATALOG.
*
*         REVISE
*                END PROCESSING OF VSN LEVEL DIRECTIVES.  THE CHANGES
*                SPECIFIED BY THE VSN LEVEL DIRECTIVES WILL BE MADE TO
*                THE VSN.  INCORRECT IF THE VSN IS NOT IN THE TAPE
*                CATALOG.
*
*         GO
*                SAME AS ADD FOR A NEW VSN.  SAME AS REVISE FOR AN
*                EXISTING VSN.
*
*         DROP
*                END PROCESSING OF VSN LEVEL DIRECTIVES.  CHANGES
*                SPECIFIED BY THE VSN LEVEL DIRECTIVES WILL BE IGNORED.
*
*         PRN= PVSN
*                SETS *PVSN* AS THE PHYSICAL (INTERNAL) VSN.  DEFAULT
*                IS THE LOGICAL (EXTERNAL) VSN.
*
*         ERRFLAG = FLAG
*                SETS OR CLEARS THE READ/WRITE ERROR DETECTED FLAG FOR
*                THE VSN.  VALID VALUES FOR *FLAG* ARE -
*
*                SET - SET ERROR FLAG.
*
*                CLEAR - CLEAR ERROR FLAG.
*
*                DEFAULT IS CLEAR.
*
*         MAINT = MAIN
*                SETS *MAIN* AS THE MAINTENANCE STATUS FOR THE VSN.  A
*                VSN HELD FOR MAINTENANCE CANNOT BE ASSIGNED TO A TAPE
*                FILE ENTRY.  VALID VALUES FOR *MAIN* ARE -
*
*                HOLD - HOLD FOR MAINTENANCE.
*
*                AVAILABLE - AVAILABLE FOR ASSIGNMENT.
*
*                DEFAULT IS AVAILABLE.
*
*         OWNER = TYPE
*                SETS *TYPE* AS THE OWNERSHIP STATUS OF THE VSN.
*                A *TYPE* VALUE OF *USER* MAY NOT BE SPECIFIED FOR
*                A VSN WITH THE SYSTEM VSN FLAG SET.
*                VALID VALUES FOR *TYPE* ARE -
*
*                CENTER - CENTER OWNED.
*
*                USER - USER OWNED.
*
*                DEFAULT IS CENTER.
*
*         SITE = SITE
*                SETS SITE AS THE OFF SITE/ON SITE STATUS OF THE VSN.
*                USERS CANNOT ACCESS AN OFF SITE VSN.  VALID VALUES FOR
*                SITE ARE -
*
*                ON - ON SITE.
*
*                OFF - OFF SITE.
*
*                DEFAULT IS ON.
*                IF THE VSN IS ASSIGNED TO A TAPE FILE ENTRY, THE SITE
*                STATUS OF EACH VSN ASSIGNED TO THE TAPE FILE WILL BE
*                CHANGED.
*
*         STATUS = STATUS
*                AVAILABLE - CLEARS BOTH THE MAINTENANCE AND ERROR
*                            FLAGS.
*
*                CLEANED - SAME AS AVAILABLE. IN ADDITION, THE USAGE
*                          COUNT IS SET TO ZERO.
*
*                HOLD - SET THE MAINTENANCE FLAG AND CLEARS THE
*                          ERROR FLAG.
*
*                ERROR - SET BOTH THE MAINTENANCE FLAG AND ERROR
*                          FLAGS.
*
*                DEFAULT IS AVAILABLE.
*                IF THE VSN IS ASSIGNED TO A TAPE FILE ENTRY, THE
*                OWNERSHIP STATUS OF EACH VSN ASSIGNED TO THE TAPE FILE
*                WILL BE CHANGED.
*
*         SYSTEM = SYS
*                SETS *SYS* AS THE SYSTEM VSN FLAG STATUS FOR THE VSN.
*                A VSN WITH THE SYSTEM VSN FLAG SET WILL NOT BE USED
*                AS A SCRATCH VSN, BUT CAN BE ASSIGNED TO A TAPE FILE
*                ENTRY BY *TFSP*.  THIS DIRECTIVE MAY ONLY BE SPECIFIED
*                WHEN A VSN IS FIRST CREATED, AND MAY NOT BE SPECIFIED
*                FOR A USER-OWNED VSN.  VALID VALUES FOR *SYSTEM* ARE -
*
*                YES - THE VSN IS A SYSTEM VSN.
*
*                NO  - THE VSN IS NOT A SYSTEM VSN.
*
*                DEFAULT IS NO.
*
*         USAGE = COUNT.
*                SETS COUNT AS THE NUMBER OF TIMES THAT THE VSN HAS
*                BEEN USED SINCE MAINTENANCE WAS LAST PERFORMED ON
*                THE TAPE. THE VALUE OF COUNT MUST BE AT LEAST ZERO
*                (0) AND NO MORE THEN 63. DEFAULT IS 0.
*
*         VT = TYPE
*                SETS *TYPE* AS THE TAPE TYPE FOR THE VSN.  THIS
*                DIRECTIVE MAY ONLY BE SPECIFIED WHEN THE VSN IS FIRST
*                CREATED.  VALID VALUES FOR *TYPE* ARE -
*
*                MTNT - THE VSN MAY BE USED AS EITHER AN *MT* (7-TRACK)
*                       OR AN *NT* (9-TRACK) TAPE.
*
*                CT   - THE VSN MAY BE USED ONLY AS A *CT* (CARTRIDGE)
*                       TAPE.
*
*                AT -   THE VSN MAY BE USED ONLY AS AN *AT* (ACS
*                       CARTRIDGE) TAPE.
*
*                DEFAULT IS MTNT.
          SPACE  4,10
***       USER LEVEL DIRECTIVES.
*
*         USER LEVEL DIRECTIVES REFERENCE THE TAPE FILE ENTRIES
*         BELONGING TO ONE USER ON THE TAPE CATALOG FILE.  USER LEVEL
*         DIRECTIVES MAY OCCUR ANYWHERE AFTER A USER DIRECTIVE
*         AND BEFORE A USER LEVEL GO OR DROP.  IF THE DIRECTIVE
*         ENTERED IS A FILE OR FILEV DIRECTIVE AND TFSP IS AT
*         THE FILE OR ALTERNATE USER LEVEL, AN *IMPLIED DROP* WILL
*         FIRST BE PERFORMED TO THE USER LEVEL AND NO UPDATES WILL
*         OCCUR.
*
*         DROP
*                END PROCESSING OF USER LEVEL DIRECTIVES.
*
*         GO
*                SAME AS DROP.
*
*         +
*                WHEN A PLUS CHARACTER IS IN COLUMN ONE OF THE INPUT
*                LINE, THE LIST OF TAPE FILE ENTRIES DISPLAYED AT THE
*                LEFT-SCREEN K-DISPLAY IS TOGGLED.  IF NOT THE OP=K
*                OPTION, THE DISPLAY DIRECTIVE MUST BE ISSUED TO COPY
*                THE DISPLAY TO THE OUTPUT FILE.
*
*         AUDITCN = CHARGNO
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES
*                BELONGING TO THE USER WITH A CHARGE NUMBER OF
*                *CHARGNO* TO THE OUTPUT FILE.  A NULL *CHARGNO* IS
*                INCORRECT.
*
*         AUDITFI = FILEIDENT
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRY
*                *FILEIDENT* TO THE OUTPUT FILE.  A NULL *FILEIDENT* IS
*                INCORRECT.
*
*         AUDITFV = VSN
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES
*                BELONGING TO THE USER WITH AN ASSIGNED VSN OF *VSN* TO
*                THE OUTPUT FILE.  A NULL *VSN* IS INCORRECT.
*
*         MREADCN = CHARGNO
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES
*                BELONGING TO THE USER WITH A CHARGE NUMBER OF
*                *CHARGNO* TO THE MACHINE READABLE FILE.  A NULL
*                *CHARGNO* IS INCORRECT.
*
*         MREADFI = FILEIDENT
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRY
*                *FILEIDENT* TO THE MACHINE READABLE FILE.  A NULL
*                *FILEIDENT* IS INCORRECT.
*
*         MREADFV = VSN
*                COPIES INFORMATION ABOUT THE TAPE FILE ENTRIES
*                BELONGING TO THE USER WITH AN ASSIGNED VSN OF *VSN* TO
*                THE MACHINE READABLE FILE.  A NULL *VSN* IS INCORRECT.
*
*         SOURCFI = FILEIDENT
*                COPIES THE DIRECTIVES REQUIRED TO CREATE THE TAPE FILE
*                ENTRY *FILEIDENT* BELONGING TO THE USER TO THE SOURCE
*                FILE.  A NULL *FILEIDENT* IS INCORRECT.
*
*         SOURCFV = VSN
*                COPIES THE DIRECTIVE REQUIRED TO CREATE THE TAPE FILE
*                ENTRIES BELONGING TO THE USER WITH AN ASSIGNED VSN OF
*                *VSN* TO THE SOURCE FILE.  A NULL *VSN* IS INCORRECT.
*
*         SOURCCN = CHARGNO
*                COPIES THE DIRECTIVES REQUIRED TO CREATE THE TAPE FILE
*                ENTRIES BELONGING TO THE USER WITH CHARGE NUMBER
*                *CHARGNO* TO THE SOURCE FILE.  A NULL *CHARGNO* IS
*                INCORRECT.
*
*         RELEASV = VSN
*                PURGES THE TAPE FILE ENTRIES BELONGING TO THE USER
*                THAT HAVE AN ASSIGNED VSN OF *VSN* FROM THE TAPE
*                CATALOG FILE.  EVERY VSN ASSOCIATED WITH THAT TAPE
*                FILE IS RELEASED.  A NULL *VSN* IS INCORRECT.
*
*         RELEASF = FILEIDENT
*                PURGES THE TAPE FILE ENTRY *FILEIDENT* BELONGING TO
*                THE USER FROM THE TAPE CATALOG FILE.  EVERY VSN
*                ASSOCIATED WITH THAT TAPE FILE ENTRY IS RELEASED.  A
*                NULL *FILEIDENT* IS INCORRECT.
*
*         FILE = FILEIDENT
*                BEGINS FILE LEVEL DIRECTIVES.  ALL DIRECTIVES
*                FOLLOWING THE FILE DIRECTIVE AND BEFORE THE NEXT
*                AMEND, RESERVE, OR FILE LEVEL GO OR DROP DIRECTIVE
*                ARE ASSOCIATED WITH THE TAPE FILE ENTRY *FILEIDENT*
*                BELONGING TO THE USER.  FILE CAN BE USED TO CREATE A
*                NEW OR UPDATE AN EXISTING SYMBOLIC ACCESS TAPE FILE
*                ENTRY.  NON-SYMBOLIC ACCESS TAPE FILES MUST BE
*                REFERENCED BY THE FILEV DIRECTIVE.  A NULL *FILEIDENT*
*                IS INCORRECT.  VALID ENTRY FROM THE USER, FILE, OR
*                THE ALTERNATE USER LEVEL.  IF ENTERED FROM THE
*                FILE OR ALTERNATE USER LEVEL, AN *IMPLIED DROP*
*                WILL FIRST BE PERFORMED TO THE USER LEVEL AND NO
*                UPDATE FOR THE CURRENT LEVEL WILL OCCUR.
*
*         FILEV = VSN/SEQNO
*                BEGINS FILE LEVEL DIRECTIVES.  ALL DIRECTIVES
*                FOLLOWING THE FILEV DIRECTIVE AND BEFORE THE NEXT
*                AMEND, RESERVE, OR FILE LEVEL GO OR DROP DIRECTIVE
*                ARE ASSOCIATED WITH THE TAPE FILE ENTRY BELONGING TO
*                THE USER THAT HAS AN ASSIGNED VSN *VSN* AND SEQUENCE
*                NUMBER *SEQNO*.  THE FILE POSITION IS A MULTI-FILE SET
*                IS SPECIFIED BY *SEQNO*.  FILEV CAN BE USED TO CREATE
*                A NEW OR UPDATE AN EXISTING TAPE FILE ENTRY.  A NULL
*                *VSN* IS INCORRECT.  IF *SEQNO* IS NULL, A VALUE OF 1
*                IS ASSUMED.  VALID ENTRY FROM THE USER, FILE, OR
*                THE ALTERNATE USER LEVEL.  IF ENTERED FROM THE
*                FILE OR ALTERNATE USER LEVEL, AN *IMPLIED DROP*
*                WILL FIRST BE PERFORMED TO THE USER LEVEL AND NO
*                UPDATE FOR THE CURRENT LEVEL WILL OCCUR.
          SPACE  4,10
***       FILE LEVEL DIRECTIVES.
*
*         FILE LEVEL DIRECTIVES REFERENCE ONE TAPE FILE ENTRY BELONGING
*         TO THE USER.  FILE LEVEL DIRECTIVES MAY OCCUR ANYWHERE AFTER
*         A FILE OR FILEV DIRECTIVE AND BEFORE AN AMEND, RESERVE, OR
*         FILE LEVEL DROP OR GO (AND FROM THE ALTERNATE USER LEVEL).
*         WHENEVER A FILE LEVEL DIRECTIVE IS ASSIGNED A NULL VALUE,
*         TFSP WILL SET THE DEFAULT VALUE UNLESS STATED OTHERWISE IN
*         THE DIRECTIVE DESCRIPTION.  SITE PERSONNEL WILL PROBABLY
*         FIND THAT THEY ONLY HAVE TO ENTER A FEW OF THE FILE LEVEL
*         DIRECTIVES (SUCH AS CN AND AVSN) WHEN CREATING NEW TAPE
*         FILE ENTRIES.  MOST OF THE FILE LEVEL DIRECTIVES EXIST FOR
*         THE "DUMPING" AND "LOADING" OF THE TAPE FILE CATALOG
*         ENTRIES VIA THE SOURCE FILE.
*
*         AMEND
*                END PROCESSING OF FILE LEVEL DIRECTIVES.  THE CHANGES
*                SPECIFIED BY THE FILE LEVEL DIRECTIVES WILL BE MADE TO
*                THE TAPE FILE.  INCORRECT IF THE TAPE FILE IS NOT
*                RESERVED.
*
*         RESERVE
*                END PROCESSING OF FILE LEVEL DIRECTIVES.  THE TAPE
*                FILE WILL BE RESERVED.  INCORRECT IF THE TAPE FILE
*                ALREADY IS RESERVED.
*
*         GO
*                SAME AS RESERVE FOR A NEW TAPE FILE ENTRY.  SAME AS
*                AMEND FOR AN EXISTING TAPE FILE ENTRY.
*
*         DROP
*                END PROCESSING OF FILE LEVEL DIRECTIVES.  CHANGES
*                SPECIFIED BY THE FILE LEVEL DIRECTIVES WILL BE
*                IGNORED.
*
*         +
*                WHEN A PLUS CHARACTER IS IN COLUMN ONE OF THE INPUT
*                LINE, THE PAGE DISPLAYED AT THE LEFT-SCREEN K-DISPLAY
*                IS TOGGLED.  IF NOT THE OP=K OPTION, THE DISPLAY
*                DIRECTIVE MUST BE ISSUED TO COPY THE DISPLAY TO THE
*                OUTPUT FILE.
*
*         AUDITAU = USERNAM
*                COPIES THE ADMIT INFORMATION GRANTED TO USER NAME
*                *USERNAM* FOR THE TAPE FILE ENTRY TO THE OUTPUT FILE.
*                IF *USERNAM* IS NULL, ALL USER NAMES ADMITTED TO THE
*                TAPE FILE ENTRY ARE PROCESSED.
*
*         SV = ACCESS
*                SETS ACCESS AS THE SYMBOLIC ACCESS STATUS OF THE TAPE
*                FILE.  VALID VALUES FOR ACCESS ARE -
*
*                NO - NO SYMBOLIC ACCESS.  TAPE FILE ENTRY CANNOT BE
*                    ACCESSED BY FILE IDENTIFIER.
*
*                SET - SYMBOLIC ACCESS.  TAPE FILE ENTRY CAN BE
*                    ACCESSED BY FILE IDENTIFIER.
*
*                DEFAULT IS NO.
*
*         RECOVER = STATUS
*                SETS *STATUS* AS THE RECOVERY STATUS OF THE TAPE FILE.
*                VALID VALUES FOR *STATUS* ARE -
*
*                NO - TAPE FILE HAS NOT BEEN RECOVERED.
*
*                YES - TAPE FILE HAS BEEN RECOVERED.  THE USER MAY HAVE
*                    TO AMEND THE THE TAPE FILE ENTRY TO RETURN IT TO
*                    ITS ORIGINAL STATE.
*
*                DEFAULT IS NO.
*
*         FI = FILEIDENT
*                CHANGES THE LOGICAL FILE IDENTIFIER OF THE TAPE FILE
*                ENTRY TO *FILEIDENT*.  THIS IS THE NAME SPECIFIED BY
*                USER COMMANDS AND THE FILE DIRECTIVE WHEN
*                ACCESSING THIS TAPE FILE ENTRY.  THE *FILEIDENT* MUST
*                NOT BE THE NAME OF ANY OTHER TAPE FILE ENTRY BELONGING
*                TO THE USER IF SYMBOLIC ACCESS.  DEFAULT IS THE SAME
*                NAME AS SPECIFIED IN THE PREVIOUS FILE DIRECTIVE.
*
*         PI = FILEIDENT
*                SETS *FILEIDENT* AS THE PHYSICAL FILE IDENTIFIER OF
*                THE TAPE FILE ENTRY.  GENERALLY, *FILEIDENT* IS THE
*                SAME AS THE LOGICAL FILE IDENTIFIER WHEN THE TAPE FILE
*                ENTRY IS CREATED.  DEFAULT IS THE SAME NAME AS
*                SPECIFIED IN THE FILE DIRECTIVE WHEN THE TAPE FILE
*                ENTRY IS FIRST CREATED.  IF *LB=KU* WHEN THE TAPE
*                FILE IS RESERVED OR AMENDED, THE PHYSICAL FILE
*                IDENTIFIER WILL BE CLEARED.
*
*         UC = WORD
*                SETS *WORD* AS THE TEN CHARACTER USER CONTROL WORD FOR
*                THE TAPE FILE ENTRY.  BLANKS ARE SIGNIFICANT.  TFSP
*                WILL LEFT JUSTIFY AND BLANK FILL IF *WORD* IS LESS
*                THAN TEN CHARACTERS.  DEFAULT IS TEN COLONS.
*
*         PW = PASSWOR
*                SETS *PASSWOR* AS THE PASSWORD THAT ALTERNATE USERS
*                MUST SPECIFY TO ACCESS THE TAPE FILE.  DEFAULT IS NO
*                PASSWORD.
*
*         CT = CAT
*                SETS *CAT* AS THE ACCESS CATEGORY FOR ALTERNATE USERS
*                OF THE TAPE FILE.  VALID VALUES FOR *CAT* ARE -
*
*                PRIVATE - PRIVATE.  ALTERNATE USER ACCESS RESTRICTED.
*
*                SPRIV - SEMI-PRIVATE.  ALTERNATE USER ACCESS ALLOWED
*                    AND RECORDED.
*
*                PUBLIC - PUBLIC.  ALTERNATE USER ACCESS ALLOWED BUT
*                    NOT RECORDED.
*
*                DEFAULT IS PRIVATE.
*
*         M = MODE
*                SETS *MODE* AS THE ACCESS PERMISSION FOR ALTERNATE
*                USERS.  VALID VALUES FOR *MODE* ARE -
*
*                READ - ALTERNATE USERS MAY ONLY READ THE TAPE FILE.
*
*                WRITE - ALTERNATE USERS MAY READ OR WRITE ON THE TAPE
*                    FILE.
*
*                NULL - ALTERNATE USERS MAY NOT ACCESS THE TAPE FILE.
*
*                DEFAULT IS READ.
*
*         AC = OP
*                SETS *OP* AS THE CATLIST PERMISSION FOR ALTERNATE
*                USERS OF THE TAPE FILE.  VALID VALUES FOR OP ARE -
*
*                YES - ALTERNATE USERS CAN AUDIT THE PUBLIC OR
*                    SEMI-PRIVATE TAPE FILE.
*
*                NO - ALTERNATE USERS CANNOT AUDIT THE TAPE FILE.
*
*                DEFAULT IS NO.  ALTERNATE USERS CANNOT AUDIT PRIVATE
*                TAPE FILES EVEN IF AC=YES.
*
*         CE = FLAG
*                SETS OR CLEARS THE READ/WRITE ERROR FLAG FOR THE TAPE
*                FILE ENTRY.  VALID VALUES FOR *FLAG* ARE -
*
*                SET - SET ERROR FLAG.
*
*                CLEAR - CLEAR ERROR FLAG.
*
*                DEFAULT IS CLEAR.
*
*         CN = CHARGNO
*                SETS *CHARGNO* AS THE CHARGE NUMBER ASSIGNED TO THE
*                TAPE FILE ENTRY.  DEFAULT IS NO CHARGE NUMBER.
*
*         PN = PROJECTNO
*                SETS *PROJECTNO* AS THE PROJECT NUMBER ASSIGNED TO THE
*                TAPE FILE ENTRY.  DEFAULT IS NO PROJECT NUMBER.
*
*         CDATE = YYMMDD
*                SETS *YYMMDD* AS THE DATE OF CREATION OF THE TAPE FILE
*                ENTRY.  DEFAULT IS THE CURRENT DATE.
*
*         CTIME = HHMMSS
*                SETS *HHMMSS* AS THE TIME OF CREATION OF THE TAPE FILE
*                ENTRY.  DEFAULT IS THE CURRENT TIME.
*
*         ADATE = YYMMDD
*                SETS *YYMMDD* AS THE DATE OF LAST ACCESS OF THE TAPE
*                FILE ENTRY.  DEFAULT IS THE CURRENT DATE.
*
*         ATIME = HHMMSS
*                SETS *HHMMSS* AS THE TIME OF LAST ACCESS OF THE TAPE
*                FILE ENTRY.  DEFAULT IS THE CURRENT TIME.
*
*         MDATE = YYMMDD
*                SETS *YYMMDD* AS THE DATE OF LAST MODIFICATION OF THE
*                TAPE FILE ENTRY.  DEFAULT IS THE CURRENT DATE.
*
*         MTIME = HHMMSS
*                SETS *HHMMSS* AS THE TIME OF LAST MODIFICATION OF THE
*                TAPE FILE ENTRY.  DEFAULT IS THE CURRENT TIME.
*
*         ACOUNT = COUNT
*                SETS *COUNT* AS THE NUMBER OF ACCESSES OF THE TAPE
*                FILE ENTRY.  DEFAULT IS ZERO.
*
*         CR = YYDDD
*                SETS *YYDDD* (JULIAN FORMAT) AS THE CREATION DATE OF
*                AN ANSI-LABELED TAPE.  THIS VALUE IS USUALLY
*                EQUIVALENT TO THE DATE SPECIFIED BY THE CDATE
*                DIRECTIVE, HOWEVER IT CAN BE DIFFERENT.  DEFAULT IS
*                THE CURRENT DATE.
*
*         CV = MODE
*                SETS *MODE* AS THE CONVERSION MODE FOR THE NINE-TRACK
*                TAPE FILE ENTRY.  VALID VALUES FOR *MODE* ARE -
*
*                AS - ASCII/DISPLAY CODE CONVERSION.
*
*                EB - EBCDIC/DISPLAY CODE CONVERSION.
*
*                DEFAULT IS AS.
*
*         D= DENSITY
*                SETS *DENSITY* AS THE TAPE DENSITY.  ALSO SETS THE
*                TAPE TYPE.  VALID VALUES FOR *DENSITY* ARE -
*
*                HI - 556 BPI, 7-TRACK (*MT*).
*
*                HY - 800 BPI, 7-TRACK (*MT*).
*
*                HD - 800 CPI, 9-TRACK (*NT*).
*
*                PE - 1600 CPI, 9-TRACK (*NT*).
*
*                GE - 6250 CPI, 9-TRACK (*NT*).
*
*                CE - 38000 CPI, CARTRIDGE (*CT*).
*
*                AE - 38000 CPI, ACS CARTRIDGE (*AT*).
*
*                DEFAULT IS PE.
*
*         E = NUMBER
*                SETS *NUMBER* AS THE ONE OR TWO DIGIT GENERATION
*                VERSION NUMBER FOR AN ANSI-LABELED TAPE.  DEFAULT IS
*                00.
*
*         F = FORMAT
*                SETS *FORMAT* AS THE DATA FORMAT OF THE TAPE FILE
*                ENTRY.  VALID VALUES FOR *FORMAT* ARE -
*
*                I - INTERNAL.
*
*                LI - LONG BLOCK INTERNAL.
*
*                S - STRANGER.
*
*                L - LONG BLOCK STRANGER.
*
*                SI - SCOPE INTERNAL.
*
*                F - FOREIGN.
*
*                DEFAULT IS I.
*
*         FA = CHAR
*                SETS *CHAR* AS THE ONE ALPHA-NUMERIC CHARACTER
*                ACCESSIBILITY RESTRICTION FOR AN ANSI-LABELED TAPE.
*                VALID VALUES FOR *CHAR* ARE -
*
*                NULL - NO ACCESSIBILITY RESTRICTIONS FOR ALTERNATE
*                    USERS.
*
*                A - NO ACCESSIBILITY ALLOWED FOR ALTERNATE USERS.
*
*                NON-A - ALTERNATE USERS MUST SPECIFY *CHAR* TO ACCESS
*                    TAPE FILE ENTRY.
*
*                DEFAULT IS NO CHARACTER.
*
*         FC = FRAMES
*                SETS *FRAMES* AS THE MAXIMUM SIZED BLOCK THAT CAN BE
*                READ FROM OR WRITTEN TO AN F FORMAT TAPE.  THE VALUE
*                SHOULD BE GREATER THAN THAT SPECIFIED BY THE NS
*                DIRECTIVE.  DEFAULT IS UNLIMITED.
*                A VALUE OF ZERO (0) SETS THE INSTALLATION DEFAULT.
*
*         G = NUMBER
*                SETS *NUMBER* AS THE ONE TO FOUR DIGIT GENERATION
*                NUMBER FOR AN ANSI LABELED TAPE.  DEFAULT IS 0001.
*
*         LB = LABEL
*                SETS LABEL AS THE LABEL STATUS OF THE TAPE FILE ENTRY.
*                VALID VALUES ARE -
*
*                KU - UNLABELED.
*
*                KL - ANSI-LABELED.
*
*                NS - NON-STANDARD LABELED.
*
*                DEFAULT IS KL.
*
*         SI = SETID
*                SETS *SETID* AS THE SET IDENTIFIER OF AN ANSI-LABELED
*                TAPE.  DEFAULT IS NO SET IDENTIFIER.
*
*         NS = FRAMES
*                SETS *FRAMES* AS THE MINIMUM SIZE OF A VALID BLOCK.
*                ANY SMALLER BLOCK IS CONSIDERED NOISE.  THE VALUE MUST
*                BE 0.GE.*FRAMES*.GE.31.  THE VALUE SHOULD BE LESS THAN
*                THAT SPECIFIED BY THE FC DIRECTIVE.  DEFAULT IS 0.
*                A VALUE OF ZERO (0) SETS THE INSTALLATION DEFAULT.
*
*         RT = YYDDD
*                SETS *YYDDD* (JULIAN FORMAT) AS THE RETENTION DATE FOR
*                AN ANSI-LABELED TAPE.  NO ONE (INCLUDING THE TAPE
*                OWNER) CAN WRITE OVER THE TAPE BEFORE THIS DATE.
*                DEFAULT IS THE CURRENT DATE.
*
*         SN = SECNO
*                SETS *SECNO* AS THE ONE TO FOUR DIGIT FILE SECTION
*                NUMBER FOR AN ANSI-LABELED TAPE.  DEFAULT IS 0001.
*
*         AVSN = VSN
*                ADDS *VSN* AS THE LAST VSN ASSIGNED TO THE TAPE FILE
*                ENTRY.  INCORRECT DIRECTIVE IF THE TAPE FILE ENTRY
*                ALREADY HAS 60 ASSIGNED VSNS, IF THE TAPE FILE ENTRY
*                IS NOT THE LAST FILE IN A MULTI-FILE SET, OR IF THE
*                VSN BEING ADDED HAS SYSTEM STATUS.  *VSN* CAN BE
*                ASSIGNED IF ONE OF THE FOLLOWING CONDITIONS IS MET -
*
*                1.  *VSN* IS NOT ASSIGNED TO ANOTHER TAPE FILE, DOES
*                    NOT HAVE SYSTEM STATUS, AND IT-S SITE AND
*                    OWNERSHIP STATUS MATCH THE STATUS OF THE FIRST
*                    ASSIGNED VSN OF THE TAPE FILE.
*
*                2.  THE TAPE FILE ENTRY HAS NO ASSIGNED VSNS AND *VSN*
*                    IS NOT ASSIGNED TO ANOTHER TAPE FILE, OR IS THE
*                    LAST VSN OF ANOTHER TAPE FILE BELONGING TO THE
*                    USER (PROVIDING FOR MULTI-FILE SET CATALOGS).
*
*                A NULL *VSN* IS INCORRECT.
*
*         TSITE = SITE
*                SETS SITE AS THE OFF SITE/ON SITE STATUS OF ALL THE
*                VSNS ASSIGNED TO THE TAPE FILE ENTRY.  USERS CANNOT
*                ACCESS OFF SITE TAPE FILES.  VALID VALUES FOR SITE
*                ARE -
*
*                ON - ON SITE.
*
*                OFF - OFF SITE.
*
*                DEFAULT IS ON.
*
*         RDATE = YYMMDD
*                SET YYMMDD AS THE USER RELEASE DATE OF THE TAPE
*                FILE ENTRY. IF THE DIRECTIVE IS SPECIFIED WITH NO
*                DATE (RDATE=), THE USER RELEASE DATE IS CLEARED.
*                DEFAULT IS NO RELEASE DATE.
*
*         URDATE = YYMMDD
*                SET YYMMDD AS THE UNCONDITIONAL RELEASE DATE OF THE
*                TAPE FILE ENTRY. IF THE DIRECTIVE IS SPECIFIED WITH NO
*                DATE (RDATE=), THE UNCONDITIONAL RELEASE DATE IS
*                CLEARED.  DEFAULT IS NO RELEASE DATE.
*
*         TOWNER = TYPE
*                SETS *TYPE* AS THE OWNERSHIP STATUS OF ALL THE VSNS
*                ASSIGNED TO THE TAPE FILE ENTRY.  VALID VALUES FOR
*                *TYPE* ARE -
*
*                CENTER - CENTER OWNED.
*
*                USER - USER OWNED.
*
*                DEFAULT IS CENTER.
*
*         AUSER = USERNAM
*                BEGINS ALTERNATE USER LEVEL DIRECTIVES.  ALL
*                DIRECTIVES FOLLOWING THE AUSER DIRECTIVE AND BEFORE
*                THE NEXT ADMIT, DROP, OR GO DIRECTIVE ARE ASSOCIATED
*                WITH THE PERMISSION GRANTED TO USER NAME *USERNAM* FOR
*                THE TAPE FILE ENTRY.  INCORRECT ENTRY IF THE TAPE FILE
*                HAS NOT YET BEEN RESERVED.  A NULL *USERNAM* IS
*                INCORRECT.  IF ENTERED FROM THE ALTERNATE USER LEVEL,
*                AN IMPLIED DROP WILL BE PERFORMED AND NO UPDATE FOR
*                THE CURRENT LEVEL WILL OCCUR.
          SPACE  4,10
***       ALTERNATE USER LEVEL DIRECTIVES.
*
*         ALTERNATE USER LEVEL DIRECTIVES REFERENCE AN ALTERNATE USER
*         GRANTED EXPLICIT PERMISSION TO ACCESS THE TAPE FILE.
*         ALTERNATE USER LEVEL DIRECTIVES MAY OCCUR ANYWHERE AFTER AN
*         AUSER DIRECTIVE AND BEFORE AN ADMIT, DROP, OR GO DIRECTIVE.
*         WHENEVER A ALTERNATE USER LEVEL DIRECTIVE IS ASSIGNED A NULL
*         VALUE, TFSP WILL SET THE DEFAULT VALUE.
*
*         ADMIT
*                END PROCESSING OF ALTERNATE USER LEVEL DIRECTIVES.
*                THE CHANGES SPECIFIED BY THE ALTERNATE USER LEVEL
*                DIRECTIVES WILL BE MADE TO THE ALTERNATE USER.
*
*         GO
*                SAME AS ADMIT.
*
*         DROP
*                END PROCESSING OF ALTERNATE USER LEVEL DIRECTIVES.
*                CHANGES SPECIFIED BY THE ALTERNATE USER LEVEL
*                DIRECTIVES WILL BE IGNORED.
*
*         AMODE = MODE
*                SETS *MODE* AS THE ACCESS PERMISSION GRANTED TO THE
*                USER.  VALID VALUES FOR *MODE* ARE -
*
*                NULL - NO ACCESS ALLOWED TO THE USER.
*
*                READ - USER ALLOWED TO READ BUT NOT WRITE ON THE TAPE
*                    FILE.
*
*                WRITE - USER ALLOWED TO READ AND WRITE ON THE TAPE
*                    FILE.
*
*                IMPLICIT - SEMI-PRIVATE ACCESS.  THE MODE SPECIFIED BY
*                    THE M FILE LEVEL DIRECTIVE TAKES PRECEDENCE.
*
*                SPECIAL - TMS CONVERSION MODE.
*
*                DEFAULT IS IMPLICIT.
*
*         AACOUNT = COUNT
*                SETS THE NUMBER OF ACCESSES BY THE USER TO *COUNT*.
*                DEFAULT IS ZERO.
*
*         AADATE = YYMMDD
*                SETS THE DATE OF LAST ACCESS BY THE USER TO *YYMMDD*.
*                DEFAULT IS THE CURRENT DATE.
*
*         AATIME = HHMMSS
*                SETS THE TIME OF LAST ACCESS BY THE USER TO *HHMMSS*.
*                DEFAULT IS THE CURRENT TIME.
          SPACE  4,10
***       INFORMATIVE DIRECTIVE MESSAGES.
*
*         INFORMATIVE DIRECTIVE MESSAGES ARE ISSUED TO THE OUTPUT FILE
*         OR K-DISPLAY AFTER THE DIRECTIVE IS PROCESSED.  THESE
*         MESSAGES ARE PREFIXED BY THE CHARACTERS *INFORM*.
*         THESE MESSAGES WILL NOT BE WRITTEN TO THE OUTPUT FILE
*         IF TFSP IS IN *BRIEF* MODE.
*
*         P AND N PARAMETERS IGNORED.
*                FIRST MESSAGE ISSUED WHENEVER TFSP IS NOT RUN IN LOCAL
*                FILE (LF) MODE.
*
*         I PARAMETER IGNORED.
*                FIRST MESSAGE ISSUED WHENEVER TFSP IS RUN WITH THE
*                OP=K OR OP=Z OPTION.
*
*         VSN REMOVED FROM CATALOG.
*                THE REMOVE DIRECTIVE HAS COMPLETED.
*
*         FILE RELEASED.
*                THE RELEASE, RELEASF, OR RELEASV DIRECTIVE HAS
*                COMPLETED.
*
*         ALTERNATE USER CURRENTLY IS ADMITTED.
*                THE USER NAME SPECIFIED BY THE AUSER DIRECTIVE HAS
*                BEEN ADMITTED PREVIOUSLY.
*
*         ALTERNATE USER NOT CURRENTLY ADMITTED.
*                THE USER NAME SPECIFIED BY THE AUSER DIRECTIVE HAS NOT
*                BEEN PREVIOUSLY ADMITTED.
*
*         ALTERNATE USER NOT PROCESSED.
*                AN ALTERNATE USER DROP DIRECTIVE HAS BEEN ISSUED.
*
*         ALTERNATE USER ADMITTED.
*                A NEW ALTERNATE USER HAS BEEN ADMITTED VIA THE ADMIT
*                DIRECTIVE.
*
*         ALTERNATE USER ADMIT UPDATED.
*                THE ADMIT ENTRY FOR A PREVIOUSLY ADMITTED ALTERNATE
*                USER HAS BEEN UPDATED VIA THE ADMIT DIRECTIVE.
*
*         PREMATURE END OF FILE, XXXXXXX.
*                A NULL INPUT LINE WAS FOUND WHILE READING DIRECTIVES
*                FROM FILE XXXXXXX.
*
*         FILE CURRENTLY IS RESERVED.
*                THE TAPE FILE SPECIFIED BY THE FILE DIRECTIVE HAS BEEN
*                PREVIOUSLY RESERVED.
*
*         FILE NOT CURRENTLY RESERVED.
*                THE TAPE FILE SPECIFIED BY THE FILE DIRECTIVE HAS NOT
*                BEEN PREVIOUSLY RESERVED.
*
*         FILE NOT PROCESSED.
*                THE FILE LEVEL DROP DIRECTIVE HAS BEEN ISSUED.
*
*         FILE RESERVED.
*                THE RESERVE DIRECTIVE HAS BEEN ISSUED FOR A TAPE FILE
*                THAT PREVIOUSLY WAS NOT RESERVED.
*
*         FILE AMENDED.
*                THE AMEND DIRECTIVE HAS BEEN ISSUED FOR A TAPE FILE
*                THAT PREVIOUSLY WAS RESERVED.
*
*         USER LEVEL COMPLETE.
*                THE USER LEVEL DROP DIRECTIVE HAS BEEN ISSUED.
*
*         VSN CURRENTLY IN CATALOG.
*                THE VSN SPECIFIED BY THE VSN DIRECTIVE HAS PREVIOUSLY
*                BEEN ADDED TO THE TAPE CATALOG FILE.
*
*         VSN INTERLOCKED.  JSN IS XXXX.
*                THE VSN SPECIFIED BY THE VSN DIRECTIVE IS BUSY
*                AND ASSIGNED (WAITING FOR TAPE TO BE MOUNTED).
*                THE JSN OF THE JOB REQUESTING THE TAPE IS GIVEN.
*
*         VSN NOT CURRENTLY IN CATALOG.
*                THE VSN SPECIFIED BY THE VSN DIRECTIVE HAS NOT BEEN
*                PREVIOUSLY ADDED TO THE TAPE CATALOG FILE.
*
*         VSN RESERVED BY UUUUUUU.
*                THE VSN SPECIFIED BY THE VSN DIRECTIVE HAS PREVIOUSLY
*                BEEN ADDED TO THE TAPE CATALOG FILE AND IS ASSIGNED TO
*                A TAPE FILE OF USER NAME UUUUUUU.
*
*         VSN NOT PROCESSED.
*                THE VSN LEVEL DROP DIRECTIVE HAS BEEN ISSUED.
*
*         VSN ADDED TO CATALOG.
*                THE ADD DIRECTIVE HAS BEEN ISSUED FOR A VSN THAT HAS
*                NOT BEEN PREVIOUSLY ADDED TO THE TAPE CATALOG FILE.
*
*         VSN REVISED.
*                THE REVISE DIRECTIVE HAS BEEN ISSUED FOR A VSN THAT
*                HAS BEEN PREVIOUSLY ADDED TO THE TAPE CATALOG FILE.
          SPACE  4,10
***       DIRECTIVE ERROR MESSAGES.
*
*         TFSP DIRECTIVE ERROR MESSAGES ARE ISSUED TO THE OUTPUT FILE
*         OR K-DISPLAY AFTER TFSP HAS ATTEMPTED TO PROCESS THE
*         DIRECTIVE.  THE MESSAGES ARE PREFIXED BY THE CHARACTERS
*         *ERROR*.
*
*         ALTERNATE FAMILIES AT MAXIMUM.
*                AN ATTEMPT WAS MADE TO ADD A FAMILY NAME WITH THE
*                *ALTFAM* DIRECTIVE WHEN THE MAXIMUM NUMBER OF
*                ALTERNATE FAMILIES WERE ALREADY DEFINED.
*
*         ASSIGNED VSNS AT MAXIMUM.
*                AN ATTEMPT WAS MADE TO ASSIGN MORE THAN 60 VSNS TO A
*                TAPE FILE OR TO ASSIGN A VSN TO A TAPE FILE THAT WAS
*                NOT THE LAST FILE OF A MULTI-FILE SET.
*
*         CANNOT CHANGE SYSTEM VSN FLAG.
*                AN ATTEMPT WAS MADE TO CHANGE THE SYSTEM VSN FLAG OF
*                A VSN ENTRY WHICH WAS ALREADY IN THE CATALOG.
*
*         CANNOT CHANGE TAPE TYPE / DENSITY.
*                AN ATTEMPT WAS MADE TO CHANGE THE TAPE TYPE OF A VSN
*                ENTRY WHICH WAS ALREADY IN THE CATALOG; OR AN ATTEMPT
*                WAS MADE TO CHANGE THE DENSITY OF A TAPE FILE WHICH
*                HAD VSN-S ASSIGNED, AND THAT NEW DENSITY IMPLIED A
*                CHANGE IN TAPE TYPE.
*
*         DATA FIELD ERROR.
*                THE DATA SPECIFIED WITH THE DIRECTIVE IS NOT VALID FOR
*                THAT DIRECTIVE.
*
*         DIRECTIVE INCORRECT FROM CURRENT LEVEL.
*                THE DIRECTIVE THAT WAS ENTERED MAY NOT BE ISSUED FROM
*                THE CURRENT LEVEL.  CONSULT *HELP* DISPLAY FOR CORRECT
*                LEVEL.
*
*         DIRECTIVE NOT VALID ON FAST ATTACH CATALOG.
*                THE DIRECTIVE CAN ONLY BE USED IN LOCAL FILE MODE.
*
*         FILE BUSY.
*                THE TAPE FILE ENTRY SPECIFIED BY THE FILE OR FILEV
*                DIRECTIVE IS IN USE AND CANNOT BE ACCESSED AT THIS
*                TIME.
*
*         FILE ALREADY RESERVED.
*                AN ATTEMPT WAS MADE TO ISSUE THE RESERVE DIRECTIVE FOR
*                A TAPE FILE THAT ALREADY WAS RESERVED.
*
*         FILE IDENTIFIER CONFLICT.
*                THE FILE IDENTIFIER SPECIFIED BY THE FI DIRECTIVE IS
*                THE SAME AS THE FILE IDENTIFIER FOR ANOTHER OF THE
*                SYMBOLIC ACCESS FILES OF THE USER.
*
*         FILE NAME CONFLICT.
*                THE FILE SPECIFIED BY THE READ DIRECTIVE IS THE SAME
*                AS A FILE USED BY ONE OF THE COMMAND
*                PARAMETERS.
*
*         FILE NOT IN CATALOG.
*                THE TAPE FILE SPECIFIED BY THE RELEASF OR RELEASV
*                DIRECTIVE IS NOT AMONG THE TAPE FILES OF THE USER.
*
*         FILE NOT RESERVED.
*                AN ATTEMPT WAS MADE TO ISSUE THE AUSER OR AMEND
*                DIRECTIVE FOR A TAPE FILE THAT IS NOT YET RESERVED.
*
*         INCORRECT DIRECTIVE.
*                EITHER THE DIRECTIVE IS NOT A TFSP DIRECTIVE OR IT
*                CANNOT BE ISSUED AT THIS POINT IN THE DIRECTIVE
*                STREAM.
*
*         INCORRECT FILE IDENTIFIER.
*                AN INCORRECT FILE IDENTIFIER WAS SPECIFIED.
*
*         INCORRECT SEQUENCE NUMBER.
*                THE SEQUENCE NUMBER SPECIFIED BY THE FILEV DIRECTIVE
*                IS TOO LARGE.
*
*         NO SCRATCH AVAILABLE.
*                NO MORE SCRATCH TAPES LEFT IN THE SCRATCH POOL.
*                SCRATCH TAPES MUST BE ADDED TO THE TAPE CATALOG
*                BEFORE ANY MORE SCRATCH TAPES CAN BE ASSIGNED.
*
*         NON-MATCHING STATUSES.
*                THE STATUS OF THE VSN SPECIFIED BY THE AVSN DIRECTIVE
*                DOES NOT MATCH THE STATUS OF THE FIRST VSN OF THE TAPE
*                FILE.
*
*         NON-MATCHING TAPE TYPE.
*                THE TAPE TYPE OF THE VSN SPECIFIED BY THE AVSN
*                DIRECTIVE EITHER DOES NOT MATCH THE TAPE TYPE IN THE
*                TAPE FILE CATALOG ENTRY, OR DOES NOT MATCH THE TAPE
*                TYPE OF THE FIRST VSN OF THE TAPE FILE.
*
*         READ DIRECTIVE INCORRECT.
*                AN ATTEMPT WAS MADE TO ISSUE THE READ DIRECTIVE FROM
*                THE FILE BEING READ BY A PREVIOUS READ DIRECTIVE.
*
*         REQUIRED DATA MISSING.
*                AN ATTEMPT WAS MADE TO RESERVE A TAPE FILE ENTRY
*                WITHOUT A VSN.
*
*         SYSTEM VSN CANNOT BE USER-OWNED.
*                AN ATTEMPT WAS MADE TO CHANGE THE OWNERSHIP OF A VSN
*                WITH THE SYSTEM VSN FLAG SET FROM *CENTER* TO *USER*;
*                OR AN ATTEMPT WAS MADE TO SET THE SYSTEM VSN FLAG FOR
*                A USER-OWNED VSN.
*
*         SYSTEM VSN MUST BE FIRST VSN.
*                AN ATTEMPT WAS MADE TO ADD A SYSTEM VSN TO AN EXISTING
*                TAPE FILE ENTRY.  A SYSTEM VSN MAY BE THE FIRST VSN OF
*                A TAPE FILE ENTRY, BUT MAY NOT OCCUPY ANY OTHER PLACE
*                IN THE SET.
*
*         VALIDATED USERS AT MAXIMUM.
*                AN ATTEMPT WAS MADE TO ADD A NINTH VALIDATED USER VIA
*                THE VALIDAT DIRECTIVE.
*
*         VSN ALREADY ASSIGNED.
*                THE VSN SPECIFIED BY AN REMOVE OR AVSN DIRECTIVE IS
*                ASSIGNED TO A TAPE FILE ENTRY.
*
*         VSN ALREADY IN CATALOG.
*                AN ATTEMPT WAS MADE TO ISSUE THE ADD DIRECTIVE FOR A
*                VSN THAT HAD ALREADY BEEN ADDED TO THE TAPE CATALOG
*                FILE.
*
*         VSN BUSY.
*                THE VSN SPECIFIED BY THE VSN OR AVSN DIRECTIVE IS IN
*                USE AND CANNOT BE ACCESSED AT THIS TIME.
*
*         VSN NOT ADDED TO CATALOG.
*                AN ATTEMPT WAS MADE TO ISSUE THE REVISE DIRECTIVE FOR
*                A VSN THAT HAD NOT YET BEEN ADDED TO THE TAPE CATALOG
*                FILE.
*
*         VSN NOT ASSIGNED TO FILE.
*                THE VSN SPECIFIED BY THE RELEASE DIRECTIVE IS NOT
*                ASSIGNED TO A TAPE FILE.
*
*         VSN NOT AVAILABLE.
*                THE VSN SPECIFIED BY THE FILEV DIRECTIVE IS EITHER NOT
*                IN THE TAPE CATALOG OR IS ASSIGNED TO ANOTHER USER.
*
*         VSN NOT IN CATALOG.
*                THE VSN SPECIFIED BY AN RELEASE OR AVSN DIRECTIVE IS
*                NOT IN THE TAPE CATALOG FILE.
          TITLE  SYSTEM EQUIVALENCES AND MACROS FOR MACROS.
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMCDCM
          QUAL   COMSMTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSPRD
*CALL     COMSSFM
*CALL     COMSSSD
*CALL     COMSSSJ
*CALL     COMSTFM
 SETREG   SPACE  4,15
**        SETREG - SET REGISTER WITH VALUE OR DEFAULT.
*
*         SETREG REG,VALUE,DEFAULT
*
*         ENTRY  REG = REGISTER TO RECEIVE VALUE OR DEFAULT.
*                VALUE = VALUE SET INTO *REG* IF NOT NULL.
*                DEFAULT = VALUE SET INTO *REG* IF *VALUE* IS NULL.
*
*         EXIT   REGISTER SET TO *VALUE* OR *DEFAULT*.
*
*         MACROS SETVAL.
 
 
          PURGMAC  SETREG
 
 SETREG   MACRO  RG,VA,DF
          SETVAL (  R= RG,),VA,DF
          ENDM
 SETVAL   SPACE  4,10
**        SETVAL - SET VALUE OR ITS DEFAULT.
*
*         SETVAL (INST),VALUE,DEFAULT
*
*         ENTRY  INST = FIRST PART OF INSTRUCTION.  (INCLUDE SPACES.)
*                VALUE = VALUE FOR *INST* IF NOT NULL.
*                DEFAULT = VALUE FOR *INST* IF *VALUE* IS NULL.
*
*         EXIT   INSTRUCTION SET WITH *VALUE* OR *DEFAULT*.
 
 
          PURGMAC  SETVAL
 
 SETVAL   MACRO  IN,VA,DF
          IFC    EQ,$VA$$    IF DEFAULT
IN_DF
          ELSE               IF NOT DEFAULT
IN_VA
          ENDIF
          ENDM
          TITLE  MACROS FOR TABLE GENERATION.
 BITMIC   SPACE  4,15
**        BITMIC - GENERATE SPECIAL CHARACTER BIT STRING MICRO.
*
* TAG     BITMIC (C1,C2,...,CN)
*
*         ENTRY  CI = SPECIAL CHARACTER (CODE .GE. 45B).
*                   = *L* FOR LEFT PARENTHESIS.
*                   = *R* FOR RIGHT PARENTHESIS.
*                   = *U* FOR UNDERLINE/ARROW.
*
*         EXIT   DECIMAL MICRO *TAG* IS GENERATED.  BIT POSITION
*                EQUALING (CHARACTER CODE - 45B) IS SET FOR EACH
*                CHARACTER *CI*.  IF *TAG* IS REDEFINED, THE NEW VALUE
*                IS THE LOGICAL DIFFERENCE OF THE OLD VALUE WITH THE
*                NEW BIT STRING.  FOR COLON, BIT POSITION 35 IS SET.
 
 
          PURGMAC  BITMIC
 
          MACRO  BITMIC,TAG,S
          LOCAL  A,B,C
 A        DECMIC 0
          ECHO   ,B=(S)
 .1       IFC    EQ,D_B_D_L_D
 C        DECMIC 1R(-1R+
 .1       ELSE
 .2       IFC    EQ,D_B_D_R_D
 C        DECMIC 1R)-1R+
 .2       ELSE
 .3       IFC    EQ,D_B_D_U_D
 C        DECMIC 65B-1R+
 .3       ELSE
 .4       IFC    EQ,D_B_D_:_D
 C        DECMIC 100B-1R+
 .4       ELSE
 C        DECMIC 1R_B-1R+
          ENDIF
 A        DECMIC "A"&1S_"C"
          ENDD
          IF     -MIC,TAG
 TAG      DECMIC "A"
          ELSE
 TAG      DECMIC "TAG"&"A"
          ENDIF
          ENDM
 CATBASE  SPACE  4,10
**        CATBASE - INITIALIZE TABLE FOR *CATBIT* MACRO.
*
* NAME    CATBASE
*
*         ENTRY  NAME = NAME OF TABLE.
*
*         EXIT   *NAME* DEFINED TO LOCATION COUNTER VALUE.
*                */CATBIT/BASE* SET TO ORIGIN COUNTER.
 
 
          PURGMAC  CATBASE
 
          MACRO  CATBASE,TAG
 TAG      BSS    0
          QUAL   CATBIT
 BASE     SET    *O
          QUAL   *
          LOC    0
          ENDM
 CATBIT   SPACE  4,25
**        CATBIT - GENERATE CATALOG ENTRY.
*
* NAME    CATBIT WORD,UPB,BCOUNT,VALUE1,VALUE2
*
*         ENTRY  NAME = IDENTIFIER TO BE ASSOCIATED WITH CATALOG
*                       ENTRY.  DEFAULT IN NO IDENTIFIER.
*                WORD = RELATIVE ADDRESS OF ENTRY IN CATALOG.  VERIFIED
*                       AGAINST ACTUAL ADDRESS.  DEFAULT IS NO
*                       VERIFICATION.
*                UPPERB = UPPER BIT POSITION OF CATALOG ENTRY.
*                         VERIFIED AGAINST ACTUAL BIT POSITION.
*                         DEFAULT IS NO VERIFICATION.
*                BCOUNT = BIT COUNT OF CATALOG ENTRY.
*                VALUE1 = VALUE OF CATALOG ENTRY IF *BCOUNT* .LE. 60.
*                         VALUE OF FIRST 60 BITS OF CATALOG ENTRY IF
*                         *BCOUNT* .GT. 60.  DEFAULT IS 0.
*                VALUE2 = VALUE OF REMAINDER OF CATALOG ENTRY IF
*                         *BCOUNT* IS .GT. 60.
*
*         EXIT   CATALOG ENTRY GENERATED.
*                */ADD/NAME* DEFINED TO ORIGIN COUNTER.
*                */CAT/NAME* DEFINED TO RELATIVE ADDRESS IN CATALOG.
*                                CATALOG.
*                */UPB/NAME* DEFINED TO POSITION COUNTER.
*                */BTC/NAME* DEFINED TO *BCOUNT*.
 
 
          PURGMAC  CATBIT
 
          MACRO  CATBIT,TAG,WD,UB,BC,V1,V2
          LOCAL  A
          IFC    NE,$TAG$$   IF *NAME* TO BE DEFINED
          QUAL   ADD
 TAG      EQU    *O
          QUAL   *
          QUAL   CAT
 TAG      EQU    *
          QUAL   *
          QUAL   UPB
 TAG      EQU    *P-1
          QUAL   *
          QUAL   BTC
 TAG      EQU    BC
          QUAL   *
          ENDIF
          IFC    NE,$WD$$    IF VERIFY RELATIVE ADDRESS
          ERRNZ  WD-*        INCONSISTENT CATALOG ADDRESS
          ENDIF
          IFC    NE,$UB$$    IF VERIFY UPPER BIT
          ERRNZ  UB-*P+1     INCONSISTENT BIT POSITION
          ENDIF
          IFLE   BC,60       IF BIT COUNT .LE. 60
 A        DECMIC BC
          VFD    "A"/V1
          ELSE               IF BIT COUNT .GT. 60
 A        DECMIC BC-60
          VFD    60/V1
          VFD    "A"/V2
          ENDIF
          ENDM
 CATEND   SPACE  4,10
**        CATEND - END TABLE FOR CATBIT MACRO.
*
*         CATEND LENGTH
*
*         ENTRY  LENGTH = TABLE LENGTH TO VERIFY AGAINST ACTUAL LENGTH.
 
 
          PURGMAC  CATEND
 
 CATEND   MACRO  LN
          BSS    0
          ERRNZ  LN-*        INCONSISTENT TABLE LENGTH
          LOC    *O
          ENDM
 DCTAB    SPACE  4,45
**        DCTAB - GENERATE DIRECTIVE CONTROL TABLE.
*
* NAME    DCTAB  IND,MNC,MXC,AC,SC,UB,BC,PRO,ENT,MNV,MXV,DEF
*
*         ENTRY  NAME = LABEL ASSOCIATED WITH DIRECTIVE.
*                IND = *DIP* PROCESSOR INDEX.
*                      PIZF - ZERO FILL.
*                      PIBF - BLANK FILL.
*                      PIOP - OPTION SELECTION.
*                      PIBD - NUMERIC BINARY DATA.
*                      PIPD - PACKED DATE.
*                      PIPT - PACKED TIME.
*                      PIJD - JULIAN DATE.
*                      PIVQ - VSN/SEQUENCE NUMBER.
*                      PIVS - PADDED VSN.
*                MNC = MINIMUM NUMBER OF CHARACTERS.
*                MXC = MAXIMUM NUMBER OF CHARACTERS.
*                AC = ADDRESS OF ALLOWED CHARACTERS BIT STRING.
*                     DEFAULT IS ="NC".
*                SC = ADDRESS OF SUPPRESSED CHARACTERS BIT STRING.
*                     DEFAULT IS ="BL".
*                UB = UPPER BIT POSITION OF CATALOG ENTRY.
*                     DEFAULT IS /UPB/NAME.
*                BC = BIT COUNT OF CATALOG ENTRY.
*                   = 0 IF NO CATALOG ENTRY.
*                     DEFAULT IS /BTC/NAME.
*                PRO = POST PROCESSOR ADDRESS.
*                      DEFAULT IS 0 - NO POST PROCESSOR.
*                ENT = ADDRESS OF CATALOG ENTRY.
*                      DEFAULT IS */ADD/NAME*.
*                MNV = ADDRESS OF MINIMUM VALUE FOR *PIBD* TYPE.
*                MXV = ADDRESS OF MAXIMUM VALUE FOR *PIBD* TYPE.
*                    = ADDRESS OF OPTION TABLE FOR *PIOP* TYPE.
*                      DEFAULT FOR *PIOP* TYPE IS /DOTAB/NAME.
*                DEF = ADDRESS OF DEFAULT VALUE.
*                      DEFAULT FOR *PIOP* TYPE IS /DOTAB/NAME.
*
*         EXIT   LABEL /DCTAB/NAME IS GENERATED.
*                MICROS *POP*, *MNV*, *MXV*, AND *DEF* DEFINED
*                FOR *DCTABO*.
*                FIRST THREE WORDS OF TABLE ARE GENERATED.
*                12/IND,6/MNC,6/MXC,18/AC,18/SC
*                12/UB,12/BC,18/PRO,18/ENT
*                6/,18/MNV,18/MXV,18/DEF
*
*         NOTES  THE *DCTAB* MACRO MUST BE FOLLOWED BY A *DCTABL*
*                MACRO.
 
 
          PURGMAC  DCTAB
 
          MACRO  DCTAB,TAG,IN,MC,XC,AC,SC,UB,BC,PR,EN,MV,XV,DF
          LOCAL  A
 
*         SET FIRST WORD.
 
 A        VFD    12/IN,6/MC,6/XC
          SETVAL (  VFD 18/),AC,(="NC")
          SETVAL (  VFD 18/),SC,(="BL")
 
*         DEFINE *NAME*.
 
          QUAL   DCTAB
 TAG      EQU    A
          QUAL   *
 
*         SET SECOND WORD.
 
          IF     -DEF,/UPB/TAG  IF NO DEFAULTS
          VFD    12/UB,12/BC,18/PR,18/EN
          ELSE               IF DEFAULTS
          SETVAL (  VFD 12/),UB,/UPB/TAG
          SETVAL (  VFD 12/),BC,/BTC/TAG
          VFD    18/PR
          SETVAL (  VFD 18/),EN,/ADD/TAG
          ENDIF
 
*         SET MICROS FOR *DCTABO*.
 
 POP      MICRO  1,, IN
          SETVAL ( MNV MICRO 1,, ),(MV),0
          IFC    NE,$IN$PIOP$  IF NOT OPTION TYPE
          SETVAL ( MXV MICRO 1,, ),(XV),0
          SETVAL ( DEF MICRO 1,, ),(DF),0
          ELSE               IF OPTION TYPE
          SETVAL ( MXV MICRO 1,, ),(XV),/DOTAB/TAG
          SETVAL ( DEF MICRO 1,, ),(DF),/DOTAB/TAG
          ENDIF
 
*         SET CHECK FOR THIRD WORD.
 
 DCTRMT   RMT
          ERRNZ  /DCTAB/TAG+2-*  NO *DCTABL* FOR TAG
 DCTRMT   RMT
          ENDM
 DCTABL   SPACE  4,20
**        DCTABL - GENERATE DIRECTIVE LEVEL CONTROL TABLE.
*
* NAME    DCTABL PVL,DVL
*
*         ENTRY  NAME = LABEL ASSOCIATED WITH DIRECTIVE.
*                PVL = FLAG FOR IMPLIED DROP REQUIREMENT.
*                    = 0 IF DIRECTIVE REQUIRES NO IMPLIED DROP.
*                    = 1 IF DIRECTIVE REQUIRES IMPLIED DROP.
*                DVL = FLAG FOR LOWER LEVEL VALIDITY.
*                    = 0 IF VALID FROM LOWER LEVEL.
*                    = 1 IF NOT VALID FROM ANOTHER LEVEL.
*                MICROS *POP*, *MNV*, *MXV*, AND *DEF* DEFINED
*                BY *DCTAB*.
*
*         EXIT   WORD 2 OF DIRECTIVE CONTROL TABLE REGENERATED.
*                1/,1/PVL,1/DVL,3/,18/MNV,18/MXV,18/DEF
 
 
          PURGMAC  DCTABL
 
          MACRO  DCTABL,TAG,PV,DV
 
*         SET MICROS FOR *DCTABO*.
 
          SETVAL ( PVL MICRO 1,, ),(PV),0
          SETVAL ( DVL MICRO 1,, ),(DV),0
 
*         SET THIRD WORD.
 
 DCTRMT   HERE
          VFD    1/,1/"PVL",1/"DVL",3/,18/"MNV",18/"MXV",18/"DEF"
          ENDM
 DCTABO   SPACE  4,40
**        DCTABO - GENERATE DIRECTIVE CONTROL TABLE OUTPUT BLOCK.
*
* NAME    DCTABO KCH,KUB,KADD,ACH,AUB,AADD,SCH,SUB,SADD,MCH,MUB,MADD
*
*         ENTRY  NAME = DIRECTIVE IDENTIFIER.
*                KCH = NUMBER OF CHARACTERS IN K-DISPLAY.
*                      DEFAULT IS 10.
*                KUB = UPPER BIT POSITION IN K-DISPLAY.
*                      DEFAULT IS 5.
*                KADD = ADDRESS IN K-DISPLAY.
*                       DEFAULT IS */KDIS/NAME*.
*                ACH = NUMBER OF CHARACTERS IN AUDIT LISTING.
*                      DEFAULT IS */ALSC/NAME*.
*                AUB = UPPER BIT POSITION IN AUDIT LISTING.
*                      DEFAULT IS */ALSU/NAME*.
*                AADD = ADDRESS IN AUDIT LISTING.
*                       DEFAULT IS */ALS/NAME*.
*                SCH = NUMBER OF CHARACTERS IN SOURCE LISTING.
*                      DEFAULT IS */SLSC/NAME*.
*                SUB = UPPER BIT POSITION IN SOURCE LISTING.
*                      DEFAULT IS */SLSU/NAME*.
*                SADD = ADDRESS IN SOURCE LISTING.
*                       DEFAULT IS */SLS/NAME*.
*                MCH = NUMBER OF CHARACTERS IN MACHINE READABLE LIST.
*                      DEFAULT IS */MLSC/NAME*.
*                MUB = UPPER BIT POSITION IN MACHINE READABLE LISTING.
*                      DEFAULT IS */MLSU/NAME*.
*                MADD = ADDRESS IN MACHINE READABLE LISTING.
*                       DEFAULT IS */MSL/NAME*.
*                MICROS *POP*, *MNV*, *MXV*, *DEF*,  *PVL*,
*                AND *DVL* DEFINED BY *DCTABL* AND
*                BY *DCTAB*.
*
*         EXIT   OUTPUT BLOCK FLAG SET IN DIRECTIVE CONTROL TABLE.
*                TWO WORD BLOCK GENERATED.
*                6/KCH,6/KUB,18/KADD,6/ACH,6/AUB,18/AADD
*                6/SCH,6/SUB,18/SADD,6/MCH,6/MUB,18/MADD
 
 
          PURGMAC  DCTABO
 
          MACRO  DCTABO,TAG,KC,KU,KA,AC,AU,AA,SC,SU,SA,MC,MU,MA
          LOCAL  A,B
 
*         SET OUTPUT BLOCK FLAG IN DIRECTIVE CONTROL TABLE.
 
 A        SET    *O
 B        SET    *
          ORG    /DCTAB/TAG+2
          VFD    1/1,1/"PVL",1/"DVL",3/,18/"MNV",18/"MXV",18/"DEF"
          ORG    A
          LOC    B
 
*         SET OUTPUT BLOCK VALUES.
 
          IFC    EQ,$"POP"$PIBD$  IF BINARY DATA TYPE
 A        SET    -1
          ELSE               IF NOT BINARY DATA TYPE
 A        SET    1
          ENDIF
          SETVAL (  VFD 6/),KC,10
          SETVAL (  VFD 6/),KU,5
          SETVAL (  VFD 18/),KA,(/KDIS/TAG)
          SETVAL (  VFD 6/),AC,(/ALSC/TAG*A)
          SETVAL (  VFD 6/),AU,(/ALSU/TAG)
          SETVAL (  VFD 18/),AA,(/ALS/TAG)
          SETVAL (  VFD 6/),SC,(/SLSC/TAG*A)
          SETVAL (  VFD 6/),SU,(/SLSU/TAG)
          SETVAL (  VFD 18/),SA,(/SLS/TAG)
          SETVAL (  VFD 6/),MC,(/MLSC/TAG*A)
          SETVAL (  VFD 6/),MU,(/MLSU/TAG)
          SETVAL (  VFD 18/),MA,(/MLS/TAG)
          ENDM
 DOTAB    SPACE  4,15
**        DOTAB - GENERATE DIRECTIVE OPTION TABLE.
*
* NAME    DOTAB  ((OP1,VAL1),(OP2,VAL2),...,(OPN,VALN))
*
*         ENTRY  NAME = LABEL ASSOCIATED WITH DIRECTIVE.
*                OPI = DIRECTIVE OPTION.
*                VALI = VALUE ASSOCIATED WITH OPTION *OPI*.
*
*         EXIT   LABEL /DOTAB/NAME IS GENERATED.
*                TWO WORD BLOCK FOR EACH OPTION IS GENERATED.
*                60/0L*OPI*
*                60/*VALI*
*                TABLE IS TERMINATED BY A ZERO WORD.
 
 
          PURGMAC  DOTAB
 
          MACRO  DOTAB,TAG,ST
          LOCAL  A,B,DOENT
 
*         DEFINE MACRO FOR TABLE GENERATION.
*         DOENT  OPTION,VALUE
 
 DOENT    MACRO  OP,VA
          VFD    60/0L_OP
          VFD    60/VA
 DOENT    ENDM
 
*         GENERATE TABLE.
 
 A        SET    *
          ECHO   ,B=(ST)
          DOENT  B
          ENDD
          CON    0
 
*         DEFINE *NAME*.
 
          QUAL   DOTAB
 TAG      EQU    A
          QUAL   *
          ENDM
 DTAB     SPACE  4,15
**        DTAB - GENERATE DIRECTIVE TABLE ENTRY.
*
* NAME    DTAB   IDENT,ADDR
*
*         ENTRY  NAME = IF SPECIFIED, LABEL */DTAB/NAME* IS DEFINED.
*                IDENT = DIRECTIVE IDENTIFIER.
*                ADDR = PROCESSOR/CONTROL TABLE ADDRESS.
*                       DEFAULT IS */DCTAB/NAME*.
*
*         EXIT   ONE WORD ENTRY GENERATED.
*                42/*IDENT*,18/ADDR
 
 
          PURGMAC  DTAB
 
          MACRO  DTAB,TAG,ID,AD
          LOCAL  A
 A        VFD    42/0L_ID
          SETVAL (  VFD 18/),AD,(/DCTAB/ID)
          IFC    NE,$TAG$$   IF DEFINE *NAME*
          QUAL   DTAB
 TAG      EQU    A
          QUAL   *
          ENDIF
          ENDM
 INDEX    SPACE  4,15
**        INDEX - GENERATE INDEXED TABLE ENTRY.
*
*         INDEX  IND,OP,ADD
*
*         ENTRY  IND = INDEX VALUE.
*                OP = OPERATION FIELD OF TABLE ENTRY.
*                ADD = ADDRESS FIELD OF TABLE ENTRY.
*                LABELS /INDEX/NAME AND /INDEX/LENGTH DEFINED BY THE
*                *INDTAB* MACRO.
*
*         EXIT   TABLE ENTRY GENERATED.
 
 
          PURGMAC  INDEX
 
 INDEX    MACRO  IN,OP,AD
          LOCAL  A
 A        SET    *O
          ORG    /INDEX/NAME+/INDEX/LENGTH*IN
          LOC    IN
          OP     AD
          ORG    A+/INDEX/LENGTH
          LOC    *O
          ENDM
 INDTAB   SPACE  4,10
**        INDTAB - DEFINE START OF INDEXED TABLE.
*
* NAME    INDTAB LENGTH
*
*         ENTRY  NAME = NAME OF INDEXED TABLE.
*                LENGTH = LENGTH OF INDEXED TABLE ENTRY.
*
*         EXIT   LABELS /INDEX/NAME AND /INDEX/LENGTH DEFINED FOR USE
*                BY THE *INDEX* MACRO.
 
 
          PURGMAC  INDTAB
 
          MACRO  INDTAB,TAG,LN
 TAG      BSS    0
          QUAL   INDEX
 NAME     SET    TAG
 LENGTH   SET    LN
          QUAL   *
          ENDM
 KEND     SPACE  4,10
**        KEND - END K-DISPLAY.
*
*         KEND
*
*         EXIT   QUALIFIED LABELS *NEXT*, *LENGTH*, AND *LINES*
*                DEFINED FOR K-DISPLAY TABLE.
 
 
          PURGMAC  KEND
 
 KEND     MACRO
 NEXT     EQU    *
 LENGTH   EQU    NEXT-START
 LINES    EQU    "KLINES"
          QUAL   *
          CON    0
          ENDM
 KLINE    SPACE  4,10
**        KLINE - GENERATE K-DISPLAY LINE.
*
*         KLINE  (STRING),E,CPL
*
*         ENTRY  STRING = CHARACTER STRING TO DISPLAY.
*                E = END-OF-LINE GENERATED IF SPECIFIED.
*                CPL = MAXIMUM NUMBER OF CHARACTERS PER LINE.
*                      DEFAULT IS 60.
*                MICROS *KLINEC* AND *KLINES* PREVIOUSLY DEFINED.
*
*         EXIT   DISPLAY LINE GENERATED.
*                MICROS *KLINEC* AND *KLINES* INCREMENTED.
 
 
          PURGMAC  KLINE
 
 KLINE    MACRO  ST,EL,CC
          LOCAL  A,B
 .1       IFC    EQ,$EL$$    IF NOT END OF LINE
          DATA   H$ST$
 .1       ELSE               IF END OF LINE
          DATA   C$ST$
 .2       IF     MIC,KLINES  IF *KLINES* PREVIOUSLY DEFINED
 KLINES   DECMIC "KLINES"+1
          ENDIF
 A        MICRO  1,,$ST$
 B        MICCNT A
          IF     -MIC,KLINEC IF *KLINEC* NOT PREVIOUSLY DEFINED
 KLINEC   DECMIC 0
          ENDIF
 KLINEC   DECMIC "KLINEC"+B
 .1       IFC    NE,$CC$$
          ERRNG  CC-"KLINEC" K-DISPLAY LINE TOO LONG
 .1       ELSE
 .2       IFC    NE,$EL$$
          ERRNG  60-"KLINEC" K-DISPLAY LINE TOO LONG
          ENDIF
          IFC    NE,$EL$$    IF END OF LINE
 KLINEC   DECMIC 0
          ENDIF
          ENDM
 KNEXT    SPACE  4,15
**        KNEXT - GENERATE POINTER TO REST OF K-DISPLAY.
*
*         KNEXT  NDISP,NOLAB
*
*         ENTRY  NDISP = ADDRESS OF REST OF K-DISPLAY.
*                NOLAB = IF SPECIFIED, LABELS *NEXT*, *LENGTH*, AND
*                        *LINES* ARE NOT DEFINED.
*
*         EXIT   ONE WORD GENERATED TO POINT TO REST OF K-DISPLAY.
*                12/7777B,30/,18/NDISP
*                LABEL *NEXT* DEFINED AT CURRENT LOCATION.
*                LABEL *LENGTH* DEFINED EQUAL TO *NEXT-START*.
*                LABEL *LINES* SET TO MICRO *KLINES*.
 
 
          PURGMAC  KNEXT
 
 KNEXT    MACRO  ND,NL
          LOCAL  A
 A        EQU    *
          VFD    12/7777B,30/,18//ND/START
          IFC    EQ,$NL$$    IF NOT *NOLAB*
 NEXT     EQU    A
 LENGTH   EQU    NEXT-START
 LINES    EQU    "KLINES"
          QUAL   *
          ENDIF
          ENDM
 KSTART   SPACE  4,15
**        KSTART - START K-DISPLAY BUFFER.
*
* NAME    KSTART CW
*
*         ENTRY  NAME = NAME ASSIGNED TO K-DISPLAY BUFFER.
*                CW = IF SPECIFIED, A CONTROL WORD SPECIFYING 64
*                     CHARACTERS PER LINE AND CODED FORMAT IS
*                     GENERATED.
*
*         EXIT   LABEL *NAME* DEFINED AT CURRENT LOCATION.
*                CONTROL WORD IS GENERATED.
*                10/0,1/0,1/1,47/0,1/0 IF *CW*.
*                42/,18//NAME/LENGTH IF NOT *CW*.
*                LABEL */NAME/START* DEFINED AFTER CONTROL WORD.
*                *NAME* SET AS QUALIFIER.
*                MICRO *KLINES* INITIALIZED.
 
 
          PURGMAC  KSTART
 
          MACRO  KSTART,TAG,CW
          IFC    EQ,$CW$$    IF NOT *CW*
 TAG      VFD    42/,18//TAG/LENGTH
          ELSE               IF *CW*
 TAG      VFD    10/0,1/0,1/1,47/0,1/0
          ENDIF
          QUAL   TAG
 START    BSS    0
 KLINES   DECMIC 0
          ENDM
 LISTER   SPACE  4,25
**        LISTER - GENERATE OUTPUT/SOURCE LISTING ENTRY.
*
* NAME    LISTER QUAL,CHAR,STRING,E,CPL
*
*         ENTRY  NAME = IF SPECIFIED, THREE LABELS ARE DEFINED -
*                       /"LQUAL"/NAME - ADDRESS OF LISTING ENTRY.
*                       /"LQUAL"U/NAME - UPPER BIT OF LISTING ENTRY.
*                       /"LQUAL"C/NAME - BIT COUNT OF LISTING ENTRY.
*                QUAL = IF SPECIFIED, MICRO *LQUAL* IS SET TO *QUAL*.
*                       MUST BE LESS THAN 8 CHARACTERS.
*                CHAR = NUMBER OF CHARACTERS IN LISTING ENTRY.
*                STRING = CHARACTERS OF LISTING ENTRY.
*                         DEFAULT IS BLANKS.
*                E = IF SPECIFIED, END OF LINE IS GENERATED.
*                CPL = MAXIMUM NUMBER OF CHARACTERS PER LINE.
*                      DEFAULT IS UNLIMITED.
*                MICRO *LISTERC* SET TO NUMBER OF CHARACTERS IN LINE.
*
*         EXIT   LISTING ENTRY GENERATED.
*                THREE LABELS DEFINED.
*                MICRO *LQUAL* REDEFINED.
*                MICRO *LISTERC* INCREMENTED.
 
 
          PURGMAC  LISTER
 
          MACRO  LISTER,TAG,LQ,CH,ST,EN,CC
          LOCAL  A,B,D,E,F,G,I,J
 A        EQU    *O
 B        EQU    *P-1
 D        DECMIC CH
 E        MICRO  1,,$ST$
 F        SET    CH-1
 F        SET    F/10
          DUP    F
 D        DECMIC "D"-10
 G        MICRO  1,10,$"E"$
 E        MICRO  11,,$"E"$
          VFD    60/10H"G"
          ENDD
 I        DECMIC "D"*6
          VFD    "I"/"D"H"E"
 .1       IFC    NE,$EN$$    IF END OF LINE
 J        DECMIC *P
          VFD    "J"/0
 .2       IFLT   "J",12      IF MORE ZEROS NEEDED
          VFD    60/0
          ENDIF
          IFC    NE,$LQ$$    IF QUALIFIER SPECIFIED
 LQUAL    MICRO  1,, LQ
 LISTERC  DECMIC CH
          ELSE               IF NO QUALIFIER
 LISTERC  DECMIC "LISTERC"+CH
          ENDIF
          IFC    NE,$TAG$$   IF *NAME* SPECIFIED
          QUAL   "LQUAL"
 TAG      EQU    A
          QUAL   *
          QUAL   "LQUAL"U
 TAG      EQU    B
          QUAL   *
          QUAL   "LQUAL"C
 TAG      EQU    CH
          QUAL   *
          ENDIF
          IFC    NE,$CC$$    IF MAXIMUM NUMBER OF CHARACTERS SPECIFIED
          ERRNG  CC-"LISTERC"  LIST LINE TOO LONG
          ENDIF
          IFC    NE,$EN$$    IF END OF LINE
 LISTERC  DECMIC 0
          ENDIF
          ENDM
 REWORD   SPACE  4,10
**        REWORD - RESET VALUE IN PREVIOUSLY DEFINED WORD.
*
*         REWORD ADDR,(VALUE)
*
*         ENTRY  ADDR = ADDRESS OF WORD TO BE RESET.
*                VALUE = NEW VALUE OF WORD IN *VFD* BIT FORMAT.
*
*         EXIT   (ADDR) = VALUE.
 
 
          PURGMAC  REWORD
 
 REWORD   MACRO  AD,VA
          LOCAL  A,B
 A        SET    *
 B        SET    *O
          ORG    AD
          VFD    VA
          ORG    B
          LOC    A
          ENDM
          TITLE  MACROS FOR EXECUTABLE CODE.
 ABTMSG   SPACE  4,15
**        ABTMSG - ABORT WITH ERROR MESSAGE
*
*         ABTMSG EADD,NA
*
*         ENTRY  EADD = ERROR MESSAGE ADDRESS.  (USES A6, X6.)
*                       IF NOT SPECIFIED, ADDRESS IS NOT CHANGED.
*
*                NA = IF SPECIFIED, NO JUMP TO *ABT*.
*
*         EXIT   *TFSP* ABORTED.  ERROR MESSAGE ISSUED TO DAYFILE.
*
*         USES   A - 6.
*                X - 6.
*
*         CALLS  ABT.
 
 
          PURGMAC  ABTMSG
 
 ABTMSG   MACRO  EA,NA
          MACREF ABTMSG
          IFC    NE,$EA$$    IF SET ERROR MESSAGE ADDRESS
          R=     X6,EA
          R=     A6,EM
          ENDIF
          IFC    EQ,$NA$$    IF ABORT *TFSP*
          EQ     //ABT       ABORT *TFSP*
          ENDIF
          ENDM
 CALLTFM  SPACE  4,15
**        CALLTFM - CALL *TFM*.
*
*         CALLTFM  FET,REQ
*
*         ENTRY  FET = FET ADDRESS.  (USES X2.)
*                REQ = FUNCTION CODE IF NO INTERLOCK.
*                    = (-1)*FUNCTION CODE IF INTERLOCK.  (USES X6.)
*
*         EXIT   (X2) = FET ADDRESS.
*                (X4) = ERROR CODE.
*                TO *ABT* IF UNRECOGNIZABLE ERROR CODE.
*
*         USES   X - 6.
*
*         CALLS  CTF.
 
 
          PURGMAC  CALLTFM
 
 CALLTFM  MACRO  FT,RQ
          MACREF CALLTFM
          R=     X6,RQ       SET FUNCTION CODE
          R=     X2,FT       SET FET ADDRESS
          RJ     //CTF       CALL *TFM*
          ENDM
 CHKFIL   SPACE  4,10
**        CHKFIL - CHECK IF FILE IS READY.
*
*         CHKFIL FET
*
*         ENTRY  FET = FET ADDRESS OF FILE.  (USES X2.)
*
*         EXIT   (X1) = 0 IF NO FILE NAME.
*                (X2) = FET ADDRESS.
*
*         CALLS  CFR.
 
 
          PURGMAC  CHKFIL
 
 CHKFIL   MACRO  FT
          MACREF CHKFIL
          R=     X2,FT
          RJ     //CFR       CHECK IF FILE IS READY
          ENDM
 CLEAR    SPACE  4,15
**        CLEAR - CLEAR BUFFER.
*
*         CLEAR  BUF,LEN
*
*         ENTRY  BUF = ADDRESS OF BUFFER.  (USES B6.)
*                LEN = LENGTH OF BUFFER.
*
*         EXIT   (B6) = BUFFER ADDRESS.
*                WORDS IN BUFFER SET TO ZERO.
*
*         USES   A - 6.
*                B - 7.
*                X - 6.
 
 
          PURGMAC  CLEAR
 
 CLEAR    MACRO  BF,LN
          LOCAL  A,B
          MACREF CLEAR
          R=     B6,BF
          R=     B7,LN
          R=     X6,0
 A        SB7    B7-B1
          NG     B7,B        IF END OF BUFFER
          SA6    B6+B7       CLEAR WORD IN BUFFER
          EQ     A           CHECK NEXT WORD
 B        BSS    0           EXIT
          ENDM
 CLINES   SPACE  4,15
**        CLINES - COUNT LINES IN BUFFER.
*
*         CLINES BUF,WC
*
*         ENTRY  BUF = BUFFER ADDRESS.  (USES A1, X1.)
*                WC = WORD COUNT OF BUFFER.  (USES B6.)
*
*         EXIT   (A1) = LWA+1 OF BUFFER.
*                (B6) = WORD COUNT OF BUFFER.
*                (B7) = LINE COUNT OF BUFFER.
*
*         USES   B - 2.
*                X - 1.
*
*         CALLS  CWL.
 
 
          PURGMAC  CLINES
 
 CLINES   MACRO  BF,WC
          MACREF CLINES
          R=     A1,BF
          R=     B6,WC
          R=     B2,0
          RJ     CWL         COUNT WORDS/LINES IN BUFFER
          ENDM
 CWORDS   SPACE  4,15
**        CWORDS - COUNT WORDS IN BUFFER.
*
*         CWORDS BUF,LC
*
*         ENTRY  BUF = BUFFER ADDRESS.  (USES A1, X1.)
*                LC = LINE COUNT OF BUFFER.  (USES B7.)
*
*         EXIT   (A1) = LWA+1 OF BUFFER.
*                (B6) = WORD COUNT OF BUFFER.
*                (B7) = LINE COUNT OF BUFFER.
*
*         USES   B - 2.
*                X - 1.
*
*         CALLS  CWL.
 
 
          PURGMAC  CWORDS
 
 CWORDS   MACRO  BF,LC
          MACREF CWORDS
          R=     A1,BF
          R=     B7,LC
          R=     B2,1
          RJ     CWL         COUNT WORDS/LINES IN BUFFER
          ENDM
 DELVSN   SPACE  4,15
**        DELVSN - DELETE VSN ENTRIES.
*
*         DELVSN VBUF,VLEN
*
*         ENTRY  VBUF = ADDRESS OF VSN BUFFER.  (USES B6.)
*                VLEN = LENGTH OF VSN BUFFER.  (USES B7.)
*
*         EXIT   (X4) = 0 IF DELETE COMPLETE.
*                     .NE. 0 IF A VSN IS ASSIGNED.
*
*         USES   B - 6, 7.
*
*         CALLS  DVS.
 
 
          PURGMAC  DELVSN
 
 DELVSN   MACRO  VB,VL
          MACREF DELVSN
          R=     B6,VB
          R=     B7,VL
          RJ     //DVS       DELETE VSN ENTRIES
          ENDM
 DISLIS   SPACE  4,25
**        DISLIS - DISPLAY LIST OF ENTRIES.
*
*         DISLIS LADD,DADD,LLEN,BCE,BCB,EPL
*
*         ENTRY  LADD = LIST ADDRESS.  (USES A1, X1.)
*                DADD = DISPLAY ADDRESS.  (USES A2, X2.)
*                LLEN = LIST LENGTH.
*                     .LT.0 IF ZERO WORD TERMINATED.
*                       DEFAULT IS -1.  (USES B3.)
*                BCE = BIT COUNT OF ENTRY.  MAXIMUM IS 120.
*                      DEFAULT IS 60.  (USES B4.)
*                BCB = BIT COUNT BETWEEN ENTRIES.  MAXIMUM IS 60.
*                      DEFAULT IS 6.  (USES B6.)
*                EPL = NUMBER OF ENTRIES PER DISPLAY LINE.
*                      DEFAULT IS 5.  (USES X7.)
*                (X6) = IMAGE TO SET BETWEEN ENTRIES, RIGHT JUSTIFIED.
*
*         EXIT   (A1) = LWA+1 OF LIST.
*                (A2) = LWA+1 OF DISPLAY.
*                (X3) = LAST BIT POSITION - 1 OF DISPLAY.
*
*         USES   B - 3, 4, 6.
*                X - 1, 2, 7.
*
*         CALLS  TLD.
 
 
          PURGMAC  DISLIS
 
 DISLIS   MACRO  LA,DA,LL,BE,BB,EP
          MACREF DISLIS
          R=     A1,LA
          R=     A2,DA
          SETREG B3,LL,(-1)
          SETREG B4,BE,60
          SETREG B6,BB,6
          SETREG X7,EP,5
          RJ     TLD         PROCESS TABLE LIST TO DISPLAY.
          ENDM
 GFILE    SPACE  4,25
**        GFILE - GET FILE CATALOG VIA FILE IDENTIFIER.
*
*         GFILE  UADD,FADD,FBUF,PBUF,VBUF,NV
*
*         ENTRY  UADD = ADDRESS OF USER NAME.  (USES A1, X1.)
*                FADD = ADDRESS OF FILE ID.  (USES A2, A3, X2, X3.)
*                FBUF = ADDRESS OF FILE CATALOG BUFFER.  (USES B6.)
*                PBUF = ADDRESS OF PREVIOUS FILE BUFFER.  (USES B7.)
*                VBUF = ADDRESS OF VSN BUFFER.  (USES B2.)
*                NV = 0 IF VERIFY FILE STATUS.
*                   .NE. 0 IF ASSUME FILE NOT FOUND.
*                       DEFAULT IS 0.  (USES B4.)
*
*         EXIT   (X4) = 0 IF FILE FOUND.
*                     .NE. 0 IF FILE NOT FOUND.  DEFAULT SET IN BUFFER.
*                (X6) = FILE CATALOG RANDOM ADDRESS.
*                (X7) = PREVIOUS FILE RANDOM ADDRESS.
*                (B6) = FILE COUNT.
*                (B7) = VSN COUNT.
*
*         USES   A - 1, 2, 3.
*                B - 2, 4.
*                X - 1, 2, 3.
*
*         CALLS  GFI.
 
 
          PURGMAC  GFILE
 
 GFILE    MACRO  UA,FA,FB,PB,VB,NV
          MACREF GFILE
          R=     A1,UA
          R=     A2,FA
          R=     A3,A2+B1
          R=     B6,FB
          R=     B7,PB
          R=     B2,VB
          SETREG B4,NV,0
          RJ     GFI         GET FILE CATALOG VIA FILE IDENTIFIER
          ENDM
 GFILEV   SPACE  4,30
**        GFILEV - GET FILE CATALOG VIA VSN.
*
*         GFILEV UADD,VADD,SQNO,FBUF,PBUF,VBUF,NV
*
*         ENTRY  UADD = ADDRESS OF USER NAME.
*                VADD = ADDRESS OF VSN.
*                SQNO = SEQUENCE NUMBER.  (USES X3.)
*                FBUF = ADDRESS OF FILE CATALOG BUFFER.  (USES B6.)
*                PBUF = ADDRESS OF PREVIOUS FILE BUFFER.  (USES B7.)
*                VBUF = ADDRESS OF VSN BUFFER.  (USES B2.)
*                NV = 0 IF VERIFY FILE STATUS.
*                   .NE. 0 IF ASSUME FILE NOT FOUND.
*                       DEFAULT IS 0.  (USES B4.)
*
*         EXIT   (X4) = 0 IF FILE FOUND.
*                     = 1 IF FILE NOT FOUND AND DEFAULT SET IN BUFFERS.
*                     = -1 IF INCORRECT SEQUENCE NUMBER.
*                     = -2 IF VSN NOT AVAILABLE.
*                (X6) = FILE CATALOG RANDOM ADDRESS.
*                (X7) = PREVIOUS FILE RANDOM ADDRESS.
*                (B6) = FILE COUNT.
*                (B7) = VSN COUNT.
*
*         USES   A - 1, 2.
*                B - 2, 4.
*                X - 1, 2, 3.
*
*         CALLS  GFV.
 
 
          PURGMAC  GFILEV
 
 GFILEV   MACRO  UA,VA,QN,FB,PB,VB,NV
          MACREF GFILEV
          R=     A1,UA
          R=     A2,VA
          R=     X3,QN
          R=     B6,FB
          R=     B7,PB
          R=     B2,VB
          SETREG B4,NV,0
          RJ     GFV         GET FILE CATALOG VIA VSN
          ENDM
 GRENTRY  SPACE  4,15
**        GRENTRY - GET RECORD ENTRY.
*
*         GRENTRY  FET,BUF
*
*         ENTRY  FET = ADDRESS OF FET TO USE.  (USES X2.)
*                BUF = ADDRESS OF WORKING BUFFER.  (USES X1.)
*
*         EXIT   (X6) = 0 IF NO MORE ENTRIES.
*                CURRENT ENTRY SET INTO BUFFER.
*
*         USES   X - 1, 2.
*
*         CALLS  GRE.
 
 
          PURGMAC  GRENTRY
 
 GRENTRY  MACRO  FT,BF
          MACREF GRENTRY
          R=     X2,FT
          R=     X1,BF
          RJ     //GRE       GET RECORD ENTRY
          ENDM
 ISSMSG   SPACE  4,15
**        ISSMSG - ISSUE MESSAGE TO OUTPUT.
*
*         ISSMSG MADD,TYPE
*
*         ENTRY  MADD = ADDRESS OF MESSAGE.  (USES B5.)
*                TYPE = *I* IF INFORMATIVE.
*                     = *E* IF ERROR.
*                       (USES B2.)
*
*         EXIT   MESSAGE ISSUED TO OUTPUT/K-DISPLAY.
*
*         USES   B - 2, 5.
*
*         CALLS  MTO.
 
 
          PURGMAC  ISSMSG
 
 ISSMSG   MACRO  MA,TY
          MACREF ISSMSG
          R=     B5,MA
          IFC    EQ,$TY$I$   IF INFORMATIVE
          R=     B2,0
          ELSE               IF ERROR
          R=     B2,1
          ENDIF
          RJ     //MTO       ISSUE MESSAGE TO OUTPUT
          ENDM
 LISTAB   SPACE  4,25
**        LISTAB - LIST ENTRIES FROM TABLE.
*
*         LISTAB TADD,LADD,TLEN,RADD,ELEN,BC
*
*         ENTRY  TADD = TABLE ADDRESS.  (USES X6.)
*                LADD = LIST ADDRESS.  (USES X7.)
*                TLEN = TABLE LENGTH.
*                     .LT. 0 IF ZERO WORD TERMINATED.
*                       DEFAULT IS -1.  (USES B2.)
*                RADD = RELATIVE ADDRESS IN ENTRY.
*                       DEFAULT IS 0.  (USES B3.)
*                ELEN = ENTRY LENGTH.  DEFAULT IS 1.  (USES B4.)
*                BC = BIT COUNT.  MAXIMUM IS 120.
*                     DEFAULT IS 60.  (USES B5.)
*
*         EXIT   (X1) = LWA+1 OF TABLE.
*
*         USES   B - 2, 3, 4, 5.
*                X - 6, 7.
*
*         CALLS  TSL.
 
 
          PURGMAC  LISTAB
 
 LISTAB   MACRO  TA,LA,TL,RA,EL,BC
          MACREF LISTAB
          R=     X6,TA
          R=     X7,LA
          SETREG B2,TL,(-1)
          SETREG B3,RA,0
          SETREG B4,EL,1
          SETREG B5,BC,60
          RJ     TSL         PROCESS TABLE ENTRY TO SINGLE ENTRY LIST
          ENDM
 LISTVSN  SPACE  4,20
**        LISTVSN - LIST VSN ENTRY.
*
*         LISTVSN  VADD,VBUF,ILOCK
*
*         ENTRY  VADD = ADDRESS OF VSN.  (USES A1, X1.)
*                VBUF = ADDRESS OF VSN BUFFER.  (USES A2, X2.)
*                ILOCK = 0 IF NO INTERLOCK SET ON VSN.
*                      = 1 IF SET INTERLOCK ON VSN.
*                        DEFAULT IS 0.  (USES B2.)
*
*         EXIT   (X4) = 0 IF VSN FOUND.
*                VSN ENTRY IMAGE SET IN BUFFER.
*                DEFAULT ENTRY IMAGE SET IN BUFFER IF VSN NOT FOUND.
*
*         USES   A - 1.
*                B - 2, 6.
*                X - 1.
*
*         CALLS  LVS.
 
 
          PURGMAC  LISTVSN
 
 LISTVSN  MACRO  VA,VB,IL
          MACREF LISTVSN
          R=     A1,VA
          R=     B6,VB
          SETREG B2,IL,0
          RJ     //LVS       LIST VSN ENTRY
          ENDM
 LJUST    SPACE  4,20
**        LJUST - LEFT JUSTIFY AND MASK FIELD IN X-REGISTER.
*
*         LJUST  XA,XB,BC,UB
*
*         ENTRY  XA = X-REGISTER WITH FIELD.
*                XB = X-REGISTER TO RECEIVE MASKED FIELD.
*                BC = BIT COUNT OF FIELD.
*                     MUST BE 1 .LE. *BC* .LE. 60.
*                UB = UPPER BIT POSITION OF FIELD.
*                     MUST BE 0 .LE. *UB* .LE. 59.
*
*         EXIT   (XA) = FIELD LEFT JUSTIFIED.
*                (XB) = FIELD LEFT JUSTIFIED AND MASKED.
*                (X0) = MASK OF LEFT JUSTIFIED FIELD.
*
*         USES   B - 2 IF *BC* AND/OR *UB* INCLUDE REGISTERS.
 
 
          PURGMAC  LJUST
 
 LJUST    MACRO  XA,XB,BC,UB
          LOCAL  A
          MACREF LJUST
          IF     REG,BC      IF BIT COUNT IN REGISTER
          MX0    1
          SB2    BC-1
          AX0    B2
          ELSE               IF CONSTANT BIT COUNT
          MX0    BC
          ENDIF
 .1       IF     REG,UB      IF UPPER BIT IN REGISTER
          SB2    UB-59
          L_XA   -B2
 .1       ELSE               IF CONSTANT UPPER BIT
 .2       IFNE   UB,59       IF NON-ZERO SHIFT COUNT
 A        SET    UB
          L_XA   59-A
          ENDIF
          B_XB   X0*XA
          ENDM
 MOVEBIT  SPACE  4,30
**        MOVEBIT - MOVE BIT STRING.
*
*         MOVEBIT  SADD,DADD,COUNT,SUPPER,DUPPER
*
*         ENTRY  SADD = SOURCE ADDRESS OF BIT STRING.  IF *SADD=A1*,
*                       X1 IS ASSUMED TO HOLD ((A1)).  (USES A1, X1.)
*                DADD = DESTINATION ADDRESS OF BIT STRING.  IF
*                       *DADD=A2*, X2 IS ASSUMED TO HOLD ((A2)).
*                       (USES A2, X2.)
*                COUNT = BIT COUNT.  DEFAULT IS 60.  (USES B4.)
*                SUPPER = UPPER BIT POSITION OF SOURCE STRING.
*                         DEFAULT IS 59.  (USES B3.)
*                DUPPER = UPPER BIT POSITION OF DESTINATION STRING.
*                         DEFAULT IS 59.  (USES B2.)
*
*         EXIT   STRING FROM *SADD* MOVED INTO *DADD*.
*                (A1) = ADDRESS OF REMAINDER OF SOURCE STRING.
*                (A2) = ADDRESS OF REMAINDER OF DESTINATION STRING.
*                (B2) = UPPER BIT POSITION OF REMAINDER OF DESTINATION
*                       STRING.
*                (B3) = UPPER BIT POSITION OF REMAINDER OF SOURCE
*                       STRING.
*
*         USES   A - 1, 2.
*                B - 2, 3, 4.
*                X - 1, 2.
*
*         CALLS  MBS.
 
          PURGMAC  MOVEBIT
 
 MOVEBIT  MACRO  SA,DA,C,SU,DU
          MACREF MOVEBIT
          R=     A1,SA
          R=     A2,DA
          SETREG B4,C,60
          SETREG B3,SU,59
          SETREG B2,DU,59
          RJ     //MBS       MOVE BIT STRING
          ENDM
 NEWPAGE  SPACE  4,20
**        NEWPAGE - GENERATE NEW PAGE HEADER FOR OUTPUT.
*
*         NEWPAGE  BUF,WC,NP
*
*         ENTRY  BUF = BUFFER ADDRESS OF NEW PAGE HEADER.
*                      DEFAULT IS (HD).
*                WC = WORD COUNT OF NEW HEADER.
*                     DEFAULT IS (HL).
*                NP = IF SPECIFIED HEADER WILL NOT BE PRINTED
*                     AT THIS TIME.
*
*         EXIT   NEW PAGE HEADER SET FOR OUTPUT FILE.
*
*         USES   A - 6.
*                X - 6.
*
*         CALLS  NPG.
 
 
          PURGMAC  NEWPAGE
 
 NEWPAGE  MACRO  BF,WC,NP
          MACREF NEWPAGE
          IFC    NE,$BF$$    IF NOT DEFAULT HEADER
          R=     X6,BF
          R=     A6,HD
          ENDIF
          IFC    NE,$WC$$    IF NOT DEFAULT WORD COUNT
          R=     X6,WC
          R=     A6,HL
          ENDIF
          IFC    EQ,$NP$$    IF PRINT NEXT PAGE
          RJ     //NPG       PRINT NEW PAGE HEADER
          ELSE               IF NO PRINT
          SX6    MXLP+1
          SA6    LC
          ENDIF
          ENDM
 RCREC    SPACE  4,20
**        RCREC - READ CATALOG RECORD.
*
*         RCREC  FET,REC,BUF,IL
*
*         ENTRY  FET = ADDRESS OF FET TO USE.  (USES X2.)
*                REC = RECORD RANDOM ADDRESS.  (USES X1.)
*                BUF = WORKING BUFFER TO RECEIVE RECORD.  (USES X3.)
*                IL .NE. 0 IF UTILITY INTERLOCK TO BE SET BEFORE READ.
*                    DEFAULT IS 0.  (USES B2.)
*
*         EXIT   RECORD READ INTO BUFFER.
*
*         USES   B - 2.
*                X - 1, 2, 3.
*
*         CALLS  RCR.
 
 
          PURGMAC  RCREC
 
 RCREC    MACRO  FT,RC,BF,IL
          MACREF RCREC
          R=     X2,FT
          R=     X1,RC
          SETREG X3,BF,0
          SETREG B2,IL,0
          RJ     //RCR       READ CATALOG RECORD
          ENDM
 READFET  SPACE  4,15
**        READFET - READ WORDS FROM FET INTO WORKING BUFFER.
*
*         READFET  FET,BUF,N
*
*         ENTRY  FET = FET ADDRESS.  (USES X2.)
*                BUF = WORKING BUFFER ADDRESS.  (USES B6.)
*                N = NUMBER OF WORDS TO TRANSFER.  (USES B7.)
*
*         EXIT   (X1) = 0 IF TRANSFER COMPLETE.
*                     = (B6) IF (B7).NE.0.
*                (X2) = FET ADDRESS.
*                (B6) = LWA+1 OF WORKING BUFFER.
*                (B7) = NUMBER OF WORDS NOT TRANSFERRED.
*
*         CALLS  RDF.
 
 
          PURGMAC  READFET
 
 READFET  MACRO  FT,BF,NW
          MACREF READFET
          R=     B6,BF
          R=     B7,NW
          R=     X2,FT
          RJ     //RDF       READ WORDS FROM FET INTO WORKING BUFFER
          ENDM
 RELVSN   SPACE  4,15
**        RELVSN - RELEASE FILE VIA VSN.
*
*         RELVSN UADD,VADD,QNADD
*
*         ENTRY  UADD = ADDRESS OF USER NAME.
*                VADD = ADDRESS OF VSN.
*                QNADD = SEQUENCE NUMBER.
*                QNADD = 1 IF NO SEQUENCE NUMBER SUPPLIED.
*
*         EXIT   (X4) = 0 IF RELEASE COMPLETE.
*                     .NE. 0 IF VSN NOT ASSIGNED TO USER.
*
*         USES   A - 1, 2.
*                X - 1, 2, 3.
*
*         CALLS  RLV.
 
 
          PURGMAC  RELVSN
 
 RELVSN   MACRO  UA,VA,QN
          MACREF RELVSN
          R=     A1,UA
          R=     A2,VA
          IFC    EQ,$QN$$,2
          R=     X3,1
          SKIP   1
          R=     X3,QN
          RJ     //RLV       RELEASE FILE VIA VSN
          ENDM
 REPVSN   SPACE  4,15
**        REPVSN - REPLACE/ADD VSNS.
*
*         REPVSN VBUF,VLEN
*
*         ENTRY  VBUF = VSN BUFFER ADDRESS.  (USES B6.)
*                VLEN = VSN BUFFER LENGTH.  (USES B7.)
*
*         EXIT   VSN ENTRIES REPLACED/ADDED.
*
*         USES   B - 6, 7.
*
*         CALLS  RVS.
 
 
          PURGMAC  REPVSN
 
 REPVSN   MACRO  VB,VL
          MACREF REPVSN
          R=     B6,VB
          R=     B7,VL
          RJ     //RVS       REPLACE/ADD VSNS
          ENDM
 RESETP   SPACE  4,15
**        RESETP - RESET *IN* AND *OUT* POINTERS OF FILE.
*
*         RESETP FET
*
*         ENTRY  FET = ADDRESS OF FET.  (USES X2.)
*
*         EXIT   *IN* AND *OUT* SET TO *FIRST*.
*                (X2) = ADDRESS OF FET.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         MACROS RECALL.
 
 
          PURGMAC  RESETP
 
 RESETP   MACRO  FT
          MACREF RESETP
          RECALL FT
          SA1    X2+B1
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          ENDM
 RJM      SPACE  4,15
**        RJM - RETURN JUMP TO ADDRESS IN REGISTERS.
*
*         RJM    ADDR
*
*         ENTRY  ADDR = ADDRESS TO RETURN JUMP TO.
*
*         EXIT   RETURN JUMP EXECUTED.
*
*         USES   A - 1, 6.
*                B - 2.
*                X - 1, 6.
 
 
          PURGMAC  RJM
 
 RJM      MACRO  AD
          LOCAL  A
          MACREF RJM
          IF     -REG,AD     IF NORMAL RETURN JUMP
          RJ     AD
          ELSE               IF RETURN JUMP TO REGISTER VALUE
          R=     B2,AD
          R=     A1,A
          BX6    X1
          R=     A6,B2
          JP     B2+1
 A        EQ     *+1
          ENDIF
          ENDM
 RJUST    SPACE  4,20
**        RJUST - RIGHT JUSTIFY AND MASK FIELD IN X-REGISTER.
*
*         RJUST  XA,XB,BC,UB
*
*         ENTRY  XA = X-REGISTER WITH FIELD.
*                XB = X-REGISTER TO RECEIVE MASKED FIELD.
*                BC = BIT COUNT OF FIELD.
*                     MUST BE 1 .LE. *BC* .LE. 60.
*                UB = UPPER BIT POSITION OF FIELD.
*                     MUST BE 0 .LE. *UB* .LE. 59.
*
*         EXIT   (XA) = FIELD RIGHT JUSTIFIED.
*                (XB) = FIELD RIGHT JUSTIFIED AND MASKED.
*                (X0) = (-1)*MASK OF RIGHT JUSTIFIED FIELD.
*
*         USES   B - 2 IF *BC* AND/OR *UB* INCLUDE REGISTERS.
 
 
          PURGMAC  RJUST
 
 RJUST    MACRO  XA,XB,BC,UB
          LOCAL  A
          MACREF RJUST
 .1       IF     REG,BC      IF BIT COUNT IN REGISTER
          MX0    1
          SB2    BC-1
          AX0    B2
          L_XA   B2
 .2       IF     REG,UB      IF UPPER BIT IN REGISTER
          SB2    UB-60
          L_XA   -B2
 .2       ELSE               IF CONSTANT UPPER BIT
 .3       IFNE   UB,60       IF NON-ZERO SHIFT COUNT
 A        SET    UB
          L_XA   -A+60
 .1       ELSE               IF CONSTANT BIT COUNT
 A        SET    BC
          MX0    -A
 .2       IF     REG,UB      IF UPPER BIT IN REGISTER
          SB2    UB-60-BC+1
          L_XA   -B2
 .2       ELSE               IF CONSTANT UPPER BIT
 .3       IFNE   BC-1,UB     IF NON-ZERO SHIFT COUNT
 A        SET    UB
          L_XA   BC-1-A+60
          ENDIF
          B_XB   -X0*XA
          ENDM
 SAFET    SPACE  4,25
**        SAFET - SET AUDIT FET.
*
*         SAFET  UADD,VADD,FADD,TYPE,RADD
*
*         ENTRY  UADD = ADDRESS OF USER NAME.  (USES A1, X1.)
*                VADD = ADDRESS OF VSN.  DEFAULT IS *=0*.
*                       (USES A2, X2.)
*                FADD = ADDRESS OF FILE IDENTIFIER.
*                       DEFAULT IS *=0*.  (USES A3, A4, X3, X4.)
*                TYPE = AUDIT TYPE.  DEFAULT IS *FCST*.  (USES B2.)
*                RADD = ADDRESS OF AUDIT RANDOM ADDRESS.
*                       DEFAULT IS *=0*.  (USES A4, X4, X6.)
*
*         EXIT   (X4) = 0 IF NO ERROR IN AUDIT.
*                (N3 - N3+15B) = AUDIT FET.
*
*         USES   A - 1, 2, 3, 4.
*                B - 2.
*                X - 1, 2, 3, 4, 6.
*
*         CALLS  SAF.
 
 
          PURGMAC  SAFET
 
 SAFET    MACRO  UA,VA,FA,TY,RA
          MACREF SAFET
          R=     A1,UA
          SETREG A2,VA,(=0)
          SETREG A4,RA,(=0)
          BX6    X4
          SETREG A3,FA,(=0)
          IFC    EQ,$FA$$    IF DEFAULT FILE IDENTIFIER
          R=     A4,=0
          ELSE               IF NOT DEFAULT FILE IDENTIFIER
          R=     A4,FA+1
          ENDIF
          SETREG B2,TY,FCST
          RJ     //SAF       SET AUDIT FET
          ENDM
 SETSORC  SPACE  4,20
**        SETSORC - SET SOURCE VALUES IN TABLE.
*
*         SETSORC   TYPE,LEVEL
*
*         ENTRY  TYPE = *A* IF AUDIT TABLE.
*                     = *K* IF K-DISPLAY TABLE.
*                     = *M* IF MACHINE READABLE TABLE.
*                     = *S* IF SOURCE LISTING TABLE.
*                       (USES B2.)
*                LEVEL = DIRECTIVE LEVEL.  (USES X1.)
*
*         EXIT   SOURCE VALUES SET IN TABLE.
*
*         USES   B - 2.
*                X - 1.
*
*         CALLS  SST.
 
 
          PURGMAC  SETSORC
 
 SETSORC  MACRO  TY,LV
          MACREF SETSORC
 .1       IFC    EQ,$TY$A$   IF AUDIT
          R=     B2,1
 .1       ELSE
 .2       IFC    EQ,$TY$K$   IF K-DISPLAY
          R=     B2,0
 .2       ELSE
 .3       IFC    EQ,$TY$M$   IF MACHINE READABLE
          R=     B2,3
 .3       ELSE               IF SOURCE LISTING
          R=     B2,2
          ENDIF
          R=     X1,LV
          RJ     //SST       SET SOURCE VALUES IN TABLE
          ENDM
 SRCHTAB  SPACE  4,35
**        SRCHTAB - SEARCH TABLE FOR ENTRY.
*
*         SRCHTAB  TADD,VADD,TLEN,ELEN,RADD.
*
*         ENTRY  TADD = ADDRESS OF TABLE.  IF *TADD=A1*, X1 IS ASSUMED
*                       TO HOLD THE FIRST WORD OF THE TABLE.
*                       USES A1, X1.
*                VADD = ADDRESS OF VALUE.  IF *VADD=A2*, X2 IS ASSUMED
*                       TO HOLD THE VALUE.  USES A2, X2.
*                TLEN = LENGTH OF TABLE.  IF .LT. 0, TABLE IS
*                       TERMINATED BY A ZERO WORD.  DEFAULT IS -1.
*                       USES B2.
*                ELEN = LENGTH OF TABLE ENTRY.  DEFAULT IS 1.  USES B3.
*                RADD = RELATIVE ADDRESS OF VALUE IN ENTRY.
*                       DEFAULT IS 0.  USES B4.
*                (X0) = SEARCH MASK.  BIT POSITIONS OF VALUE SHOULD BE
*                       SET.
*
*         EXIT   (A1) = ADDRESS OF ENTRY IF VALUE IS FOUND.
*                (A2) = *VADD*.
*                (A3) = ADDRESS OF VALUE WORD IF VALUE IS FOUND.
*                (B2) = *TLEN*.
*                (B3) = *ELEN*.
*                (B4) = *RADD*.
*                (B7) = RELATIVE ADDRESS OF VALUE WORD IN TABLE IF
*                       VALUE IS FOUND.
*                (X1) = FIRST WORD OF ENTRY IF VALUE IS FOUND.
*                (X2) = VALUE.
*                (X3) = VALUE WORD OF ENTRY IF VALUE IS FOUND.
*                (X4) = 0 IF VALUE IS FOUND.
*
*         CALLS  STB.
 
 
          PURGMAC  SRCHTAB
 
 SRCHTAB  MACRO  TA,VA,TL,EL,RA
          MACREF SRCHTAB
          R=     A1,TA
          R=     A2,VA
          SETREG B2,TL,(-1)
          SETREG B3,EL,1
          SETREG B4,RA,0
          RJ     //STB       SEARCH TABLE
          ENDM
 USERAUD  SPACE  4,25
**        USERAUD - PROCESS USER AUDIT LIST.
*
*         USERAUD  TYPE,CN,VSN
*
*         ENTRY  (UN) = USER NAME.
*                TYPE = *A* IF *AUDIT*.
*                     = *M* IF *MACHINE READABLE.*
*                     = *S* IF *SOURCE*.
*                     = *SNV* IF *SOURCE WITH NO VSNS.*
*                       (USES B2.)
*                CN = ADDRESS OF CHARGE NUMBER.
*                     DEFAULT IS IGNORE CHARGE NUMBER.  (USES A1, X1.)
*                VSN = ADDRESS OF VSN.
*                      DEFAULT IS IGNORE VSN.  (USES A2, X2.)
*
*         EXIT   ALL FILES MATCHING ENTRY CONDITIONS PROCESSED.
*
*         USES   A - 1, 2.
*                B - 2.
*                X - 1, 2.
*
*         CALLS  USA.
 
 
          PURGMAC  USERAUD
 
 USERAUD  MACRO  TY,CN,VS
          MACREF USERAUD
 .1       IFC    EQ,$TY$A$   IF AUDIT
          R=     B2,1
 .1       ELSE
 .2       IFC    EQ,$TY$M$   IF MACHINE READABLE
          R=     B2,3
 .2       ELSE
 .3       IFC    EQ,$TY$S$   IF SOURCE
          R=     B2,2
 .3       ELSE               IF SOURCE NO VSNS
          R=     B2,4
          ENDIF
          SETREG A1,CN,(=0)
          SETREG A2,VS,(=0)
          RJ     //USA       PROCESS USER AUDIT LIST
          ENDM
 WCREC    SPACE  4,20
**        WCREC - WRITE CATALOG RECORD.
*
*         WCREC  FET,REC,BUF,IL
*
*                ENTRY       ADDRESS OF FET TO USE.  (USES X2.)
*                REC = RECORD RANDOM ADDRESS.  (USES X1.)
*                BUF = WORKING BUFFER ADDRESS.  (USES X3.)
*                IL .NE. 0 IF CLEAR UTILITY INTERLOCK AFTER WRITE.
*                    DEFAULT IS 0.  (USES B2.)
*
*         EXIT   CATALOG RECORD REWRITTEN.
*
*         USES   B - 2.
*                X - 1, 2, 3.
*
*         CALLS  WCR.
 
 
          PURGMAC  WCREC
 
 WCREC    MACRO  FT,REC,BUF,IL
          MACREF WCREC
          R=     X2,FT
          R=     X1,REC
          R=     X3,BUF
          SETREG B2,IL,0
          RJ     //WCR       WRITE CATALOG RECORD
          ENDM
 WLINES   SPACE  4,15
**        WLINES - WRITE LINES TO OUTPUT FILE.
*
*         WLINES BUF,LC
*
*         ENTRY  BUF = BUFFER ADDRESS.  (USES A1, X1.)
*                LC = LINE COUNT OF BUFFER.  (USES B7.)
*
*         EXIT   LINES WRITTEN TO OUTPUT FILE.
*
*         USES   A - 1.
*                B - 2, 7.
*                X - 1.
*
*         CALLS  WTL.
 
 
          PURGMAC  WLINES
 
 WLINES   MACRO  BF,LC
          R=     A1,BF
          R=     B2,1
          R=     B7,LC
          RJ     //WTL       WRITE LINES TO OUTPUT
          ENDM
 WRITFET  SPACE  4,15
**        WRITFET - WRITE WORDS FROM WORKING BUFFER INTO FET.
*
*         WRITFET  FET,BUF,N
*
*         ENTRY  FET = FET ADDRESS.  (USES X2.)
*                BUF = WORKING BUFFER ADDRESS.  (USES B6.)
*                N = NUMBER OF WORDS TO TRANSFER.  (USES B7.)
*
*         EXIT   (X1) = 0 IF TRANSFER COMPLETE.
*                     = (B6) IF (B7).NE.0.
*                (X2) = FET ADDRESS.
*                (B6) = LWA+1 OF WORKING BUFFER.
*                (B7) = NUMBER OF WORDS NOT TRANSFERRED.
*
*         CALLS  WTF.
 
 
          PURGMAC  WRITFET
 
 WRITFET  MACRO  FT,BF,NW
          MACREF WRITFET
          R=     B6,BF
          R=     B7,NW
          R=     X2,FT
          RJ     //WTF       WRITE WORDS FROM WORKING BUFFER INTO FET
          ENDM
 WWORDS   SPACE  4,15
**        WWORDS - WRITE WORDS TO OUTPUT FILE.
*
*         WWORDS BUF,WC
*
*         ENTRY  BUF = BUFFER ADDRESS.  (USES A1, X1.)
*                WC = WORD COUNT OF BUFFER.  (USES B6.)
*
*         EXIT   WORDS WRITTEN TO OUTPUT FILE.
*
*         USES   A - 1.
*         B - 2, 6.
*         X - 1.
*
*         CALLS  WTL.
 
 
          PURGMAC  WWORDS
 
 WWORDS   MACRO  BF,WC
          R=     A1,BF
          R=     B2,0
          R=     B6,WC
          RJ     //WTL       WRITE LINES TO OUTPUT FILE
          ENDM
          TITLE  PROGRAM EQUIVALENCES.
 QUAL     SPACE  4,10
**        QUALIFIERS USED BY *TFSP*.
 
 
          QUAL
          QUAL   ADD
          QUAL   ALS
          QUAL   ALSC
          QUAL   ALSU
          QUAL   BTC
          QUAL   CAT
          QUAL   CATBIT
          QUAL   DCTAB
          QUAL   DOTAB
          QUAL   DTAB
          QUAL   INDEX
          QUAL   KAUSLS
          QUAL   KAUSRS
          QUAL   KDIS
          QUAL   KFAMLS
          QUAL   KFAMRS
          QUAL   KFILLS1
          QUAL   KFILLS2
          QUAL   KFILLS3
          QUAL   KFILRS
          QUAL   KLEFT
          QUAL   KMESS
          QUAL   KRIGHT
          QUAL   KUSELS
          QUAL   KUSERS
          QUAL   KVSNLS
          QUAL   KVSNRS
          QUAL   LVAU
          QUAL   LVFA
          QUAL   LVFI
          QUAL   LVUS
          QUAL   LVVS
          QUAL   MLS
          QUAL   MLSC
          QUAL   MLSU
          QUAL   PAUA
          QUAL   PAUAC
          QUAL   PAUAU
          QUAL   PDIR
          QUAL   PDIRC
          QUAL   PDIRU
          QUAL   PDIS
          QUAL   PDISC
          QUAL   PDISU
          QUAL   PFIA
          QUAL   PFIAC
          QUAL   PFIAU
          QUAL   PHEL
          QUAL   PHELC
          QUAL   PHELU
          QUAL   PRESET
          QUAL   PVSA
          QUAL   PVSAC
          QUAL   PVSAU
          QUAL   SCS
          QUAL   SCSC
          QUAL   SCSU
          QUAL   SMA
          QUAL   SMAC
          QUAL   SMAU
          QUAL   SMB
          QUAL   SMBC
          QUAL   SMBU
          QUAL   SMC
          QUAL   SMCC
          QUAL   SMCU
          QUAL   SMD
          QUAL   SMDD
          QUAL   SMDU
          QUAL   SMF
          QUAL   SMFC
          QUAL   SMFU
          QUAL   UPB
          QUAL
 MICRO    SPACE  4,10
**        SPECIAL CHARACTER BIT STRING MICROS.
 
 
 AC       BITMIC (+,-,*,/,L,R,$,=, ,(,),.,#,[,])
 AC       BITMIC (%,",U,!,&,',?,<,>,@,\,^,;,:)  ALL CHARACTERS
 AH       BITMIC (*,-)       ASTERISK AND HYPHEN
 AS       BITMIC (*)         ASTERISK
 BL       BITMIC ( )         BLANK CHARACTER
 CO       BITMIC ((,))       COMMA
 EC       BITMIC (+,-,*,/,L,R,$,=, ,(,),.,#,[,])
 EC       BITMIC (%,",U,!,&,',?,<,>,@,\,^,;)  ALL EXCEPT COLON
 NC       BITMIC ()          NO CHARACTERS
 MICRO    SPACE  4,10
**        GENERAL MICROS.
 
 
 MXAA     DECMIC 777777B     MAXIMUM ALTERNATE USER ACCESS COUNT
 MXAC     DECMIC 77777777B   MAXIMUM ACCESS COUNT
 MXFC     DECMIC 12000B      MAXIMUM MAXIMUM BLOCK COUNT
          SPACE  4,10
**        GENERAL EQUATES.
 
 
 CAPL     EQU    72          CHARACTERS ASSEMBLED PER LINE OF INPUT
 CSPL     EQU    80          CHARACTERS SCANNED PER LINE OF INPUT
 MXLP     EQU    60          MAXIMUM NUMBER OF LINES PER OUTPUT PAGE
 USBBL    EQU    CSPL+10     STRING BUFFER LENGTH
 BUFL     SPACE  4,10
**        BUFFER LENGTHS.
 
 
 CBUFL    EQU    5           CHARACTER BUFFER LENGTH
 EBUFL    EQU    4           ERROR MESSAGE BUFFER LENGTH
 FBUFL    EQU    1001B       FILE BUFFER LENGTH
 KBUFL    EQU    8           K-DISPLAY INPUT BUFFER LENGTH
 RBUFL    EQU    1B          REWIND FILE BUFFER LENGTH
 SBUFL    EQU    101B        SCRATCH FILE BUFFER LENGTH
 TBUFL    EQU    1001B       TAPE CATALOG FILE BUFFER LENGTH
 N1BUFL   EQU    401B        VSN BUFFER LENGTH
 N2BUFL   EQU    101B        USER NAME BUFFER LENGTH
 N3BUFL   EQU    501B        TAPE FILE BUFFER LENGTH
 N4BUFL   EQU    101B        ALTERNATE USER NAME BUFFER LENGTH
 TAVSL    EQU    TSVL*60+1   ASSIGNED VSNS BUFFER LENGTH
 UBUFL    EQU    101B        ALTERNATE USER BUFFER LENGTH
 VBUFL    EQU    101B        VSN ENTRY BUFFER LENGTH
 WBUFL    EQU    TCEL+TSVL*60+1  WORKING BUFFER
          SPACE  4,10
**        LEVEL DEFINITIONS.
 
 
 LVFA     EQU    0           FAMILY LEVEL
 LVVS     EQU    1           VSN LEVEL
 LVUS     EQU    2           USER LEVEL
 LVFI     EQU    3           FILE LEVEL
 LVAU     EQU    4           ALTERNATE USER LEVEL
 OP       SPACE  4,10
**        *OP* PARAMETER OPTIONS.
 
 
 KOPT     EQU    0           *K* K-DISPLAY OPTION
 IOPT     EQU    1           *I* INPUT FILE OPTION
 ZOPT     EQU    2           *Z* CONTROL CARD OPTION
          SPACE  4,10
**        PROCESSOR INDICES.
 
 
 PIZF     EQU    0           ZERO FILL
 PIBF     EQU    1           BLANK FILL
 PIOP     EQU    2           OPTION SELECTION
 PIBD     EQU    3           NUMERIC BINARY DATA
 PIPD     EQU    4           PACKED DATE
 PIPT     EQU    5           PACKED TIME
 PIJD     EQU    6           JULIAN DATE
 PIVQ     EQU    7           VSN/SEQUENCE NUMBER
 PIVS     EQU    8           PADDED VSN
 PIBS     EQU    9           SPECIAL CHARACTER BIT STRING
 ORG      SPACE  4,10
**        PROGRAM ORIGIN.
 
 
 ORIG     EQU    110B
          ORG    ORIG
          TITLE  DATA AREA.
 FETS     SPACE  4,10
**        FILE ENVIRONMENT TABLES.
 
 
 I        BSS    0           INPUT FILE
 INPUT    FILEC  IBUF,FBUFL,(FET=16)
 
 L        BSS    0           OUTPUT FILE
 OUTPUT   FILEC  LBUF,FBUFL,(FET=16),EPR
 
 N1       BSS    0           VSN TAPE CATALOG FILE
 NEW1     FILEB  N1BUF,N1BUFL,(FET=8),EPR
          REWORD N1+5,(42/,18/EBUF)  ERROR MESSAGE ADDRESS
 
 N2       BSS    0           USER NAME TAPE CATALOG FILE
 NEW2     FILEB  N2BUF,N2BUFL,(FET=8),EPR
          REWORD N2+5,(42/,18/EBUF)  ERROR MESSAGE ADDRESS
 
 N3       BSS    0           TAPE FILE TAPE CATALOG FILE
 NEW3     FILEB  N3BUF,N3BUFL,(FET=16),EPR
          REWORD N3+5,(42/,18/EBUF)  ERROR MESSAGE ADDRESS
 
 N4       BSS    0           ALTERNATE USER NAME TAPE CATALOG FILE
 NEW4     FILEB  N4BUF,N4BUFL,(FET=8),EPR
          REWORD N4+5,(42/,18/EBUF)  ERROR MESSAGE ADDRESS
 
 R        BSS    0           REWIND FILE
 R        FILEB  RBUF,RBUFL,(FET=8)
 
 RD       BSS    0           *READ* FILE
 RD       FILEC  SBUF,SBUFL,(FET=8)
 
 S        BSS    0           SOURCE FILE
 SOURCE   FILEC  SSBUF,FBUFL,(FET=16),EPR
 
 SS       BSS    0           MACHINE READABLE OUTPUT FILE
 SS       FILEC  SSBUF,FBUFL,(FET=16),EPR
 
 T        BSS    0           TERMINAL INTERRUPT FILE
 ZZZZINT  FILEC  TBUF,SBUFL,(FET=8),(DTY=2RTT)
 
 UB       BSS    0           ALTERNATE USER ENTRY BUFFER
 UB       FILEB  UBUF,UBUFL,(FET=8)
 
 VB       BSS    0           VSN ENTRY BUFFER FET
 VB       FILEB  VBUF,VBUFL,(FET=8)
 WORKING  SPACE  4,10
**        WORKING STORAGE.
 
 
 AA       CON    0           AUDIT RANDOM ADDRESS
 AB       CON    0           ABORT OPTION
 AF       CON    0           ADMIT FLAG
 AI       CON    0           ALTERNATE INPUT FILE NAME
 AP       CON    0           ALTERNATE PROCESSING FLAG
 AU       CON    0           ALTERNATE USER
 BF       CON    0           BRIEF/NOBRIEF FLAG
 CF       CON    0           CURRENT FAMILY NAME
 CI       CON    0           CLEAR INTERLOCK FLAG
 CL       CON    "NC"        SPECIAL CHARACTER FOR COLON
 DD       CON    0           DISPLAY DATE
 DE       CON    0           DENSITY / TAPE TYPE
 DF       CON    0           DIRECTIVE IMAGE
          CON    0           PROCESSOR/CONTROL TABLE ADDRESS
          CON    0           DIRECTIVE SEPARATOR
 DM       CON    0           DIRECTIVE MESSAGE FLAG
 DP       CON    0           DROP PROCESSOR COUNT
 DT       CON    0           DISPLAY TIME
 ED       CON    0           EQUIVALENCED DIRECTIVE FLAG
 EF       CON    0           ERROR FLAG
 EL       CON    0           END OF LINE FLAG
 EM       CON    0           DAYFILE ERROR MESSAGE ADDRESS
 ER       CON    0           ERROR ADDRESS
 ET       CON    0           EOF FOR INPUT FLAG
 FA       CON    0           FAST-ATTACH FLAG FOR *TFSPE*
 FM       CON    0           ALTERNATE FAMILY NAME
 HD       CON    PDIR        SECOND PART OF HEADER LENGTH
 HL       CON    PDIRL       PAGE HEADER LENGTH
 IF       CON    I           INPUT FILE FET ADDRESS
 IS       CON    0           INPUT FILE STATUS
 JD       CON    0           JULIAN DATE
 LC       CON    MXLP+1      LINE COUNT OF OUTPUT PAGE
 LF       CON    0           LOCAL FILE OPTION
 LV       CON    LVFA        CURRENT LEVEL
 ME       CON    0           MAINTENANCE AND ERROR STATUS
 MI       CON    2RAA        MACHINE ID
 MX       CON    0           CATALOG DEVICE MACHINE INDEX-1
 NI       BSS    2           NEW FILE IDENTIFIER
 NL       CON    0           NEXT LEVEL NUMBER
 NV       CON    0           NO VERIFY FLAG
 OP       DATA   C*I*        INPUT OPTION
 OS       CON    0           OUTPUT FILE STATUS
 OT       CON    0           ORIGIN TYPE
 PD       CON    0           PACKED DATE
 PG       CON    0           CURRENT PAGE NUMBER
 QN       CON    0           SEQUENCE NUMBER
 RC       CON    0           REEL COUNT
 RF       CON    0           RESERVE FLAG
 RS       CON    0           URDATE SPECIFIED FLAG
 RT       CON    0           RETRY FLAG
 SB       CON    0           ADDRESS OF STRING BUFFER
 SE       CON    "CO"        SEPARATOR CHARACTER
 SF       CON    0           SAVE SPECIAL STORAGE FLAG
 SM       CON    0           STRING BUFFER MAXIMUM ADDRESS
 SP       CON    0           STRING BUFFER POINTER
 ST       CON    0           VSN STATUS BITS
 SV       CON    0           SYMBOLIC ACCESS FLAG
 SVF      CON    0           SYSTEM VSN FLAG
 TE       CON    0           *TFSPE* FLAG
 TG       CON    0           TOGGLE PAGE
 TI       CON    0           TERMINAL INTERRUPT FLAG
 VTT      CON    0           VSN TAPE TYPE
 WKSP     SPACE  4,10
**        SPECIAL WORKING STORAGE.
 
 
 WKSP     BSS    0           FIRST WORD OF SPECIAL STORAGE
 AV       CON    0           NEW ASSIGNED VSN BUFFER ADDRESS
 CA       CON    0           CATALOG RANDOM ADDRESS
 CN       CON    0           CHARGE NUMBER
 EV       CON    0           EXTERNAL VSN
 FI       BSS    2           FILE IDENTIFIER
 FV       CON    0           FIRST VSN
 PA       CON    0           PREVIOUS FILE CATALOG RANDOM ADDRESS
 UF       CON    0           USER NAME FOUND FLAG
 UN       CON    0           USER NAME
 VC       CON    0           VSN COUNT
 VF       CON    0           VSN IN CATALOG FLAG
 VI       CON    0           SCRATCH VSN INTERLOCK FLAG
 VS       CON    0           VOLUME SERIAL NUMBER
 WKSPL    EQU    *-WKSP      SPECIAL WORKING STORAGE LENGTH
 SSJ=     SPACE  4,10
**        SSJ= BLOCK.
 
 
 SSJ=     VFD    12/0,24/-0,12/LSCS,12/IRSI
          BSSZ   SSJL-1
 FCAT     SPACE  4,10
**        FCAT - FILE  CATALOG IMAGE.
 
 
 CIGS     BSS    0           FIRST WORD OF CATALOG IMAGES
 FCAT     CATBASE
 FI       CATBIT CELI,59,FIKL*6,10H,7H  LOGICAL FILE IDENTIFIER
          CATBIT CEST,17,6
 AC       CATBIT CEST,11,1,0 ALTERNATE AUDIT MODE
 RECOVER  CATBIT CEST,10,1,0 RECOVERED STATUS
          CATBIT CEST,9,7
 SV       CATBIT CEST,2,1,0  SYMBOLIC ACCESS FLAG
 CE       CATBIT CEST,1,1,0  ERROR FLAG
 FBIL     CATBIT CEST,0,1,0  FILE BUSY INTERLOCK
 EVSN     CATBIT CEES,59,36  EXTERNAL VSN
          CATBIT CEES,23,12
 REELC    CATBIT CEES,11,12,0  REEL COUNT
          CATBIT CETD,59,1
 LB       CATBIT CETD,58,2,2 LABEL
 TTYP     CATBIT CETD,56,2,2 TAPE DEVICE TYPE
          POS    *P+2
 D        CATBIT CETD,56,6,44B  TAPE DEVICE TYPE / DENSITY
 CV       CATBIT CETD,50,3,2 CONVERSION MODE
          CATBIT CETD,47,12
 F        CATBIT CETD,35,6,0 FORMAT
 NS       CATBIT CETD,29,6,0 NOISE SIZE
 FC       CATBIT CETD,23,24,"MXFC"  MAXIMUM BLOCK SIZE
 IVSN     CATBIT CEVS,59,36  INTERNAL VSN
 FA       CATBIT CEVS,23,6,0 ACCESSIBILITY CHARACTER
          CATBIT CEVS,17,3
 SN       CATBIT CEVS,14,15,0001  SECTION NUMBER
 PI       CATBIT CEPI,59,FIKL*6,10H,7H  PHYSICAL FILE IDENTIFIER
          CATBIT CESQ,17,3
 QN       CATBIT CESQ,14,15,0001  SEQUENCE NUMBER
 SI       CATBIT CESI,59,VSKL*6  SET IDENTIFIER
 E        CATBIT CESI,23,9,00  GENERATION VERSION NUMBER
 G        CATBIT CESI,14,15,0001  GENERATION NUMBER
 CR       CATBIT CERC,59,30  CREATION DATE (YYDDD)
 RT       CATBIT CERC,29,30  RETENTION DATE (YYDDD)
 PW       CATBIT CEPW,59,PWKL*6,0  PASSWORD
          CATBIT CEPW,17,6
 CT       CATBIT CEPW,11,6,FCPR  FILE CATEGORY
 M        CATBIT CEPW,5,6,FMRE  FILE MODE
 NCAT     CATBIT CECD,59,24  NEXT CATALOG RANDOM ADDRESS
 CDATE    CATBIT CECD,35,18  CREATION DATE (PACKED)
 CTIME    CATBIT CECD,17,18  CREATION TIME (PACKED)
 AUCAT    CATBIT CEMD,59,24  ADMIT CATALOG RANDOM ADDRESS
 MDATE    CATBIT CEMD,35,18  MODIFICATION DATE (PACKED)
 MTIME    CATBIT CEMD,17,18  MODIFICATION TIME (PACKED)
 ACOUNT   CATBIT CEAD,59,24,0  ACCESS COUNT
 ADATE    CATBIT CEAD,35,18  ACCESS DATE (PACKED)
 ATIME    CATBIT CEAD,17,18  ACCESS TIME (PACKED)
 UC       CATBIT CEUC,59,UCKL*6,0  USER CONTROL WORD
 CN       CATBIT CECN,59,60  CHARGE NUMBER
 PN       CATBIT CEPN,59,PNKL*6  PROJECT NUMBER
          CATBIT CEPN+2,59,60
          CATBIT CEPN+3,59,60
          CATBIT CEPN+4,59,60
          CATEND TCEL        END OF TAPE FILE CATALOG
 ACAT     SPACE  4,10
**        ACAT - ALTERNATE  USER  CATALOG IMAGE.
 
 
 ACAT     CATBASE
 AUSER    CATBIT AEUN,59,UNKL*6  ALTERNATE USER NAME
          CATBIT AEUN,17,18
 AACOUNT  CATBIT AEAC,59,18,0000  ACCESS COUNT
 AMODE    CATBIT AEAC,41,6,0 ADMIT MODE
 AADATE   CATBIT AEAC,35,18  ACCESS DATE
 AATIME   CATBIT AEAC,17,18  ACCESS TIME
          CATEND TAEL        END OF ALTERNATE USER CATALOG
 VCAT     SPACE  4,10
**        VCAT - VSN CATALOG IMAGE.
 
 
 VCAT     CATBASE
 VSN      CATBIT VEES,59,VSKL*6 VSN
 VASC     CATBIT VEES,23,6,0 ASSIGNED VSN CATALOG NUMBER
 VASF     CATBIT VEES,17,18,0   ASSIGNED FILE POINTER
 PRN      CATBIT VEVS,59,VSKL*6 INTERNAL VSN (PRN)
 REELNO   CATBIT VEVS,23,6,0 REEL NUMBER
          CATBIT VEVS,17,1
 MAINT    CATBIT VEVS,16,1,0 MAINTENANCE FLAG
          CATBIT VEVS,15,1,1 AVAILABLE SCRATCH STATUS
          CATBIT VEVS,14,2
 OWNER    CATBIT VEVS,12,1,0 OWNERSHIP TYPE
          CATBIT VEVS,11,4
 SYSTEM   CATBIT VEVS,7,1,0  SYSTEM VSN FLAG
 VT       CATBIT VEVS,6,2,0  VSN ENTRY TAPE TYPE (0=MT/NT,1=CT,3=AT)
 NEWRDT   CATBIT VEVS,4,1,0  NEW RELEASE DATE FORMAT
 SITE     CATBIT VEVS,3,1,0  SITE STATUS
          CATBIT VEVS,2,1
 ERRFLAG  CATBIT VEVS,1,1,0  ERROR FLAG
 VSBF     CATBIT VEVS,0,1,0  VSN BUSY FLAG
 FVSN     CATBIT VEFV,59,36  FIRST VSN
          CATBIT VEFV,23,24
 NVSN     CATBIT VENV,59,36  NEXT VSN
 USAGE    CATBIT VENV,23,6,0 USAGE COUNT
 URDATE   CATBIT VENV,17,18  RELEASE DATE
          CATEND TSVL        END OF VSN ENTRY CATALOG
 DFIC     SPACE  4,10
**        DFIC - DEFAULT FILE CATALOG.
 
 
 DFIC     CATBASE
          CATBIT CELI,59,FIKL*6,10H,7H  LOGICAL FILE IDENTIFIER
          CATBIT CEST,17,6
          CATBIT CEST,11,1,0 ALTERNATE AUDIT MODE
          CATBIT CEST,10,1,0 RECOVERED STATUS
          CATBIT CEST,9,7
          CATBIT CEST,2,1,0  SYMBOLIC ACCESS FLAG
          CATBIT CEST,1,1,0  ERROR FLAG
          CATBIT CEST,0,1,0  FILE BUSY INTERLOCK
          CATBIT CEES,59,36  EXTERNAL VSN
          CATBIT CEES,23,12
          CATBIT CEES,11,12,0  REEL COUNT
          CATBIT CETD,59,1
          CATBIT CETD,58,2,2 LABEL
          CATBIT CETD,56,6,44B  TAPE DEVICE TYPE / DENSITY
          CATBIT CETD,50,3,2 CONVERSION MODE
          CATBIT CETD,47,12
          CATBIT CETD,35,6,0 FORMAT
          CATBIT CETD,29,6,0 NOISE SIZE
          CATBIT CETD,23,24,"MXFC"  MAXIMUM BLOCK SIZE
          CATBIT CEVS,59,36  INTERNAL VSN
          CATBIT CEVS,23,6,0 ACCESSIBILITY CHARACTER
          CATBIT CEVS,17,3
          CATBIT CEVS,14,15,0001  SECTION NUMBER
          CATBIT CEPI,59,FIKL*6  PHYSICAL FILE IDENTIFIER
          CATBIT CESQ,17,3
          CATBIT CESQ,14,15,0001  SEQUENCE NUMBER
          CATBIT CESI,59,VSKL*6  SET IDENTIFIER
          CATBIT CESI,23,9,00  GENERATION VERSION NUMBER
          CATBIT CESI,14,15,0001  GENERATION NUMBER
          CATBIT CERC,59,30  CREATION DATE (YYDDD)
          CATBIT CERC,29,30  RETENTION DATE (YYDDD)
          CATBIT CEPW,59,PWKL*6,0  PASSWORD
          CATBIT CEPW,17,6
          CATBIT CEPW,11,6,FCPR  FILE CATEGORY
          CATBIT CEPW,5,6,FMRE  FILE MODE
          CATBIT CECD,59,24  NEXT CATALOG RANDOM ADDRESS
          CATBIT CECD,35,18  CREATION DATE (PACKED)
          CATBIT CECD,17,18  CREATION TIME (PACKED)
          CATBIT CEMD,59,24  ADMIT CATALOG RANDOM ADDRESS
          CATBIT CEMD,35,18  MODIFICATION DATE (PACKED)
          CATBIT CEMD,17,18  MODIFICATION TIME (PACKED)
          CATBIT CEAD,59,24,0  ACCESS COUNT
          CATBIT CEAD,35,18  ACCESS DATE (PACKED)
          CATBIT CEAD,17,18  ACCESS TIME (PACKED)
          CATBIT CEUC,59,UCKL*6,0  USER CONTROL WORD
          CATBIT CECN,59,60  CHARGE NUMBER
          CATBIT CEPN,59,PNKL*6  PROJECT NUMBER
          CATBIT CEPN+2,59,60
          CATBIT CEPN+3,59,60
          CATBIT CEPN+4,59,60
          CATEND TCEL        END OF DEFAULT FILE CATALOG
 DAUC     SPACE  4,10
**        DAUC - DEFAULT ALTERNATE USER CATALOG.
 
 
 DAUC     CATBASE
          CATBIT AEUN,59,UNKL*6  ALTERNATE USER NAME
          CATBIT AEUN,17,18
          CATBIT AEAC,59,18,0000  ACCESS COUNT
          CATBIT AEAC,41,1,0 ADMIT TYPE
          CATBIT AEAC,40,5,0 ADMIT MODE
          CATBIT AEAC,35,18  ACCESS DATE
          CATBIT AEAC,17,18  ACCESS TIME
          CATEND TAEL        END OF DEFAULT ALTERNATE USER CATALOG
 DVSC     SPACE  4,10
**        DVSC - DEFAULT VSN CATALOG.
 
 
 DVSC     CATBASE
          CATBIT VEES,59,VSKL*6 VSN
          CATBIT VEES,23,6,0 ASSIGNED FILE CATALOG NUMBER
          CATBIT VEES,17,18,0   ASSIGNED FILE POINTER
          CATBIT VEVS,59,VSKL*6 INTERNAL VSN (PRN)
          CATBIT VEVS,23,6,0 REEL NUMBER
          CATBIT VEVS,17,1
          CATBIT VEVS,16,1,0 MAINTENANCE FLAG
          CATBIT VEVS,15,1,1 AVAILABLE SCRATCH STATUS
          CATBIT VEVS,14,2
          CATBIT VEVS,12,1,0 OWNERSHIP TYPE
          CATBIT VEVS,11,4
          CATBIT VEVS,7,1,0  SYSTEM VSN FLAG
          CATBIT VEVS,6,2,0  VSN ENTRY TAPE DEVICE TYPE
          CATBIT VEVS,4,1,0  NEW RELEASE DATE FORMAT
          CATBIT VEVS,3,1,0  SITE STATUS
          CATBIT VEVS,2,1
          CATBIT VEVS,1,1,0  ERROR FLAG
          CATBIT VEVS,0,1,0  VSN BUSY FLAG
          CATBIT VEFV,59,36  FIRST VSN
          CATBIT VEFV,23,24
          CATBIT VENV,59,36  NEXT VSN
          CATBIT VENV,23,6,0 USAGE COUNT
          CATBIT VENV,17,18  RELEASE DATE
          CATEND TSVL        END OF VSN ENTRY CATALOG
 CIGSL    EQU    *-CIGS      LENGTH OF CATALOG IMAGES
 THBP     SPACE  4,15
**        TABLE FOR HOLD BUFFER PROCESSING.
*
*         THIS TABLE CONTAINS 2 WORD ENTRIES FOR EACH MEMORY PARTITION
*         THAT NEEDS TO BE SAVED WHEN PROCESSING HIGHER LEVEL
*         DIRECTIVES FROM A LOWER LEVEL.  THE TABLE IS TERMINATED WITH
*         A ZERO WORD.
*
*T,       60/ADDRESS
*T,       60/WORD COUNT
 
 
 THBP     CON    WKSP,WKSPL  SPECIAL WORKING STORAGE
          CON    CIGS,CIGSL  CATALOG IMAGES
          CON    TAVS,TAVSL  TABLE OF ASSIGNED VSNS
          CON    0
 
*         HBUFL SHOULD BE THE SUM OF LENGTHS OF THE MEMORY PARTITIONS
*         SAVED IN HBUF.
 
 HBUFL    EQU    WKSPL+CIGSL+TAVSL
 DTAB     SPACE  4,15
**        DIRECTIVE TABLES.
*
*         ENTRY  ONE WORD PER DIRECTIVE.
*                42/IDENT,18/ADDR
*
*                IDENT = DIRECTIVE IDENTIFIER, LEFT JUSTIFIED.
*                ADDR = ADDRESS OF DIRECTIVE CONTROL TABLE IF
*                       EQUIVALENCED DIRECTIVE.
*                     = (-1) * PROCESSOR ADDRESS IF NOT EQUIVALENCED
*                       DIRECTIVE.
*
*         EACH DIRECTIVE TABLE IS TERMINATED BY A ZERO WORD.
 TFAD     SPACE  4,10
**        TFAD - TABLE OF FAMILY LEVEL DIRECTIVES.
 
 
 TFAD     BSS    0
          DTAB   ALTFAM
          DTAB   AUDITCH
          DTAB   AUDITUN
          DTAB   AUDITVS
          DTAB   BRIEF,-/LVFA/BRF
          DTAB   CALTFAM
          DTAB   CATERR
          DTAB   COLON
          DTAB   DISPLAY,-DIS
          DTAB   DROP,-/LVFA/DRO
          DTAB   STOP,-STO
          DTAB   FAMNAME
          DTAB   FOREIGN
          DTAB   GLOBAL
          DTAB   GO,-/LVFA/PGO
          DTAB   HELP,-HEL
          DTAB   INVALID
          DTAB   ISV,-/LVFA/ISV
          DTAB   LINKFAM
          DTAB   MID
          DTAB   MREADCH
          DTAB   MREADUN
          DTAB   MREADVS
          DTAB   NOBRIEF,-/LVFA/NBF
          DTAB   PURGALL
          DTAB   PURGE
          DTAB   READ
          DTAB   RELEASE
          DTAB   REMOVE
          DTAB   REWIND
          DTAB   SEPARAT
          DTAB   SOURCCH
          DTAB   SOURCE,-/LVFA/SOU
          DTAB   SOURCUN
          DTAB   SOURCVS
          DTAB   USER
          DTAB   VALIDAT
          DTAB   VSN
          CON    0           END OF TABLE
 TVSD     SPACE  4,10
**        TVSD - TABLE OF VSN LEVEL DIRECTIVES.
 
 
 TVSD     BSS    0
          DTAB   ADD,-/LVVS/ADD
          DTAB   BRIEF,-/LVFA/BRF
          DTAB   COLON
          DTAB   DISPLAY,-DIS
          DTAB   DROP,-/LVVS/DRO
          DTAB   STOP,-STO
          DTAB   ERRFLAG
          DTAB   GO,-/LVVS/PGO
          DTAB   HELP,-HEL
          DTAB   MAINT
          DTAB   NOBRIEF,-/LVFA/NBF
          DTAB   OWNER
 PRN      DTAB   PRN
          DTAB   READ
          DTAB   REVISE,-/LVVS/REV
          DTAB   REWIND
          DTAB   SEPARAT
          DTAB   SITE
          DTAB   STATUS
          DTAB   SYSTEM
          DTAB   USAGE
          DTAB   VT
          CON    0           END OF TABLE
 TUSD     SPACE  4,10
**        TUSD - TABLE OF USER LEVEL DIRECTIVES.
 
 
 TUSD     BSS    0
          DTAB   AUDITCN
          DTAB   AUDITFI
          DTAB   AUDITFV
          DTAB   BRIEF,-/LVFA/BRF
          DTAB   COLON
          DTAB   DISPLAY,-DIS
          DTAB   DROP,-/LVUS/DRO
          DTAB   STOP,-STO
 FILE     DTAB   FILE
          DTAB   FILEV
          DTAB   GO,-/LVUS/DRO
          DTAB   HELP,-HEL
          DTAB   MREADCN
          DTAB   MREADFI
          DTAB   MREADFV
          DTAB   NOBRIEF,-/LVFA/NBF
          DTAB   READ
          DTAB   RELEASF
          DTAB   RELEASV
          DTAB   REWIND
          DTAB   SEPARAT
          DTAB   SOURCCN
          DTAB   SOURCFI
          DTAB   SOURCFV
          CON    0           END OF TABLE
 TFLD     SPACE  4,10
**        TFLD - TABLE OF FILE LEVEL DIRECTIVES.
 
 
 TFLD     BSS    0
          DTAB   AC
          DTAB   ACOUNT
          DTAB   ADATE
          DTAB   AMEND,-/LVFI/ALT
          DTAB   ATIME
          DTAB   AUDITAU
          DTAB   AUSER
          DTAB   AVSN
          DTAB   BRIEF,-/LVFA/BRF
          DTAB   CDATE
          DTAB   CE
          DTAB   CN
          DTAB   COLON
          DTAB   CR
          DTAB   CT
          DTAB   CTIME
          DTAB   CV
          DTAB   D
          DTAB   DISPLAY,-DIS
          DTAB   DROP,-/LVFI/DRO
          DTAB   E
          DTAB   STOP,-STO
          DTAB   F
          DTAB   FA
          DTAB   FC
 FI       DTAB   FI
          DTAB   G
          DTAB   GO,-/LVFI/PGO
          DTAB   HELP,-HEL
          DTAB   LB
          DTAB   M
          DTAB   MDATE
          DTAB   MTIME
          DTAB   NOBRIEF,-/LVFA/NBF
          DTAB   NS
 PI       DTAB   PI
          DTAB   PN
 PW       DTAB   PW
          DTAB   RDATE
          DTAB   READ
          DTAB   RECOVER
          DTAB   RESERVE,-/LVFI/RES
          DTAB   REWIND
          DTAB   RT
          DTAB   SEPARAT
 SI       DTAB   SI
          DTAB   SN
          DTAB   SV
          DTAB   TOWNER
          DTAB   TSITE
 UC       DTAB   UC
          DTAB   URDATE
          CON    0           END OF TABLE
 TAUD     SPACE  4,10
**        TAUD - TABLE OF ALTERNATE USER LEVEL DIRECTIVES.
 
 
 TAUD     BSS    0
          DTAB   AACOUNT
          DTAB   AADATE
          DTAB   AATIME
          DTAB   ADMIT,-/LVAU/ADM
          DTAB   AMODE
          DTAB   BRIEF,-/LVFA/BRF
          DTAB   COLON
          DTAB   DISPLAY,-DIS
          DTAB   DROP,-/LVAU/DRO
          DTAB   STOP,-STO
          DTAB   GO,-/LVAU/ADM
          DTAB   HELP,-HEL
          DTAB   NOBRIEF,-/LVFA/NBF
          DTAB   READ
          DTAB   REWIND
          DTAB   SEPARAT
          CON    0           END OF TABLE
 TDTA     SPACE  4,10
**        TDTA - TABLE OF DIRECTIVE TABLE ADDRESSES.
 
 
 TDTA     INDTAB 1
          INDEX  LVFA,CON,TFAD  FAMILY LEVEL
          INDEX  LVVS,CON,TVSD  VSN LEVEL
          INDEX  LVUS,CON,TUSD  USER LEVEL
          INDEX  LVFI,CON,TFLD  FILE LEVEL
          INDEX  LVAU,CON,TAUD  ALTERNATE USER LEVEL
 DCTAB    SPACE  4,50
**        DIRECTIVE CONTROL TABLES.
*
*         ENTRY  AT LEAST THREE WORDS PER DIRECTIVE.
*                12/INDEX,6/MINC,6/MAXC,18/ALLOW,18/SUPP
*                12/UBIT,12/BITC,18/PROC,18/ENTRY
*                1/OB,1/PVL,1/DVL,3/ ,18/MINV,18/MAXV,18/DEFAULT
*
*                INDEX = *DIP* PROCESSOR INDEX.
*                        PIZF - ZERO FILL.
*                        PIOP - OPTION SELECTION.
*                        PIBD - NUMERIC BINARY DATA.
*                        PIPD - PACKED DATE.
*                        PIPT - PACKED TIME.
*                        PIJD - JULIAN DATE.
*                        PIVQ - VSN/SEQUENCE NUMBER.
*                        PIVS - PADDED VSN.
*                MINC = MINIMUM NUMBER OF CHARACTERS.
*                MAXC = MAXIMUM NUMBER OF CHARACTERS.
*                ALLOW = ADDRESS OF ALLOWED CHARACTERS BIT STRING.
*                SUPP = ADDRESS OF SUPPRESSED CHARACTERS BIT STRING.
*                UBIT = UPPER BIT POSITION OF CATALOG ENTRY.
*                BITC = BIT COUNT OF CATALOG ENTRY.
*                     = 0 IF NO CATALOG ENTRY.
*                PROC = POST PROCESSOR ADDRESS.
*                     = 0 IF NO POST PROCESSOR.
*                ENTRY = ADDRESS OF CATALOG ENTRY.
*                PVL = FLAG FOR IMPLIED DROP REQUIREMENT.
*                    = 0 IF DIRECTIVE REQUIRES NO IMPLIED DROP.
*                    = 1 IF DIRECTIVE REQUIRES AN IMPLIED DROP.
*                DVL = FLAG FOR LOWER LEVEL VALIDITY.
*                    = 0 IF VALID FROM LOWER LEVEL.
*                    = 1 IF NOT VALID FROM DIFFERENT LEVEL.
*                MINV = ADDRESS OF MINIMUM VALUE FOR *PIBD* TYPE.
*                MAXV = ADDRESS OF MAXIMUM VALUE FOR *PIBD* TYPE.
*                     = ADDRESS OF OPTION TABLE FOR *PIOP* TYPE.
*                DEFAULT = ADDRESS OF DEFAULT VALUE.
*                OB = OUTPUT BLOCK FLAG.  IF SET, AN EXTRA TWO WORD
*                     BLOCK FOLLOWS.
*                6/KCH,6/KUB,18/KADD,6/ACH,6/AUB,18/AADD
*                6/SCH,6/SUB,18/SADD,6/MCH,6/MUB,18/MADD
*
*                KCH = NUMBER OF CHARACTERS IN K-DISPLAY.
*                KUB = UPPER BIT POSITION IN K-DISPLAY.
*                KADD = ADDRESS IN K-DISPLAY.
*                ACH = NUMBER OF CHARACTERS IN AUDIT LISTING.
*                AUB = UPPER BIT POSITION IN AUDIT LISTING.
*                AADD = ADDRESS IN AUDIT LISTING.
*                SCH = NUMBER OF CHARACTERS IN SOURCE LISTING.
*                SUB = UPPER BIT POSITION IN SOURCE LISTING.
*                SADD = ADDRESS IN SOURCE LISTING.
*                MCH = NUMBER OF CHARACTERS IN MACHINE READABLE LIST.
*                MUB = UPPER BIT POSITION IN MACHINE READABLE LISTING.
*                MADD = ADDRESS IN MACHINE READABLE LISTING.
 
 
*         UNIVERSAL DIRECTIVE CONTROL TABLES.
 
 COLON    DCTAB  PIBS,0,1,="EC",,59,UCKL*6,,CL,,,=0
 COLON    DCTABL 0,0
 COLON    DCTABO ,,,0,0,0,0,0,0,0,0,0
 READ     DCTAB  PIZF,1,7,,,59,42,REA,AI
 READ     DCTABL 0,0
 READ     DCTABO ,,,0,0,0,0,0,0,0,0,0
 REWIND   DCTAB  PIZF,1,7,,,59,42,REW,R
 REWIND   DCTABL 0,0
 SEPARAT  DCTAB  PIBS,0,1,="EC",,59,UCKL*6,,SE,,,(=C*,*)
 SEPARAT  DCTABL 0,0
 SEPARAT  DCTABO ,,,0,0,0,0,0,0,0,0,0
 
*         FAMILY LEVEL DIRECTIVE CONTROL TABLES.
 
 ALTFAM   DCTAB  PIZF,0,7,,,59,FNKL*6,/LVFA/AFM,/LVFA/AFMA,,,=0
 ALTFAM   DCTABL 0,0
 AUDITCH  DCTAB  PIZF,1,10,="AS",,59,CNKL*6,/LVFA/ACH,CN
 AUDITCH  DCTABL 0,0
 AUDITUN  DCTAB  PIZF,0,7,="AS",,59,UNKL*6,/LVFA/AUN,UN,,,=0
 AUDITUN  DCTABL 0,0
 AUDITVS  DCTAB  PIVS,0,6,,,59,VSKL*6,/LVFA/AVS,VS,,,=0
 AUDITVS  DCTABL 0,0
 CALTFAM  DCTAB  PIZF,0,7,,,59,FNKL*6,/LVFA/CAF,/LVFA/CAFA,,,=0
 CALTFAM  DCTABL 0,0
 CATERR   DCTAB  PIOP,0,10,,,0,1,/LVFA/CAT,/LVFA/CATA
 CATERR   DCTABL 0,0
 FAMNAME  DCTAB  PIZF,0,7,,,59,7*6,/LVFA/FAM,/LVFA/FAMA,,,FM
 FAMNAME  DCTABL 0,0
 FOREIGN  DCTAB  PIOP,0,10,,,0,1,/LVFA/FOR,/LVFA/FORA
 FOREIGN  DCTABL 0,0
 GLOBAL   DCTAB  PIOP,0,10,,,0,1,/LVFA/GLO,/LVFA/GLOA
 GLOBAL   DCTABL 0,0
 INVALID  DCTAB  PIZF,1,7,="AS",,59,UNKL*6,/LVFA/INV,UN
 INVALID  DCTABL 0,0
 LINKFAM  DCTAB  PIZF,0,7,,,59,FNKL*6,/LVFA/LKF,/LVFA/LKFA,,,=0
 LINKFAM  DCTABL 0,0
 MID      DCTAB  PIZF,0,2,,,11,2*6,/LVFA/MID,/LVFA/MIDA,,,MI
 MID      DCTABL 0,0
 MREADCH  DCTAB  PIZF,1,10,="AS",,59,CNKL*6,/LVFA/MCH,CN
 MREADCH  DCTABL 0,0
 MREADUN  DCTAB  PIZF,0,7,="AS",,59,UNKL*6,/LVFA/MUN,UN,,,=0
 MREADUN  DCTABL 0,0
 MREADVS  DCTAB  PIVS,0,6,,,59,VSKL*6,/LVFA/MVS,VS,,,=0
 MREADVS  DCTABL 0,0
 PURGALL  DCTAB  PIZF,1,7,="AS",,59,UNKL*6,/LVFA/PGA,UN
 PURGALL  DCTABL 1,1
 PURGE    DCTAB  PIVS,1,6,,,59,VSKL*6,/LVFA/PTF,VS
 PURGE    DCTABL 1,1
 RELEASE  DCTAB  PIVS,1,6,,,59,VSKL*6,/LVFA/REL,VS
 RELEASE  DCTABL 1,1
 REMOVE   DCTAB  PIVS,1,6,,,59,VSKL*6,/LVFA/REM,VS
 REMOVE   DCTABL 1,1
 SOURCCH  DCTAB  PIZF,1,10,="AS",,59,CNKL*6,/LVFA/SCH,CN
 SOURCCH  DCTABL 0,0
 SOURCUN  DCTAB  PIZF,0,7,="AS",,59,UNKL*6,/LVFA/SUN,UN,,,=0
 SOURCUN  DCTABL 0,0
 SOURCVS  DCTAB  PIVS,0,6,,,59,VSKL*6,/LVFA/SVS,VS,,,=0
 SOURCVS  DCTABL 0,0
 USER     DCTAB  PIZF,1,7,="AS",,59,UNKL*6,/LVFA/USE,UN
 USER     DCTABL 1,0
 VALIDAT  DCTAB  PIZF,1,7,="AS",,59,UNKL*6,/LVFA/VAL,UN
 VALIDAT  DCTABL 0,0
 VSN      DCTAB  PIVS,1,6,,,59,VSKL*6,/LVFA/VSN,VS
 VSN      DCTABL 1,0
 
*         VSN LEVEL DIRECTIVE CONTROL TABLES.
 
 ERRFLAG  DCTAB  PIOP,0,10
 ERRFLAG  DCTABL 0,1
 ERRFLAG  DCTABO 0,0,0,0,0,0
 MAINT    DCTAB  PIOP,0,10
 MAINT    DCTABL 0,1
 MAINT    DCTABO 0,0,0,0,0,0
 OWNER    DCTAB  PIOP,0,10,,,,,/LVVS/OWN
 OWNER    DCTABL 0,1
 OWNER    DCTABO
 PRN      DCTAB  PIBF,0,6,="AC",="NC",,,,,,,VS
 PRN      DCTABL 0,1
 PRN      DCTABO ,,,,,,0,0,0
 SITE     DCTAB  PIOP,0,10
 SITE     DCTABL 0,1
 SITE     DCTABO
 STATUS   DCTAB  PIOP,0,10,,,1,2,/LVVS/STA,ME
 STATUS   DCTABL 0,1
 STATUS   DCTABO 0,0,0,0,0,0,0,0,0,0,0,0
 SYSTEM   DCTAB  PIOP,2,3,,,,,/LVVS/SYS
 SYSTEM   DCTABL 0,1
 SYSTEM   DCTABO
 USAGE    DCTAB  PIBD,0,10,,,,,,,=0,=77B,=C*0*
 USAGE    DCTABL 0,1
 USAGE    DCTABO -2
 VT       DCTAB  PIOP,2,4,,,,,/LVVS/VTY
 VT       DCTABL 0,1
 VT       DCTABO
 
*         USER LEVEL DIRECTIVE CONTROL TABLES.
 
 AUDITCN  DCTAB  PIZF,1,10,="AS",,59,CNKL*6,/LVUS/ACN,CN
 AUDITCN  DCTABL 0,0
 AUDITFI  DCTAB  PIBF,1,17,="AC",="NC",59,FIKL*6,/LVUS/AFI,FI
 AUDITFI  DCTABL 0,0
 AUDITFV  DCTAB  PIVS,1,6,,,59,VSKL*6,/LVUS/AFV,VS
 AUDITFV  DCTABL 0,0
 FILE     DCTAB  PIBF,1,17,="AC",="NC",59,FIKL*6,/LVUS/FIL,FI
 FILE     DCTABL 1,0
 FILEV    DCTAB  PIVQ,1,6,,,59,60,/LVUS/FIV,FV
 FILEV    DCTABL 1,0
 MREADCN  DCTAB  PIZF,1,10,="AS",,59,CNKL*6,/LVUS/MCN,CN
 MREADCN  DCTABL 0,0
 MREADFI  DCTAB  PIBF,1,17,="AC",="NC",59,FIKL*6,/LVUS/MFI,FI
 MREADFI  DCTABL 0,0
 MREADFV  DCTAB  PIVS,1,6,,,59,VSKL*6,/LVUS/MFV,VS
 MREADFV  DCTABL 0,0
 RELEASF  DCTAB  PIBF,1,17,,,59,FIKL*6,/LVUS/RLF,FI
 RELEASF  DCTABL 1,1
 RELEASV  DCTAB  PIVQ,1,6,,,59,60,/LVUS/RLV,VS
 RELEASV  DCTABL 1,1
 SOURCCN  DCTAB  PIZF,1,10,="AS",,59,CNKL*6,/LVUS/SCN,CN
 SOURCCN  DCTABL 0,0
 SOURCFI  DCTAB  PIBF,1,17,="AC",="NC",59,FIKL*6,/LVUS/SFI,FI
 SOURCFI  DCTABL 0,0
 SOURCFV  DCTAB  PIVS,1,6,,,59,VSKL*6,/LVUS/SFV,VS
 SOURCFV  DCTABL 0,0
 
*         FILE LEVEL DIRECTIVE CONTROL TABLES.
 
 AC       DCTAB  PIOP,0,10
 AC       DCTABL 1,0
 AC       DCTABO ,,,,,,,,,0,0,0
 ACOUNT   DCTAB  PIBD,0,10,,,,,,,=0,="MXAC",=C*0000*
 ACOUNT   DCTABL 1,0
 ACOUNT   DCTABO -8
 ADATE    DCTAB  PIPD,0,6,,,,,,,,,DD
 ADATE    DCTABL 1,0
 ADATE    DCTABO
 ATIME    DCTAB  PIPT,0,6,,,,,,,,,DT
 ATIME    DCTABL 1,0
 ATIME    DCTABO
 AUDITAU  DCTAB  PIZF,0,7,="AS",,59,UNKL*6,/LVFI/AAU,AU,,,=0
 AUDITAU  DCTABL 0,0
 AUSER    DCTAB  PIZF,1,7,="AS",,59,UNKL*6,/LVFI/AUS,AU
 AUSER    DCTABL 1,0
 AVSN     DCTAB  PIVS,1,6,,,59,VSKL*6,/LVFI/AVS,VS
 AVSN     DCTABL 1,0
 CDATE    DCTAB  PIPD,0,6,,,,,,,,,DD
 CDATE    DCTABL 1,0
 CDATE    DCTABO
 CE       DCTAB  PIOP,0,10
 CE       DCTABL 1,0
 CE       DCTABO
 CN       DCTAB  PIZF,0,10,="AS",,,,,,,=0
 CN       DCTABL 1,0
 CN       DCTABO
 CR       DCTAB  PIJD,0,5,,,,,,,,,JD
 CR       DCTABL 1,0
 CR       DCTABO ,,,,,,,,,0,0,0
 CT       DCTAB  PIOP,0,10
 CT       DCTABL 1,0
 CT       DCTABO
 CTIME    DCTAB  PIPT,0,6,,,,,,,,,DT
 CTIME    DCTABL 1,0
 CTIME    DCTABO
 CV       DCTAB  PIOP,0,10
 CV       DCTABL 1,0
 CV       DCTABO
 D        DCTAB  PIOP,2,2,,,,,/LVFI/DEN
 D        DCTABL 1,0
 D        DCTABO
 E        DCTAB  PIBD,0,10,,,,,,,=0,=99,=C*00*
 E        DCTABL 1,0
 E        DCTABO -2,,,,,,,,,0,0,0
 F        DCTAB  PIOP,0,10
 F        DCTABL 1,0
 F        DCTABO
 FA       DCTAB  PIZF,0,1,,,,,,,,,=0
 FA       DCTABL 1,0
 FA       DCTABO ,,,,,,,,,0,0,0
 FC       DCTAB  PIBD,0,10,,,,,,,=0,="MXFC",=C*"MXFC"*
 FC       DCTABL 1,0
 FC       DCTABO -4,,,,,,,,,0,0,0
 FI       DCTAB  PIBF,0,17,="AC",="NC",,,/LVFI/PFI,,,,FI
 FI       DCTABL 1,0
 FI       DCTABO 20,,,,,,0,0,0
 G        DCTAB  PIBD,0,10,,,,,,,=1,=9999,=C*0001*
 G        DCTABL 1,0
 G        DCTABO -4,,,,,,,,,0,0,0
 LB       DCTAB  PIOP,0,10
 LB       DCTABL 1,0
 LB       DCTABO
 M        DCTAB  PIOP,0,10
 M        DCTABL 1,0
 M        DCTABO
 MDATE    DCTAB  PIPD,0,6,,,,,,,,,DD
 MDATE    DCTABL 1,0
 MDATE    DCTABO
 MTIME    DCTAB  PIPT,0,6,,,,,,,,,DT
 MTIME    DCTABL 1,0
 MTIME    DCTABO
 NS       DCTAB  PIBD,0,10,,,,,,,=0,=31,=C*0*
 NS       DCTABL 1,0
 NS       DCTABO -2,,,,,,,,,0,0,0
 PI       DCTAB  PIBF,0,17,="AC",="NC",,,,,,,FI
 PI       DCTABL 1,0
 PI       DCTABO 20,,,,,,0,0,0
 PN       DCTAB  PIZF,0,20,="AH",,,,,,,=0
 PN       DCTABL 1,0
 PN       DCTABO 20
 PW       DCTAB  PIZF,0,7,="EC",,,,,,,,=0
 PW       DCTABL 1,0
 PW       DCTABO ,,,,,,0,0,0
 RDATE    DCTAB  PIPD,0,6,,,17,18,/LVFI/RDA,/LVFI/RDAA,,,(=1L)
 RDATE    DCTABL 1,0
 RDATE    DCTABO 0,0,0,0,0,0,0,0,0,0,0,0
 RECOVER  DCTAB  PIOP,0,10
 RECOVER  DCTABL 1,0
 RECOVER  DCTABO ,,,0,0,0,,,,0,0,0
 RT       DCTAB  PIJD,0,5,,,,,,,,,JD
 RT       DCTABL 1,0
 RT       DCTABO ,,,,,,,,,0,0,0
 SI       DCTAB  PIBF,0,6,="AC",="NC",,,,,,,=0
 SI       DCTABL 1,0
 SI       DCTABO ,,,,,,0,0,0,0,0,0
 SN       DCTAB  PIBD,0,10,,,,,,,=1,=9999,=C*0001*
 SN       DCTABL 1,0
 SN       DCTABO -4,,,,,,,,,0,0,0
 SV       DCTAB  PIOP,0,10,,,,,/LVFI/PSV
 SV       DCTABL 1,0
 SV       DCTABO ,,,,,,,,,0,0,0
 TOWNER   DCTAB  PIOP,0,10,,,/UPB/OWNER,/BTC/OWNER,,ST
 TOWNER   DCTABL 1,0
 TOWNER   DCTABO ,,,0,0,0,0,0,0,0,0,0
 TSITE    DCTAB  PIOP,0,10,,,/UPB/SITE,/BTC/SITE,,ST
 TSITE    DCTABL 1,0
 TSITE    DCTABO ,,,0,0,0,0,0,0,0,0,0
 UC       DCTAB  PIBF,0,10,="AC",="NC",,,,,,,=0
 UC       DCTABL 1,0
 UC       DCTABO ,,,,,,0,0,0
 URDATE   DCTAB  PIPD,0,6,,,,,/LVFI/URD,TAVS+/CAT/URDATE,,,(=1L)
 URDATE   DCTABL 1,0
 URDATE   DCTABO
 
*         ALTERNATE USER LEVEL DIRECTIVE CONTROL TABLES.
 
 AACOUNT  DCTAB  PIBD,0,10,,,,,,,=0,="MXAA",=C*0000*
 AACOUNT  DCTABL 1,0
 AACOUNT  DCTABO -6,,,,,,,,,0,0,0
 AADATE   DCTAB  PIPD,0,6,,,,,,,,,DD
 AADATE   DCTABL 1,0
 AADATE   DCTABO ,,,,,,,,,0,0,0
 AATIME   DCTAB  PIPT,0,6,,,,,,,,,DT
 AATIME   DCTABL 1,0
 AATIME   DCTABO ,,,,,,,,,0,0,0
 AMODE    DCTAB  PIOP,0,10
 AMODE    DCTABL 1,0
 AMODE    DCTABO ,,,,,,,,,0,0,0
 DOTAB    SPACE  4,10
**        DIRECTIVE OPTION TABLES.
*
*         ENTRY  TWO WORDS PER OPTION.
*         60/ IDENT
*         60/ VALUE
*
*                IDENT = OPTION IDENTIFIER, LEFT JUSTIFIED.
*                VALUE = VALUE ASSIGNED TO CATALOG ENTRY.
*
*         EACH OPTION TABLE IS TERMINATED BY A ZERO WORD.
 
 
*         FAMILY LEVEL OPTION TABLES.
 
 CATERR   DOTAB  ((CLEAR,0),(SET,1))
 FOREIGN  DOTAB  ((NO,0),(YES,1))
 GLOBAL   DOTAB  ((NO,0),(YES,1))
 
*         VSN LEVEL DIRECTIVE OPTION TABLES.
 
 ERRFLAG  DOTAB  ((CLEAR,0),(SET,1))
 MAINT    DOTAB  ((AVAILABLE,0),(HOLD,1))
 STATUS   DOTAB  ((AVAILABLE,0),(CLEANED,1),(HOLD,2),(ERROR,3))
 OWNER    DOTAB  ((CENTER,0),(USER,1))
 SITE     DOTAB  ((ON,0),(OFF,1))
 SYSTEM   DOTAB  ((NO,0),(YES,1))
 VT       DOTAB  ((MTNT,0),(CT,1),(AT,3))
 
*         FILE LEVEL DIRECTIVE OPTION TABLES.
 
 AC       DOTAB  ((NO,0),(YES,1))
 CE       DOTAB  ((CLEAR,0),(SET,1))
 CT       DOTAB  ((PRIVATE,FCPR),(SPRIV,FCSP),(PUBLIC,FCPU))
 CV       DOTAB  ((AS,2),(EB,3))
 D        DOTAB  ((PE,44B),(GE,45B),(HI,2),(LO,1),(HY,3),(HD,43B),(CE,26
,B),(AE,66B))
 F        DOTAB  ((I,0),(SI,1),(F,2),(S,3),(L,4),(LI,5))
 LB       DOTAB  ((KL,2),(KU,0),(NS,1))
 M        DOTAB  ((READ,FMRE),(WRITE,FMWR),(NULL,FMNA))
 RECOVER  DOTAB  ((NO,0),(YES,1))
 SV       DOTAB  ((NO,0),(SET,1))
 TOWNER   DOTAB  ((CENTER,0),(USER,1))
 TSITE    DOTAB  ((ON,0),(OFF,1))
 
*         ALTERNATE USER LEVEL DIRECTIVE OPTION TABLES.
 
 AMODE    DOTAB  ((IMPLICIT,0),(WRITE,FMWR),(READ,FMRE),(NULL,FMNA),(SPE
,CIAL,FMPF))
 DMESS    SPACE  4,10
**        DAYFILE MESSAGES.
 
 
 MABT     DATA   C* TFSP ABORTED.*
 MABU     DATA   C* TFSP ABORTED BY USER.*
 MANT     DATA   C* ABNORMAL TERMINATION, ERROR CODE = $$$$$$$.*
 MCOM     DATA   C* TFSP COMPLETE.*
 MDER     DATA   C* DIRECTIVE ERRORS.*
 MFNA     DATA   C* FAMILY NOT ACTIVE.*
 MINA     DATA   C* INCORRECT ACCESS.*
 MTCI     DATA   C* TAPE CATALOG FILE INTERLOCKED.*
 MUTE     DATA   C* UNEXPECTED TAPE CATALOG ERROR.*
 EMESS    SPACE  4,10
**        DIRECTIVE ERROR MESSAGES.
 
 
 EAFM     KLINE  ( ALTERNATE FAMILIES AT MAXIMUM.),E,50
 EAVM     KLINE  ( ASSIGNED VSNS AT MAXIMUM.),E,50
 ECSV     KLINE  ( CANNOT CHANGE SYSTEM VSN FLAG.),E,50
 ECTD     KLINE  ( CANNOT CHANGE TAPE TYPE / DENSITY.),E,50
 EDFE     KLINE  ( DATA FIELD ERROR.),E,50
 EDLE     KLINE  ( DIRECTIVE INCORRECT FROM CURRENT LEVEL.),E,50
 ENVF     KLINE  ( DIRECTIVE NOT VALID ON FAST ATTACH CATALOG.),E,50
 EFAR     KLINE  ( FILE ALREADY RESERVED.),E,50
 EFIB     KLINE  ( FILE BUSY.),E,50
 EFIC     KLINE  ( FILE IDENTIFIER CONFLICT.),E,50
 EFNC     KLINE  ( FILE NAME CONFLICT.),E,50
 EFNI     KLINE  ( FILE NOT IN CATALOG.),E,50
 EFNR     KLINE  ( FILE NOT RESERVED.),E,50
 EILD     KLINE  ( INCORRECT DIRECTIVE.),E,50
 EIFI     KLINE  ( INCORRECT FILE IDENTIFIER.),E,50
 EIQN     KLINE  ( INCORRECT SEQUENCE NUMBER.),E,50
 EWSA     KLINE  ( NO SCRATCH AVAILABLE.),E,50
 ENMS     KLINE  ( NON-MATCHING STATUSES.),E,50
 ENMT     KLINE  ( NON-MATCHING TAPE TYPE.),E,50
 ERDI     KLINE  ( READ DIRECTIVE INCORRECT.),E,50
 ERDM     KLINE  ( REQUIRED DATA MISSING.),E,50
 ESVC     KLINE  ( SYSTEM VSN CANNOT BE USER-OWNED.),E,50
 ESVM     KLINE  ( SYSTEM VSN MUST BE FIRST VSN.),E,50
 EVUM     KLINE  ( VALIDATED USERS AT MAXIMUM.),E,50
 EVAA     KLINE  ( VSN ALREADY ASSIGNED.),E,50
 EVAI     KLINE  ( VSN ALREADY IN CATALOG.),E,50
 EVSB     KLINE  ( VSN BUSY.),E,50
 EVNA     KLINE  ( VSN NOT ADDED TO CATALOG.),E,50
 EVNF     KLINE  ( VSN NOT ASSIGNED TO FILE.),E,50
 EVNV     KLINE  ( VSN NOT AVAILABLE.),E,50
 EVNC     KLINE  ( VSN NOT IN CATALOG.),E,50
 IMESS    SPACE  4,10
**        INFORMATIVE MESSAGES.
 
 
 IAIA     KLINE  ( ALTERNATE USER CURRENTLY IS ADMITTED.),E,50
 IANA     KLINE  ( ALTERNATE USER NOT CURRENTLY ADMITTED.),E,50
 IANP     KLINE  ( ALTERNATE USER NOT PROCESSED.),E,50
 IAUA     KLINE  ( ALTERNATE USER ADMITTED.),E,50
 IAUU     KLINE  ( ALTERNATE USER ADMIT UPDATED.),E,50
 IEOF     KLINE  ( PREMATURE END OF FILE, XXXXXXX.),E,50
 IFAL     KLINE  ( FILE AMENDED.),E,50
 IFIR     KLINE  ( FILE CURRENTLY IS RESERVED.),E,50
 IFNP     KLINE  ( FILE NOT PROCESSED.),E,50
 IFNR     KLINE  ( FILE NOT CURRENTLY RESERVED.),E,50
 IFRC     KLINE  ( FILE RELEASED FROM CATALOG.),E,50
 IFRE     KLINE  ( FILE RESERVED.),E,50
 IIPI     KLINE  ( I PARAMETER IGNORED.),E,50
 IPNI     KLINE  ( P AND N PARAMETERS IGNORED.),E,50
 IULC     KLINE  ( USER LEVEL COMPLETE.),E,50
 IVAC     KLINE  ( VSN ADDED TO CATALOG.),E,50
 IVIC     KLINE  ( VSN CURRENTLY IN CATALOG.),E,50
 IVNC     KLINE  ( VSN NOT CURRENTLY IN CATALOG.),E,50
 IVNP     KLINE  ( VSN NOT PROCESSED.),E,50
 IVRB     KLINE  ( VSN RESERVED BY #######.),E,50
 IVRC     KLINE  ( VSN REMOVED FROM CATALOG.),E,50
 IVSI     KLINE  ( VSN INTERLOCKED.  JSN IS ????.),E,50
 IVSR     KLINE  ( VSN REVISED.),E,50
 PHEAD    SPACE  4,10
**        PAGE HEADER MESSAGES.
 
 
 PAUA     BSS    0           ALTERNATE USER AUDIT LISTING
          LISTER PAUA,17,(   AUDIT LISTING.),E
          LISTER ,10,(   USER = )
 USER     LISTER ,7          USER NAME
          LISTER ,10,(   FILE = )
 FILE     LISTER ,17         FILE IDENTIFIER
          LISTER ,1,,E
          LISTER ,10,(   FVSN = )
 FVSN     LISTER ,6          FIRST VSN
          LISTER ,11,(      QN = )
 QN       LISTER ,4,0001,E   SEQUENCE NUMBER
          LISTER ,1,( ),E
          LISTER ,30,(    USER NAME     MODE        )
          LISTER ,31,( ACCESSES      DATE        TIME),E
          LISTER ,1,( ),E
 PAUAL    EQU    *-PAUA      LENGTH OF HEADER
 
 PDIR     BSS    0           DIRECTIVE LISTING
          LISTER PDIR,21,(   DIRECTIVE LISTING.),E
          LISTER ,1,( ),E
 PDIRL    EQU    *-PDIR      LENGTH OF HEADER
 
 PDIS     BSS    0           DISPLAY LISTING
          LISTER PDIS,19,(   DISPLAY LISTING.),E
 PDISL    EQU    *-PDIS      LENGTH OF HEADER
 
 PFIA     BSS    0           FILE AUDIT LISTING
          LISTER PFIA,17,(   AUDIT LISTING.),E
          LISTER ,1,( ),E
          LISTER ,40,( USER      FILE-IDENTIFIER   SV FVSN    )
          LISTER ,38,(QN   CE CHARGE    PROJECT-NUMBER      )
 EOL1     LISTER ,2          END OF LINE FOR MASS STORAGE OUTPUT
          LISTER ,42,( PASSWORD PHYSICAL-FILE-ID   MD CT  AC UCW),E
          LISTER ,40,( CR      CV  D    E    F   FA  FC     G )
          LISTER ,38,(    LB  NS   RT      SN      SI       )
 EOL2     LISTER ,2          END OF LINE FOR MASS STORAGE OUTPUT
          LISTER ,40,( ACCESSES CDATE  CTIME  ADATE  ATIME  MD)
          LISTER ,10,(ATE  MTIME),E
          LISTER ,1,( ),E
 PFIAL    EQU    *-PFIA      LENGTH OF HEADER
 
 PHEL     BSS    0           HELP DISPLAY
          LISTER PHEL,16,(   HELP LISTING.),E
 PHELL    EQU    *-PHEL      LENGTH OF HEADER
 
 PVSA     BSS    0           VSN AUDIT LISTING
          LISTER PVSA,17,(   AUDIT LISTING.),E
          LISTER ,1,( ),E
          LISTER ,48,(  VSN    PRN    VT   STATUS UC OWNER SITE SYSTEM)
          LISTER ,39,( USER    CHARGE      URDATE FVSN   NVSN),E
          LISTER ,1,( ),E
 PVSAL    EQU    *-PVSA      LENGTH OF HEADER
          TITLE  MAIN PROGRAM.
 TFS      SPACE  4,10
**        TFS - MAIN ROUTINE FOR *TFSP* AND *TFSPE*.
 
 
 TFS      BSS    0
          SX6    B1          FLAG CLEAR INTERLOCK ON ABORT
          SA6    CI
          RCREC  N1,1,REC1   READ FIRST RECORD
          SX3    REC1+TBHL   SET SYSTEM TABLE ADDRESS
          SX4    TSST        SET SYSTEM TABLE IMAGE ADDRESS
          RJ     MSV         SAVE SYSTEM TABLE VALUES
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          SA1    TE
          NZ     X1,TFS2     IF *TFSPE*
          SA1    LF
          NZ     X1,TFS1     IF LOCAL FILE MODE
          ISSMSG IPNI,I      ISSUE INFORMATIVE MESSAGE
 TFS1     SA1    OP          CHECK OPTION
          SX1    X1-IOPT
          ZR     X1,TFS2     IF *OP=I*
          ISSMSG IIPI,I      ISSUE INFORMATIVE MESSAGE
 TFS2     SA1    LV          GET LEVEL
          SETSORC  K,X1      SET SOURCE VALUES IN K-DISPLAY
          SA1    /KFILLS1/FILE  PREVENT EXTRA END OF LINES
          SB3    59
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /KFILLS2/FILE
          SB3    59
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /KFILLS3/FILE
          SB3    59
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /KAUSLS/FILE
          SB3    59
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /KDIS/FI
          SB3    5
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /KDIS/PI
          SB3    5
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    DM          CHECK DIRECTIVE MESSAGE FLAG
          SX6    B0          CLEAR FLAG
          SA6    A1
          NZ     X1,TFS3     IF KEEP CURRENT MESSAGE
          MOVE   4,(=40H),/KMESS/DIRECT  CLEAR CURRENT MESSAGE
 TFS3     RJ     DIP         PROCESS DIRECTIVE INPUT
          SA1    EF
          ZR     X1,TFS4     IF NO ERROR
          ABTMSG MDER,NA     SET ERROR MESSAGE ADDRESS
          SA1    AB
          NZ     X1,TFS6     IF ABORT OPTION
 TFS4     SA1    ET
          PL     X1,TFS2     IF NOT EOF
          SA1    IF          CHECK INPUT FET ADDRESS
          SX1    X1-I
          NZ     X1,TFS7     IF NOT END OF INPUT FILE
          SA1    IS          CHECK INPUT FILE STATUS
          SX1    X1
          ZR     X1,TFS6     IF NO INPUT FILE
          PL     X1,TFS5     IF NOT BATCH JOB
          MX0    42
          SA1    I           GET INPUT FILE NAME
          BX1    X0*X1
          SB2    1RX
          SB3    TFSD
          SB5    -IEOF
          RJ     SNM         SET NAME IN MESSAGE
          ISSMSG TFSD,I      ISSUE INFORMATIVE MESSAGE
          EQ     TFS6        TERMINATE TFSP
 
 TFS5     ISSMSG EILD,E      ISSUE ERROR MESSAGE
          SX6    B0
          SA6    ET          CLEAR EOF FLAG
          SA6    EF          CLEAR ERROR FLAG
          SA1    I           CLEAR *EOF* ON FET
          MX0    57
          LX0    3
          BX6    X0*X1
          SA6    A1
          EQ     TFS2        READ NEXT LINE OF INPUT FILE
 
 TFS6     MOVE   TFSAL,TFSA,USBB  SET TERMINATION DIRECTIVES
          SX6    USBB-1
          SA6    SP
          SX6    X6+B1
          SA6    SB
          SX6    USBB+TFSAL
          SA6    SM
          EQ     TFS8        SET FET ADDRESS
 
 TFS7     SA1    TFSB+0      RESET INPUT STRING BUFFER POINTERS
          SX6    X1
          SA6    SB
          SA1    A1+B1
          SX6    X1
          SA6    SM
          SA1    A1+B1
          SX6    X1
          SA6    SP
          MOVE   USBBL,TFSC,USBB  RESET INPUT STRING BUFFER
 TFS8     SX6    I           SET INPUT FET ADDRESS
          SA6    IF
          SX6    B0          CLEAR EOF FLAG
          SA6    ET
          SA6    AI          CLEAR ALTERNATE INPUT FILE NAME
          EQ     TFS2        READ NEXT LINE OF INPUT FILE
 
 TFSA     DATA   1RD,1RR,1RO,1RP  TERMINATION DIRECTIVES
          DATA   1R,,1RD,1RR,1RO,1RP
          DATA   1R,,1RD,1RR,1RO,1RP
          DATA   1R,,1RD,1RR,1RO,1RP
 TFSAL    EQU    *-TFSA      LENGTH OF TERMINATION DIRECTIVE
 
 TFSB     BSS    0           STRING POINTER IMAGES
          LOC    0
          BSS    1           IMAGE OF (SB)
          BSS    1           IMAGE OF (SM)
          BSS    1           IMAGE OF (SP)
          LOC    *O
 
 TFSC     BSS    USBBL       IMAGE OF INPUT STRING BUFFER
 TFSD     DATA   C* PREMATURE END OF FILE, XXXXXXX.*
 ABT      SPACE  4,10
**        ABT - ABORT *TFSP*.
*
*         ENTRY  (CI) = 0 IF NO CLEAR OF UTILITY INTERLOCK.
*                (EM) = DAYFILE ERROR MESSAGE ADDRESS.
*                     = 0 IF NO ERROR MESSAGE.
*
*         EXIT   *TFSP* ABORTED.
 
 
 ABT      BSS    0           ENTRY
          SA1    CI
          ZR     X1,ABT1     IF NO CLEAR OF INTERLOCK
          SX6    B0          FLAG NO INTERLOCKS CLEARED
          SA6    A1
          SA6    RT          CLEAR RETRY FLAG
          RJ     RVE         REPLACE VSN ENTRIES
          SX1    B0          SET NO USER NAME
          RJ     IUN         INTERLOCK USER NAME
 ABT1     SA2    FM          CHECK FAMILY NAME
          SA1    CF
          BX2    X1-X2
          ZR     X2,ABT2     IF NO FAMILY NAME CHANGE NEEDED
          RJ     CFM         CHANGE FAMILY
 ABT2     SA1    OS
          ZR     X1,ABT3     IF NO OUTPUT FILE
          WRITER L,R         FLUSH OUTPUT BUFFER
 ABT3     SA1    TE
          ZR     X1,ABT5     IF NOT *TFSPE*
 ABT4     RETURN N1,R        RETURN FILE
 ABT5     MESSAGE  MABT,0,R  ISSUE *TFSP ABORTED* MESSAGE
          SA5    EM
          ZR     X5,ABT6     IF NO ERROR MESSAGE
          MESSAGE  X5,3,R    ISSUE ERROR MESSAGE
 ABT6     RETURN T,R         RETURN INTERRUPT FILE
          ABORT              ABORT PROGRAM
 END      SPACE  4,10
**        END - TERMINATE *TFSP*.
*
*         EXIT   TO ABT IF DIRECTIVE ERRORS AND ABORT MODE.
*                *TFSP* TERMINATED.
*
*         USES   A - 1, 2.
*                X - 1, 2.
*
*         CALLS  ABT, CFM, IUN, RVE.
*
*         MACROS ENDRUN, ENFA, MESSAGE, RETURN, WRITER.
*
*         ENTERED AT END7 FROM TFR.
 
 
 END      BSS    0           ENTRY
          SA1    EF
          ZR     X1,END1     IF NO DIRECTIVE ERRORS
          SA1    AB
          NZ     X1,ABT      IF ABORT MODE
 END1     RJ     RVE         REPLACE VSN ENTRIES IN CATALOG FILE
          SX1    B0          SET NO USER NAME
          RJ     IUN         INTERLOCK USER NAME
 END2     SA1    OS
          ZR     X1,END3     IF NO OUTPUT FILE
          WRITER L,R         FLUSH OUTPUT BUFFER
 END3     SA1    EF
          ZR     X1,END4     IF NO DIRECTIVE ERRORS
          MESSAGE  MDER,3,R  ISSUE DIRECTIVE ERROR MESSAGE
 END4     SA1    TE
          ZR     X1,END6     IF NOT *TFSPE*
 END5     RETURN N1,R        RETURN FILE
 END6     RETURN T,R         RETURN INTERRUPT FILE
 
*         ENTRY FROM TFR.
 
 END7     SA2    FM          CHECK FAMILY NAME
          SA1    CF
          BX2    X1-X2
          ZR     X2,END8     IF FAMILY NOT CHANGED
          RJ     CFM         CHANGE FAMILY
 END8     MESSAGE  MCOM,0,R  ISSUE COMPLETION MESSAGE
          ENDRUN             TERMINATE PROGRAM
 RPV      SPACE  4,10
**        RPV - REPRIEVE HANDLER.
*
*         EXIT   PROGRAM RESUMED IF TERMINAL INTERRUPT.
*                PROGRAM ABORTED IF SYSTEM ERROR.
 
 
 RPV      BSS    0           ENTRY
          SA1    RPVA+7      CHECK ERROR FLAG
          RJUST  X1,X1,12,11
          SX6    X1-TIET
          ZR     X6,RPV1     IF TERMINAL INTERRUPT
          SX6    X1-TAET
          ZR     X6,RPV1     IF TERMINAL INTERRUPT
          EQ     RPV7        ISSUE ERROR MESSAGE
 RPV1     SX6    B0          CLEAR INTERRUPT RESPONSE
          SA6    RPVC
          QUAL   RPV
          RESETP T           DISPLAY INTERRUPT INFORMATION
          WRITEW X2,RPVD,RPVDL
          WRITER X2,R
          READ   X2,R        GET USER RESPONSE
          READC  X2,RPVC,1
          QUAL   *
          SA1    RPVA+4
          NZ     X1,RPV6     IF INTERRUPTS PENDING
          MX0    42          CHECK USER RESPONSE
          SA1    RPVC
          SA2    RPVE
 RPV2     ZR     X2,RPV1     IF INCORRECT RESPONSE
          BX6    X0*X2
          BX6    X6-X1
          ZR     X6,RPV3     IF RESPONSE FOUND
          SA2    A2+B1
          EQ     RPV2        CHECK NEXT TABLE ENTRY
 
 RPV3     SB2    X2
          JP     B2          PROCESS RESPONSE
 
 RPV4     SX6    B1          SET TERMINAL INTERRUPT FLAG
          SA6    TI
 RPV5     REPRIEVE  RPVA,RESUME,237B  RESUME PROGRAM
 
 RPV6     ABTMSG MABU        ABORT *TFSP*
 
 RPV7     SX6    X1-RPVBL
          PL     X6,RPV8     IF UNKNOWN ERROR
          SA2    X1+RPVB
          ZR     X2,RPV8     IF UNKNOWN ERROR
          ABTMSG X2          ABORT *TFSP*
 
 RPV8     RJ     COD         CONVERT TO OCTAL DISPLAY
          BX1    X4          SET DISPLAY ERROR CODE
          SB2    1R$         SET CHARACTER TO REPLACE
          SB3    MANT        SET DAYFILE MESSAGE ADDRESS
          SB5    B3
          RJ     SNM         SET NAME IN MESSAGE
          ABTMSG MANT        ABORT *TFSP*
 
 RPVA     BSS    0           REPRIEVE BLOCK
          LOC    0
          VFD    36/0
          VFD    12/RPVAL    BLOCK LENGTH
          VFD    2/0
          VFD    9/          FUNCTION
          VFD    1/0         COMPLETION BIT
          VFD    30/0        CHECKSUM LWA
          VFD    30/RPV      TRANSFER ADDRESS
          VFD    60/         CHECKSUM VALUE
          VFD    24/237B     MASK
          VFD    24/         ERROR CLASS
          VFD    12/         ERROR CODE
          VFD    60/         PENDING INTERRUPTS
          VFD    60/         PENDING RA+1 REQUEST
          VFD    60/         INTERRUPTED TERMINAL I/O
          VFD    48/
          VFD    12/         ERROR FLAG
          VFD    60/
          BSS    20B         EXCHANGE PACKAGE
 RPVAL    EQU    *
          LOC    *O
 
 RPVB     INDTAB 1           TABLE OF ERROR CODE MESSAGES
          INDEX  0,CON,0     INCORRECT - NORMAL TERMINATION
          INDEX  ARET,CON,(=C* ARITHMETIC ERROR.*)
          INDEX  ITET,CON,(=C* SCP INVALID TRANSFER ADDRESS.*)
          INDEX  PSET,CON,(=C* PROGRAM STOP ERROR.*)
          INDEX  PPET,CON,(=C* PPU ABORT.*)
          INDEX  CPET,CON,0  INCORRECT - CPU ABORT
          INDEX  PCET,CON,(=C* PPU CALL ERROR.*)
          INDEX  MLET,CON,(=C* MESSAGE LIMIT.*)
          INDEX  TLET,CON,(=C* TIME LIMIT ERROR.*)
          INDEX  FLET,CON,(=C* FILE LIMIT ERROR.*)
          INDEX  TKET,CON,(=C* TRACK LIMIT ERROR.*)
          INDEX  SRET,CON,(=C* SRU LIMIT ERROR.*)
          INDEX  FSET,CON,(=C* FORCED ERROR.*)
          INDEX  RCET,CON,(=C* JOB HUNG IN AUTORECALL.*)
          INDEX  ODET,CON,(=C* OPERATOR DROP.*)
          INDEX  IDET,CON,(=C* IDLEDOWN.*)
          INDEX  RRET,CON,(=C* OPERATOR RERUN.*)
          INDEX  DRET,CON,(=C* DEADSTART RERUN.*)
          INDEX  STET,CON,(=C* SUSPENSION TIMEOUT.*)
          INDEX  OKET,CON,(=C* OPERATOR KILL.*)
          INDEX  SVET,CON,(=C* SECURITY VIOLATION.*)
          INDEX  SSET,CON,(=C* SUBSYSTEM ABORTED.*)
          INDEX  ECET,CON,(=C* ECS PARITY ERROR.*)
          INDEX  PEET,CON,(=C* CPU PARITY ERROR.*)
          INDEX  SYET,CON,(=C* SYSTEM ABORT.*)
          INDEX  RAET,CON,(=C* RECOVERY ABORT.*)
          INDEX  RSET,CON,(=C* RECOVERED SUBSYSTEM.*)
          INDEX  ORET,CON,(=C* OVERRIDE ERROR CONDITION.*)
 RPVBL    EQU    *-RPVB      NUMBER OF RECOGNIZED ERROR CODES
 
 RPVC     CON    0           INTERRUPT USER RESPONSE
 
 RPVD     BSS    0           INTERRUPT INSTRUCTIONS
          DATA   C* USER BREAK PROCESSING.*
          DATA   C* *
          DATA   C* PLEASE ENTER ONE OF THE FOLLOWING NUMBERS -*
          DATA   C* *
          DATA   C* 1   ABORT TFSP.*
          DATA   C* 2   RESUME PROCESSING (SOME TERMINAL OUTPUT LOST).*
          DATA   C* 3   TERMINATE CURRENT AUDIT OR SOURCE DIRECTIVE.*
 RPVDL    EQU    *-RPVD      LENGTH OF INSTRUCTIONS
 
 RPVE     BSS    0           TABLE OF USER INTERRUPT RESPONSES
          VFD    42/0L1,18/RPV6    TERMINATE TFSP
          VFD    42/0L2,18/RPV5    RESUME PROCESSING
          VFD    42/0L3,18/RPV4    TERMINATE AUDIT OR SOURCE DIRECTIVE
          CON    0           END OF TABLE
 COMMON   SPACE  4,10
**        COMMON DECKS FOR REPRIEVE HANDLER.
 
 
          QUAL   RPV
 QUAL$    EQU    1           FORCE UNQUALIFIED COMMON DECKS
*CALL     COMCCIO
*CALL     COMCRDC
*CALL     COMCSYS
*CALL     COMCWTW
          QUAL   *
          TITLE  SUBROUTINES FOR MACROS.
 CFR      SPACE  4,10
**        CFR - CHECK IF FILE IS READY.
*
*         ENTRY  (X2) = FET ADDRESS.
*
*         EXIT   (X1) = 0 IF NO FILE NAME.
*                (X2) = FET ADDRESS.
*
*         USES   A - 1.
*
*         MACROS RECALL.
 
 
 CFR      SUBR               ENTRY/EXIT
          SA1    X2
          AX1    18
          ZR     X1,CFRX     IF NO FILE NAME
          RECALL X2          WAIT UNTIL FILE IS READY
          SX1    B1
          EQ     CFRX        RETURN
 CTF      SPACE  4,15
**        CTF - CALL *TFM*.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (X6) = FUNCTION IF NO INTERLOCK TO SET.
*                     = (-1)*FUNCTION IF INTERLOCK TO SET.
*
*         EXIT   (X2) = FET ADDRESS.
*                (X4) = ERROR CODE.
*                TO *ABT* IF UNEXPECTED ERROR CODE.
*
*         USES   A - 1, 2, 4, 6, 7.
*                X - 0, 1, 6, 7.
*
*         MACROS ABTMSG, MESSAGE, RECALL, RJUST, SYSTEM.
 
 
 CTF      SUBR               ENTRY/EXIT
          LX6    3
          PL     X6,CTF1     IF NO INTERLOCK TO SET
          BX6    -X6         RESET FUNCTION CODE
          SA1    LF
          NZ     X1,CTF1     IF LOCAL FILE MODE
          SX6    X6+4        SET INTERLOCK BIT
 CTF1     SA6    CTFA        SAVE FUNCTION CODE
 CTF2     RECALL X2          INSURE FET NOT BUSY
          MX0    42          SET FUNCTION CODE IN FET
          SA1    X2
          BX6    X0*X1
          SA1    CTFA
          BX6    X6+X1
          SA6    X2
          SX7    X2          SAVE FET ADDRESS
          SA7    CTFB
          SYSTEM TFM,R,X7,SSJF*100B  CALL *TFM*
          SA2    CTFB        GET ERROR CODE
          SA4    X2
          RJUST  X4,X4,8,16
          SX1    X4-/EMSG/MXEC
          PL     X1,CTF3     IF BEYOND KNOWN ERROR CODES
          SA1    X4+CTFC     GET PROCESSOR ADDRESS
          SB2    X1
          ZR     B2,CTF3     IF NO PROCESSOR ADDRESS
          JP     B2          JUMP TO PROCESSOR
 
*         PROCESS UNEXPECTED ERROR CODES.
 
 CTF3     MESSAGE  EBUF,0,R  ISSUE *TFM* ERROR MESSAGE
          ABTMSG MUTE        ABORT *TFSP*
 
 CTFA     BSS    1           FUNCTION CODE
 CTFB     BSS    1           FET ADDRESS
 CTFC     INDTAB 1           TABLE OF ERROR CODE PROCESSORS
          INDEX  0,CON,CTFX  NO ERROR
          INDEX  /EMSG/VBS,CON,CTFX  VSN BUSY
          INDEX  /EMSG/LNF,CON,CTFX  FILE NOT FOUND
          INDEX  /EMSG/FNF,CON,CTFX  FILE NOT FOUND
          INDEX  /EMSG/VNF,CON,CTFX  VSN NOT FOUND
          INDEX  /EMSG/UNF,CON,CTFX  USER NOT FOUND
          INDEX  /EMSG/NMT,CON,CTFX  FILE NOT ON TAPE
          INDEX  /EMSG/VSR,CON,CTFX  VSN RESERVED
          INDEX  /EMSG/VSD,CON,CTFX  VSN DUPLICATE
          INDEX  /EMSG/FAR,CON,CTFX  FILE ALREADY RESERVED
          INDEX  /EMSG/VAR,CON,CTFX  VSN ALREADY RESERVED
          INDEX  /EMSG/DLK,CON,CTF3  DEADLOCK
          INDEX  /EMSG/ILR,CON,CTF3  *TFM* INCORRECT REQUEST
          INDEX  /EMSG/TMD,CON,CTF3  *TMS* DISABLED
          INDEX  /EMSG/MNA,CON,CTF3  *MAGNET* NOT ACTIVE
          INDEX  /EMSG/EBP,CON,CTF3  ERRONEOUS BUFFER POINTER
          INDEX  /EMSG/TUA,CON,CTF3  *TFM* UTILITY ACTIVE
          INDEX  /EMSG/BAE,CON,CTF3  BUFFER ARGUMENT ERROR
          INDEX  /EMSG/EID,CON,CTF3  ERROR IN INDEX DATA
          INDEX  /EMSG/ECD,CON,CTF3  ERROR IN CATALOG DATA
          INDEX  /EMSG/EAD,CON,CTF3  ERROR IN CATALOG DATA
          INDEX  /EMSG/RAE,CON,CTF3  RANDOM ADDRESS ERROR
          INDEX  /EMSG/TKL,CON,CTF3  TRACK LIMIT
          INDEX  /EMSG/MSE,CON,CTF3  MASS STORAGE ERROR
          INDEX  /EMSG/CNF,CON,CTFX  CATALOG NOT FOUND
          INDEX  /EMSG/ECF,CON,CTFX  EMPTY CATALOG
          INDEX  /EMSG/CLE,CON,CTF3  CATALOG LINKAGE ERROR
          INDEX  /EMSG/IOS,CON,CTF3  I/O SEQUENCE ERROR ON CATALOG
          INDEX  /EMSG/EOI,CON,CTF3  EOI NOT ON TRACK CHAIN
          INDEX  /EMSG/NAE,CON,CTFX  NO ADMITS
          INDEX  /EMSG/TPI,CON,CTF3  TMS PROCESSING INHIBITED
          INDEX  /EMSG/SFA,CON,CTF3  FAMILY ACTIVITY SUSPENDED
          INDEX  /EMSG/FCE,CON,CTF3  FAMILY CATALOG ERROR
          INDEX  /EMSG/WSA,CON,CTFX  WAIT SCRATCH ASSIGNMENT
          INDEX  /EMSG/NEU,CON,CTF3  NO EXTEND ON USER OWNED FILE
          INDEX  /EMSG/WRF,CON,CTF3  WRITE REQUEST ON READ ONLY FILE
          INDEX  /EMSG/MPE,CON,CTF3  MULTI-FILE PROCESSING ERROR
          INDEX  /EMSG/FCI,CON,CTF3  FILE CREATION INCORRECT
          INDEX  /EMSG/EFD,CON,CTFX  ERROR IN FILE DATA
          INDEX  /EMSG/CNA,CON,CTFX  LINKED CATALOG NOT ACCESSIBLE
 
          ERRNZ  *-CTFC-/EMSG/MXEC  INCORRECT NUMBER OF ERROR CODES
 CWL      SPACE  4,15
**        CWL - COUNT WORDS/LINES IN BUFFER.
*
*         ENTRY  (A1) = BUFFER ADDRESS.
*                (B2) = 0 IF COUNT NUMBER OF LINES.
*                     = 1 IF COUNT NUMBER OF WORDS.
*                (B6) = WORD COUNT IF (B2) = 0.
*                (B7) = LINE COUNT IF (B2) = 1.
*                (X1) = FIRST WORD OF BUFFER.
*
*         EXIT   (A1) = LWA+1 OF BUFFER.
*                (B6) = WORD COUNT OF BUFFER.
*                (B7) = LINE COUNT OF BUFFER.
*
*         USES   B - 3, 4.
*                X - 0, 1.
 
 
 CWL      SUBR               ENTRY/EXIT
          SB3    B6          SET WORD COUNT FOR COUNTING LINES
          SB4    377777B
          ZR     B2,CWL1     IF COUNTING LINES
          SB3    B4          SET LINE COUNT FOR COUNTING WORDS
          SB4    B7
 CWL1     MX0    -12         SET END OF LINE MASK
          SB6    B0          PRESET WORD COUNT
          SB7    B0          PRESET LINE COUNT
 CWL2     GE     B6,B3,CWLX  IF NO MORE WORDS IN BUFFER
          GE     B7,B4,CWLX  IF NO MORE LINES IN BUFFER
          SB6    B6+B1       INCREMENT WORD COUNT
          BX6    -X0*X1      CHECK END OF LINE BYTE
          SA1    A1+B1
          NZ     X6,CWL2     IF NOT END OF LINE
          SB7    B7+B1       INCREMENT LINE COUNT
          EQ     CWL2        CHECK WORD/LINE COUNTS
 DVS      SPACE  4,15
**        DVS - DELETE VSN ENTRY.
*
*         ENTRY  (B6) = ADDRESS OF VSN BUFFER.
*                (B7) = LENGTH OF VSN BUFFER.
*
*         EXIT   (X4) = 0 IF DELETE COMPLETE.
*                     .NE. 0 IF A VSN IS ASSIGNED TO A FILE.
*
*         USES   A - 1, 3, 6.
*                B - 6, 7.
*                X - 1, 3, 6.
*
*         CALLS  SMD.
*
*         MACROS CALLTFM, RESETP, WRITFET.
 
 
 DVS      SUBR               ENTRY/EXIT
          SX6    B6          SAVE BUFFER ADDRESS
          SA6    DVSA
          SX6    B7          SAVE BUFFER LENGTH
          SA6    DVSB
          RESETP N1          SET VSN ENTRIES INTO FET BUFFER
          SA1    DVSA
          SA3    DVSB
          WRITFET  X2,X1,X3
          CALLTFM  X2,DVES   DELETE VSN ENTRIES
          NZ     X4,DVSX     IF ERROR
          SA1    DVSA        SET BUFFER ADDRESS
          SB6    X1
          SA1    DVSB        SET BUFFER LENGTH
          SB7    X1
          RJ     SMD         ISSUE *SDRM* ACCOUNT FILE MESSAGE
          SX4    B0          FLAG NO ERROR
          EQ     DVSX        RETURN
 
 DVSA     BSS    1           VSN BUFFER ADDRESS
 DVSB     BSS    1           VSN BUFFER LENGTH
 GFI      SPACE  4,25
**        GFI - GET FILE CATALOG VIA FILE IDENTIFIER.
*
*         ENTRY  (X1) = USER NAME.
*                (X2) = FIRST 10 CHARACTERS OF FILE ID.
*                (X3) = LAST 7 CHARACTERS OF FILE ID.
*                (B2) = VSN BUFFER ADDRESS.
*                (B4) = 0 IF VERIFY FILE STATUS.
*                     .NE. 0 IF ASSUME FILE NOT FOUND.
*                (B6) = FILE CATALOG BUFFER ADDRESS.
*                (B7) = PREVIOUS FILE BUFFER ADDRESS.
*
*         EXIT   (X4) = 0 IF FILE FOUND.
*                     .NE. IF FILE NOT FOUND.  DEFAULT SET IN BUFFER.
*                (X6) = FILE CATALOG RANDOM ADDRESS.
*                (X7) = PREVIOUS FILE RANDOM ADDRESS.
*                (B6) = FILE COUNT.
*                (B7) = VSN COUNT.
*
*         USES   A - 1, 2, 3, 6.
*                B - 2.
*                X - 1, 2, 3.
*
*         CALLS  UFA.
*
*         MACROS GFILEV, MOVE, MOVEBIT, RJUST, SAFET.
 
 
 GFI3     SA3    GFIC        SET DEFAULT CATALOG IMAGE IN BUFFER
          MOVE   TCEL,DFIC,X3
          SA2    GFIC        SET DEFAULT FILE IDENTIFIER
          MOVEBIT  GFIB,X2+/CAT/FI,/BTC/FI,,/UPB/FI
          SA2    GFIC        SET DEFAULT PHYSICAL IDENTIFIER
          MOVEBIT  GFIB,X2+/CAT/PI,/BTC/PI,,/UPB/PI
          SA2    GFIC        SET SYMBOLIC ACCESS FLAG
          MOVEBIT  (=1),X2+/CAT/SV,/BTC/SV,/BTC/SV-1,/UPB/SV
          SB7    B0          SET VSN COUNT
          SB6    B1          SET FILE COUNT
          SX7    B0          SET PREVIOUS FILE RANDOM ADDRESS
          SX6    B0          SET FILE CATALOG RANDOM ADDRESS
          SX4    B1          FLAG FILE NOT FOUND
 
 GFI      SUBR               ENTY/EXIT
          BX6    X1          SAVE USER NAME
          SA6    GFIA
          BX6    X2          SAVE FILE IDENTIFIER
          SA6    GFIB
          BX6    X3
          SA6    A6+B1
          SX6    B6          SAVE FILE CATALOG BUFFER ADDRESS
          SA6    GFIC
          SX6    B7          SAVE PREVIOUS FILE BUFFER ADDRESS
          SA6    GFID
          SX6    B2          SAVE VSN BUFFER ADDRESS
          SA6    GFIE
          NZ     B4,GFI3     IF NO VERIFY
          SAFET  GFIA,,GFIB,SCST  SET AUDIT FET
          NZ     X4,GFI3     IF FILE NOT FOUND
          SA1    GFIC        SET BUFFER ADDRESSES
          SB6    X1
          SA1    GFIE
          SB2    X1
          RJ     UFA         UNPACK FILE AUDIT
          SA6    GFIF        SAVE CATALOG RANDOM ADDRESS
          SA1    GFIC        GET SEQUENCE NUMBER
          SA3    X1+/CAT/QN
          RJUST  X3,X3,/BTC/QN,/UPB/QN
          SX3    X3-1
          NZ     X3,GFI2     IF MULTI-FILE
          SA1    X1+/CAT/NCAT  CHECK NEXT CATALOG RANDOM ADDRESS
          RJUST  X1,X1,/BTC/NCAT,/UPB/NCAT
          NZ     X1,GFI2     IF MULTI-FILE
          SA1    A1+/CAT/REELC-/CAT/NCAT  SET VSN COUNT
          RJUST  X1,X1,/BTC/REELC,/UPB/REELC
          SB7    X1
          SB6    B1          SET FILE COUNT
          SX7    B0          SET PREVIOUS FILE RANDOM ADDRESS
          SA1    GFIF        SET FILE CATALOG RANDOM ADDRESS
          BX6    X1
          EQ     GFIX        RETURN
 
 GFI2     SA2    GFIE        SET ADDRESS OF FIRST VSN
          SA4    GFIC        SET FILE CATALOG BUFFER ADDRESS
          SB6    X4
          SA4    GFID        SET PREVIOUS FILE BUFFER ADDRESS
          SB2    X2          SET VSN BUFFER ADDRESS
          GFILEV GFIA,X2,X3+B1,B6,X4,B2  GET FILE CATALOG VIA VSN
          EQ     GFIX        RETURN
 
 GFIA     BSS    1           USER NAME
 GFIB     BSS    2           FILE IDENTIFIER
 GFIC     BSS    1           FILE CATALOG BUFFER ADDRESS
 GFID     BSS    1           PREVIOUS FILE BUFFER ADDRESS
 GFIE     BSS    1           VSN BUFFER ADDRESS
 GFIF     BSS    1           FILE CATALOG RANDOM ADDRESS
 GFV      SPACE  4,30
**        GFV - GET FILE CATALOG VIA VSN.
*
*         ENTRY  (X1) = USER NAME.
*                (X2) = VSN.
*                (X3) = SEQUENCE NUMBER.
*                (B2) = VSN BUFFER ADDRESS.
*                (B4) = 0 IF VERIFY FILE STATUS.
*                     .NE. 0 IF ASSUME FILE NOT FOUND.
*                (B6) = FILE BUFFER ADDRESS.
*                (B7) = PREVIOUS FILE BUFFER ADDRESS.
*
*         EXIT   (X4) = 0 IF FILE FOUND.
*                     = 1 IF FILE NOT FOUND.  DEFAULT USED.
*                     = -1 IF INCORRECT SEQUENCE NUMBER.
*                     = -2 IF VSN UNAVAILABLE.
*                (X6) = FILE CATALOG RANDOM ADDRESS.
*                (X7) = PREVIOUS FILE CATALOG RANDOM ADDRESS.
*                (B6) = FILE COUNT.
*                (B7) = VSN COUNT.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  UFA.
*
*         MACROS LISTVSN, MOVE, MOVEBIT, REPVSN, RJUST, SAFET.
 
 
 GFV11    SA1    GFVH        GET FILE COUNT
          SB6    X1
          SA1    GFVI        GET VSN COUNT
          SB7    X1
          SA1    GFVJ        GET FILE RANDOM ADDRESS
          BX6    X1
          SA1    GFVK        GET PREVIOUS FILE RANDOM ADDRESS
          BX7    X1
 
 GFV      SUBR               ENTRY/EXIT
          BX6    X1          SAVE USER NAME
          SA6    GFVA
          BX6    X2          SAVE VSN
          SA6    GFVB
          SX6    X3          SAVE SEQUENCE NUMBER
          SA6    GFVC
          SX6    B6          SAVE FILE BUFFER ADDRESS
          SA6    GFVD
          SX6    B7          SAVE PREVIOUS FILE BUFFER ADDRESS
          SA6    GFVE
          SX6    B2          SAVE VSN BUFFER ADDRESS
          SA6    GFVF
          SX6    B4          SAVE NO VERIFY FLAG
          SA6    GFVG
          SX6    B0          CLEAR FILE COUNT
          SA6    GFVH
          SA6    GFVI        CLEAR VSN COUNT
          SA6    GFVJ        CLEAR CATALOG RANDOM ADDRESS
          SA6    GFVK        CLEAR PREVIOUS CATALOG RANDOM ADDRESS
          SA6    GFVL        CLEAR LAST VSN
          ZR     B4,GFV1     IF VERIFY STATUS
          SX3    X3-1
          ZR     X3,GFV7     IF FIRST FILE
 GFV1     SAFET  GFVA,GFVB,,SCST  SET AUDIT FET
          NZ     X4,GFV7     IF NO FILE FOR USER
 GFV2     SB6    WBUF        SET FILE BUFFER
          SB2    WBUF+TCEL   SET VSN BUFFER
          RJ     UFA         UNPACK FILE AUDIT
          NZ     X4,GFV6     IF END OF AUDIT
          SA1    GFVH        INCREMENT FILE COUNT
          SX7    X1+B1
          SA7    A1
          SA1    GFVC        COMPARE TO SEQUENCE NUMBER
          IX7    X1-X7
          NG     X7,GFV4     IF FILE ALREADY FOUND
          SA3    GFVE        GET PREVIOUS FILE BUFFER ADDRESS
          SB2    GFVK        GET PREVIOUS RANDOM ADDRESS ADDRESS
          NZ     X7,GFV3     IF FILE NOT YET FOUND
          SA3    GFVD        GET FILE BUFFER ADDRESS
          SB2    GFVJ        GET RANDOM ADDRESS ADDRESS
 GFV3     SA6    B2          SET RANDOM ADDRESS
          MOVE   TCEL,WBUF,X3  SET CATALOG IMAGE IN BUFFER
 GFV4     SA3    GFVI        INCREMENT VSN COUNT
          SA2    WBUF+/CAT/REELC
          RJUST  X2,X1,/BTC/REELC,/UPB/REELC
          IX6    X1+X3
          LX1    2           SET SIZE OF VSN BUFFERS
          LX3    2
          SB2    B0
          MX0    VSKL*6      COMPARE LAST VSN TO EXTERNAL VSN
          SA2    GFVL
          SA4    WBUF+TCEL
          BX2    X2-X4
          BX2    X0*X2
          NZ     X2,GFV5     IF VSNS NOT THE SAME
          SB2    -4          FLAG MATCHING VSNS
          SX6    X6-1        DECREMENT VSN COUNT
 GFV5     SA6    A3          RESET VSN COUNT
          SA2    X1+WBUF+TCEL-4  RESET LAST VSN
          BX6    X2
          SA6    GFVL
          SA4    GFVF        GET VSN BUFFER ADDRESS
          IX3    X4+X3
          MOVE   X1,WBUF+TCEL,X3+B2  SET VSNS IN BUFFER
          EQ     GFV2        CHECK NEXT FILE
 
 GFV6     SA1    GFVH
          ZR     X1,GFV7     IF NO FILES
          SA2    GFVC        CHECK IF FILE FOUND
          IX6    X1-X2
          SX4    B0
          PL     X6,GFV11    IF FILE FOUND
          SX6    X6+B1       CHECK IF VALID SEQUENCE NUMBER
          SX4    -B1
          NZ     X6,GFV11    IF INCORRECT SEQUENCE NUMBER
          SA3    GFVD        SET DEFAULT FILE CATALOG
          MOVE   TCEL,DFIC,X3
          SA2    GFVD        SET SEQUENCE NUMBER IN CATALOG
          MOVEBIT  GFVC,X2+/CAT/QN,/BTC/QN,/BTC/QN-1,/UPB/QN
          SX4    B1
          EQ     GFV11       SET FILE COUNT
 
 GFV7     SA1    GFVC        CHECK IF VALID SEQUENCE NUMBER
          SX1    X1-1
          SX4    -B1
          NZ     X1,GFV11    IF INCORRECT SEQUENCE NUMBER
          LISTVSN  GFVB,GFVM,1  LIST VSN ENTRY
          ZR     X4,GFV8     IF VSN FOUND
          SX4    -2
          EQ     GFV11       SET FILE COUNT
 
 GFV8     SA1    GFVG
          NZ     X1,GFV9     IF NO VERIFY
          SA1    GFVM+/CAT/VSBF  CHECK IF VSN IS BUSY
          RJUST  X1,X1,/BTC/VSBF,/UPB/VSBF
          SX4    -2
          NZ     X1,GFV11    IF VSN IS BUSY
          SA1    GFVM+/CAT/VASF  CHECK IF VSN IS ASSIGNED
          RJUST  X1,X1,/BTC/VASF,/UPB/VASF
          NZ     X1,GFV10    IF VSN IS ASSIGNED TO ANOTHER USER
          SA1    LF
          NZ     X1,GFV9     IF LOCAL FILE MODE
          SA1    GFVM+/CAT/NVSN  CHECK IF IN SCRATCH POOL
          LJUST  X1,X1,/BTC/NVSN,/UPB/NVSN
          NZ     X1,GFV10    IF IN SCRATCH POOL
 GFV9     SA3    GFVD        SET DEFAULT FILE CATALOG
          MOVE   TCEL,DFIC,X3
          SA3    GFVF        SET ASSIGNED VSN
          MOVE   TSVL,GFVM,X3
          SA2    GFVD        SET EXTERNAL VSN
          MOVEBIT  GFVM+/CAT/VSN,X2+/CAT/EVSN,/BTC/EVSN,,/UPB/EVSN
          SA2    GFVD        SET INTERNAL VSN
          MOVEBIT  GFVM+/CAT/PRN,X2+/CAT/IVSN,/BTC/IVSN,,/UPB/IVSN
          SA2    GFVD        SET REEL COUNT
          SA2    X2+/CAT/REELC
          MOVEBIT  (=1),A2,/BTC/REELC,/BTC/REELC-1,/UPB/REELC
          SX6    B1          SET FILE COUNT
          SA6    GFVH
          SA6    GFVI        SET VSN COUNT
          SX4    B1
          EQ     GFV11       SET FILE COUNT
 
 GFV10    MOVEBIT  (=0),GFVM+/CAT/VSBF,/BTC/VSBF,,/UPB/VSBF
          REPVSN GFVM,4      REPLACE VSN ENTRY
          SX4    -2
          EQ     GFV11       SET FILE COUNT
 
 GFVA     BSS    1           USER NAME
 GFVB     BSS    1           VSN
 GFVC     BSS    1           SEQUENCE NUMBER
 GFVD     BSS    1           FILE BUFFER ADDRESS
 GFVE     BSS    1           PREVIOUS FILE BUFFER ADDRESS
 GFVF     BSS    1           VSN BUFFER ADDRESS
 GFVG     BSS    1           NO VERIFY FLAG
 GFVH     BSS    1           FILE COUNT
 GFVI     BSS    1           VSN COUNT
 GFVJ     BSS    1           FILE RANDOM ADDRESS
 GFVK     BSS    1           PREVIOUS FILE RANDOM ADDRESS
 GFVL     BSS    1           LAST VSN
 GFVM     BSS    TSVL        VSN ENTRY BUFFER
 GRE      SPACE  4,15
**        GRE - GET RECORD ENTRY.
*
*         ENTRY  (X1) = ENTRY BUFFER ADDRESS.
*                (X2) = TAPE CATALOG FET ADDRESS.
*                FET BUFFER CONTAINS IMAGE OF ONE RECORD
*                OF TAPE CATALOG FILE.
*
*         EXIT   (X6) = 0 IF NO MORE ENTRIES.
*                CURRENT ENTRY IMAGE IN ENTRY BUFFER.
*
*         USES   A - 1, 3.
*                X - 0, 1, 3, 4.
*
*         MACROS RCREC, READFET, RJUST.
 
 
 GRE      SUBR               ENTRY/EXIT
          SX6    X1          SAVE ENTRY BUFFER ADDRESS
          SA6    GREA
 GRE1     SA1    X2+B1       CHECK IF FIRST READ OF RECORD
          SX1    X1
          SA3    X2+3
          IX3    X3-X1
          NZ     X3,GRE2     IF NOT FIRST READ
          READFET  X2,GREB,TBHL  POSITION PAST BUFFER CONTROL WORD
 GRE2     SA1    X2+B1       GET ENTRY COUNT
          SA3    X1
          RJUST  X3,X6,12,23
          RJUST  X3,X3,12,23 GET ENTRY LENGTH
          IX6    X6*X3
          SX4    X1+4        CHECK IF ANY ENTRIES LEFT
          IX4    X4+X6
          SA1    X2+3
          IX4    X1-X4
          PL     X4,GRE3     IF NO MORE ENTRIES
          SA1    GREA        GET NEXT ENTRY
          READFET  X2,X1,X3
          SX6    B1          FLAG ENTRY FOUND
          EQ     GREX        RETURN
 
 GRE3     MX0    -24         CHECK NEXT RANDOM ADDRESS
          SA1    X2+TFRR
          BX6    -X0*X1
          ZR     X6,GREX     IF NO MORE RECORDS
          RCREC  X2,X6       READ NEXT RECORD
          EQ     GRE1        PROCESS NEXT ENTRY
 
 GREA     BSS    1           ENTRY BUFFER ADDRESS
 GREB     BSS    TBHL        BUFFER CONTROL WORD BUFFER
 LVS      SPACE  4,15
**        LVS - LIST VSN ENTRY.
*
*         ENTRY  (X1) = VSN.
*                (B2) = 0 IF NO INTERLOCK OF VSN.
*                     = 1 IF INTERLOCK VSN.
*                (B6) = VSN BUFFER ADDRESS.
*
*         EXIT   (X4) = 0 IF VSN FOUND.
*                VSN ENTRY IMAGE SET IN BUFFER.
*                DEFAULT SET IN BUFFER IF NOT FOUND.
*
*         USES   A - 1, 2, 3, 4, 6.
*                X - 1, 2, 3.
*
*         MACROS CALLTFM, MOVE, MOVEBIT, RESETP, WRITFET.
 
 
 LVS      SUBR               ENTRY/EXIT
          BX6    X1          SAVE VSN
          SA6    LVSA
          SX6    B6          SAVE VSN BUFFER ADDRESS
          SA6    LVSB
          SX6    B2          SAVE INTERLOCK STATUS
          SA6    LVSC
          MOVE   TSVL,DVSC,B6  SET DEFAULT VSN IMAGE
          SA2    LVSB
          MOVEBIT  LVSA,X2+/CAT/VSN,/BTC/VSN,,/UPB/VSN
          SA2    LVSB
          MOVEBIT  LVSA,X2+/CAT/PRN,/BTC/PRN,,/UPB/PRN
          RESETP N1          SET VSN ENTRY IMAGE IN FET
          SA1    LVSB
          WRITFET  X2,X1,4
          SA1    LVSC        CHECK INTERLOCK STATUS
          SX6    LVES        SET FUNCTION CODE
          ZR     X1,LVS1     IF NO INTERLOCK
          SX6    -LVES       SET FUNCTION CODE WITH INTERLOCK
 LVS1     CALLTFM  X2,X6     LIST VSN ENTRY
          SX6    X4          SAVE ERROR CODE
          SA6    LVSD
          SA3    LVSB        SET VSN ENTRY IMAGE IN BUFFER
          MOVE   TSVL,N1BUF,X3
          SA1    LF
          ZR     X1,LVS2     IF NOT LOCAL FILE MODE
          SA2    LVSB        CLEAR VSN BUSY FLAG
          MOVEBIT  (=0),X2+/CAT/VSBF,/BTC/VSBF,,/UPB/VSBF
 LVS2     SA4    LVSD
          EQ     LVSX        RETURN
 
 LVSA     BSS    1           VSN
 LVSB     BSS    1           VSN ENTRY BUFFER ADDRESS
 LVSC     BSS    1           INTERLOCK STATUS
 LVSD     BSS    1           ERROR CODE
 MBS      SPACE  4,20
**        MBS - MOVE BIT STRING.
*
*         ENTRY  (A1) = ADDRESS OF SOURCE STRING.
*                (A2) = ADDRESS OF DESTINATION STRING.
*                (B2) = UPPER BIT POSITION OF DESTINATION STRING.
*                (B3) = UPPER BIT POSITION OF SOURCE STRING.
*                (B4) = BIT COUNT.
*                (X1) = FIRST WORD OF SOURCE STRING.
*                (X2) = FIRST WORD OF DESTINATION STRING.
*
*         EXIT   (A1) = ADDRESS OF REMAINDER OF SOURCE STRING.
*                (A2) = ADDRESS OF REMAINDER OF DESTINATION STRING.
*                (B2) = UPPER BIT POSITION OF REMAINDER OF DESTINATION
*                       STRING.
*                (B3) = UPPER BIT POSITION OF REMAINDER OF SOURCE
*                       STRING.
*
*         USES   B - 4.
*                X - 1, 2.
*
*         CALLS  SBS.
 
 
 MBS      SUBR               ENTRY/EXIT
 MBS1     LE     B4,MBSX     IF NO MORE BITS TO TRANSFER
          RJ     SBS         SET BIT STRING
          SA6    A2          SET NEW STRING
          BX2    X6
          PL     B2,MBS2     IF MORE BITS IN DESTINATION WORD
          SB2    59          RESET UPPER BIT POSITION
          SA2    A2+B1       RESET DESTINATION ADDRESS
 MBS2     PL     B3,MBS1     IF MORE BITS IN SOURCE WORD
          SB3    59          RESET UPPER BIT POSITION
          SA1    A1+B1       RESET SOURCE ADDRESS
          EQ     MBS1        CHECK BIT COUNT
 MTO      SPACE  4,15
**        MTO - ISSUE MESSAGE TO OUTPUT.
*
*         ENTRY  (B2) = 0 IF INFORMATIVE MESSAGE.
*                     = 1 IF ERROR MESSAGE.
*                (B5) = MESSAGE ADDRESS.
*
*         EXIT   MESSAGE ISSUED TO OUTPUT FILE/K-DISPLAY.
*
*         USES   A - 1, 2, 6.
*                B - 2, 7.
*                X - 1, 2, 6.
*
*         CALLS  IRL.
*
*         MACROS CWORDS, MOVE, WLINES.
 
 
 MTO      SUBR               ENTRY/EXIT
          SX6    B5          SAVE MESSAGE ADDRESS
          SA6    MTOA
          SA2    =10H *INFORM*
          ZR     B2,MTO1     IF INFORMATIVE MESSAGE
          SX6    B1          SET ERROR FLAG
          SA6    EF
          SA6    DM          SET DIRECTIVE MESSAGE FLAG
          SA2    =10H *ERROR*
 MTO1     BX6    X2          SET START OF MESSAGE IN K-DISPLAY
          SA6    /KMESS/MESSAGE+0
          CWORDS B5,1        COUNT WORDS IN LINE
          SX6    B0          FLAG END OF K-DISPLAY
          SA6    B6+/KMESS/MESSAGE+1
          SA2    MTOA        SET MESSAGE IN K-DISPLAY
          MOVE   B6,X2,/KMESS/MESSAGE+1
          SA1    BF          CHECK IF *BRIEF* MODE
          ZR     X1,MTO2     IF NOT *BRIEF* MODE
          SA1    DM          CHECK MESSAGE TYPE
          ZR     X1,MTOX     IF INFORMATIVE MESSAGE AND *BRIEF*
          WLINES  /KMESS/DIRECT,1   WRITE DIRECTIVE TO OUTPUT
 MTO2     WLINES  /KMESS/MESSAGE,1  WRITE MESSAGE TO OUTPUT
          SA1    DM          CHECK MESSAGE TYPE
          ZR     X1,MTOX     IF INFORMATIVE MESSAGE
          RJ     IRL         IGNORE REST OF INPUT LINE
          EQ     MTOX        RETURN
 
 MTOA     BSS    1           MESSAGE ADDRESS
 NPG      SPACE  4,15
**        NPG - NEW PAGE HEADER GENERATOR.
*
*         ENTRY  (HD) = ADDRESS OF HEADER BUFFER.
*                (HL) = LENGTH OF HEADER.
*                (PG) = PAGE NUMBER.
*
*         EXIT   PAGE HEADER WRITTEN TO OUTPUT FILE.
*
*         USES   A - 1, 2, 6.
*                B - 7.
*                X - 0, 1, 2, 6.
*
*         CALLS  CDD.
*
*         MACROS CLINES, WRITEW.
 
 
 NPG      SUBR               ENTRY/EXIT
          SA1    OS
          ZR     X1,NPGX     IF NO OUTPUT FILE
          PL     X1,NPG1     IF TERMINAL OUTPUT
          SA1    PG          RESET PAGE NUMBER
          SX1    X1+B1
          SX6    X1
          SA6    A1
          RJ     CDD         CONVERT CONSTANT TO DECIMAL DISPLAY
          MX0    24          RESET PAGE NUMBER IN HEADER
          BX6    -X0*X6
          SA1    =C*PAGE*
          BX6    X1+X6
          SA6    NPGE
          CLINES NPGA,NPGAL  COUNT LINES IN FIRST PART OF HEADER
          SX6    B7          SET LINE COUNT
          SA6    LC
          SB7    B6          WRITE FIRST PART OF HEADER TO OUTPUT FILE
          WRITEW L,A1-B6,B7
 NPG1     SA1    HD          COUNT LINES IN SECOND PART OF HEADER
          SA2    HL
          CLINES X1,X2
          SA2    LC          RESET LINE COUNT
          SX6    X2+B7
          SA6    A2
          SB7    B6          WRITE SECOND PART OF HEADER TO OUTPUT FILE
          WRITEW L,A1-B6,B7
          EQ     NPGX        RETURN
 
 NPGA     BSS    0           FIRST LINE OF PAGE HEADER
          DATA   H*1  TAPE FILE SUPERVISOR.      *
 NPGB     DATA   H$*TFSP*     FAMILY = $
 NPGC     DATA   H*                    *
 NPGD     DATA   H*YY/MM/DD. HH.MM.SS.           *
 NPGE     DATA   C*PAGE     1*
 NPGF     BSS    0           SECOND LINE OF PAGE HEADER
          DUP    9
          DATA   10H
          ENDD
 NPGG     BSS    0           DIRECTIVE IMAGE
          DATA   30H
          CON    0
 NPGAL    EQU    *-NPGA      LENGTH OF FIRST PART OF HEADER
 RCR      SPACE  4,15
**        RCR - READ CATALOG RECORD.
*
*         ENTRY  (X1) = RECORD RANDOM ADDRESS.
*                (X2) = FET ADDRESS.
*                (X3) = WORKING BUFFER ADDRESS.
*                     = 0 IF NO WORKING BUFFER.
*                (B2) .NE. 0 IF SET UTILITY INTERLOCK BEFORE READ.
*
*         EXIT   RECORD READ INTO BUFFER.
*
*         USES   A - 3, 6.
*                X - 3, 6.
*
*         CALLS  SUI.
*
*         MACROS CALLTFM, READFET, RESETP.
 
 
 RCR      SUBR               ENTRY/EXIT
          BX6    X1          SET RANDOM ADDRESS
          SA6    X2+TFRR
          SX6    X3          SAVE WORKING BUFFER ADDRESS
          SA6    RCRA
          ZR     B2,RCR1     IF NO INTERLOCK TO SET
          RJ     SUI         SET UTILITY INTERLOCK
 RCR1     RESETP X2          READ CATALOG RECORD
          CALLTFM  X2,RDRS
          SA3    RCRA        CHECK BUFFER ADDRESS
          ZR     X3,RCRX     IF NO WORKING BUFFER
          READFET  X2,X3,100B  MOVE TO WORKING BUFFER
          EQ     RCRX        RETURN
 
 RCRA     BSS    1           WORKING BUFFER ADDRESS
 RDF      SPACE  4,20
**        RDF - READ WORDS FROM FET INTO WORKING BUFFER.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (B6) = WORKING BUFFER ADDRESS.
*                (B7) = NUMBER OF WORDS TO TRANSFER.
*
*         EXIT   (X1) = 0 IF TRANSFER COMPLETE.
*                     = (B6) IF (B7).NE.0.
*                (X2) = FET ADDRESS.
*                (B6) = LWA+1 OF WORKING BUFFER.
*                (B7) = NUMBER OF WORDS NOT TRANSFERRED.
*
*         USES   A - 1, 3, 7.
*                X - 3, 6, 7.
*
*         MACROS READW.
 
 
 RDF      SUBR               ENTRY/EXIT
          SA1    X2+2        COMPARE *IN* TO *OUT*
          SA3    A1+B1
          IX6    X1-X3
          PL     X6,RDF1     IF *IN* .GE. *OUT*
          SA1    X2+B1       GET *FIRST*
          SX1    X1
          SA3    A3+B1       GET *LIMIT*
          SX3    X3
          IX1    X3-X1       GET NUMBER OF WORDS AVAILABLE IN BUFFER
          IX6    X6+X1
 RDF1     SX1    B7          CHECK IF ENOUGH WORDS IN BUFFER
          IX1    X6-X1
          SX7    B0
          PL     X1,RDF2     IF ENOUGH WORDS IN BUFFER
          SB7    X6          RESET WORD COUNT
          BX7    -X1
 RDF2     SA7    RDFA        SAVE NUMBER OF WORDS NOT TRANSFERRED
          READW  X2,B6,B7    TRANSFER FROM FET BUFFER
          SA1    RDFA
          ZR     X1,RDFX     IF TRANSFER COMPLETE
          SB7    X1          SET NUMBER OF WORDS NOT TRANSFERRED
          SX1    B6          SET LWA+1 OF BUFFER
          EQ     RDFX        RETURN
 
 RDFA     BSS    1           NUMBER OF WORDS NOT TRANSFERRED
 RLV      SPACE  4,15
**        RLV - RELEASE BY VSN.
*
*         ENTRY  (X1) = USER NAME.
*                (X2) = VSN.
*                (X3) = SEQUENCE NUMBER.
*
*         EXIT   (X4) = 0 IF RELEASE COMPLETE.
*                     .NE. 0 IF VSN NOT ASSIGNED TO USER.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  SMB.
*
*         MACROS CALLTFM, MOVEBIT, RESETP.
 
 
 RLV      SUBR               ENTRY/EXIT
          BX6    X1          SAVE USER NAME
          SA6    RLVA
          BX6    X2          SAVE VSN
          SA6    RLVB
          BX6    X3
          SA6    RLVC
          RESETP N3          SET FET FOR RELEASE
          MOVEBIT  RLVA,N3+TFUN,UNKL*6
          MOVEBIT  RLVB,N3+TFES,VSKL*6
          SX6    B0
          SA6    N3+TFID
          MOVEBIT  (=0),N3+TFID+1,FIKL*6-60
          MOVEBIT  RLVC,N3+TFID+1,15,14,14
          CALLTFM  N3,RTCS   RELEASE TAPE CATALOG FILE
          EQ     RLVX        RETURN
 
 RLVA     BSS    1           USER NAME
 RLVB     BSS    1           VSN
 RLVC     BSS    1           SEQUENCE NUMBER
 RVS      SPACE  4,15
**        RVS - REPLACE/ADD VSNS.
*
*         ENTRY  (B6) = VSN BUFFER ADDRESS.
*                (B7) = VSN BUFFER LENGTH.
*
*         EXIT   VSN ENTRIES REPLACED/ADDED.
*
*         USES   A - 1, 3, 6.
*                X - 1, 3, 6.
*
*         MACROS CALLTFM, RESETP, WRITFET.
 
 
 RVS      SUBR               ENTRY/EXIT
          ZR     B7,RVSX     IF NO VSNS TO REPLACE
          SX6    B6          SAVE BUFFER ADDRESS
          SA6    RVSA
          SX6    B7          SAVE BUFFER LENGTH
          SA6    RVSB
          RESETP N1          SET VSN BUFFER INTO FET BUFFER
          SA1    RVSA
          SA3    RVSB
          WRITFET  X2,X1,X3
          CALLTFM  X2,RVES   REPLACE/ADD VSN ENTRIES
          EQ     RVSX        RETURN
 
 RVSA     BSS    1           VSN BUFFER ADDRESS
 RVSB     BSS    1           VSN BUFFER LENGTH
 SAF      SPACE  4,20
**        SAF - SET AUDIT FET.
*
*         ENTRY  (X1) = USER NAME.
*                (X2) = VSN.
*                (X3) = FIRST TEN CHARACTERS OF FILE IDENTIFIER.
*                (X4) = LAST SEVEN CHARACTERS OF FILE IDENTIFIER.
*                (X6) = AUDIT RANDOM ADDRESS.
*                (B2) = AUDIT TYPE.
*
*         EXIT   (X4) = 0 IF NO ERROR IN AUDIT.
*                (N3 - N3+15B) = AUDIT FET.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         MACROS CALLTFM, MOVEBIT, RESETP.
 
 
 SAF      SUBR               ENTRY/EXIT
          SA6    SAFA        SAVE RANDOM ADDRESS
          BX6    X1          SAVE USER NAME
          SA6    SAFB
          BX6    X2          SAVE VSN
          SA6    SAFC
          BX6    X3          SAVE FILE IDENTIFIER
          SA6    SAFD
          BX6    X4
          SA6    A6+B1
          SX6    B2          SAVE AUDIT TYPE
          SA6    SAFE
          RESETP N3          RESET FET POINTERS
          SA1    SAFA        SET AUDIT RANDOM ADDRESS
          BX6    X1
          SA6    N3+TFRR
          MOVEBIT  SAFB,N3+TFUN,UNKL*6  SET USER NAME IN FET
          MOVEBIT  SAFC,N3+TFES,VSKL*6  SET VSN IN FET
          MOVEBIT  SAFD,N3+TFID,FIKL*6  SET FILE ID IN FET
          MOVEBIT  SAFE,N3+TFPW,3,2,2  SET AUDIT TYPE IN FET
          CALLTFM  N3,AUCS   ISSUE AUDIT REQUEST
          EQ     SAFX        RETURN
 
 SAFA     BSS    1           AUDIT RANDOM ADDRESS
 SAFB     BSS    1           USER NAME
 SAFC     BSS    1           VSN
 SAFD     BSS    2           FILE IDENTIFIER
 SAFE     BSS    1           AUDIT TYPE
 SBS      SPACE  4,20
**        SBS - SET BIT STRING.
*
*         ENTRY  (X1) = SOURCE STRING.
*                (X2) = DESTINATION STRING.
*                (B2) = UPPER BIT POSITION OF DESTINATION STRING.
*                (B3) = UPPER BIT POSITION OF SOURCE STRING.
*                (B4) = MAXIMUM BIT COUNT.
*
*         EXIT   (X6) = NEW STRING.
*                (B2) = LOWER BIT POSITION - 1 OF DESTINATION STRING.
*                     .LT. 0 IF STRING AT END OF WORD.
*                (B3) = LOWER BIT POSITION - 1 OF SOURCE STRING.
*                     .LT. 0 IF STRING AT END OF WORD.
*                (B4) = REMAINING BIT COUNT.
*                (B6) = NUMBER OF BITS TRANSFERRED.
*
*         USES   B - 7.
*                X - 0, 7.
 
 
 SBS      SUBR               ENTRY/EXIT
          SB6    B4-B1
          LE     B6,B3,SBS1  IF UPPER BIT OF SOURCE .GT. BIT COUNT
          SB6    B3
 SBS1     LE     B6,B2,SBS2  IF UPPER BIT OF DESTINATION .GT. COUNT
          SB6    B2
 SBS2     BX6    X2          PRESET DESTINATION IMAGE
          NG     B6,SBS4     IF NO BIT COUNT
          MX0    1           CREATE MASK
          AX0    B6
          SB7    B3+B1       GET SOURCE STRING
          LX0    B7
          BX6    X0*X1
          SB7    B2-B3       GET DESTINATION IMAGE
          PL     B7,SBS3     IF VALID SHIFT COUNT
          SB7    B7+60
 SBS3     LX0    B7
          BX0    -X0*X2
          LX6    B7          SET NEW IMAGE
          BX6    X0+X6
 SBS4     SB6    B6+B1       SET NUMBER OF BITS SET
          SB2    B2-B6       RESET UPPER BIT POSITIONS
          SB3    B3-B6
          SB4    B4-B6       RESET BIT COUNT
          EQ     SBSX        RETURN
 SST      SPACE  4,20
**        SST - SET SOURCE VALUES IN TABLE.
*
*         ENTRY  (B2) = 0 IF K-DISPLAY TABLE.
*                       1 IF AUDIT TABLE.
*                       2 IF SOURCE FILE TABLE.
*                (X1) = DIRECTIVE LEVEL.
*
*         EXIT   SOURCE VALUES SET IN TABLE.
*
*         USES   A - 1, 2, 6.
*                B - 2, 3, 4.
*                X - 0, 1, 2, 6.
*
*         CALLS  CXS.
*
*         MACROS MOVEBIT.
 
 
 SST      SUBR               ENTRY/EXIT
          SX2    B2          SET LOWER BIT POSITION OF TABLE ADDRESS
          LX2    59-0
          SX6    B0
          NG     X2,SST1     IF LOWER BIT 0
          SX6    30
 SST1     SA6    SSTA
          SX6    B2          SET ADDRESS OF TABLE ADDRESS
          AX6    1
          SX6    CXSA+3+X6
          SA6    SSTB
          SA1    TDTA+X1     GET DIRECTIVE TABLE ADDRESSES
          SX6    X1+B1       SAVE NEXT ADDRESS
          SA6    SSTC
 SST2     SA1    X1
          ZR     X1,SSTX     IF END OF DIRECTIVE TABLES
          RJ     CXS         CONVERT CATALOG ENTRY TO SOURCE
          NG     B3,SST4     IF NO DIRECTIVE CONTROL TABLE
          SA1    CXSA+2
          PL     X1,SST4     IF NO OUTPUT CONTROL BLOCK
          SA1    SSTB        GET TABLE ADDRESS
          SA1    X1
          SA2    SSTA
          SB2    X2
          AX1    B2
          SX2    X1
          ZR     X2,SST4     IF NO TABLE ADDRESS
          MX0    -6          GET UPPER BIT POSITION
          AX1    18
          BX6    -X0*X1
          SB2    X6
          LX1    48          GET CHARACTER COUNT
          AX1    6+48
          SB3    59          PRESET DATA FIELD BIT POSITION
          SX6    6
          IX1    X1*X6
          SB4    X1          PRESET BIT COUNT
          PL     X1,SST3     IF CHARACTERS COUNTED FROM LEFT
          SB4    -B4         RESET BIT COUNT
          SB3    B4-B1       RESET BIT POSITION
 SST3     MOVEBIT  CBUF+1,X2,B4,B3,B2  MOVE DATA FIELD TO SOURCE FIELD
 SST4     SA1    SSTC        GET DIRECTIVE TABLE ADDRESS
          SX6    X1+B1       SAVE NEXT ADDRESS
          SA6    A1
          EQ     SST2        GET DIRECTIVE TABLE IMAGE
 
 SSTA     CON    30          LOWER BIT POSITION OF TABLE ADDRESS
 SSTB     CON    CXSA+3      ADDRESS OF TABLE ADDRESS
 SSTC     BSS    1           DIRECTIVE TABLE ADDRESS
 STB      SPACE  4,20
**        STB - SEARCH TABLE.
*
*         ENTRY  (A1) = TABLE ADDRESS.
*                (B2) = TABLE LENGTH.
*                     .LT. 0 IF TERMINATED BY A ZERO WORD.
*                (B3) = ENTRY LENGTH.
*                (B4) = RELATIVE ADDRESS IN ENTRY.
*                (X0) = MASK.
*                (X2) = VALUE TO COMPARE AGAINST.
*
*         EXIT   (A1) = ADDRESS OF ENTRY IF FOUND.
*                (A3) = (A1) + (B4).
*                (B7) = RELATIVE ADDRESS IN TABLE IF FOUND.
*                (X1) = FIRST WORD OF ENTRY IF FOUND.
*                (X3) = ENTRY WORD WITH VALUE.
*                (X4) .NE. 0 IF ENTRY NOT FOUND.
*
*         USES   B - 6.
 
 
 STB1     ZR     X1,STBX     IF END OF TABLE
 STB2     BX4    X3-X2       COMPARE ENTRIES
          BX4    X0*X4
          ZR     X4,STBX     IF ENTRY FOUND
          SB7    B7+B3       GET NEXT ENTRY IN TABLE
          SA1    A1+B3
          SA3    A3+B3
          NG     B2,STB1     IF TABLE TERMINATED BY A ZERO WORD
          SB6    B7-B2
          NG     B6,STB2     IF NOT END OF TABLE
 
 STB      SUBR               ENTRY/EXIT
          SA3    A1+B4       POSITION FIRST ENTRY
          SB7    B4
          SX4    B1          PRESET ENTRY NOT FOUND
          ZR     B2,STBX     IF NO TABLE
          PL     B2,STB2     IF TABLE LENGTH SPECIFIED
          EQ     STB1        CHECK FOR END OF TABLE
 TLD      SPACE  4,25
**        TLD - TABLE LIST TO DISPLAY PROCESSOR.
*
*         ENTRY  (A1) = ADDRESS OF TABLE.
*                (A2) = ADDRESS OF DISPLAY.
*                (B3) = TABLE LENGTH.
*                (B4) = BIT COUNT OF ENTRY.
*                (B6) = BIT COUNT OF IMAGE BETWEEN ENTRIES.
*                (X6) = IMAGE BETWEEN ENTRIES, RIGHT JUSTIFIED.
*                (X7) = NUMBER OF ENTRIES PER DISPLAY LINE.
*
*         EXIT   (A1) = LWA+1 OF TABLE.
*                (A2) = LWA+1 OF DISPLAY.
*                (X3) = LAST BIT POSITION + 1 OF DISPLAY.
*
*         USES   A - 3, 4, 5, 6, 7.
*                B - 2, 4.
*                X - 1, 2, 4, 5, 6, 7.
*
*         CALLS  FEL, ZTB.
*
*         MACROS MOVEBIT.
 
 
 TLD8     SA3    TLDI        SET LAST BIT POSITION + 1 OF DISPLAY
 
 TLD      SUBR               ENTRY/EXIT
          SA6    TLDA        SET *BETWEEN* IMAGE
          SX6    B6-B1       SET UPPER BIT POSITION OF IMAGE
          SA6    TLDB
          SX6    B6+B4       SET BIT COUNT OF IMAGE
          SA6    TLDC
          SX6    B3
          NG     B3,TLD1     IF ZERO-WORD TERMINATED TABLE
          SX6    A1+B3
 TLD1     SA6    TLDD        SET LWA+1 OF TABLE
          SA7    TLDE        SET ENTRIES PER DISPLAY LINE
          SX6    B0          SET ENTRY COUNT
          SA6    TLDF
          SX6    B0          PRESET ONE WORD PER ENTRY FLAG
          SB4    B4-60
          NG     B4,TLD2     IF ONE WORD PER ENTRY
          SX6    B1          SET TWO WORDS PER ENTRY FLAG
 TLD2     SA6    TLDG
          SX6    A1          SET TABLE ADDRESS
          SA6    TLDH
          SX6    59          SET UPPER BIT POSITION OF DISPLAY
          SA6    TLDI
 TLD3     SA1    TLDH        GET ADDRESS OF TABLE
          SA3    TLDD        GET LWA+1 OF TABLE
          IX6    X1-X3
          SA1    X1
          NG     X3,TLD4     IF ZERO-WORD TERMINATED
          PL     X6,TLD8     IF END OF TABLE
          EQ     TLD5        SPACE FILL NAME
 
 TLD4     ZR     X1,TLD8     IF END OF TABLE
 TLD5     RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA6    TLDA+1      SET ENTRY IN IMAGE
          SA3    TLDG
          ZR     X3,TLD6     IF ONE WORD PER ENTRY
          SA1    A1+B1       GET REST OF ENTRY
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA6    A6+B1       SET REST OF ENTRY IN IMAGE
 TLD6     SX6    A1+B1       RESET TABLE ADDRESS
          SA6    TLDH
          SA3    TLDC        GET BIT COUNT OF IMAGE
          SA4    TLDB        GET UPPER BIT POSITION OF IMAGE
          SA5    TLDI        GET UPPER BIT POSITION OF DISPLAY
          MOVEBIT  TLDA,A2,X3,X4,X5  MOVE IMAGE TO DISPLAY
          SA1    TLDF        RESET ENTRY COUNT
          SX6    X1+B1
          SA6    A1
          SA1    TLDE        COMPARE TO ENTRIES PER LINE
          IX6    X6-X1
          SA2    A2          PRESET DISPLAY ADDRESS
          NZ     X6,TLD7     IF NOT LAST ENTRY ON LINE
          SA6    A6
          SX3    B2
          RJ     FEL         FORCE END OF LINE
          SB2    59          RESET UPPER BIT POSITION
 TLD7     SX6    B2
          SA6    TLDI
          EQ     TLD3        CHECK FOR END OF TABLE
 
 TLDA     BSS    3           IMAGE OF ENTRY
 TLDB     BSS    1           UPPER BIT POSITION OF IMAGE
 TLDC     BSS    1           LENGTH OF IMAGE
 TLDD     BSS    1           LWA+1 OF TABLE
 TLDE     BSS    1           ENTRIES PER LINE
 TLDF     BSS    1           ENTRY COUNT
 TLDG     BSS    1           TWO WORD ENTRY FLAG
 TLDH     BSS    1           ADDRESS OF TABLE
 TLDI     BSS    1           UPPER BIT POSITION OF DISPLAY
 TSL      SPACE  4,20
**        TSL - TABLE ENTRIES TO SINGLE ENTRY LIST PROCESSOR.
*
*         ENTRY  (X6) = TABLE ADDRESS.
*                (X7) = LIST ADDRESS.
*                (B2) = TABLE LENGTH.
*                     .LT. 0 IF ZERO WORD TERMINATED.
*                (B3) = RELATIVE ADDRESS IN ENTRY.
*                (B4) = ENTRY LENGTH.
*                (B5) = BIT COUNT.  MUST BE .LE. 120.
*
*         EXIT   (X1) = LWA+1 OF TABLE.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - 2, 3, 4, 6, 7.
*
*         MACROS MOVEBIT.
 
 
 TSL6     SA1    TSLA        RETURN LWA+1 OF TABLE
 
 TSL      SUBR               ENTRY/EXIT
          SA6    TSLA        SAVE TABLE ADDRESS
          SA7    TSLF        SAVE LIST ADDRESS
          SX6    X6+B2
          PL     B2,TSL1     IF NOT ZERO WORD TERMINATED
          SX6    B2
 TSL1     SA6    TSLB        SAVE LWA+1 OF TABLE
          SX6    B3          SAVE RELATIVE ADDRESS IN ENTRY
          SA6    TSLC
          SX6    B4          SAVE ENTRY LENGTH
          SA6    TSLD
          SX6    B5          SAVE BIT COUNT
          SA6    TSLE
 TSL2     SA1    TSLA        GET TABLE ADDRESS
          SA2    TSLB        GET LWA+1 OF TABLE
          SA3    TSLC        GET RELATIVE ADDRESS IN TABLE
          SA4    TSLD        GET ENTRY LENGTH
          IX6    X1+X3       SET ADDRESS OF ENTRY
          IX7    X1+X4       SET ADDRESS OF NEXT ENTRY
          SA1    X1
          PL     X2,TSL3     IF NOT ZERO WORD TERMINATED
          ZR     X1,TSL6     IF END OF TABLE
          EQ     TSL4        MOVE TABLE ENTRY TO LIST
 
 TSL3     IX2    X6-X2
          PL     X2,TSL6     IF END OF TABLE
 TSL4     SA3    TSLE        GET BIT COUNT
          SA2    TSLF        GET LIST ADDRESS
          SA7    TSLA        RESET TABLE ADDRESS
          SX7    X2+B1       RESET LIST ADDRESS
          SX4    X3-61
          NG     X4,TSL5     IF LESS THAN 60 BITS
          SX7    X7+B1
 TSL5     SA7    A2          RESET LIST ADDRESS
          MOVEBIT  X6,X2,X3  MOVE ENTRY FROM TABLE TO LIST
          EQ     TSL2        CHECK NEXT ENTRY
 
 TSLA     BSS    1           TABLE ADDRESS
 TSLB     BSS    1           LWA+1 OF TABLE
 TSLC     BSS    1           RELATIVE ADDRESS IN ENTRY
 TSLD     BSS    1           ENTRY LENGTH
 TSLE     BSS    1           BIT COUNT
 TSLF     BSS    1           LIST ADDRESS
 USA      SPACE  4,20
**        USA - USER AUDIT LIST PROCESSOR.
*
*         ENTRY  (X1) = 0 IF IGNORE CHARGE NUMBER.
*                     = CHARGE NUMBER.
*                (X2) = VSN.
*                     = 0 IF AUDIT ALL FILES.
*                (B2) = 1 IF *AUDIT*.
*                     = 2 IF *SOURCE*.
*                     = 3 IF *MACHINE READABLE.*
*                     = 4 IF *SOURCE* WITHOUT VSNS.
*
*         EXIT   FILES PROCESSED FOR USER NAME.
*
*         USES   A - 1, 2, 6.
*                B - 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  FIA, FIS, PMF, PSF, UFA.
*
*         MACROS CLEAR, LJUST, MOVEBIT, RJUST, SAFET.
 
 
 USA8     SX4    B0          PRESET NO ERRORS
          SA1    UASB
          NZ     X1,USAX     IF FILES FOUND
          SX4    B1          FLAG ERRORS
 
 USA      SUBR               ENTRY/EXIT
          SX6    B2          SAVE TYPE
          SA6    USAC
          BX6    X1          SAVE CHARGE NUMBER
          SA6    USAA
          BX6    X2          SAVE VSN
          SA6    USAD
          SX6    B0          SET RANDOM ADDRESS TO ZERO
          SA6    UASB        FLAG NO FILES FOUND
          SB2    FCST
          ZR     X2,USA1     IF NO VSN
          SB2    SCST
 USA1     SAFET  UN,USAD,,B2 SET FET FOR AUDIT
          NZ     X4,USAX     IF NO FILES FOUND
 USA2     CLEAR  TAVS,TAVSL  CLEAR VSN BUFFER
          SB6    FCAT        SET BUFFER ADDRESSES
          SB2    TAVS
          RJ     UFA         UNPACK FILE AUDIT
          NZ     X4,USA8     IF AUDIT COMPLETE
          SA1    TI
          NZ     X1,USA8     IF TERMINAL INTERRUPT
          SA1    USAA
          ZR     X1,USA3     IF NO CHARGE NUMBER
          SA2    /ADD/CN     COMPARE CHARGE NUMBERS
          BX1    X1-X2
          NZ     X1,USA2     IF CHARGE NUMBERS DO NOT MATCH
 USA3     SX6    B1          FLAG FILE FOUND
          SA6    UASB
          SA1    USAC        CHECK TYPE
          SX1    X1-1
          NZ     X1,USA4     IF NOT AUDIT
          RJ     FIA         PROCESS FILE AUDIT
          EQ     USA2        CHECK NEXT FILE
 
 USA4     SX1    X1-1
          NZ     X1,USA6     IF NOT SOURCE
          SA1    /ADD/QN     CHECK SEQUENCE NUMBER
          RJUST  X1,X1,/BTC/QN,/UPB/QN
          SX6    X1-1
          ZR     X6,USA5     IF FIRST FILE
          SA1    /ADD/EVSN   COMPARE LAST VSN TO EXTERNAL VSN
          LJUST  X1,X1,/BTC/EVSN,/UPB/EVSN
          SA2    USAE
          SX6    B0
          BX1    X1-X2
          NZ     X1,USA5     IF NOT THE SAME VSN
          SX6    B1          FLAG SKIP FIRST VSN
 USA5     RJ     PSF         PROCESS FILE SOURCE
          SA1    /ADD/REELC  SET LAST VSN
          RJUST  X1,X1,/BTC/REELC,/UPB/REELC
          LX1    2
          MOVEBIT  X1+TAVS+/CAT/VSN-4,USAE,/BTC/VSN,/UPB/VSN
          EQ     USA2        CHECK NEXT FILE
 
 USA6     SX1    X1-1
          NZ     X1,USA7     IF NOT MACHINE READABLE
          RJ     PMF         PROCESS FILE MACHINE READABLE
          EQ     USA2        CHECK NEXT FILE
 
 USA7     RJ     FIS         PROCESS FILE SOURCE LISTING
          EQ     USA2        CHECK NEXT FILE
 
 USAA     BSS    1           CHARGE NUMBER
 UASB     BSS    1           FILE FOUND FLAG
 USAC     BSS    1           TYPE CODE
 USAD     BSS    1           VSN
 USAE     BSS    1           LAST VSN
 WCR      SPACE  4,15
**        WCR - WRITE CATALOG RECORD.
*
*         ENTRY  (X1) = RECORD RANDOM ADDRESS.
*                (X3) = WORKING BUFFER ADDRESS.
*                (B2) .NE. 0 IF CLEAR UTILITY INTERLOCK AFTER WRITE.
*
*         EXIT   RECORD REWRITTEN FROM BUFFER.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS  CUI.
*
*         MACROS CALLTFM, RESETP, WRITFET.
 
 
 WCR      SUBR               ENTRY/EXIT
          SX6    B2          SAVE INTERLOCK STATUS
          SA6    WCRA
          SX6    X3          SAVE BUFFER ADDRESS
          SA6    WCRB
          BX6    X1          SET RANDOM ADDRESS
          SA6    X2+TFRR
          RESETP X2          RESET FET POINTERS
          SA1    WCRB        GET BUFFER ADDRESS
          WRITFET  X2,X1,100B  WRITE CATALOG RECORD
          CALLTFM  X2,WRRS
          SA1    WCRA
          ZR     X1,WCRX     IF NOT CLEAR INTERLOCK
          RJ     CUI         CLEAR UTILITY INTERLOCK
          EQ     WCRX        RETURN
 
 WCRA     BSS    1           INTERLOCK STATUS
 WCRB     BSS    1           BUFFER ADDRESS
 WTF      SPACE  4,20
**        WTF - WRITE WORDS FROM WORKING BUFFER IN FET.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (B6) = WORKING BUFFER ADDRESS.
*                (B7) = NUMBER OF WORDS TO TRANSFER.
*
*         EXIT   (X1) = 0 IF TRANSFER COMPLETE.
*                     = (B6) IF (B7).NE.0.
*                (X2) = FET ADDRESS.
*                (B6) = LWA+1 OF WORKING BUFFER.
*                (B7) = NUMBER OF WORDS NOT TRANSFERRED.
*
*         USES   A - 1, 3, 7.
*                X - 3, 6, 7.
*
*         MACROS WRITEW.
 
 
 WTF      SUBR               ENTRY/EXIT
          SA1    X2+2        COMPARE *IN* TO *OUT*
          SA3    A1+B1
          IX6    X3-X1
          SX6    X6-1
          PL     X6,WTF1     IF *OUT* .GT. *IN*
          SA1    X2+B1       GET *FIRST*
          SX1    X1
          SA3    A3+B1       GET *LIMIT*
          SX3    X3
          IX1    X3-X1       GET NUMBER OF WORDS AVAILABLE IN BUFFER
          IX6    X6+X1
 WTF1     SX1    B7          CHECK IF ENOUGH WORDS IN BUFFER
          IX1    X6-X1
          SX7    B0
          PL     X1,WTF2     IF ENOUGH WORDS IN BUFFER
          SB7    X6          RESET WORD COUNT
          BX7    -X1
 WTF2     SA7    WTFA        SAVE NUMBER OF WORDS NOT TRANSFERRED
          WRITEW X2,B6,B7    TRANSFER TO FET BUFFER
          SA1    WTFA
          ZR     X1,WTFX     IF TRANSFER COMPLETE
          SB7    X1          SET NUMBER OF WORDS NOT TRANSFERRED
          SX1    B6          SET LWA+1 OF BUFFER
          EQ     WTFX        RETURN
 
 WTFA     BSS    1           NUMBER OF WORDS NOT TRANSFERRED
 WTL      SPACE  4,15
**        WTL - WRITE LINES TO OUTPUT.
*
*         ENTRY  (A1) = BUFFER ADDRESS.
*                (B2) = 0 IF COUNT BY WORDS.
*                     = 1 IF COUNT BY LINES.
*                (B6) = WORD COUNT IF (B2) = 0.
*                (B7) = LINE COUNT IF (B2) = 1.
*                (X1) = FIRST WORD OF BUFFER.
*
*         EXIT   LINES WRITTEN TO OUTPUT FILE.
*
*         USES   A - 1, 2, 6.
*                B - 2, 6.
*                X - 1, 2, 6.
*
*         MACROS CLINES, CWORDS, NEWPAGE, WRITEW.
 
 
 WTL      SUBR               ENTRY/EXIT
          ZR     B2,WTL1     IF COUNT BY WORDS
          CWORDS A1,B7       COUNT NUMBER OF WORDS IN BUFFER
          EQ     WTL2        SAVE BUFFER ADDRESS
 
 WTL1     CLINES A1,B6       COUNT NUMBER OF LINES IN BUFFER
 WTL2     SB2    A1-B6       SAVE BUFFER ADDRESS
          SX6    B2
          SA6    WTLA
          SX6    B6          SAVE WORD COUNT
          SA6    WTLB
          SX6    B7          SAVE LINE COUNT
          SA6    WTLC
          SA1    OS
          ZR     X1,WTLX     IF NO OUTPUT FILE
          PL     X1,WTL3     IF TERMINAL OUTPUT
          SA1    LC          CHECK LINE COUNT
          SX1    X1+B7
          SX1    X1-MXLP
          NG     X1,WTL3     IF NOT TOO MANY LINES ON PAGE
          NEWPAGE            GENERATE NEW PAGE HEADER
 WTL3     SA1    WTLC        RESET LINE COUNT
          SA2    LC
          IX6    X1+X2
          SA6    A2
          SA1    WTLA        GET BUFFER ADDRESS
          SB6    X1
          SA1    WTLB        GET WORD COUNT
          WRITEW L,B6,X1     WRITE TO OUTPUT FILE
          EQ     WTLX        RETURN
 
 WTLA     BSS    1           BUFFER ADDRESS
 WTLB     BSS    1           WORD COUNT
 WTLC     BSS    1           LINE COUNT
          TITLE  MISCELLANEOUS SUBROUTINES.
 ACI      SPACE  4,25
**        ACI - ASSEMBLE CHARACTERS INTERFACE.
*
*         ENTRY  (X1) = BIT STRING OF CHARACTERS TO PERMIT.
*                (X4) = MAXIMUM NUMBER OF CHARACTERS PERMITTED.
*                (X6) = BIT STRING OF CHARACTER TO SUPPRESS.
*
*         EXIT   (CBUF - CBUF+CBUFL) = LEFT JUSTIFIED
*                                      ASSEMBLED CHARACTERS.
*                (X4) = NUMBER OF CHARACTERS.
*                (B5) = SEPARATOR  ( 0 IF END-OF-LINE).
*                (B6) = 0 IF EOF.
*                     .NE. 0 IF ASSEMBLY COMPLETE.
*                (ET) = -1 IF EOF.
*
*         USES   A - 1, 2, 4, 6, 7.
*                B - 2, 4.
*                X - 1, 2, 6, 7.
*
*         CALLS  ASC.
*
*         MACROS CLEAR.
*
*         NOTES  BASED ON SUBROUTINE *ACI* IN *MODVAL*.
 
 
 ACI      SUBR               ENTRY/EXIT
          SA6    ACIC        SAVE BIT STRING TO SUPPRESS
          SX6    X4          SAVE MAXIMUM CHARACTER COUNT
          SA6    ACIE
          BX7    X1          SAVE BIT STRING TO PERMIT
          SX6    B0          CLEAR CHARACTER COUNT
          SA7    ACIB
          SA6    ACIA
          SA6    ACID        CLEAR CHARACTER BUFFER INDEX
          CLEAR  CBUF,CBUFL  CLEAR CHARACTER BUFFER
 ACI1     SA2    ACIC        CHARACTERS TO BE SUPPRESSED
          SA1    ACIB        CHARACTERS TO BE ALLOWED
          BX6    X2
          RJ     ASC         ASSEMBLE CHARACTERS
          SA2    ACID
          SA6    CBUF+X2     STORE ASSEMBLED CHARACTERS
          SA1    ACIA
          SB4    X4-10
          IX4    X1+X4       INCREMENT CHARACTER COUNT
          NG     B4,ACIX     IF SEPARATOR ENCOUNTERED
          BX7    X4
          SA7    A1
          SA4    ACIE        RESET MAXIMUM CHARACTER COUNT
          IX4    X4-X7
          BX7    X4
          SA7    A4
          SX7    X2-CBUFL-1
          PL     X7,ACI1     IF BUFFER FULL
          SX7    X2+B1       INCREMENT CHARACTER BUFFER INDEX
          SA7    A2
          EQ     ACI1        ASSEMBLE MORE CHARACTERS
 
 
 ACIA     BSS    1           CHARACTER COUNT
 ACIB     BSS    1           BIT STRING OF CHARACTERS TO PERMIT
 ACIC     BSS    1           BIT STRING OF CHARACTERS TO SUPPRESS
 ACID     BSS    1           CHARACTER BUFFER INDEX
 ACIE     BSS    1           MAXIMUM CHARACTER COUNT
 ARV      SPACE  4,20
**        ARV - ADD/REVISE VSN ENTRY.
*
*         ENTRY  (VCAT) = VSN ENTRY IMAGE.
*                (VI) = 1, IF VSN BUSY AND ASSIGNED.
*                       0, IF VSN NOT BUSY OR ASSIGNED.
*
*         EXIT   VSN ENTRY ADDED REVISED IN *VBUF*.
*                (ER) = 0, IF NO ERROR FOUND.
*                     = ERROR MESSAGE ADDRESS, IF ERROR OCCURRED.
*                (VI) = IF VSN INTERLOCKED, THIS WILL BE CLEARED.
*
*         USES   A - 1, 2, 6.
*                X - 0, 1, 2, 6.
*
*         CALLS  RVB, RVE.
*
*         MACROS CALLTFM, MOVE, RESETP, WRITFET.
 
 
 ARV      SUBR               ENTRY/EXIT
          SX6    B0
          SA6    ER          CLEAR ERROR FLAG
          SA1    VI          CHECK FOR VSN INTERLOCKED
          ZR     X1,ARV4     IF VSN NOT INTERLOCKED
          MX0    36          SET UP MASK
          SX1    HMVS+UOVS+TVVS+ERVS
          BX0    X0+X1
          SA1    VCAT+VEVS   GET CURRENT STATUS
          SA2    VBUF+VEVS   GET BEGINNING STATUS
          BX1    X0*X1
          BX2    X0*X2
          BX1    X1-X2
          ZR     X1,ARV4     IF STATUS NOT CHANGED
          WRITFET N1,VCAT,TSVL
          RESETP N1          RESET BUFFER POINTERS
          CALLTFM X2,-GNSS
          ZR     X4,ARV3     IF NO ERRORS OCCURRED
          SX1    /EMSG/WSA   CHECK FOR *WAIT SCRATCH ASSIGNMENT*
          IX2    X1-X4
          NZ     X2,ARV1     IF NOT THIS ERROR
          SX6    EWSA        *NO SCRATCH AVAILABLE*
          BX6    -X6
          SA6    ER
          EQ     ARVX        RETURN
 
 ARV1     SX1    /EMSG/VBS   CHECK FOR ERROR
          IX2    X1-X4
          NZ     X2,ARV2     IF NOT THIS ERROR
          SX6    EVAA        *VSN ALREADY ASSIGNED*
          BX6    -X6
          SA6    ER
          EQ     ARVX        RETURN
 
 ARV2     SX6    IVNP        *VSN NOT PROCESSED*
          SA6    ER
          EQ     ARVX        RETURN
 
 ARV3     MOVE   TSVL,N1BUF,VCAT
          SX6    B0
          SA6    VI          CLEAR VSN INTERLOCK
 ARV4     RJ     RVB         REPLACE VSN IN BUFFER
          SA1    LF
          NZ     X1,ARVX     IF LOCAL FILE MODE
          RJ     RVE         REPLACE VSN ENTRIES
          EQ     ARVX        RETURN
 ASC      SPACE  4,30
**        ASC - ASSEMBLE CHARACTERS.
*
*         ENTRY  (SP) = STRING BUFFER ADDRESS OF PREVIOUS CHAR.
*                (SM) = STRING BUFFER LIMIT.
*                (IF) = INPUT FET ADDRESS.
*                (X1) = BIT STRING OF CHARACTERS TO PERMIT.
*                (X4) = MAXIMUM CHARACTER COUNT.
*                (X6) = BIT STRING OF CHARACTERS TO SUPPRESS.
*                IF BIT POSITION EQUALING (SPECIAL CHARACTER DISPLAY
*                CODE - 45B) IS SET, THAT CHARACTER IS SUPPRESSED OR
*                PERMITTED AS DATA (NOT TREATED AS SEPARATOR).
*
*         EXIT   (SP) = UPDATED STRING BUFFER ADDRESS.
*                (X6) = LEFT -JUSTIFIED ASSEMBLED CHARACTERS.
*                (X5) = RIGHT-JUSTIFIED ASSEMBLED CHARACTERS.
*                (X4) = NUMBER OF CHARACTERS
*                (B5) = SEPARATOR (0 IF END OF LINE).
*                (B6) = 0 IF EOF.
*                (ET) = -1 IF EOF.
*
*         USES   A - 1, 2, 4, 6, 7.
*                B - 2, 3, 4, 7.
*                X - 1, 2, 7.
*
*         CALLS  ISB.
*
*         NOTES  BASED ON SUBROUTINE *ASC* IN *SFS*.
 
 
 ASC8     SX4    -B4         SET CHARACTER COUNT
          SX4    X4+10D
          SX6    B5          SAVE SEPARATOR
          SA6    EL
          SX6    B2          RESET STRING POINTER
          SA6    SP
          SX6    B0
          SB3    B4+B4
          ZR     X4,ASCX     IF NO CHARACTERS
          SB4    B3+B3       LEFT JUSTIFY CHARACTER STRING
          SB4    B4+B3
          LX6    X5,B4
 
 ASC      SUBR               ENTRY/EXIT
          SX4    X4-10       SAVE (10 - MAXIMUM NUMBER OF CHARACTERS)
          BX7    -X4
          SA7    ASCC
          SX5    B0          PRESET CHARACTER STRING
          SB4    10          PRESET MAXIMUM CHARACTER COUNT
          BX7    X1
          SB6    B1          PRESET NOT EOF
 ASC1     SA1    SP          SET STRING POINTER
          SB2    X1
          SA1    SM          SET MAXIMUM SCAN CHARACTERS
          SB7    USBB+CAPL   CHARACTER ASSEMBLY LIMIT
          SB3    X1
          LE     B3,B7,ASC2  IF LINE LENGTH .LE. CHARACTER LIMIT
          SB3    B7
 ASC2     GE     B2,B3,ASC7  IF BUFFER EMPTY
 ASC3     SA4    ASCC        CHECK CHARACTER COUNT
          SB5    X4
          GT     B4,B5,ASC4  IF LESS THAN MAXIMUM
          SX6    -B1         FLAG MAXIMUM COUNT
          SA6    A4
          SA4    ="BL"       RESET TO SUPPRESS BLANKS
          BX6    X4
          SA6    ASCA
          SA4    ="NC"       RESET TO ALLOW NO SPECIAL CHARACTERS
          BX7    X4
          SA7    A6+B1
 ASC4     SB2    B2+B1       CHECK IF END OF BUFFER
          SB5    B0
          GE     B2,B3,ASC8  IF END OF STRING BUFFER
          SA1    B2          GET CHARACTER
          SB5    X1
          SB7    X1-1R+
          LT     B7,ASC6     IF NOT SPECIAL CHARACTER
          AX4    X6,B7       CHECK IF SUPPRESSED CHARACTER
          LX4    59
          NG     X4,ASC3     IF CHARACTER TO BE SUPPRESSED
          SA4    CL          CHECK FOR COLON CHARACTER
          AX4    B7
          LX4    59
          PL     X4,ASC5     IF NOT COLON CHARACTER
          SX1    1R:         SET COLON AS CHARACTER
          SB7    100B-1R+
 ASC5     AX4    X7,B7       CHECK IF PERMITTED CHARACTER
          LX4    59
          PL     X4,ASC8     IF CHARACTER NOT TO BE PERMITTED
 ASC6     LX5    6           ADD TO CHARACTER STRING
          SB4    B4-1
          BX5    X5+X1
          NZ     B4,ASC3     IF MORE CHARACTERS TO ASSEMBLE
          SB6    B1
          EQ     ASC8        SET CHARACTER COUNT
 
 ASC7     SA6    ASCA        SAVE BIT STRINGS
          SA7    A6+B1
          SX6    B4          SAVE CHARACTER COUNT
          SA6    ASCB
          RJ     ISB         INPUT STRING BUFFER
          SA2    ASCB        RESTORE CHARACTER COUNT
          SA1    ASCA        RESTORE BIT STRINGS
          SB4    X2
          BX6    X1
          SA1    A1+B1
          SX7    X1
          NZ     B6,ASC1     IF NOT END OF FILE
          SA1    SP          RESET STRING POINTER
          SB2    X1
          SB5    B0          RESET END OF LINE INDICATOR
          EQ     ASC8        SET CHARACTER COUNT
 
 ASCA     BSS    1           SUPPRESSED CHARACTERS BIT STRING
          BSS    1           ALLOWED CHARACTERS BIT STRING
 ASCB     BSS    1           HOLD AREA FOR CHARACTER COUNT
 ASCC     BSS    1           10 - MAXIMUM NUMBER OF CHARACTERS
 AUA      SPACE  4,15
**        AUA - ALTERNATE USER AUDIT LIST PROCESSOR.
*
*         ENTRY  (ACAT) = IMAGE OF ALTERNATE USER ENTRY.
*
*         EXIT   ALTERNATE USER INFORMATION WRITTEN TO OUTPUT FILE.
*
*         USES   A - 1.
*                X - 1.
*
*         CALLS  SFN.
*
*         MACROS MOVEBIT, SETSORC, WLINES.
 
 
 AUA      SUBR               ENTRY/EXIT
          SA1    /ADD/AUSER  SET ALTERNATE USER NAME IN LISTING
          LJUST  X1,X1,/BTC/AUSER,/UPB/AUSER
          RJ     SFN         SPACE FILL NAME
          BX1    X6
          MOVEBIT  A1,/ALS/AUSER,UNKL*6,,/ALSU/AUSER
          SETSORC  A,LVAU    SET SOURCE VALUES IN AUDIT LIST
          WLINES AUAA,1      WRITE TO OUTPUT FILE
          EQ     AUAX        RETURN
 
 AUAA     BSS    0           AUDIT LISTING
          LISTER ALS,4
 AUSER    LISTER ,7          ALTERNATE USER NAME
          LISTER ,7
 AMODE    LISTER ,5,WRITE    ADMIT MODE
          LISTER ,8
 AACOUNT  LISTER ,6,000000   ACCESS COUNT
          LISTER ,8
 AADATE   LISTER ,6,YYMMDD   ACCESS DATE
          LISTER ,6
 AATIME   LISTER ,6,HHMMSS,E ACCESS TIME
 AUL      SPACE  4,10
**        AUL - ALTERNATE USER LEVEL PROCESSOR.
*
*         EXIT   PROGRAM SET FOR ALTERNATE USER DIRECTIVES.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         MACROS MOVE, MOVEBIT.
 
 
 AUL      SUBR               ENTRY/EXIT
          SX6    LVAU        SET ALTERNATE USER LEVEL
          SA6    LV
          SA1    UN          SET USER NAME IN K-DISPLAY
          BX6    X1
          SA6    /KAUSLS/USER
          MOVEBIT  FI,/KAUSLS/FILE,FIKL*6  SET FILE ID IN K-DISPLAY
          SA1    AU          SET ALTERNATE USER IN K-DISPLAY
          BX6    X1
          SA6    /KAUSLS/AUSER
          SA1    AF          CHECK ADMIT FLAG
          SA2    AULA        PRESET MESSAGE ADDRESS
          ZR     X1,AUL1     IF USER NOT ADMITTED
          SA2    AULB        RESET MESSAGE ADDRESS
 AUL1     MOVE   3,A2,/KAUSLS/MESS  SET ADMIT MESSAGE
          SA1    AULC        RESET LEFT SCREEN POINTER
          BX6    X1
          SA6    /KLEFT/NEXT
          SA1    AULD        RESET RIGHT SCREEN POINTER
          BX6    X1
          SA6    /KRIGHT/NEXT
          SA1    =H* ALT USER *  SET LEVEL IN HELP DISPLAY
          BX6    X1
          SA6    /KRIGHT/LV
          EQ     AULX        RETURN
 
 AULA     DATA   30HUSER NOT CURRENTLY ADMITTED.
 AULB     DATA   30HUSER CURRENTLY IS ADMITTED.
 AULC     KNEXT  KAUSLS,NOLAB
 AULD     KNEXT  KAUSRS,NOLAB
 AUS      SPACE  4,15
**        AUS - ALTERNATE USER SOURCE LIST PROCESSOR.
*
*         ENTRY  (ACAT) = IMAGE OF ALTERNATE USER ENTRY.
*
*         EXIT   ALTERNATE USER INFORMATION WRITTEN TO SOURCE FILE.
*
*         USES   A - 1.
*                X - 1.
*
*         CALLS  SFN.
*
*         MACROS MOVEBIT, SETSORC, WRITEW.
 
 
 AUS      SUBR               ENTRY/EXIT
          SA1    /ADD/AUSER  SET ALTERNATE USER NAME IN LIST
          RJ     SFN         SPACE FILL NAME
          BX1    X6
          MOVEBIT  A1,/SLS/AUSER,UNKL*6,,/SLSU/AUSER
          SETSORC  S,LVAU    SET SOURCE VALUES IN SOURCE LISTING
          WRITEW S,AUSA,AUSAL  WRITE TO SOURCE FILE
          EQ     AUSX        RETURN
 
 AUSA     BSS    0           SOURCE LISTING
          LISTER SLS,6,AUSER=
 AUSER    LISTER ,7          ALTERNATE USER
          LISTER ,7,(,AMODE=)
 AMODE    LISTER ,5,WRITE,E,CAPL  ADMIT MODE
          LISTER ,8,AACOUNT=
 AACOUNT  LISTER ,6,000000   ACCESS COUNT
          LISTER ,8,(,AADATE=)
 AADATE   LISTER ,6,YYMMDD   ACCESS DATE
          LISTER ,8,(,AATIME=)
 AATIME   LISTER ,6,HHMMSS   ACCESS TIME
          LISTER ,3,(,GO),E,CAPL
 AUSAL    EQU    *-AUSA      LENGTH OF SOURCE LISTING
 CAB      SPACE  4,15
**        CAB - CHECK IF ALTERNATE USER ENTRY IN BUFFER.
*
*         ENTRY  (AU) = ALTERNATE USER NAME.
*
*         EXIT   (X4) = 0 IF ENTRY FOUND.
*                (A1) = ADDRESS OF ENTRY IN *UBUF*.
*
*         USES   B - 2, 3.
*                X - 0, 1.
*
*         MACROS SRCHTAB.
 
 
 CAB      SUBR               ENTRY/EXIT
          SA1    UB+1        GET BUFFER LENGTH
          SB2    X1
          SA1    A1+B1
          SB3    X1
          SB2    B3-B2
          MX0    42          SEARCH BUFFER FOR ALTERNATE USER ENTRY
          SRCHTAB  UBUF,AU,B2,2
          EQ     CABX        RETURN
 CFC      SPACE  4,10
**        CFC - CHECK FOR FILE NAME CONFLICT.
*
*         ENTRY  (X2) = ADDRESS OF FET TO CHECK AGAINST.
*
*         EXIT   (X4) = 0 IF NO CONFLICT.
*                     = ADDRESS OF CONFLICTING FET.
*
*         USES   A - 1, 3, 4.
*                X - 0, 1, 3.
 
 
 CFC      SUBR               ENTRY/EXIT
          MX0    42          CHECK FILE NAME
          SA1    X2
          BX4    X0*X1
          ZR     X4,CFCX     IF NO FILE NAME
          SA4    CFCA        SET TABLE ADDRESS
 CFC1     ZR     X4,CFCX     IF END OF TABLE
          IX3    X2-X4
          ZR     X3,CFC2     IF SAME FET
          SA3    X4          CHECK IF CONFLICT
          BX3    X3-X1
          BX3    X0*X3
          ZR     X3,CFCX     IF FILE NAME CONFLICT
 CFC2     SA4    A4+B1
          EQ     CFC1        CHECK NEXT FET
 
 CFCA     BSS    0           TABLE OF FET ADDRESSES
          CON    I           INPUT FILE FET
          CON    L           OUTPUT FILE FET
          CON    N1          TAPE CATALOG FILE FET
          CON    S           SOURCE FILE FET
          CON    SS          MACHINE READABLE FILE FET
          CON    0           END OF TABLE
 CFI      SPACE  4,15
**        CFI - CHECK FILE IDENTIFIER IN OUTPUT.
*
*         ENTRY  (A1) = ADDRESS OF FILE ID IN OUTPUT.
*                (B3) = UPPER BIT POSITION OF FILE ID IN OUTPUT.
*                (X1) = FIRST WORD OF FILE ID IN OUTPUT.
*
*         EXIT   END OF LINE ELIMINATED FROM FILE ID IN OUTPUT.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         MACROS MOVEBIT.
 
 
 CFI2     MX0    -12         CHECK FOR END OF LINE
          SA1    CFIA
          SA2    CFIC
          IX2    X1+X2
          SA2    X2
          BX1    -X0*X2
          NZ     X1,CFI3     IF NOT END OF LINE
          MOVEBIT  (=10H),A2,6,5,5  FORCE NO END OF LINE
 CFI3     MX0    -12         CHECK FOR END OF LINE
          SA1    CFIA
          SA2    CFID
          IX2    X1+X2
          SA2    X2
          BX1    -X0*X2
          NZ     X1,CFIX     IF NOT END OF LINE
          MOVEBIT  (=10H),A2,6,5,5  FORCE NO END OF LINE
 
 CFI      SUBR               ENTRY/EXIT
          SX6    A1          SAVE ADDRESS OF FILE ID IN OUTPUT
          SA6    CFIA
          SX6    B3          SAVE UPPER BIT POSITION OF FILE ID
          SA6    CFIB
          SX6    B1          CHECK FOR POSSIBLE END OF LINES
          SX7    B1
          SB6    B3-6
          NG     B6,CFI1     IF NO END OF LINE IN FIRST WORD
          SX6    B0
          SB6    B3-42
          NG     B6,CFI1     IF POSSIBLE END OF LINE IN TWO WORDS
          SX7    B0
 CFI1     SA6    CFIC        SET POSSIBLE END OF LINE POSITIONS
          SA7    CFID
          MOVEBIT  A1,CFIE,FIKL*6,B3  GET FILE ID
          SA1    CFIE        CHECK IF NO FILE ID
          SA2    A1+B1
          BX1    X1+X2
          NZ     X1,CFI2     IF FILE ID IS PRESENT
          SA2    CFIA        SPACE FILE FILE ID FIELD
          SA3    CFIB
          MOVEBIT  (=17H),X2,FIKL*6,,X3
          EQ     CFIX        RETURN
 
 CFIA     BSS    1           ADDRESS OF FILE ID IN OUTPUT
 CFIB     BSS    1           UPPER BIT OF FILE ID IN OUTPUT
 CFIC     BSS    1           POSITION OF END OF LINE IN OUTPUT
 CFID     BSS    1           POSITION OF END OF LINE IN OUTPUT
 CFIE     BSS    2           IMAGE OF FILE ID
 CFM      SPACE  4,10
**        CFM - CHANGE FAMILY.
*
*         ENTRY  (X1) = NEW FAMILY NAME.
*
*         EXIT   TO *ABT1* IF CHANGE NOT ALLOWED.
*
*         USES   A - 1, 6.
*                X - 1, 5, 6.
*
*         MACROS ABTMSG, ENFAM.
 
 
 CFM      SUBR               ENTRY/EXIT
          BX6    X1
          SA6    CFMA
          ENFAM  CFMA        CHANGE FAMILY
          SA1    CFMA
          LX1    59-11
          PL     X1,CFMX     IF CHANGE SUCCESSFUL
          SA1    CF          FORCE NO FAMILY CHANGE
          BX6    X1
          SA6    FM
          ABTMSG MFNA        ABORT *TFSP*
 
 CFMA     BSS    1           NEW FAMILY NAME
 CJD      SPACE  4,10
**        CJD - CHECK JULIAN DATE.
*
*         ENTRY  (X1) = JULIAN DATE LEFT JUSTIFIED.
*
*         EXIT   (X4) = 0 IF IN CORRECT FORMAT.
*
*         USES   A - 1, 5, 6, 7.
*                X - 0, 1, 5, 6, 7.
*
*         CALLS  DXB.
 
 
 CJD      SUBR               ENTRY/EXIT
          MX0    12          GET YEAR
          BX5    X0*X1
          MX0    24          SAVE DAY
          LX1    12
          SX2    1RD
          LX2    36
          BX6    X1+X2
          BX6    X0*X6
          SA6    CJDA
          LX2    6           FLAG DECIMAL
          BX5    X5+X2
          RJ     DXB         CONVERT DISPLAY TO BINARY
          NZ     X4,CJDX     IF ERROR
          MX0    -2          CHECK FOR LEAP YEAR
          BX0    -X0*X6
          SX7    365
          NZ     X0,CJD1     IF NOT LEAP YEAR
          SX7    X7+B1
 CJD1     SA5    CJDA        GET DAY
          SA7    A5          SAVE NUMBER OF DAYS IN YEAR
          RJ     DXB         CONVERT DISPLAY TO BINARY
          NZ     X4,CJDX     IF ERROR
          SA1    CJDA        CHECK NUMBER OF DAYS
          IX1    X1-X6
          PL     X1,CJDX     IF LEGAL NUMBER OF DAYS
          SX4    B1          FLAG ERROR
          EQ     CJDX        RETURN
 
 CJDA     BSS    1           DAY COUNT
 CRD      SPACE  4,20
**        CRD - CHECK RELEASE DATE.
*
*         IF THE RELEASE DATE WAS SPECIFIED, ISSUE THE CONDITIONAL
*         RELEASE (*SDCR*) MESSAGE, AND CLEAR THE SYMBOLIC ACCESS FLAGS
*         FROM ALL CATALOG ENTRIES.
*
*         ENTRY  (RS) = 1 IF URDATE SPECIFIED.
*
*         EXIT   (RS) = 0.
*
*         USES   A - 1, 2, 3, 6.
*                X - 1, 2, 3, 6.
*
*         CALLS  SMB.
*
*         MACROS CALLTFM, GFILEV, ISSMSG, MOVEBIT, RESETP, RJUST,
*                WRITFET.
 
 
 CRD      SUBR               ENTRY/EXIT
          SA1    RS
          NZ     X1,CRD1     IF URDATE SPECIFIED
          SA1    TAVS+/CAT/URDATE
          RJUST  X1,X1,/BTC/URDATE,/UPB/URDATE
          ZR     X1,CRDX     IF NO URDATE SET
          SX6    B1
          EQ     CRD2        VERIFY NO CATALOG ENTRIES ARE SYMBOLIC
 
 CRD1     SX6    B0          CLEAR URDATE SPECIFIED
          SA6    A1
          SA1    UN
          SA2    FV
          SA3    TAVS+/CAT/URDATE
          RJUST  X3,X3,/BTC/URDATE,/UPB/URDATE
          RJ     SMB         ISSUE *SDCR* MESSAGE
          SA1    TAVS+/CAT/URDATE
          RJUST  X1,X1,/BTC/URDATE,/UPB/URDATE
          ZR     X1,CRDX     IF URDATE CLEARED
          SX6    B1
 CRD2     SA6    CRDA        SAVE SEQUENCE NUMBER
          GFILEV UN,FV,X6,FCAT,PCAT,TAVS
          SA1    /ADD/SV
          RJUST  X1,X1,/BTC/SV,/UPB/SV
          ZR     X1,CRD3     IF NOT SYMBOLIC ACCESS
          SA6    N3+TFRR     SET RANDOM ADDRESS
          MOVEBIT  (=0),/ADD/SV,/BTC/SV,,/UPB/SV  CLEAR SYMBOLIC ACCESS
          RESETP N3
          WRITFET  X2,FCAT,TCEL
          SX6    RCES        REPLACE CATALOG ENTRY
          CALLTFM  X2,X6
 CRD3     SA1    /ADD/NCAT
          RJUST  X1,X1,/BTC/NCAT,/UPB/NCAT
          ZR     X1,CRDX     IF NO MORE CATALOG ENTRIES
          SA1    CRDA
          SX6    X1+B1
          EQ     CRD2        CLEAR SYMBOLIC ACCESS IN NEXT CATALOG
 
 CRDA     CON    0           SEQUENCE NUMBER
 CUI      SPACE  4,10
**        CUI - CLEAR UTILITY INTERLOCK.
*
*         EXIT   UTILITY INTERLOCK CLEARED ON TAPE CATALOG FILE.
*
*         USES   A - 1.
*                X - 1.
*
*         MACROS CALLTFM, RESETP.
 
 
 CUI      SUBR               ENTRY/EXIT
          SA1    LF
          NZ     X1,CUIX     IF LOCAL FILE MODE
          RESETP N1          CLEAR UTILITY INTERLOCK
          CALLTFM  X2,CUAS
          EQ     CUIX        RETURN
 CVB      SPACE  4,15
**        CVB - CHECK IF VSN ENTRY IN BUFFER.
*
*         ENTRY  (VS) = VSN.
*
*         EXIT   (X4) = 0 IF VSN FOUND.
*                (A1) = ADDRESS OF ENTRY IN *VBUF*.
*
*         USES   B - 2, 3.
*                X - 0, 1.
*
*         MACROS SRCHTAB.
 
 
 CVB      SUBR               ENTRY/EXIT
          SA1    VB+1        GET BUFFER LENGTH
          SB2    X1
          SA1    A1+B1
          SB3    X1
          SB2    B3-B2
          MX0    36          SEARCH BUFFER FOR VSN ENTRY
          SRCHTAB  VBUF,VS,B2,4
          EQ     CVBX        RETURN
 CXS      SPACE  4,10
**        CXS - CONVERT CATALOG IMAGE TO SOURCE.
*
*         ENTRY  (X1) = IMAGE OF DIRECTIVE TABLE ENTRY.
*
*         EXIT   (B2) .LT. 0 IF NO DIRECTIVE CONTROL TABLE.
*                (CBUF) = IMAGE OF DIRECTIVE WITH EQUAL SIGN.
*                (CBUF+1 - CBUF+2) = IMAGE OF DATA FIELD.
*                (CXSA - CXSA+3) = IMAGE OF CONTROL TABLE.
*
*         USES   A - 1, 2, 4, 6.
*                B - 3.
*                X - 0, 1, 2, 4, 6.
*
*         CALLS  CDD, SFN, UDT, ZTB.
*
*         MACROS MOVE, MOVEBIT, SRCHTAB.
 
 
 CXS8     SA1    CXSA+0      GET SUPPRESSED CHARACTERS
          SA2    X1
          AX1    18          GET ALLOWED CHARACTERS
          SA1    X1
          LX1    59-100B+1R+
          NG     X1,CXS9     IF COLONS ALLOWED
          LX2    59-1R +1R+
          PL     X2,CXS9     IF BLANKS NOT SUPPRESSED
          SA1    CXSB        SET FIRST WORD OF DATA FIELD IMAGE
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA6    CBUF+1
          SA1    CXSB+1      SET SECOND WORD OF DATA FIELD IMAGE
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA6    CBUF+2
          SB3    B0          FLAG CONTROL TABLE FOUND
          EQ     CXSX        RETURN
 
 CXS9     SA1    =H*          *  PRESET DATA FIELD BUFFER
          BX6    X1
          SA6    CBUF+1
          SA6    A6+B1
          SA4    CXSA+0      GET BIT COUNT OF DATA FIELD
          LX4    18
          AX4    36+18
          SX0    6
          IX4    X0*X4
          MOVEBIT  CXSB,CBUF+1,X4  MOVE DATA FIELD TO BUFFER
          SB3    B0          FLAG CONTROL TABLE FOUND
 
 CXS      SUBR               ENTRY/EXIT
          SB3    X1
          NG     B3,CXSX     IF NO DIRECTIVE TABLE
          MX0    42          GET DIRECTIVE IMAGE
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    -6+60       POSITION DIRECTIVE IMAGE
          SX2    1R=&1R
          BX6    X6-X2
          SA6    CBUF+0      SET DIRECTIVE IMAGE IN BUFFER
          MOVE   5,B3,CXSA   GET DIRECTIVE CONTROL TABLE
          SX6    B0          CLEAR DATA FIELD BUFFER
          SA6    CXSB
          SA6    A6+B1
          SA2    CXSA+1      SET CATALOG TABLE ADDRESS
          SA1    X2
          MX0    -12         SET BIT COUNT
          AX2    36
          BX3    -X0*X2
          SB4    X3
          AX2    12          SET UPPER BITS
          SB3    X2
          MOVEBIT  A1,CXSB,B4,B3  MOVE ENTRY TO BUFFER
          SA1    CXSA+0      SET PROCESSOR ADDRESS
          AX1    48
          SA2    CXSC+X1
          SB2    X2
          SA2    A1+B1       GET BIT COUNT
          LX2    12
          AX2    36+12
          SB3    X2
          SA1    CXSB        RIGHT JUSTIFY VALUE
          LX1    B3
          JP     B2          JUMP TO PROCESSOR
 
*         PROCESS OPTION SELECTION (PIOP).
 
 CXS1     BX2    X1          SET VALUE TO COMPARE
          SA1    CXSA+2      SET ADDRESS OF TABLE
          AX1    18
          MX0    60          SET MASK
          SRCHTAB  X1,A2,,2,1  SEARCH FOR OPTION
          BX6    X1
          EQ     CXS7        SAVE SOURCE ENTRY
 
*         PROCESS BINARY DATA (PIBD).
 
 CXS2     RJ     CDD         CONVERT CONSTANT TO DISPLAY CODE
          NZ     B2,CXS3     IF VALUE NON-ZERO
          SX6    1R0         SET DATA FIELD OF ZERO
          SB2    6
 CXS3     MX0    1           BUILD DATA FIELD MASK
          SB3    B2-B1
          AX0    B3
          LX0    B2
          SA1    =H*0000000000*  INSERT LEADING ZEROES
          BX1    -X0*X1
          BX6    X0*X6
          BX6    X1+X6
          EQ     CXS7        TRIM EXCESS BLANKS
 
*         PROCESS PACKED DATE (PIPD).
 
 CXS4     SB3    70          FLAG DATE
          RJ     UDT         UNPACK DATE
          EQ     CXS7        SAVE SOURCE ENTRY
 
*         PROCESS PACKED TIME (PIPT).
 
 CXS5     SB3    100         FLAG TIME
          RJ     UDT         UNPACK TIME
          EQ     CXS7        SAVE SOURCE ENTRY
 
*         PROCESS SPECIAL CHARACTER BIT STRING (PIBS).
 
 CXS6     SX6    B0          PRESET NO CHARACTER
          ZR     X1,CXS7     IF NO CHARACTER
          NX1,B2             GET CHARACTER CODE
          SB2    B2-47
          SB3    1R+
          SX6    B3-B2
          LX6    54
 CXS7     SA6    CXSB
          EQ     CXS8        SAVE SOURCE ENTRY
 
 CXSA     BSS    5           CONTROL TABLE IMAGE
 CXSB     BSS    2           DATA FIELD BUFFER
 CXSC     INDTAB 1           TABLE OF PROCESSOR ADDRESSES
          INDEX  PIZF,CON,CXS8  ZERO FILL
          INDEX  PIBF,CON,CXS8  BLANK FILL
          INDEX  PIOP,CON,CXS1  OPTION SELECTION
          INDEX  PIBD,CON,CXS2  BINARY DATA
          INDEX  PIPD,CON,CXS4  PACKED DATE
          INDEX  PIPT,CON,CXS5  PACKED TIME
          INDEX  PIJD,CON,CXS8  JULIAN DATE
          INDEX  PIVQ,CON,CXS8  VSN/SEQUENCE NUMBER
          INDEX  PIVS,CON,CXS8  PADDED VSN
          INDEX  PIBS,CON,CXS6  SPECIAL CHARACTER BIT STRING
 DDC      SPACE  4,15
**        DDC - DECIMAL DIGIT CONVERSION.
*
*         ENTRY  (X1) = DISPLAY CODE OF TWO DECIMAL DIGITS IN UPPER 12
*                       BITS.
*                (X2) = MINIMUM BINARY VALUE.
*                (X3) = MAXIMUM BINARY VALUE.
*
*         EXIT   (X4) = 0 IF NO CONVERSION ERROR.
*                (X6) = BINARY VALUE OF DECIMAL DIGITS.
*
*         USES   A - 2, 3, 6.
*                X - 0, 1, 2, 3, 5.
*
*         CALLS  DXB.
 
 
 DDC      SUBR               ENTRY/EXIT
          BX6    X2          SAVE MINIMUM VALUE
          SA6    DDCA
          BX6    X3          SAVE MAXIMUM VALUE
          SA6    DDCB
          MX0    12          GET FIRST TWO DIGITS
          BX1    X0*X1
          SX2    1RD         FORCE DECIMAL CONVERSION
          LX2    42
          BX5    X1+X2
          RJ     DXB         CONVERT DISPLAY TO BINARY
          NZ     X4,DDCX     IF CONVERSION ERROR
          SA2    DDCA        COMPARE TO MINIMUM VALUE
          IX4    X6-X2
          NG     X4,DDCX     IF LESS THAN MINIMUM
          SA3    DDCB        COMPARE TO MAXIMUM VALUE
          IX4    X3-X6
          NG     X4,DDCX     IF GREATER THAN MAXIMUM
          SX4    B0          FLAG NO ERROR
          EQ     DDCX        RETURN
 
 DDCA     BSS    1           MINIMUM VALUE
 DDCB     BSS    1           MAXIMUM VALUE
 DIP      SPACE  4,15
**        DIP - DIRECTIVE INPUT PROCESSOR.
*
*         ENTRY  (IF) = INPUT FILE FET ADDRESS.
*
*         EXIT   (EF) .NE. 0 IF DIRECTIVE ERROR.
*                (ET) .LT. 0 IF END OF INPUT FILE.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                X - 0, 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  ACI, CJD, DTO, DXB, DXD, DXT, PVS, SCI.
*
*         MACROS ISSMSG, LJUST, MOVE, MOVEBIT, RJM, SRCHTAB.
 
 
 DIP28    SA1    DIPD        SET ADDRESS OF DATA FIELD
          SB6    X1
          RJ     DTO         ISSUE DIRECTIVE TO OUTPUT FILE
          SA1    DIPA+1      CHECK PROCESSOR ADDRESS
          AX1    18
          SB2    X1
          ZR     B2,DIPX     IF NO PROCESSOR
          RJM    B2          JUMP TO PROCESSOR
          SA1    SF          CHECK IF RESET NEEDED
          ZR     X1,DIPX     IF NO RESET NEEDED
          RJ     RNS         RESET NEEDED STORAGE
 
 DIP      SUBR               ENTRY/EXIT
          SX6    B0          CLEAR BUFFER SAVE FLAG
          SA6    SF
          SA6    AP          CLEAR ALTERNATE PROCESSING FLAG
          SA1    LV          GET TABLE OF DIRECTIVES FOR THIS LEVEL
          BX6    X1          STORE LEVEL NUMBER
          SA6    NL
          SA1    TDTA+X1     GET PROCESSOR ADDRESS
          BX6    X1
          RJ     SCI         SCAN FOR CODE IDENTIFIER
          SX6    B0          CLEAR TERMINAL INTERRUPT FLAG
          SA6    TI
          ZR     B6,DIPX     IF END OF FILE
          ZR     X1,DIP22    IF DIRECTIVE NOT FOUND
          SA1    AP          CHECK IF ALTERNATE PROCESSING
          ZR     X1,DIP3     IF DIRECTIVE AT CURRENT LEVEL
          NG     B7,DIP23    IF NOT VALID AT CURRENT LEVEL
          SA1    B7+2        CHECK IF DIRECTIVE VALID AT CURRENT LEVEL
          LX1    59-57
          NG     X1,DIP23    IF NOT VALID AT CURRENT LEVEL
          LX1    59-58-59+57  CHECK IF DROP REQUIRED
          NG     X1,DIP1     IF IMPLIED DROP REQUIRED
          SX6    B1          SET STORAGE COPY FLAG
          SA6    SF
          RJ     SNS         SAVE NEEDED STORAGE
          EQ     DIP3        PROCESS DIRECTIVE AT CURRENT LEVEL
 
 DIP1     SX6    B7          SAVE EQUIVALENCED DIRECTIVE FLAG
          SA6    ED
          SA2    LV          GET CURRENT LEVEL
          SA3    NL          GET DESTINATION LEVEL
          IX6    X2-X3       COMPUTE NUMBER OF LEVELS TO DROP
          NG     X6,DIP23    IF INCORRECT DROP
          ZR     X6,DIP23    IF INCORRECT DROP
          SA6    DP          NUMBER OF DROPS TO PROCESS
 DIP2     SA1    DIPE+X2     GET DROP PROCESSOR ADDRESS
          ZR     X1,DIP3     IF NO DROP FOR THIS LEVEL
          RJM    X1          EXECUTE DROP FOR THIS LEVEL
          SA2    LV          GET CURRENT LEVEL NUMBER
          SA3    DP          GET DROP COUNTER
          SX6    X3-1        DECREMENT DROP COUNTER
          SA4    ED          RESET B7 FOR EQUIVALENCED DIRECTIVE
          SB7    X4
          SA6    A3          STORE DROP COUNTER
          NZ     X6,DIP2     IF MORE IMPLIED DROPS
 DIP3     PL     B7,DIP4     IF EQUIVALENCED DIRECTIVE
          SB6    B0          FLAG NO DATA FIELD
          RJ     DTO         ISSUE DIRECTIVE TO OUTPUT FILE
          SA1    DF+1        SET PROCESSOR ADDRESS
          BX1    -X1
          RJM    X1          JUMP TO PROCESSOR
          SA1    SF          CHECK IF RESET NEEDED
          ZR     X1,DIPX     IF NO RESET
          RJ     RNS         RESET NEEDED STORAGE
          EQ     DIPX        RETURN
 
 DIP4     SA1    DF+2        CHECK SEPARATOR
          SB4    X1-1R=
          NZ     B4,DIP25    IF SEPARATOR NOT *=*
          MOVE   3,B7,DIPA   GET DIRECTIVE CONTROL BLOCK
          SA2    DIPA        SET CHARACTERS TO SUPPRESS
          SA1    X2
          BX6    X1
          AX2    18          SET CHARACTERS TO ALLOW
          SA1    X2
          SA3    SE          DO NOT ALLOW SEPARATOR CHARACTER
          BX1    -X3*X1
          MX0    -6          GET MAXIMUM CHARACTER COUNT
          AX2    18
          BX4    -X0*X2
          RJ     ACI         ASSEMBLE CHARACTERS
          SX6    B5          SAVE SEPARATOR
          SA6    DF+2
          SX6    -CBUF       PRESET DATA FIELD ADDRESS
          SA6    DIPD
          MX0    -6          CHECK NUMBER OF CHARACTERS
          SA1    DIPA
          AX1    36          SET MAXIMUM NUMBER OF CHARACTERS
          BX2    -X0*X1
          AX1    6           SET MINIMUM NUMBER OF CHARACTERS
          BX1    -X0*X1
          IX1    X4-X1
          NG     X1,DIP24    IF TOO FEW CHARACTERS
          IX1    X2-X4
          NG     X1,DIP24    IF TOO MANY CHARACTERS
          SB3    X2          SET CHARACTER COUNT FOR *PIBF*, *PIOP*
          NZ     X4,DIP6     IF NOT DEFAULT
          SB2    B1+B1       SET NUMBER OF WORDS OF DEFAULT DATA FIELD
          SX1    X2-11
          PL     X1,DIP5     IF TWO WORDS
          SB2    B1          SET ONE WORD
          SX6    B0          CLEAR SECOND WORD OF BUFFER
          SA6    CBUF+1
 DIP5     SA1    DIPA+2      SET DEFAULT VALUE
          SX2    X1
          MOVE   B2,X2,CBUF
          SX4    B3          SET CHARACTER COUNT FOR *PIBF*, *PIOP*
 DIP6     SA1    DIPA        CHECK DATA FIELD TYPE
          AX1    48
          SA1    DIPC+X1     GET INDEX ADDRESS
          SB2    X1
          JP     B2          JUMP TO ADDRESS
 
*         ZERO FILL (PIZF).
 
 DIP7     MOVE   2,CBUF,DIPB DO NOT CHANGE DATA
          SB6    -2          FLAG LEFT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         BLANK FILL (PIBF).
 
 DIP8     SX1    6           SET (X0) = CHARACTER MASK
          IX4    X4*X1
          LJUST  X1,X1,X4,59
          SA1    =C*          *  PRESET BLANK FILL
          BX6    X1
          SA6    DIPB
          SA6    A6+B1
          MOVEBIT  CBUF,DIPB,X4  MOVE DATA
          SX6    DIPB        RESET DATA FIELD ADDRESS
          SA6    DIPD
          SB6    -2          FLAG LEFT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         OPTION SELECTION (PIOP).
 
 DIP9     SX1    6           SET (X0) = CHARACTER MASK
          IX4    X4*X1
          LJUST  X1,X1,X4,59
          SA1    DIPA+2      SET OPTION TABLE ADDRESS
          AX1    18
          SRCHTAB  X1,CBUF,,2  SEARCH FOR OPTION
          NZ     X4,DIP24    IF ENTRY NOT FOUND
          SA4    A1+B1       SAVE VALUE
          BX6    X4
          BX7    X3          SAVE DATA FIELD
          BX4    X3-X2
          ZR     X4,DIP10    IF EXACT MATCH
          SRCHTAB  A1+B3,A2,B2,B3,B4  SEARCH REST OF TABLE
          NZ     X4,DIP10    IF NO CONFLICT
          BX4    X3-X2
          NZ     X4,DIP24    IF NOT EXACT MATCH
          SA4    A1+B1       SAVE VALUE
          BX6    X4
          BX7    X3          SAVE DATA FIELD
 DIP10    SA6    DIPB
          SA7    CBUF
          SB6    B1          FLAG RIGHT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         NUMERIC BINARY DATA (PIBD).
 
 DIP11    SA5    CBUF
          SB7    B1
          RJ     DXB         CONVERT DISPLAY CODE TO BINARY
          NZ     X4,DIP24    IF ERROR IN DATA
          SA1    DIPA+2      GET MAXIMUM VALUE
          AX1    18
          SA2    X1
          AX1    18          GET MINIMUM VALUE
          SA1    X1
          IX2    X2-X6
          NG     X2,DIP24    IF VALUE TOO LARGE
          IX1    X6-X1
          NG     X1,DIP24    IF VALUE TOO SMALL
          SA6    DIPB
          SB6    B1          FLAG RIGHT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         PACKED DATE (PIPD).
 
 DIP12    SA1    CBUF
          RJ     DXD         CONVERT DISPLAY CODE TO PACKED DATE
          NZ     X4,DIP24    IF ERROR IN DATA
          SA6    DIPB
          SB6    B1          FLAG RIGHT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         PACKED TIME (PIPT).
 
 DIP13    SA1    CBUF
          RJ     DXT         CONVERT DISPLAY CODE TO PACKED TIME
          NZ     X4,DIP24    IF ERROR IN DATA
          SA6    DIPB
          SB6    B1          FLAG RIGHT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         JULIAN DATE (PIJD).
 
 DIP14    SA1    CBUF
          BX6    X1
          SA6    DIPB
          RJ     CJD         CHECK FOR JULIAN DATE
          NZ     X4,DIP24    IF NOT JULIAN DATE
          SB6    -2          FLAG LEFT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         VSN/SEQUENCE NUMBER (PIVQ).
 
 DIP15    RJ     PVS         PAD VSN
          SA6    DIPB        SAVE VSN
          SA1    =C*1*       SET SEQUENCE NUMBER DEFAULT
          BX6    X1
          SA6    CBUF
          SA1    DF+2        CHECK SEPARATOR
          SX1    X1-1R/
          NZ     X1,DIP16    IF SEQUENCE NOT SPECIFIED
          SA1    ="BL"       SET SUPPRESSED CHARACTERS
          BX6    X1
          SA1    ="NC"       SET ALLOWED CHARACTERS
          SX4    10          SET MAXIMUM CHARACTERS
          RJ     ACI         ASSEMBLE CHARACTERS
 DIP16    SA1    CBUF        SAVE SEQUENCE IMAGE
          BX6    X1
          SA6    DIPB+1
          MOVEBIT  DIPB,CBUF,VSKL*6  SET DATA FIELD IMAGE
          MOVEBIT  (=C*/*),CBUF,6,,59-VSKL*6
          MOVEBIT  DIPB+1,CBUF,60,,59-VSKL*6-6
          SA5    DIPB+1      GET DISPLAY SEQUENCE NUMBER
          SB7    B1
          RJ     DXB         CONVERT DISPLAY TO BINARY
          NZ     X4,DIP24    IF CONVERSION ERROR
          ZR     X6,DIP24    IF VALUE .EQ. 0
          SX1    X6-10000
          PL     X1,DIP24    IF VALUE .GT. 9999
          SA1    DIPB        MERGE VSN AND SEQUENCE NUMBER
          BX6    X1+X6
          SA6    A1
          SB6    -2          FLAG LEFT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         PADDED VSN (PIVS).
 
 DIP17    RJ     PVS         PAD VSN
          SA6    DIPB
          SA6    CBUF
          SB6    -2          FLAG LEFT JUSTIFIED
          EQ     DIP20       SET VALUE IN TABLE
 
*         SPECIAL CHARACTER BIT STRING (PIBS).
 
 DIP18    SA1    CBUF        CHECK IF SPECIFIED
          BX6    X1
          ZR     X1,DIP19    IF NO CHARACTER
          LX1    -54+60      GET BIT POSITION
          SB2    X1-1R+
          NG     B2,DIP24    IF NOT SPECIAL CHARACTER
          SX6    B1          POSITION BIT STRING
          LX6    B2
 DIP19    SA6    DIPB
          SB2    -2          FLAG LEFT JUSTIFIED
*         EQ     DIP20       SET VALUE IN TABLE
 
*         SET VALUE IN CATALOG TABLE.
 
 DIP20    SA3    DIPA+1      SET CATALOG TABLE ADDRESS
          SA2    X3
          MX0    -12         SET BIT COUNT
          AX3    36
          BX1    -X0*X3
          SB4    X1
          AX3    12          SET UPPER BIT OF FIELD
          SB2    X3
          SB3    59
          NG     B6,DIP21    IF LEFT JUSTIFIED
          SB3    B4-B1       SET UPPER BIT POSITION OF VALUE
 DIP21    MOVEBIT  DIPB,A2,B4,B3,B2  SET VALUE IN TABLE
          EQ     DIP28       ISSUE DIRECTIVE TO OUTPUT FILE
 
 DIP22    SB6    B0          FLAG NO DATA FIELD
          RJ     DTO         ISSUE DIRECTIVE TO OUTPUT FILE
          SB5    EILD        SET ERROR MESSAGE ADDRESS
          EQ     DIP27       ISSUE MESSAGE
 
 DIP23    SB6    B0          FLAG NO DATA FIELD
          RJ     DTO         ISSUE DIRECTIVE TO OUTPUT
          SB5    EDLE        SET ERROR MESSAGE ADDRESS
          EQ     DIP27       ISSUE ERROR MESSAGE
 
 DIP24    SA1    DIPD        SET DATA FIELD ADDRESS
          SB6    X1
          EQ     DIP26       ISSUE ERROR MESSAGE
 
 DIP25    SB6    B0          FLAG NO DATA FIELD
 DIP26    RJ     DTO         ISSUE DIRECTIVE TO OUTPUT FILE
          SB5    EDFE        SET ERROR MESSAGE ADDRESS
 DIP27    ISSMSG B5,E        ISSUE ERROR MESSAGE
          EQ     DIPX        RETURN
 
 DIPA     BSS    3           IMAGE OF DIRECTIVE CONTROL BLOCK
 DIPB     BSS    2           IMAGE OF DATA FIELD VALUE
 DIPC     INDTAB 1           *DIP* PROCESSOR TABLE
          INDEX  PIZF,CON,DIP7  ZERO FILL
          INDEX  PIBF,CON,DIP8  BLANK FILL
          INDEX  PIOP,CON,DIP9  OPTION SELECTION
          INDEX  PIBD,CON,DIP11  NUMERIC BINARY DATA
          INDEX  PIPD,CON,DIP12  PACKED DATE
          INDEX  PIPT,CON,DIP13  PACKED TIME
          INDEX  PIJD,CON,DIP14  JULIAN DATE
          INDEX  PIVQ,CON,DIP15  VSN/SEQUENCE NUMBER
          INDEX  PIVS,CON,DIP17  PADDED VSN
          INDEX  PIBS,CON,DIP18  SPECIAL CHARACTER BIT STRING
 DIPD     BSS    1           DATA FIELD ADDRESS
 
 DIPE     BSS    0           DROP PROCESSOR TABLE
          LOC    0
          CON    0           FAMILY LEVEL DROP
          CON    /LVVS/DRO   VSN LEVEL DROP
          CON    /LVUS/DRO   USER LEVEL DROP
          CON    /LVFI/DRO   FILE LEVEL DROP
          CON    /LVAU/DRO   ALTERNATE USER LEVEL DROP
          LOC    *O
          CON    0           END OF PROCESSOR ADDRESS
 DTO      SPACE  4,20
**        DTO - ISSUE DIRECTIVE TO OUTPUT FILE.
*
*         ENTRY  (DF) = DIRECTIVE LEFT JUSTIFIED.
*                (B6) = 0 IF NO DATA FIELD.
*                     = ADDRESS OF SPACE FILLED DATA FIELD.
*                (BF) = BRIEF/NOBRIEF FLAG.
*
*         EXIT   DIRECTIVE ISSUED TO OUTPUT FILE.
*                ((B6) - (B6)+1) SPACE FILLED.
*
*         USES   A - 1, 6.
*                B - 6.
*                X - 1, 6.
*
*         CALLS  SFN.
*
*         MACROS MOVE, MOVEBIT, WLINES.
 
 
 DTO      SUBR               ENTRY/EXIT
          SA1    =10H            BLANK FILL DATA FIELD
          BX6    X1
          SA6    /KMESS/DIRECT+2
          SA6    A6+B1
          SA1    DF          GET DIRECTIVE
          RJ     SFN         SPACE FILL NAME
          LX6    -6+60       SET DIRECTIVE IN MESSAGE
          SA6    /KMESS/DIRECT+1
          ZR     B6,DTO2     IF NO DATA FIELD
          SX2    2R= &2R     SET EQUAL SIGN IN MESSAGE
          BX6    X6-X2
          SA6    A6
          PL     B6,DTO1     IF ALREADY SPACE FILLED
          SB6    -B6         GET DATA FIELD ADDRESS
          SA1    B6
          RJ     SFN         SPACE FILL NAME
          SA6    B6
          SA1    B6+B1       GET SECOND WORD OF DATA FIELD
          RJ     SFN         SPACE FILL NAME
          SA6    B6+B1
 DTO1     MOVEBIT  B6,/KMESS/DIRECT+1,PNKL*6,,5  MOVE FIELD TO MESSAGE
 DTO2     SX6    B0          CLEAR MESSAGE BUFFER
          SA6    /KMESS/MESSAGE
          SA6    A6+B1
          SA1    =10H *********  SET START OF DIRECTIVE MESSAGE
          BX6    X1
          SA6    /KMESS/DIRECT
          MOVE   3,/KMESS/DIRECT+1,NPGG  MOVE DIRECTIVE TO PAGE HEADER
          SA1    BF          CHECK *BRIEF* FLAG
          NZ     X1,DTOX     IF *BRIEF* MODE SET
          WLINES /KMESS/DIRECT,1  WRITE DIRECTIVE TO OUTPUT FILE
          EQ     DTOX        RETURN
 DXD      SPACE  4,15
**        DXD - DISPLAY TO PACKED DATE CONVERSION.
*
*         ENTRY  (X1) = DISPLAY DATE LEFT JUSTIFIED IN YYMMDD FORMAT.
*
*         EXIT   (X4) = 0 IF NO CONVERSION ERROR.
*                (X6) = PACKED DATE.
*
*         USES   A - 1, 3, 6, 7.
*                X - 0, 1, 2, 3, 7.
*
*         CALLS  DDC.
 
 
 DXD      SUBR               ENTRY/EXIT
          SX4    B0          CHECK BLANK RELEASE DATE
          SA3    =C* *
          BX6    X1-X3
          ZR     X6,DXDX     IF NO RELEASE DATE
          BX6    X1          SAVE MONTH AND DAY
          SA6    DXDA
          SX2    B0          SET MINIMUM VALUE
          SX3    99          SET MAXIMUM VALUE
          RJ     DDC         CONVERT DECIMAL DIGITS
          NZ     X4,DXDX     IF CONVERSION ERROR
          MX0    -2          CHECK FOR LEAP YEAR
          BX1    -X0*X6
          SX7    28
          NZ     X1,DXD1     IF NOT LEAP YEAR
          SX7    X7+B1
 DXD1     SA7    DXDC+2-1    SET NUMBER OF DAYS IN FEBRUARY
          SX6    X6-70
          PL     X6,DXD2     IF BETWEEN 1970 AND 1999
          SX6    X6+100
 DXD2     SX4    B1          CHECK IF YEAR TOO LARGE
          SX1    X6-100B
          PL     X1,DXDX     IF AFTER 2033
          LX6    12          SET PACKED YEAR
          SA6    DXDB
          SA1    DXDA        GET MONTH
          LX1    12
          SX2    B1          SET MINIMUM NUMBER OF MONTHS/DAYS
          SX3    12          SET MAXIMUM NUMBER OF MONTHS
          RJ     DDC         CONVERT DECIMAL DIGITS
          NZ     X4,DXDX     IF CONVERSION ERROR
          SA3    DXDC+X6-1   GET NUMBER OF DAYS IN MONTH
          SA1    DXDB        SET PACKED MONTH
          LX6    6
          BX6    X1+X6
          SA6    A1
          SA1    DXDA        GET DAY
          LX1    24
          RJ     DDC         CONVERT DECIMAL DIGITS
          NZ     X4,DXDX     IF CONVERSION ERROR
          SA1    DXDB        SET PACKED DAY
          BX6    X1+X6
          EQ     DXDX        RETURN
 
 DXDA     BSS    1           DISPLAY DATE
 DXDB     BSS    1           PACKED DATE
 DXDC     BSS    0           DAYS PER MONTH TABLE
          LOC    1
          CON    31          JANUARY
          CON    28          FEBRUARY
*         CON    29          (FEBRUARY - LEAP YEAR)
          CON    31          MARCH
          CON    30          APRIL
          CON    31          MAY
          CON    30          JUNE
          CON    31          JULY
          CON    31          AUGUST
          CON    30          SEPTEMBER
          CON    31          OCTOBER
          CON    30          NOVEMBER
          CON    31          DECEMBER
          LOC    *O
 DXT      SPACE  4,15
**        DXT - DISPLAY TO PACKED TIME CONVERSION.
*
*         ENTRY  (X1) = DISPLAY TIME LEFT JUSTIFIED IN HHMMSS FORMAT.
*
*         EXIT   (X4) = 0 IF NO CONVERSION ERROR
*                (X6) = PACKED TIME.
*
*         USES   A - 1, 6.
*                X - 1, 2, 3.
*
*         CALLS  DDC.
 
 
 DXT      SUBR               ENTRY/EXIT
          BX6    X1          SAVE MINUTES AND SECONDS
          SA6    DXTA
          SX2    B0          SET MINIMUM VALUE
          SX3    23          SET MAXIMUM NUMBER OF HOURS
          RJ     DDC         CONVERT DISPLAY DIGITS
          NZ     X4,DXTX     IF CONVERSION ERROR
          LX6    12          SET PACKED HOURS
          SA6    DXTB
          SA1    DXTA        GET MINUTES
          LX1    12
          SX3    59          SET MAXIMUM NUMBER OF MINUTES/SECONDS
          RJ     DDC         CONVERT DISPLAY DIGITS
          NZ     X4,DXTX     IF CONVERSION ERROR
          SA1    DXTB        SET PACKED MINUTES
          LX6    6
          BX6    X1+X6
          SA6    A1
          SA1    DXTA        GET SECONDS
          LX1    24
          RJ     DDC         CONVERT DISPLAY DIGITS
          NZ     X4,DXTX     IF CONVERSION ERROR
          SA1    DXTB        SET PACKED SECONDS
          BX6    X1+X6
          EQ     DXTX        RETURN
 
 DXTA     BSS    1           DISPLAY TIME
 DXTB     BSS    1           PACKED TIME
 FAL      SPACE  4,10
**        FAL - FAMILY LEVEL PROCESSOR.
*
*         EXIT   PROGRAM SET FOR FAMILY LEVEL DIRECTIVES.
*
*         USES   A - 1, 6.
*                X - 1, 6.
 
 
 FAL      SUBR               ENTRY/EXIT
          SX6    LVFA        SET FAMILY LEVEL
          SA6    LV
          SA1    FALA        RESET LEFT SCREEN POINTER
          BX6    X1
          SA6    /KLEFT/NEXT
          SA1    FALB        RESET RIGHT SCREEN POINTER
          BX6    X1
          SA6    /KRIGHT/NEXT
          SA1    =H*   FAMILY *  SET LEVEL IN HELP DISPLAY
          BX6    X1
          SA6    /KRIGHT/LV
          EQ     FALX        RETURN
 
 FALA     KNEXT  KFAMLS,NOLAB
 FALB     KNEXT  KFAMRS,NOLAB
 FEL      SPACE  4,15
**        FEL - FORCE END OF LINE.
*
*         ENTRY  (A2) = ADDRESS TO START END OF LINE.
*                (X3) = BIT POSITION TO START END OF LINE.
*
*         EXIT   (A2) = ADDRESS OF END OF END OF LINE.
*
*         USES   A - 1.
*                B - 4.
*                X - 0, 1, 2, 6.
*
*         MACROS MOVEBIT.
 
 
 FEL      SUBR               ENTRY/EXIT
          MX0    -12         CHECK BIT POSITION
          SX1    X3-59
          NZ     X1,FEL1     IF NOT AT START OF WORD
          SA1    A2-1        CHECK PREVIOUS WORD
          BX1    -X0*X1
          ZR     X1,FELX     IF ALREADY AT END OF LINE
 FEL1     SA2    A2
          SB4    X3+B1       PRESET BIT COUNT
          SX6    X3-6
          PL     X6,FEL2     IF END OF LINE ON ONLY ONE WORD
          SB4    B4+60       RESET BIT COUNT
 FEL2     MOVEBIT  FELA,A2,B4,,X3  SET END OF LINE
          EQ     FELX        RETURN
 
 FELA     BSS    2           END OF LINE IMAGE
 FEV      SPACE  4,15
**        FEV - FIND EXTERNAL VSN.
*
*         ENTRY  (FCAT) = FILE CATALOG IMAGE.
*                (TAVS) = ASSIGNED VSN ENTRIES.
*
*         EXIT   (X4) = 0 IF VSN FOUND.
*                (A1) = ADDRESS OF EXTERNAL VSN ENTRY IN *TAVS*.
*                (X6) = VSN BUFFER SIZE.
*
*         USES   A - 2.
*                X - 0, 2.
*
*         MACROS RJUST, SRCHTAB.
 
 
 FEV      SUBR               ENTRY/EXIT
          MX0    VSKL*6      FIND EXTERNAL VSN
          SA2    /ADD/EVSN
          SRCHTAB  TAVS,A2,TAVSL,4
          SA2    /ADD/REELC
          RJUST  X2,X6,/BTC/REELC,/UPB/REELC
          LX6    2
          EQ     FEVX        RETURN
 FIA      SPACE  4,15
**        FIA - FILE AUDIT LIST PROCESSOR.
*
*         ENTRY  (FCAT) = IMAGE OF FILE CATALOG.
*                (TAVS) = IMAGE OF ASSIGNED VSNS.
*
*         EXIT   FILE INFORMATION WRITTEN TO OUTPUT FILE.
*
*         USES   A - 1, 6.
*                B - 2, 3, 7.
*                X - 1, 6, 7.
*
*         CALLS  CDD, FEL, FEV, SFN.
*
*         MACROS CLEAR, DISLIS, LISTAB, MOVEBIT, RJUST, SETSORC,
*                WWORDS.
 
 
 FIA      SUBR               ENTRY/EXIT
          SA1    UN          SET USER NAME IN LISTING
          RJ     SFN         SPACE FILL NAME
          BX1    X6          SET USER NAME IN LISTING
          MOVEBIT  A1,/ALS/FUN,UNKL*6,59,/ALSU/FUN
          SA1    TAVS+/CAT/FVSN  SET FIRST VSN IN LISTING
          MOVEBIT  A1,/ALS/VSNF,VSKL*6,,/ALSU/VSNF
          SA1    /ADD/QN  SET SEQUENCE NUMBER IN LISTING
          RJUST  X1,X1,/BTC/QN,/UPB/QN
          SX1    X1+10000
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          BX1    X6
          MOVEBIT  A1,/ALS/QN,24,23,/ALSU/QN
          SETSORC  A,LVFI    SET SOURCE VALUES IN AUDIT LISTING
          SA1    /ALS/FI     CHECK FOR EXTRA END OF LINES
          SB3    /ALSU/FI
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /ALS/PI
          SB3    /ALSU/PI
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          MOVE   4,FIAF,FIAD CLEAR RELEASE MESSAGE
          MX0    -18
          SA1    TAVS+/CAT/URDATE  SET UNCONDITIONAL RELEASE DATE
          BX1    -X0*X1
          ZR     X1,FIA1     IF NO CONDITIONAL RELEASE DATE
          SA1    TAVS+/CAT/NEWRDT  CHECK RELEASE DATE FORMAT
          LJUST  X1,X1,/BTC/NEWRDT,/UPB/NEWRDT
          NG     X1,FIA0.1   IF NEW FORMAT
          MOVEBIT  /ALS/URDATE,/ALS/RDATE,6*6,/ALSU/URDATE,/ALSU/RDATE
          MOVE   4,FIAE,FIAD SET CONDITIONALLY RELEASE MESSAGE
          EQ     FIA1        CLEAR LIST OF VSNS
 
 FIA0.1   MOVE   4,FIAG,FIAD SET UNCONDITIONAL RELEASE MESSAGE
 FIA1     CLEAR  FIAC,60     CLEAR LIST OF VSNS
          RJ     FEV         FIND EXTERNAL VSN
          SB2    X6          GET LIST OF VSNS
          LISTAB A1,FIAC,B2,,4,VSKL*6
          SA1    =4R         SET IMAGE BETWEEN VSNS
          BX6    X1
          SX7    12          PRESET NUMBER OF VSN ENTRIES PER LINE
          SA1    OS
          NG     X1,FIA2     IF MASS STORAGE OUTPUT
          SX7    6           RESET NUMBER OF VSN ENTRIES PER LINE
 FIA2     DISLIS FIAC,FIAB,,VSKL*6,24,X7
          RJ     FEL         FORCE END OF LINE
          SA1    =C* *       INSERT BLANK LINE
          BX6    X1
          SA6    A2
          SB7    A2-FIAA+1   SET ASSIGNED VSNS LIST LENGTH
          WWORDS FIAA,B7     WRITE ASSIGNED VSNS LIST
          EQ     FIAX        RETURN
 
 FIAA     BSS    0           AUDIT LISTING
          LISTER ALS,1
 FUN      LISTER ,7          USER NAME
          LISTER ,2
 FI       LISTER ,17         FILE IDENTIFIER
          LISTER ,2
 SV       LISTER ,1          SYMBOLIC ACCESS FLAG
          LISTER ,2
 VSNF     LISTER ,6          FIRST VSN
          LISTER ,2
 QN       LISTER ,4          SEQUENCE NUMBER
          LISTER ,1
 CE       LISTER ,1          ERROR FLAG
          LISTER ,1
 CN       LISTER ,10         CHARGE NUMBER
          LISTER ,1
 PN       LISTER ,20         PROJECT NUMBER
 EOL1     LISTER ,2          END OF TERMINAL OUTPUT LINE
          LISTER ,1
 PW       LISTER ,7          PASSWORD
          LISTER ,2
 PI       LISTER ,17         PHYSICAL IDENTIFIER
          LISTER ,2
 M        LISTER ,1          MODE
          LISTER ,2
 CT       LISTER ,2          CATEGORY
          LISTER ,2
 AC       LISTER ,1          ALTERNATE AUDIT FLAG
          LISTER ,2
 UC       LISTER ,10         USER CONTROL WORD
          LISTER ,1,,E
          LISTER ,1
 CR       LISTER ,5          CREATION DATE
          LISTER ,3
 CV       LISTER ,2          CONVERSION MODE
          LISTER ,2
 D        LISTER ,2          DENSITY
          LISTER ,3
 E        LISTER ,2          GENERATION VERSION NUMBER
          LISTER ,3
 F        LISTER ,2          FORMAT
          LISTER ,2
 FA       LISTER ,1          ACCESSIBILITY CHARACTER
          LISTER ,3
 FC       LISTER ,4          MAXIMUM FRAME COUNT
          LISTER ,3
 G        LISTER ,4          GENERATION NUMBER
          LISTER ,2
 LB       LISTER ,2          LABEL TYPE
          LISTER ,2
 NS       LISTER ,2          NOISE SIZE
          LISTER ,3
 RT       LISTER ,5          RETENTION DATE
          LISTER ,3
 SN       LISTER ,4          SECTION NUMBER
          LISTER ,4
 SI       LISTER ,6          SET IDENTIFIER
          LISTER ,3
 EOL2     LISTER ,2          END OF TERMINAL OUTPUT LINE
          LISTER ,1
 ACOUNT   LISTER ,8          ACCESS COUNT
          LISTER ,1
 CDATE    LISTER ,6          CREATION DATE
          LISTER ,1
 CTIME    LISTER ,6          CREATION TIME
          LISTER ,1
 ADATE    LISTER ,6          ACCESS DATE
          LISTER ,1
 ATIME    LISTER ,6          ACCESS TIME
          LISTER ,1
 MDATE    LISTER ,6          MODIFICATION DATE
          LISTER ,1
 MTIME    LISTER ,6,,E       MODIFICATION TIME
 FIAD     DATA   36L
 FIAB     BSS    0           LISTING OF ASSIGNED VSNS
          DUP    10
          DATA   30H
          DATA   26L
          ENDD
          DATA   C* *
 FIAC     BSS    60          LIST OF ASSIGNED VSNS
 FIAE     BSS    0
          LISTER ,27,( ** CONDITIONALLY RELEASED )
 RDATE    LISTER ,6,YYMMDD
          LISTER ,3,( **),E
 FIAF     DATA   36L
 FIAG     BSS    0
          LISTER ,19,( ** TO BE RELEASED )
 URDATE   LISTER ,6,YYMMDD   UNCONDITIONAL RELEASE DATE
          LISTER ,11,( **        ),E
 FIL      SPACE  4,10
**        FIL - FILE LEVEL PROCESSOR.
*
*         EXIT   PROGRAM SET FOR FILE LEVEL DIRECTIVES.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  RDA.
*
*         MACROS LJUST, MOVE, MOVEBIT, RJUST.
 
 
 FIL      SUBR               ENTRY/EXIT
          SX6    B0          CLEAR ALTERNATE USER
          SA6    AU
          SX6    LVFI        SET FILE LEVEL
          SA6    LV
          SA1    UN          SET USER NAME IN K-DISPLAY
          BX6    X1
          SA6    /KFILLS1/USER
          SA6    /KFILLS2/USER
          SA6    /KFILLS3/USER
          MOVEBIT  FI,/KFILLS1/FILE,FIKL*6  SET FILE ID IN K-DISPLAY
          MOVEBIT  FI,/KFILLS2/FILE,FIKL*6
          MOVEBIT  FI,/KFILLS3/FILE,FIKL*6
          SA1    RF          CHECK RESERVED FLAG
          SA2    FILA        PRESET MESSAGE ADDRESS
          ZR     X1,FIL1     IF FILE NOT RESERVED
          SA2    FILB        RESET MESSAGE ADDRESS
 FIL1     MOVE   3,A2,/KFILLS1/MESS  SET RESERVE MESSAGE IN K-DISPLAY
          MOVE   3,/KFILLS1/MESS,/KFILLS2/MESS
          MOVE   3,/KFILLS2/MESS,/KFILLS3/MESS
          SA1    /ADD/D      GET FILE DENSITY
          RJUST  X1,X2,/BTC/D,/UPB/D
          MX0    60          GET DENSITY MNEMONIC
          SRCHTAB  /DOTAB/D,A2,,2,1
          MOVEBIT  A1,/KDIS/D,2*6,,5  SET MNEMONIC IN K-DISPLAY
          SA1    FILC        RESET LEFT SCREEN POINTER
          BX6    X1
          SA6    /KLEFT/NEXT
          SA1    FILD        RESET RIGHT SCREEN POINTER
          BX6    X1
          SA6    /KRIGHT/NEXT
          SA1    =H*     FILE *  SET LEVEL IN HELP DISPLAY
          BX6    X1
          SA6    /KRIGHT/LV
          SX6    B1          SET FILE LEVEL TOGGLE PAGE
          SA6    TG
          SA1    TAVS+/CAT/URDATE  CHECK RELEASE DATE
          RJUST  X1,X6,/BTC/URDATE,/UPB/URDATE
          ZR     X6,FILX     IF NO RELEASE DATE
          SA1    TAVS+/CAT/NEWRDT  CHECK RELEASE DATE FORMAT
          LJUST  X1,X1,/BTC/NEWRDT,/UPB/NEWRDT
          NG     X1,FILX     IF NEW FORMAT
          SA6    /LVFI/RDAA
          RJ     /LVFI/RDA   CONVERT RDATE TO URDATE
          EQ     FILX        RETURN
 
 FILA     DATA   30HFILE NOT CURRENTLY RESERVED.
 FILB     DATA   30HFILE CURRENTLY IS RESERVED.
 FILC     KNEXT  KFILLS1,NOLAB
 FILD     KNEXT  KFILRS,NOLAB
 FIS      SPACE  4,15
**        FIS - FILE SOURCE LISTING PROCESSOR.
*
*         ENTRY  (FCAT) = IMAGE OF FILE CATALOG.
*                (TAVS) = IMAGE OF ASSIGNED VSNS.
*
*         EXIT   FILE INFORMATION WRITTEN TO SOURCE FILE.
*
*         USES   A - 1, 2, 3, 6.
*                B - 2.
*                X - 1, 2, 3, 6.
*
*         CALLS  AUS, CDD, FEL, FEV, SCS.
*
*         MACROS CLEAR, DISLIS, GRENTRY, LISTAB, MOVEBIT, RCREC, RJUST,
*                SETSORC, WRITEC, WRITEW.
 
 
 FIS7     WRITEC S,(=C*DROP*)  WRITE LAST LINE OF ENTRY
 
 FIS      SUBR               ENTRY/EXIT
          SX6    B0          PRESET ADD ALL VSNS
          SA6    FISD
          SA1    /ADD/QN CHECK SEQUENCE NUMBER
          RJUST  X1,X1,/BTC/QN,/UPB/QN
          SB2    X1-1
          NZ     B2,FIS2     IF NOT *QN=1*
          SA2    /ADD/SV CHECK SYMBOLIC ACCESS
          RJUST  X2,X2,/BTC/SV,/UPB/SV
          ZR     X2,FIS1     IF NOT SYMBOLIC ACCESS
          MOVEBIT  FI,FISE,FIKL*6  SAVE VALUE OF (FI)
          MOVEBIT  /ADD/FI,FI,FIKL*6  ADD *FILE* TO SOURCE ENTRY
          SA1    /DTAB/FILE
          RJ     SCS         PROCESS SPECIAL CHARACTER SOURCE ENTRY
          MOVEBIT  FISE,FI,FIKL*6  RESTORE VALUE OF (FI)
          SX6    FISG        FLAG *FILE* DIRECTIVE
          SA6    FISH
          MOVE   CSPL/10,SCSB,X6  SAVE IMAGE OF DIRECTIVE
          EQ     FIS3        GET SOURCE VALUES
 
 FIS1     SX6    B1          RESET TO IGNORE FIRST VSN
          SA6    FISD
 FIS2     RJ     CDD         CONVERT TO DECIMAL DISPLAY
          BX1    X4          SET SEQUENCE NUMBER IN IDENTIFIER
          MOVEBIT  A1,/SLS/QN,4*6,,/SLSU/QN
          SA1    TAVS+/CAT/FVSN
          MOVEBIT  A1,/SLS/IDENT,VSKL*6,,/SLSU/IDENT
          WRITEC S,FISF      WRITE FIRST LINE OF SOURCE ENTRY
          SX6    FISF        FLAG *FILEV* DIRECTIVE
          SA6    FISH
 FIS3     SA1    TAVS+/CAT/NEWRDT  CHECK RELEASE DATE FORMAT
          LJUST  X1,X6,/BTC/NEWRDT,/UPB/NEWRDT
          SX1    1RU
          NG     X6,FIS3.1   IF NEW FORMAT
          SX1    1R
 FIS3.1   MOVEBIT A1,/SLS/NEWRDT,1*6,5,/SLSU/NEWRDT
          SETSORC  S,LVFI    SET SOURCE VALUES IN SOURCE LISTING
          SA1    /DTAB/FI    ADD *FI* TO SOURCE ENTRY
          RJ     SCS         PROCESS SPECIAL CHARACTER SOURCE ENTRY
          WRITEW S,FISA,FISAL  WRITE FIRST PART OF SOURCE LISTING
          SA1    /DTAB/PI    ADD *PI* TO SOURCE ENTRY
          RJ     SCS         PROCESS SPECIAL CHARACTER SOURCE ENTRY
          SA1    /DTAB/PW    ADD *PW* TO SOURCE ENTRY
          RJ     SCS         PROCESS SPECIAL CHARACTER SOURCE ENTRY
          SA1    /DTAB/UC    ADD *UC* TO SOURCE ENTRY
          RJ     SCS         PROCESS SPECIAL CHARACTER SOURCE ENTRY
          SA1    /DTAB/SI    ADD *SI* TO SOURCE ENTRY
          RJ     SCS         PROCESS SPECIAL CHARACTER SOURCE ENTRY
          CLEAR  FISC,60     CLEAR LIST OF VSNS
          RJ     FEV         FIND EXTERNAL VSN
          SA2    FISD
          ZR     X2,FIS4     IF SYMBOLIC ACCESS
          SA1    A1+TSVL     SKIP FIRST VSN
          SX6    X6-4
 FIS4     ZR     X6,FIS5     IF NO ASSIGNED VSNS
          SB2    X6          GET LIST OF VSNS
          LISTAB A1,FISC,B2,,4,VSKL*6
          SA3    =6R,AVSN=   SET IMAGE BETWEEN ENTRIES
          BX6    X3
          DISLIS FISC,FISB,,VSKL*6,36,6  SET VSNS IN SOURCE LISTING
          RJ     FEL         FORCE END OF LINE
          SX2    A2-FISB     SET LENGTH OF SOURCE LISTING
          WRITEW S,FISB,X2   WRITE ASSIGNED VSNS TO SOURCE
 FIS5     WRITEC S,(=C*GO*)  WRITE LAST LINE OF SOURCE ENTRY
          SA1    /ADD/AUCAT  CHECK FOR ALTERNATE USERS
          RJUST  X1,X1,/BTC/AUCAT,/UPB/AUCAT
          ZR     X1,FISX     IF NO ALTERNATE USERS
          SA1    FISH        WRITE FIRST DIRECTIVE
          WRITEC S,X1
          SA1    /ADD/AUCAT  GET ALTERNATE USERS RANDOM ADDRESS
          RJUST  X1,X1,/BTC/AUCAT,/UPB/AUCAT
          RCREC  N4,X1
 FIS6     GRENTRY  N4,ACAT   GET RECORD ENTRY
          ZR     X6,FIS7     IF END OF ENTRIES
          RJ     AUS         PROCESS ALTERNATE USER SOURCE LISTING
          EQ     FIS6        GET NEXT ENTRY
 
 FISA     BSS    0           SOURCE LISTING
          LISTER SLS,3,(SV=)
 SV       LISTER ,3,NO       SYMBOLIC ACCESS STATUS
          LISTER ,9,(,RECOVER=)
 RECOVER  LISTER ,3,NO       RECOVERY STATUS
          LISTER ,4,(,PN=)
 PN       LISTER ,20,,E,CAPL PROJECT NUMBER
          LISTER ,3,CN=
 CN       LISTER ,10         CHARGE NUMBER
          LISTER ,4,(,CT=)
 CT       LISTER ,7,PRIVATE  FILE CATEGORY
          LISTER ,3,(,M=)
 M        LISTER ,5,WRITE    FILE MODE
          LISTER ,4,(,AC=)
 AC       LISTER ,3,NO       ALTERNATE AUDIT FLAG
          LISTER ,4,(,CE=)
 CE       LISTER ,5,CLEAR,E,CAPL  ERROR FLAG
          LISTER ,3,CR=
 CR       LISTER ,5,YYDDD    CREATION DATE
          LISTER ,4,(,CV=)
 CV       LISTER ,2,AS       CONVERSION MODE
          LISTER ,3,(,D=)
 D        LISTER ,2,PE       DENSITY
          LISTER ,3,(,E=)
 E        LISTER ,2,00       GENERATION VERSION NUMBER
          LISTER ,3,(,F=)
 F        LISTER ,2,I        FORMAT
          LISTER ,4,(,FA=)
 FA       LISTER ,1          ACCESSIBILITY CHARACTER
          LISTER ,4,(,FC=)
 FC       LISTER ,4,"MXFC"   MAXIMUM BLOCK COUNT
          LISTER ,3,(,G=)
 G        LISTER ,4,0001     GENERATION NUMBER
          LISTER ,4,(,LB=)
 LB       LISTER ,2,KL       LABEL TYPE
          LISTER ,4,(,NS=)
 NS       LISTER ,2,00,E,CAPL  NOISE SIZE
          LISTER ,3,RT=
 RT       LISTER ,5,YYDDD    RETENTION DATE
          LISTER ,4,(,SN=)
 SN       LISTER ,4,0001     SECTION NUMBER
          LISTER ,8,(,ACOUNT=)
 ACOUNT   LISTER ,8,00000000 ACCESS COUNT
          LISTER ,7,(,CDATE=)
 CDATE    LISTER ,6,YYMMDD   CREATION DATE
          LISTER ,7,(,CTIME=)
 CTIME    LISTER ,6,HHMMSS,E,CAPL  CREATION TIME
          LISTER ,6,ADATE=
 ADATE    LISTER ,6,YYMMDD   LAST ACCESS DATE
          LISTER ,7,(,ATIME=)
 ATIME    LISTER ,6,HHMMSS   LAST ACCESS TIME
          LISTER ,7,(,MDATE=)
 MDATE    LISTER ,6,YYMMDD   LAST MODIFICATION DATE
          LISTER ,7,(,MTIME=)
 MTIME    LISTER ,6,HHMMSS,E,CAPL  LAST MODIFICATION TIME
 NEWRDT   LISTER ,1,(U)      URDATE/RDATE FLAG
          LISTER ,6,(RDATE=)
 URDATE   LISTER ,6,YYMMDD,E,CAPL  RELEASE DATE
 FISAL    EQU    *-FISA      LENGTH OF SOURCE LISTING
 
 FISB     BSS    0           ASSIGNED VSNS SOURCE LISTINGS
          DUP    10
          DATA   24H,AVSN=      ,AVSN=
          DATA   24H,AVSN=      ,AVSN=
          DATA   24L,AVSN=      ,AVSN=
          ENDD
 FISC     BSS    60          ASSIGNED VSNS
 FISD     BSS    1           PROCESS FIRST VSN FLAG
 FISE     BSS    2           VALUE OF (FI)
 
 FISF     BSS    0           FIRST LINE OF *FILEV* ENTRY
          LISTER SLS,6,FILEV=
 IDENT    LISTER ,6          VSN IDENTIFIER
          LISTER ,1,/
 QN       LISTER ,4,,E,CAPL  SEQUENCE NUMBER
 
 FISG     BSS    CSPL/10     FIRST LINE OF *FILE* ENTRY
          CON    0
 
 FISH     CON    FISF        ADDRESS OF FIRST DIRECTIVE
 FOB      SPACE  4,10
**        FOB - FLUSH OUTPUT BUFFER.
*
*         ENTRY  (OS) .GT. 0 IF TERMINAL OUTPUT.
*
*         EXIT   OUTPUT WRITTEN TO TERMINAL FILE.
*
*         USES   A - 1.
*                X - 1.
*
*         MACROS WRITER.
 
 
 FOB      SUBR               ENTRY/EXIT
          SA1    OS
          ZR     X1,FOBX     IF NO OUTPUT FILE
          NG     X1,FOBX     IF MASS STORAGE OUTPUT FILE
          WRITER L,R         FLUSH OUTPUT BUFFER
          EQ     FOBX        RETURN
 GAE      SPACE  4,15
**        GAE - GET ALTERNATE USER ENTRY.
*
*         ENTRY  (AU) = ALTERNATE USER NAME.
*                (CA) = RANDOM ADDRESS OF FILE CATALOG.
*
*         EXIT   (X4) .NE. 0 IF ALTERNATE USER NOT IN CATALOG.
*                (ACAT - ACAT+1) = ALTERNATE USER ENTRY.
*
*         USES   A - 1, 6.
*                X - 1, 2, 6.
*
*         CALLS  CAB.
*
*         MACROS CALLTFM, MOVE, MOVEBIT, RESETP, WRITFET.
 
 
 GAE      SUBR               ENTRY/EXIT
          RJ     CAB         CHECK IF ALTERNATE USER IN BUFFER
          ZR     X4,GAE1     IF ALTERNATE USER IN BUFFER
          MOVEBIT  AU,DAUC+/CAT/AUSER,UNKL*6,,/UPB/AUSER
          MOVE   TAEL,DAUC,ACAT  SET DEFAULT ALTERNATE USER CATALOG
          SA1    CA          CHECK CATALOG ADDRESS
          SX4    B1          PRESET ERROR FLAG
          ZR     X1,GAEX     IF NO CATALOG ADDRESS
          BX6    X1
          SA6    N4+TFRR
          RESETP N4          LIST ALTERNATE USER ENTRY
          WRITFET  X2,ACAT,TAEL
          CALLTFM  X2,LAES
          NZ     X4,GAEX     IF ALTERNATE USER NOT FOUND
          SA1    N4BUF
 GAE1     SX2    A1          GET ALTERNATE USER ENTRY
          MOVE   TAEL,X2,ACAT
          SX4    B0
          EQ     GAEX        RETURN
 GUV      SPACE  4,15
**        GUV - GET USER INFORMATION FOR VSN.
*
*         ENTRY  (VCAT) = VSN ENTRY IMAGE.
*
*         EXIT   (X1) = USER NAME.
*                     = 0 IF NOT ASSIGNED.
*                (FI) = FILE IDENTIFIER.
*                (UN) = USER NAME.
*
*         USES   A - 1, 6.
*                X - 1, 2, 6.
*
*         MACROS MOVE, MOVEBIT, RCREC, RJUST.
 
 
 GUV2     SA1    UN          GET USER NAME
 
 GUV      SUBR               ENTRY/EXIT
          SA1    /ADD/VASF   GET ASSIGNED FILE POINTER
          RJUST  X1,X6,/BTC/VASF,/UPB/VASF
          ZR     X6,GUV1     IF NOT ASSIGNED
          RCREC  N3,X6       GET ASSIGNED FILE CATALOG
          SA2    /ADD/VASC   GET CATALOG NUMBER
          RJUST  X2,X2,/BTC/VASC,/UPB/VASC
          SX2    X2-1        GET ADDRESS OF FILE CATALOG IN BUFFER
          SX1    TCEL
          IX2    X2*X1
          SX2    N3BUF+4+X2
          MOVE   X1,X2,FCAT  SET FILE CATALOG IMAGE
          MOVEBIT  N3BUF+3,UN,UNKL*6  SET USER NAME
          MOVEBIT  /ADD/FI,FI,FIKL*6  SET FILE ID
          EQ     GUV2        RETURN WITH USER NAME
 
 GUV1     SA6    UN          CLEAR USER NAME
          SA1    =17H                   CLEAR FILE IDENTIFIER
          MOVEBIT  A1,FI,FIKL*6
          EQ     GUV2        RETURN WITH USER NAME
 GVE      SPACE  4,15
**        GVE - GET VSN ENTRY.
*
*         ENTRY  (VS) = VSN NAME.
*                (X6) = 0 IF NO INTERLOCK.
*                     = 1 IF INTERLOCK.
*
*         EXIT   (X4) = 0 IF VSN IN CATALOG.
*                (VCAT - VCAT+3) = VSN ENTRY.
*
*         USES   A - 1, 6.
*                B - 2.
*                X - 1, 6.
*
*         CALLS  CVB.
*
*         MACROS LISTVSN, MOVE.
 
 
 GVE1     SX2    A1          GET VSN ENTRY
          MOVE   TSVL,X2,VCAT
          SX4    B0
 
 GVE      SUBR               ENTRY/EXIT
          SA6    GVEA        SAVE INTERLOCK STATUS
          RJ     CVB         CHECK IF VSN IN BUFFER
          ZR     X4,GVE1     IF VSN IN BUFFER
          SA1    GVEA        LIST VSN
          SB2    X1
          LISTVSN  VS,VCAT,B2
          EQ     GVEX        RETURN
 
 GVEA     CON    4           INTERLOCK STATUS
 IFP      SPACE  4,15
**        IFP - INPUT FILE PROCESSOR.
*
*         ENTRY  (IF) = INPUT FILE FET ADDRESS.
*
*         EXIT   (KBUF - KBUF+KBUFL) = CODED LINE FROM INPUT FILE.
*                (X1) = 0 IF NOT EOR/EOF.
*                (X7) = 0 IF END OF LINE FOUND.
*
*         USES   A - 2, 3.
*                X - 0, 2, 3.
*
*         MACROS READC.
 
 
 IFP      SUBR               ENTRY/EXIT
          SA2    IF
          SA3    OP          CHECK INPUT OPTION
          SX3    X3-ZOPT
          ZR     X3,IFP1     IF *Z* OPTION
          SA3    X2          CHECK IF NO FILE NAME
          SX1    -B1
          AX3    18
          ZR     X3,IFPX     IF NO FILE NAME
 IFP1     READC  X2,KBUF,KBUFL
          MX0    -12         CHECK IF END OF LINE FOUND
          BX7    -X0*X4
          EQ     IFPX        RETURN
 IRL      SPACE  4,10
**        IRL - IGNORE REST OF INPUT LINE.
*
*         EXIT   CURRENT INPUT LINE SKIPPED.
*
*         USES   A - 1.
*                X - 1, 4, 6.
*
*         CALLS  ACI.
 
 
 IRL      SUBR               ENTRY/EXIT
          SA1    EL          CHECK FOR END OF LINE
          ZR     X1,IRLX     IF END OF INPUT LINE
          MX1    60          ALLOW ALL CHARACTERS
          SX6    B0          SUPPRESS NO CHARACTERS
          SX4    CSPL        SET MAXIMUM NUMBER OF CHARACTERS
          RJ     ACI         ASSEMBLE CHARACTERS
          EQ     IRLX        RETURN
 ISB      SPACE  4,20
**        ISB - INPUT STRING BUFFER.
*
*         ENTRY  (IF) = INPUT FET ADDRESS.
*
*         EXIT   (SB) = STRING BUFFER ADDRESS.
*                (SP) = STRING BUFFER CHARACTER POINTER.
*                (SM) = STRING BUFFER LIMIT.
*                (B6) = 0 IF EOR OR EOF.
*                (ET) = -1 IF EOR OR EOF.
*
*         USES   A - 1, 2, 6, 7.
*                B - 2, 6.
*                X - 1, 2, 6, 7.
*
*         CALLS  FOB, IFP, KFI, KIP, TOG, USB.
*
*         MACROS READS, RJM.
*
*         NOTES  BASED ON SUBROUTINE *ISB* IN *SFS*.
 
 
 ISB4     SX6    -B1         SET END OF FILE FLAG
          SA6    ET
          SB6    B0
 
 ISB      SUBR               ENTRY/EXIT
          SA1    OP          CHECK OPTION
          SX1    X1-KOPT
          NZ     X1,ISB1     IF NOT K-DISPLAY
          SA1    IF          CHECK INPUT FET ADDRESS
          SX1    X1-I
          NZ     X1,ISB1     IF ALTERNATE INPUT FILE
          RJ     KIP         PROCESS K-DISPLAY INPUT
          SX7    B0
          EQ     ISB2        SET STRING BUFFER POINTERS
 
 ISB1     RJ     FOB         FLUSH OUTPUT BUFFER
          RJ     IFP         PROCESS INPUT FILE
          NZ     X1,ISB4     IF EOR OR EOF
 ISB2     SA7    ISBA        SET END OF LINE FOUND FLAG
          MX0    12          INSURE END OF LINE AFTER 72 CHARACTERS
          SA1    KBUF+7
          BX7    X0*X1
          SA7    A1
          SB2    KBUF
          RJ     USB         UNPACK STRING BUFFER
          SX6    X6+B1       RESET STRING BUFFER LIMIT
          SA6    SM
          SX7    USBB-1      SET STRING BUFFER CHARACTER POINTER
          SA7    SP
          SX7    X7+B1       SET STRING BUFFER ADDRESS
          SA7    SB
          SA1    X7          CHECK FIRST CHARACTER
          SX1    X1-1R+
          NZ     X1,ISB3     IF NOT TOGGLE CHARACTER
          SA1    LV          CHECK DIRECTIVE LEVEL
          SA1    X1+ISBB
          ZR     X1,ISB3     IF NO TOGGLE PROCESSOR
          RJM    X1          JUMP TO PROCESSOR
 ISB3     SB6    B1          FLAG NO EOR/EOF
          SA1    ISBA
          ZR     X1,ISBX     IF END OF LINE FOUND
          RJ     IFP         PROCESS INPUT FILE
          SA7    ISBA
          EQ     ISB3        FIND END OF LINE
 
 ISBA     BSS    1           END OF LINE FLAG
 ISBB     INDTAB 1           TABLE OF TOGGLE PROCESSORS
          INDEX  LVFA,CON,0  FAMILY LEVEL
          INDEX  LVVS,CON,0  VSN LEVEL
          INDEX  LVUS,CON,KFI  USER LEVEL
          INDEX  LVFI,CON,TOG  FILE LEVEL
          INDEX  LVAU,CON,0  ALTERNATE USER LEVEL
 IUN      SPACE  4,10
**        IUN - INTERLOCK USER NAME.
*
*         ENTRY  (X1) = USER NAME TO INTERLOCK.
*                (X1) = 0 TO CLEAR INTERLOCK.
*
*         EXIT   USER NAME INTERLOCK SET.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         MACROS RCREC, WCREC.
 
 
 IUN      SUBR               ENTRY/EXIT
          SA2    LF
          NZ     X2,IUNX     IF LOCAL FILE MODE
          BX6    X1          SAVE USER NAME
          SA6    IUNA
          RCREC  N1,1,REC1,1 CHANGE INTERLOCKED USER NAME
          SA1    IUNA
          SA2    REC1+BWUN
          MX6    -18
          BX6    -X6*X2
          BX6    X6+X1       MERGE USER NAME
          SA6    A2          WRITE INTERLOCK WORD
          WCREC  N1,1,REC1,1
          EQ     IUNX        RETURN
 
 IUNA     BSS    1           INTERLOCKED USER NAME
 KAV      SPACE  4,15
**        KAV - SET ASSIGNED VSNS IN K-DISPLAY.
*
*         ENTRY  (FCAT) = FILE CATALOG IMAGE.
*                (TAVS) = ASSIGNED VSNS IMAGE.
*
*         EXIT   VSNS SET IN K-DISPLAY.
*
*         USES   A - 1, 6.
*                B - 2.
*                X - 1, 6.
*
*         CALLS  FEV.
*
*         MACROS CLEAR, DISLIS, LISTAB.
 
 
 KAV      SUBR               ENTRY/EXIT
          CLEAR  KAVA,60     CLEAR LIST OF VSNS
          RJ     FEV         FIND EXTERNAL VSN
          SB2    X6          GET LIST OF VSNS
          LISTAB A1,KAVA,B2,,4,36
          SX6    3R          DISPLAY LIST OF VSNS
          DISLIS KAVA,/KFILLS1/AVSN,TAVSL/4,36,18,6
          SA1    RC          SET LENGTH OF DISPLAY
          SX6    6
          SX1    X1+5
          IX1    X1/X6
          SX6    6
          IX1    X1*X6
          SX6    X1+/KFILLS1/AVSN-/KFILLS1/START
          SA6    KFILLS1     LENGTH OF DISPLAY
          EQ     KAVX        RETURN
 
 KAVA     BSS    TAVSL/4     LIST OF ASSIGNED VSNS
 KFI      SPACE  4,15
**        KFI - SET FILE IDENTIFIERS IN K-DISPLAY.
*
*         ENTRY  (AA) = AUDIT RANDOM ADDRESS.
*
*                (AA) = NEW AUDIT RANDOM ADDRESS.
*
*         USES   A - 1, 2, 6.
*                B - 2, 3.
*                X - 1, 2, 6.
*
*         CALLS  CDD, SFN.
*
*         MACROS DISLIS, CLEAR, MOVEBIT, READFET, RJUST, SAFET.
 
 
 KFI      SUBR               ENTRY/EXIT
          CLEAR  KFIE,KFIEL  CLEAR LIST OF FILE IDENTIFIERS
          SX6    KFIE        SET LIST ADDRESS
          SA6    KFIA
 KFI1     SAFET  UN,,,FCST,AA  SET UP FET FOR AUDIT
          SX6    B0          PRESET NEW AUDIT RANDOM ADDRESS
          ZR     X4,KFI2     IF FILES FOUND
          SA6    AA          CLEAR RANDOM ADDRESS
          EQ     KFI7        LIST FILES
 
 KFI2     SA1    N3          CHECK IF AUDIT COMPLETE
          RJUST  X1,X1,1,1
          NZ     X1,KFI3     IF END OF AUDIT
          SA1    N3+TFRR     RESET RANDOM ADDRESS
          BX6    X1
 KFI3     SA6    AA
 KFI4     READFET  N3,FCAT,TCEL  SET CATALOG IMAGE
          NZ     X1,KFI6     IF END OF BUFFER
          SA1    /ADD/REELC  SET VSN ENTRIES
          RJUST  X1,X1,/BTC/REELC,/UPB/REELC
          LX1    2
          READFET  X2,TAVS,X1
          READFET  X2,KFIC,1 SET CATALOG RANDOM ADDRESS
          SA1    /ADD/SV     CHECK IF SYMBOLIC ACCESS
          RJUST  X1,X1,/BTC/SV,/UPB/SV
          ZR     X1,KFI5     IF NOT SYMBOLIC ACCESS
          SA2    KFIA        INCREMENT LIST ADDRESS
          SX6    X2+2
          SA6    A2
          MOVEBIT  /ADD/FI,X2,FIKL*6,/UPB/FI  SET FILE ID IN LIST
          EQ     KFI4        CHECK FOR NEXT FILE
 
 KFI5     SA2    KFIA        SET FIRST VSN IN LIST
          MOVEBIT  TAVS+/CAT/FVSN,X2,VSKL*6,/UPB/FVSN
          MOVEBIT  (=C*/*),A2,1*6,,B2  SET SLASH IN LIST
          SA1    /ADD/QN     GET SEQUENCE NUMBER
          RJUST  X1,X1,/BTC/QN,/UPB/QN
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          BX1    X4
          RJ     SFN         SPACE FILL NAME
          SA6    KFID
          SA2    KFIA        INCREMENT LIST ADDRESS
          SX6    X2+2
          SA6    A2
          MOVEBIT  KFID,X2,10*6,,17  SET *QN* IN LIST
          EQ     KFI4        CHECK FOR NEXT FILE
 
 KFI6     SA1    AA
          ZR     X1,KFI7     IF NO MORE FILES
          SA2    KFIA        CHECK IF BUFFER FULL
          SX2    X2-KFIE-13*2
          NG     X2,KFI1     IF BUFFER NOT FULL
          SA2    KFIA        SET DUMMY FILE IDENTIFIERS
          MOVEBIT  (=17H),X2,FIKL*6
          MOVEBIT  (=17H  MORE FILES),A2+B1,FIKL*6
 KFI7     SX6    2R          SET IMAGE BETWEEN ENTRIES
          DISLIS KFIE,/KUSELS/FILE,KFIEL,FIKL*6,12,3
          SA1    KFIA        SET LENGTH OF DISPLAY
          SX1    X1-KFIE+4
          SX6    6
          IX1    X1/X6
          SX6    6
          IX1    X1*X6
          SX6    X1+/KUSELS/FILE-/KUSELS/START+6
          SA6    KUSELS
          EQ     KFIX        GET *TFM* ERROR CODE
 
 KFIA     BSS    1           LIST ADDRESS
 KFIC     BSS    1           CATALOG RANDOM ADDRESS
 KFID     BSS    1           SEQUENCE NUMBER
 KFIE     BSS    24*2+6      FILE ID LIST BUFFER
 KFIEL    EQU    *-KFIE      LIST BUFFER LENGTH
 KFM      SPACE  4,10
**        KFM - SET FAMILY LEVEL K-DISPLAY.
*
*         EXIT   FAMILY LEVEL K-DISPLAY SET.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  CDD, SFN.
*
*         MACROS DISLIS, LJUST, MOVEBIT, RJUST.
 
 
 KFM      SUBR               ENTRY/EXIT
          SA1    TFMN        GET FAMILY NAME
          LJUST  X1,X1,42,59
          RJ     SFN         SPACE FILL NAME
          SA6    KFMA
          MOVEBIT  KFMA,/KFAMLS/FAMNAME,42,,5  SET FAMILY NAME
          MOVEBIT  KFMA,NPGC,42  SET NAME IN PAGE HEADER
          MOVEBIT  KFMA,/MLS/FAMILY,/MLSC/FAMILY*6,,/MLSU/FAMILY
          SA1    TLFM        GET LINKED FAMILY NAME
          LJUST  X1,X1,42,59
          RJ     SFN         SPACE FILL NAME
          SA6    KFMA
          MOVEBIT  KFMA,/KFAMLS/LINKFAM,42,,5  SET FAMILY NAME
          MOVEBIT  TIDM,/KFAMLS/MID,2*6,,5  SET MACHINE ID
          SA1    TSTT        SET ERROR STATUS
          RJUST  X1,X6,1,2
          SA1    =6HSET
          NZ     X6,KFM1     IF ERROR STATUS SET
          SA1    =6HCLEAR
 KFM1     MOVEBIT  A1,/KFAMLS/CATERR,6*6,,5
          SA1    TSTT        SET FOREIGN STATUS
          RJUST  X1,X6,1,13
          SA1    =3HYES
          NZ     X6,KFM2     IF FOREIGN STATUS ON
          SA1    =3HNO
 KFM2     MOVEBIT  A1,/KFAMLS/FOREIGN,3*6,,5
          SA1    TSTT        SET GLOBAL STATUS
          RJUST  X1,X6,1,12
          SA1    =3HYES
          NZ     X6,KFM3     IF GLOBAL STATUS ON
          SA1    =3HNO
 KFM3     MOVEBIT  A1,/KFAMLS/GLOBAL,3*6,,5
          SA1    TCMB        SET MESSAGE BUFFER
          RJ     SFN         SPACE FILL NAME
          SA6    KFMB
          SA1    TCMB+1      GET SECOND WORD
          RJ     SFN         SPACE FILL NAME
          SA6    KFMB+1
          SA1    TCMB+2      GET THIRD WORD
          RJ     SFN         SPACE FILL NAME
          SA6    KFMB+2
          SA1    TCMB+3      GET FOURTH WORD
          RJ     SFN         SPACE FILL NAME
          SA6    KFMB+3
          MOVEBIT  KFMB,/KFAMLS/MB,240,,53  MOVE TO K-DISPLAY
          SA1    TTCS        GET CATALOG SIZE
          RJUST  X1,X1,24,35
          SA2    =100000000
          IX1    X2+X1
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          LJUST  X6,X1,48,47 SET CATALOG SIZE IN K-DISPLAY
          MOVEBIT  A1,/KFAMLS/SIZE+1,8*6,,23
          SA1    TSMC        GET *MT/NT* SCRATCH COUNT
          RJUST  X1,X1,24,23
          SA2    =100000000
          IX1    X1+X2
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          LJUST  X6,X1,48,47 SET *MT/NT* SCRATCH COUNT IN K-DISPLAY
          MOVEBIT  A1,/KFAMLS/SCM+2,8*6
          SA1    TSCC        GET *CT* SCRATCH COUNT
          RJUST  X1,X1,24,23
          SA2    =100000000
          IX1    X1+X2
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          LJUST  X6,X1,48,47 SET *CT* SCRATCH COUNT IN K-DISPLAY
          MOVEBIT  A1,/KFAMLS/SCC+2,8*6
          SA1    TSAC        GET *AT* SCRATCH COUNT
          RJUST  X1,X1,24,23
          SA2    =100000000
          IX1    X1+X2
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          LJUST  X6,X1,48,47 SET *AT* SCRATCH COUNT IN K-DISPLAY
          MOVEBIT  A1,/KFAMLS/SCA+2,8*6
          SX6    1R          DISPLAY LIST OF VALIDATED USER NAMES
          DISLIS TVUN,/KFAMLS/VALIDAT,UNCL,42,,4
          SX6    1R          DISPLAY LIST PERMITTED ALTERNATE FAMILIES
          DISLIS TAFM,/KFAMLS/ALTFAM,PAFL,42,,4
          EQ     KFMX        RETURN
 
 
 KFMA     BSS    1           SPACE FILLED FAMILY NAME
 KFMB     BSS    MBML        SPACE FILLED MESSAGE BUFFER
 KIP      SPACE  4,10
**        KIP - KEYBOARD INPUT PROCESSOR.
*
*         ENTRY  (KCW) = K-DISPLAY CONTROL WORD.
*
*         EXIT   DATA IN *KBUF*.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         MACROS CONSOLE, MOVE, RECALL.
*
*         NOTES  BASED ON SUBROUTINE *KIP* IN *SFS*.
 
 
 KIP      SUBR               ENTRY/EXIT
          SX6    B0          CLEAR K-DISPLAY INPUT BUFFER
          SA6    KBUF
          MOVE   3,KIPA,/KMESS/STATUS  MOVE MESSAGE TO K-DISPLAY
          CONSOLE KCW
 KIP1     SA1    KBUF        CHECK K-DISPLAY INPUT
          NZ     X1,KIP2     IF INPUT PRESENT
          RECALL
          EQ     KIP1
 
 KIP2     MOVE   3,KIPB,/KMESS/STATUS  MOVE MESSAGE TO K-DISPLAY
          EQ     KIPX        RETURN
 
 KIPA     DATA   28L WAITING FOR INPUT.
 KIPB     DATA   28L PROCESSING DIRECTIVES.
 KST      SPACE  4,10
**        KST - SET VSN STATUS IN K-DISPLAY.
*
*         ENTRY  (VCAT) = VSN CATALOG.
*
*         EXIT   VSN STATUS SET INTO K-DISPLAY.
*
*         USES   A - 1.
*                X - 1.
*
*         MACROS RJUST.
 
 
 KST3     MOVEBIT A1,/KDIS/STATUS,10*6,59,5
 
 KST      SUBR               ENTRY/EXIT
          SA1    /ADD/ERRFLAG  CHECK ERROR FLAG
          RJUST  X1,X1,/BTC/ERRFLAG,/UPB/ERRFLAG
          ZR     X1,KST1     IF ERROR FLAG NOT SET
          SA1    =10HERROR
          EQ     KST3        SET VSN STATUS IN K-DISPLAY
 
 KST1     SA1    /ADD/MAINT  CHECK MAINTENANCE FLAG
          RJUST  X1,X1,/BTC/MAINT,/UPB/MAINT
          ZR     X1,KST2     IF MAINTENANCE FLAG NOT SET
          SA1    =10HHOLD
          EQ     KST3        SET VSN STATUS IN K-DISPLAY
 
 KST2     SA1    =10HAVAILABLE
          EQ     KST3        SET VSN STATUS IN K-DISPLAY
 KVQ      SPACE  4,15
**        KVQ - SET FIRST VSN AND SEQUENCE NUMBER IN K-DISPLAY.
*
*         ENTRY  (FV) = FIRST VSN.
*                (QN) = SEQUENCE NUMBER.
*
*         EXIT   FIRST VSN AND SEQUENCE SET INTO K-DISPLAY.
*
*         USES   A - 1, 6.
*                X - 0, 1, 6.
*
*         CALLS  CDD, SFN.
 
 
 KVQ      SUBR               ENTRY/EXIT
          SA1    FV          GET FIRST VSN
          RJ     SFN         SPACE FILL NAME
          MX0    36          SET SPACE FILLED FIRST VSN
          BX6    X0*X6
          SA6    /KFILLS1/FVSN
          SA6    /KFILLS2/FVSN
          SA6    /KFILLS3/FVSN
          SA1    QN          GET SEQUENCE NUMBER
          SX1    X1+10000
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          MX0    -24
          BX6    -X0*X6      SET DISPLAY VALUE
          LX6    36
          SA6    /KFILLS1/QN
          SA6    /KFILLS2/QN
          SA6    /KFILLS3/QN
          EQ     KVQX        RETURN
 MSV      SPACE  4,10
**        MSV - MOVE SYSTEM TABLE VALUES TO/FROM WORKING BUFFER.
*
*         ENTRY  (X3) = ADDRESS FROM WHICH TO MOVE VALUES.
*                (X4) = ADDRESS TO WHICH TO MOVE VALUES.
*
*         EXIT   TABLE VALUES MOVED.
*
*         MACROS MOVEBIT.
 
 
 MSV      SUBR               ENTRY/EXIT
          MOVEBIT  X3+TMFM,X4+TMFM,7*6  MOVE FAMILY NAME
          MOVEBIT  X3+TMFM,X4+TMFM,18,17,17  STATUS FLAGS
          MOVEBIT  X3+TMID,X4+TMID,2*6  MACHINE ID
          MOVEBIT  X3+TMMB,X4+TMMB,MBML*60  MESSAGE BUFFER
          MOVEBIT  X3+TMUN,X4+TMUN,UNCL*60  VALID USERNAME
          MOVEBIT  X3+TMLF,X4+TMLF,7*6  LINKED FAMILY NAME
          MOVEBIT  X3+TMPA,X4+TMPA,PAFL*60  PERMITTED FAMILIES
          EQ     MSVX        RETURN
 PFC      SPACE  4,15
**        PFC - PACK DIRECT CELLS INTO FILE CATALOG.
*
*         ENTRY  (CA) = CATALOG RANDOM ADDRESS.
*                (EV) = EXTERNAL VSN.
*                (QN) = SEQUENCE NUMBER.
*                (RC) = REEL COUNT.
*                (RF) = 0 IF FILE NOT RESERVED.
*                (VC) = VSN COUNT.
*
*         EXIT   VALUES SET INTO FILE CATALOG.
*
*         USES   A - 1, 3.
*                X - 0, 1, 3.
*
*         MACROS MOVEBIT, SRCHTAB.
 
 
 PFC      SUBR               ENTRY/EXIT
          MOVEBIT  CA,PCAT+/CAT/NCAT,/BTC/NCAT,/BTC/NCAT-1,/UPB/NCAT
          MOVEBIT  QN,/ADD/QN,/BTC/QN,/BTC/QN-1,/UPB/QN
          MOVEBIT  RC,/ADD/REELC,/BTC/REELC,/BTC/REELC-1,/UPB/REELC
          MOVEBIT  EV,/ADD/EVSN,/BTC/EVSN,,/UPB/EVSN
          MX0    VSKL*6      FIND INTERNAL VSN
          SA3    VC
          LX3    2
          SRCHTAB  TAVS,EV,VSKL*6,4
          MOVEBIT  A1+/CAT/PRN,/ADD/IVSN,/BTC/IVSN,,/UPB/IVSN
          EQ     PFCX        RETURN
 PMF      SPACE  4,15
**        PMF - PROCESS MACHINE READABLE LIST FOR FILE.
*
*         ENTRY  (FCAT) = FILE CATALOG IMAGE.
*                (TAVS) = ASSIGNED VSNS IMAGE.
*
*         EXIT   FILE INFORMATION WRITTEN TO MACHINE READABLE FILE.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  FEV, VSM.
*
*         MACROS MOVE, RJUST.
 
 
 PMF      SUBR               ENTRY/EXIT
          SX6    B0          CLEAR VSN COUNT
          SA6    PMFA
          RJ     FEV         FIND EXTERNAL VSN
          SX6    A1          SAVE RELATIVE ADDRESS IN *TAVS*
          SA6    PMFB
 PMF1     SA2    PMFA        CHECK VSN COUNT
          SA1    /ADD/REELC
          RJUST  X1,X1,/BTC/REELC,/UPB/REELC
          IX1    X2-X1
          PL     X1,PMFX     IF END OF VSNS
          SX6    X2+B1       RESET VSN COUNT
          SA6    A2
          LX2    2           SET VSN ENTRY
          SA1    PMFB
          IX2    X1+X2
          MOVE   TSVL,X2,VCAT
          RJ     VSM         PROCESS VSN MACHINE READABLE LIST
          EQ     PMF1        CHECK NEXT VSN
 
 PMFA     BSS    1           VSN COUNT
 PMFB     BSS    1           RELATIVE ADDRESS IN *TAVS*
 PSF      SPACE  4,10
**        PSF - PROCESS SOURCE LISTING FOR FILE.
*
*         ENTRY  (FCAT) = FILE CATALOG IMAGE.
*                (TAVS) = ASSIGNED VSNS IMAGE.
*                (X6) = 0 IF INCLUDE EXTERNAL VSN.
*                     = 1 IF EXCLUDE EXTERNAL VSN.
*
*         EXIT   FILE LEVEL DIRECTIVES WRITTEN TO SOURCE FILE.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  FEV, FIS, VSS.
*
*         MACROS MOVE, RJUST, WRITEC.
 
 
 PSF      SUBR               ENTRY/EXIT
          SA6    PSFA        SET INITIAL VSN COUNT
          RJ     FEV         FIND EXTERNAL VSN
          SX6    A1          SAVE RELATIVE ADDRESS IN *TAVS*
          SA6    PSFB
 PSF1     SA2    PSFA        CHECK VSN COUNT
          SA1    /ADD/REELC
          RJUST  X1,X1,/BTC/REELC,/UPB/REELC
          IX1    X2-X1
          PL     X1,PSF2     IF END OF VSNS
          SX6    X2+B1       RESET VSN COUNT
          SA6    A2
          LX2    2           SET VSN ENTRY
          SA1    PSFB
          IX2    X1+X2
          MOVE   TSVL,X2,VCAT
          RJ     VSS         PROCESS VSN SOURCE LISTING
          EQ     PSF1        CHECK FOR NEXT VSN
 
 PSF2     SA1    UN          SET USER NAME IN SOURCE LISTING
          BX6    X1
          SA6    PSFD
          WRITEC S,PSFC      WRITE *USER* DIRECTIVE
          RJ     FIS         PROCESS FILE SOURCE LISTING
          WRITEC S,(=C*DROP*)  WRITE LAST DIRECTIVE
          EQ     PSFX        RETURN
 
 PSFA     BSS    1           VSN COUNT
 PSFB     BSS    1           RELATIVE ADDRESS IN *TAVS*
 PSFC     DATA   10HUSER =      INITIAL DIRECTIVE
 PSFD     DATA   C*       *
 PVS      SPACE  4,15
**        PVS - PAD VSN WITH CHARACTER *0*.
*
*         ENTRY  (X4) = NUMBER OF CHARACTERS IN UNPADDED VSN.
*                (CBUF) = LEFT JUSTIFIED UNPADDED VSN.
*
*         EXIT   (X6) = PADDED VSN.  CHARACTER *0* INSERTED BEFORE
*                       FIRST NUMERIC CHARACTER UNTIL VSN IS SIX
*                       CHARACTERS LONG.
*
*         USES   A - 1, 2.
*                B - 2, 3.
*                X - 0, 1, 2, 3, 4, 7.
 
 
 PVS      SUBR               ENTRY/EXIT
          SX1    6           GET CORRECT NUMBER OF ZEROS
          IX4    X1*X4
          SB2    X4
          SA1    =36R000000
          AX1    B2
          SA2    CBUF        GET UNPADDED VSN
          SB3    60
          MX0    -6
          SX6    B0
 PVS1     BX7    X2          SAVE END OF VSN
          LX2    6           CHECK CHARACTER
          BX3    -X0*X2
          ZR     X3,PVS2     IF END OF CHARACTERS
          SX4    X3-1R0
          PL     X4,PVS2     IF NUMERIC CHARACTER
          LX6    6           BUILD FIRST PART OF VSN
          BX6    X6+X3
          BX2    X0*X2
          SB3    B3-6
          EQ     PVS1        CHECK NEXT CHARACTER
 
 PVS2     SB2    B2-36       ADD ZEROES TO VSN
          AX6    B2
          BX6    X6+X1
          BX6    X6+X7       ADD END OF VSN
          SB3    B3+B2
          LX6    B3
          EQ     PVSX        RETURN
 RAB      SPACE  4,15
**        RAB - REPLACE ALTERNATE USER ENTRY IN BUFFER.
*
*         ENTRY  (ACAT) = ALTERNATE USER ENTRY IMAGE.
*
*         EXIT   IMAGE SET INTO *UBUF*.
*
*         USES   X - 3.
*
*         CALLS  CAB, RAE.
*
*         MACROS MOVE, WRITFET.
 
 
 RAB2     SX3    A1          REPLACE ALTERNATE USER ENTRY IN BUFFER
          MOVE   TAEL,ACAT,X3
 
 RAB      SUBR               ENTRY/EXIT
          RJ     CAB         CHECK FOR ALTERNATE USER ENTRY IN BUFFER
          ZR     X4,RAB2     IF ALTERNATE USER ENTRY IN BUFFER
          WRITFET  UB,ACAT,TAEL  SET ENTRY INTO BUFFER
          ZR     X1,RABX     IF TRANSFER COMPLETE
          RJ     RAE         REPLACE ALTERNATE USER ENTRIES
          WRITFET  UB,ACAT,TAEL  SET ENTRY INTO BUFFER
          EQ     RABX        RETURN
 RAE      SPACE  4,10
**        RAE - REPLACE ALTERNATE USER ENTRY IN CATALOG FILE.
*
*         ENTRY  (UBUF) = ALTERNATE USER ENTRIES.
*
*         EXIT   ALTERNATE USER ENTRIES REPLACED IN CATALOG.
*
*         USES   A - 1, 2.
*                X - 1, 2.
*
*         MACROS CALLTFM, RESETP, WRITFET.
 
 
 RAE      SUBR               ENTRY/EXIT
          RESETP N4          RESET FET POINTERS
          SA1    UB+1        GET WORD COUNT OF BUFFER
          SX1    X1
          SA2    A1+B1
          IX1    X2-X1
          ZR     X1,RAEX     IF NO ENTRIES IN BUFFER
          SA2    CA          SET CATALOG RANDOM ADDRESS
          BX6    X2
          SA6    N4+TFRR
          WRITFET  N4,UBUF,X1  REPLACE/ADD ADMIT ENTRIES
          CALLTFM  X2,RAES
          RESETP UB
          EQ     RAEX        RETURN
 RAF      SPACE  4,15
**        RAF - RESERVE/AMEND FILE CATALOG ENTRY.
*
*         ENTRY  DIRECT CELLS SET.
*                (FCAT) = FILE CATALOG BUFFER.
*                (PCAT) = PREVIOUS FILE BUFFER.
*                (TAVS) = ASSIGNED VSNS.
*
*         EXIT   FILE CATALOG ENTRY REPLACED IN CATALOG.
*
*         USES   A - 1, 2, 3, 5, 6, 7.
*                X - 0, 1, 2, 3, 4, 5, 6, 7.
*
*         CALL   CRD, PFC, SMA.
*
*         MACROS CALLTFM, REPVSN, RESETP, RJUST, WRITFET.
 
 
 RAF9     SA1    VC          REPLACE VSN ENTRIES
          LX1    2
          REPVSN TAVS,X1
          RJ     SMA         ISSUE *SDAU* ACCOUNT FILE MESSAGE
          SA1    RF
          NZ     X1,RAF10    IF PREVIOUSLY RESERVED
          SA1    PA
          ZR     X1,RAF10    IF NO PREVIOUS FILE
          RJ     PFC         PACK DIRECT CELLS INTO FILE CATALOG
          RESETP N3          SET UP FET
          SA1    PA          SET PREVIOUS FILE RANDOM ADDRESS
          BX6    X1
          SA6    X2+TFRR
          WRITFET  X2,PCAT,TCEL  SET PREVIOUS FILE INTO FET BUFFER
          CALLTFM  X2,RCES   REPLACE PREVIOUS FILE
 RAF10    RJ     CRD         CHECK RELEASE DATE
 
 RAF      SUBR               ENTRY/EXIT
          RJ     PFC         PACK DIRECT CELLS INTO FILE CATALOG
          SA1    /ADD/TTYP   CHECK TAPE DEVICE TYPE
          RJUST  X1,X6,/BTC/TTYP,/UPB/TTYP
          ZR     X6,RAF1     IF SEVEN TRACK
          SA1    /ADD/CV
          RJUST  X1,X6,/BTC/CV,/UPB/CV
          SX6    X6-2
          PL     X6,RAF2     IF CONVERSION MODE EQUAL AS OR EB
          SX6    B1
 RAF1     SX6    X6+B1
          SA6    RAFA
          MOVEBIT  A6,/ADD/CV,/BTC/CV,/BTC/CV-1,/UPB/CV
 RAF2     SA1    /ADD/LB     CHECK LABEL TYPE
          RJUST  X1,X6,/BTC/LB,/UPB/LB
          ZR     X6,RAF3     IF UNLABELED
          SA2    /ADD/PI
          NZ     X2,RAF4     IF PHYSICAL FILE ID EXISTS
          MOVEBIT  /ADD/FI,A2,FIKL*6  SET PHYSICAL FILE ID
          EQ     RAF4        SET UP FET
 
 RAF3     SA6    /ADD/PI     CLEAR PHYSICAL FILE ID
          MOVEBIT  (=0),A6+B1,FIKL*6-10*6
 RAF4     RESETP N3          SET UP FET
          SA1    CA          SET FILE CATALOG RANDOM ADDRESS
          BX6    X1
          SA6    X2+TFRR
          SA1    UN          SET USER NAME
          BX6    X1
          SA6    X2+TFUN
          WRITFET  X2,FCAT,TCEL  SET FILE CATALOG INTO FET BUFFER
          SA1    RF          CHECK IF FILE IS RESERVED
          SX6    ICES
          ZR     X1,RAF5     IF FILE NOT RESERVED
          SX6    RCES
 RAF5     CALLTFM  X2,X6     RESERVE/AMEND FILE CATALOG
          SA2    CA
          NZ     X2,RAF6     IF FILE PREVIOUSLY RESERVED
          SA1    N3+TFRR     SET FILE CATALOG RANDOM ADDRESS
          RJUST  X1,X2,24,59
          BX6    X2
          SA6    A2
 RAF6     SA1    TAVS+/CAT/VASF  CHECK FIRST FILE RANDOM ADDRESS
          RJUST  X1,X1,24,23
          ZR     X1,RAF7     IF NO FIRST FILE
          BX2    X1          SET RANDOM ADDRESS FOR VSN ENTRIES
 RAF7     SA3    ST          GET VSN STATUS BITS
          SX6    UOVS+TVVS
          BX3    X6*X3
          SX6    B1
          LX6    17-0
          ERRNZ  400000B-RTVS  INCORRECT BIT POSITION
          BX3    X6+X3
          SA1    FV          GET FIRST VSN
          BX7    X1
          SX4    B0          PRESET VSN NUMBER
          MX0    VSKL*6      GET VSN MASK
          SA1    TAVS        GET FIRST ENTRY IN TABLE
 RAF8     ZR     X1,RAF9     IF END OF VSNS
          BX6    X0*X1       SET RANDOM INDEX
          BX6    X6+X2
          SA6    A1
          SA1    A1+B1       SET STATUS BITS
          SX6    ASVS+UOVS+TVVS+VIVS
          BX6    -X6*X1
          BX6    X6+X3
          SX4    X4+B1       SET REEL NUMBER
          LX4    18
          BX6    X6+X4
          AX4    18
          SA6    A1
          SA7    A1+B1       SET FIRST VSN
          SA1    A1+3        SET NEXT VSN
          BX6    X0*X1
          SA5    A7+B1
          BX5    -X0*X5
          BX6    X6+X5
          SA6    A7+B1
          EQ     RAF8        CHECK NEXT VSN
 
 RAFA     BSS    1           CONVERSION MODE
 RNS      SPACE  4,10
**        RNS - RESET NEEDED STORAGE.
*
*         ENTRY  NONE.
*
*         EXIT   CATALOG BUFFERS, SPECIAL WORKING STORAGE, AND TABLE
*                OF ASSIGNED VSNS RESTORED FROM HOLD BUFFER *HBUF*.
*
*         USES   A - 1, 2, 6.
*                B - 2, 3.
*                X - 1, 2, 6.
 
 
 RNS      SUBR               ENTRY/EXIT
          SA1    HBUF-1      FWA OF HOLD BUFFER-1
          SA2    THBP-1      FWA OF TABLE OF MEMORY PARTITIONS-1
 
 RNS1     SA2    A2+B1       MEMORY PARTITION TO RESET FROM TABLE
          ZR     X2,RNSX     IF RESET COMPLETE
          SB2    X2
          SA2    A2+B1       GET WORD COUNT FROM TABLE
          SB3    X2
 
 RNS2     SA1    A1+B1       HOLD BUFFER WORD TO MOVE
          BX6    X1
          SA6    B2          WORD RESET IN MEMORY
          SB2    B2+B1       INCREMENT MEMORY ADDRESS TO RESET
          SB3    B3-B1       DECREMENT WORD COUNT
          NZ     B3,RNS2     IF MORE WORDS TO MOVE
          EQ     RNS1        CONTINUE
 RCW      SPACE  4,10
**        RCW - READ CMR WORD.
*
*         ENTRY  (X2) = ADDRESS OF CMR WORD TO READ.
*
*         EXIT   (X1) = CMR WORD.
*
*         USES   A - 1.
*                X - 1, 2, 6.
*
*         MACROS SYSTEM.
 
 
 RCW      SUBR               ENTRY/EXIT
          MX6    1           SET ABSOLUTE READ
          SA6    RCWB
          LX2    18          SET READ ADDRESS
          SX1    A6          SET BUFFER ADDRESS
          LX6    36-59       SET WORD COUNT
          BX6    X6+X2
          BX6    X6+X1
          SA6    RCWA        WRITE STATUS WORD
          SYSTEM RSB,R,RCWA  READ CMR WORD
          SA1    RCWB
          EQ     RCWX        RETURN
 
 RCWA     CON    0           *RSB* STATUS WORD
 RCWB     CON    0           *RSB* BUFFER
 RVB      SPACE  4,15
**        RVB - REPLACE VSN ENTRY IN BUFFER.
*
*         ENTRY  (VCAT) = VSN ENTRY IMAGE.
*
*         EXIT   IMAGE SET INTO *VBUF*.
*
*         USES   X - 3.
*
*         CALLS  CVB, RVE.
*
*         MACROS MOVE, WRITFET.
 
 
 RVB2     SX3    A1          REPLACE VSN ENTRY IN BUFFER
          MOVE   TSVL,VCAT,X3
 
 RVB      SUBR               ENTRY/EXIT
          RJ     CVB         CHECK FOR VSN ENTRY IN BUFFER
          ZR     X4,RVB2     IF VSN ENTRY IN BUFFER
          WRITFET  VB,VCAT,4 SET ENTRY INTO BUFFER
          ZR     X1,RVBX     IF TRANSFER COMPLETE
          RJ     RVE         REPLACE VSN ENTRIES
          WRITFET  VB,VCAT,4 SET ENTRY INTO BUFFER
          EQ     RVBX        RETURN
 RVE      SPACE  4,10
**        RVE - REPLACE VSN ENTRY IN CATALOG FILE.
*
*         ENTRY  (VBUF) = VSN ENTRIES.
*
*         EXIT   VSN ENTRIES REPLACED IN CATALOG.
*
*         USES   A - 1, 2.
*                X - 1, 2.
*
*         MACROS REPVSN, RESETP.
 
 
 RVE      SUBR               ENTRY/EXIT
          SA1    VB+1        GET WORD COUNT OF BUFFER
          SX1    X1
          SA2    A1+B1
          IX1    X2-X1
          ZR     X1,RVEX     IF NO ENTRIES IN BUFFER
          REPVSN VBUF,X1     REPLACE/ADD VSN ENTRIES
          RESETP VB
          EQ     RVEX        RETURN
 SCI      SPACE  4,25
**        SCI - SCAN FOR CODE IDENTIFIER.
*
*         ENTRY  (SP) = ADDRESS OF LAST CHARACTER PROCESSED.
*                (SM) = STRING BUFFER LIMIT.
*                (X6) = TABLE ADDRESS OF TABLE INFORMATION.
*                (NL) = CURRENT PROCESSING LEVEL.
*
*         EXIT   (X1) = 0 IF ERROR.
*                (B6) = 0 IF END OF FILE.
*                (B7) = CONTROL BLOCK OR PROCESSOR ADDRESS.
*                (AP) = 1 IF DIRECTIVE FOUND AT A HIGHER LEVEL.
*                (NL) = LEVEL ON WHICH DIRECTIVE WAS FOUND.
*                (DF) = DIRECTIVE IMAGE.
*                (DF+1) = PROCESSOR/CONTROL TABLE ADDRESS.
*                (DF+2) = DIRECTIVE SEPARATOR.
*                (EL) = 0 IF END OF LINE.
*                (ET) = -1 IF EOF.
*
*         USES   A - 1, 2, 6, 7.
*                B - 4.
*                X - 0, 2, 4, 6, 7.
*
*         CALLS  ASC.
*
*         MACROS LJUST, SRCHTAB.
*
*         NOTES  BASED ON SUBROUTINE *SCI* IN *SFS*.
 
 
 SCI5     SX1    B0          FLAG ERROR
 
 SCI      SUBR               ENTRY/EXIT
          SA6    SCIA        SAVE DIRECTIVE TABLE ADDRESS
 SCI1     SA2    ="BL"       SET CHARACTERS TO SUPPRESS
          BX6    X2
          SA1    ="NC"       SET CHARACTERS TO ALLOW
          RJ     ASC         ASSEMBLE CHARACTERS
          SX7    B5          GET SEPARATOR
          SA7    DF+2
          SA6    DF          SAVE DIRECTIVE IMAGE
          SB4    B5-1R=      SET SEPARATOR
          SX1    B1          FLAG NO ERROR
          ZR     B6,SCIX     IF EOF
          SX2    X4-8
          PL     X2,SCI5     IF TOO MANY CHARACTERS
          ZR     X4,SCI1     IF NO CHARACTERS
          SX1    6           SET (X0) = CHARACTER MASK
          IX4    X4*X1
          LJUST  X1,X1,X4,59
          MX4    18          FORCE AT LEAST THREE CHARACTERS IN MASK
          BX0    X0+X4
          SA1    SCIA        GET DIRECTIVE TABLE ADDRESS
          BX2    X6          SET DIRECTIVE TO SEARCH FOR
 SCI2     SRCHTAB  X1,A2,-1  SEARCH FOR DIRECTIVE
          ZR     X4,SCI3     IF DIRECTIVE FOUND
          SA1    NL          CHECK NEXT LEVEL
          SX6    X1-1
          NG     X6,SCI5     IF INCORRECT DIRECTIVE
          SA6    NL          STORE LEVEL BEING PROCESSED
          SX7    B1
          SA7    AP          SET ALTERNATE PROCESSING FLAG
          SA1    TDTA+X6     GET FWA OF DIRECTIVE TABLE
          EQ     SCI2        PROCESS NEXT LEVEL
 
 SCI3     BX6    X1          SAVE DIRECTIVE TABLE IMAGE
          SA6    SCIC
          BX6    X1-X2
          AX6    18
          ZR     X6,SCI4     IF EXACT MATCH
          SRCHTAB  A1+B3,A2,B2,B3,B4  CHECK FOR DIRECTIVE CONFLICT
          ZR     X4,SCI5     IF DIRECTIVE CONFLICT
 SCI4     MX0    42          SAVE DIRECTIVE IMAGE
          SA1    SCIC
          BX6    X0*X1
          SA6    DF
          BX6    -X0*X1      SAVE PROCESSOR/CONTROL TABLE ADDRESS
          SA6    A6+B1
          SB7    X6
          SB6    B1          FLAG NOT END OF FILE
          EQ     SCIX        RETURN
 
 SCIA     BSS    1           ADDRESS OF DIRECTIVE TABLE
 SCIB     BSS    1           ALLOWED CHARACTERS BIT STRING
 SCIC     BSS    1           DIRECTIVE TABLE IMAGE
 SCS      SPACE  4,15
**        SCS - SPECIAL CHARACTER SOURCE ENTRY PROCESSOR.
*
*         ENTRY  (X1) = FIRST WORD OF DIRECTIVE TABLE.
*
*         EXIT   DIRECTIVE WRITTEN TO SOURCE FILE.
*                (SCSB) = IMAGE OF LINE WRITTEN TO SOURCE FILE.
*
*         USES   A - 1, 6.
*                B - 2, 3, 5.
*                X - 0, 1, 2, 3, 6.
*
*         CALLS  CXS.
*
*         MACROS MOVEBIT, WRITEC.
 
 
 SCS      SUBR               ENTRY/EXIT
          RJ     CXS         CONVERT CATALOG ENTRY TO SOURCE
          SB2    B0          UNPACK DATA FIELD
          SB3    B0
          MX0    -6
 SCS1     SA1    B2+CBUF+1   GET WORD OF CHARACTERS
          SB5    9
 SCS2     LX1    6           GET CHARACTER
          BX6    -X0*X1
          SA6    B3+SCSC
          SB3    B3+B1
          SB5    B5-B1
          PL     B5,SCS2     IF MORE CHARACTERS IN WORD
          SB2    B2+B1
          LE     B2,B1,SCS1  IF MORE WORDS
          SX3    B1          FIND SPECIAL CHARACTERS IN STRING BUFFER
          LX3    1R -45B     ASSUME SPACE
          SB2    19
 SCS3     NG     B2,SCS4     IF ALL CHARACTERS CHECKED
          SA1    B2+SCSC
          SB2    B2-B1
          SB3    X1-45B
          NG     B3,SCS3     IF NOT SPECIAL CHARACTER
          SX6    B1          FLAG SPECIAL CHARACTER
          LX6    B3
          BX3    X3+X6
          EQ     SCS3        CHECK NEXT CHARACTER
 
 SCS4     SX6    100B        FIND TWO CHARACTERS NOT IN STRING
          LX3    59-77B+45B-1
          SB2    B0
 SCS5     GT     B2,B1,SCS7  IF TWO CHARACTERS FOUND
 SCS6     LX3    1           CHECK CHARACTER
          SX6    X6-1
          NG     X3,SCS6     IF CHARACTER IN STRING
          SA6    B2+SCSA     SAVE UNUSED CHARACTER
          SB2    B2+B1
          EQ     SCS5        CHECK NUMBER OF CHARACTERS
 
 SCS7     SB5    B0          CHANGE COLON CHARACTERS IN STRING
          SA2    /SCS/FIELD
          SB2    /SCSU/FIELD
 SCS8     SX1    B5-20
          PL     X1,SCS10    IF ALL CHARACTERS CHECKED
          SA1    B5+SCSC
          NZ     X1,SCS9     IF NOT COLON
          SA1    SCSA+1      GET COLON CHARACTER
 SCS9     MOVEBIT  A1,A2,6,5,B2
          SB5    B5+B1
          EQ     SCS8        CHECK NEXT CHARACTER
 
 SCS10    MOVEBIT  CBUF,/SCS/DIRECT,,,/SCSU/DIRECT  SET DIRECTIVE
          MOVEBIT  SCSA+1,/SCS/COLON,6,5,/SCSU/COLON  SET COLON
          MOVEBIT  SCSA+0,/SCS/SEP1,6,5,/SCSU/SEP1  SET SEPARATOR
          MOVEBIT  SCSA+0,/SCS/SEP2,6,5,/SCSU/SEP2
          MOVEBIT  SCSA+0,/SCS/SEP3,6,5,/SCSU/SEP3
          WRITEC S,SCSB      WRITE SOURCE ENTRY
          EQ     SCSX        RETURN
 
 SCSA     BSS    1           SEPARATOR CHARACTER
          BSS    1           COLON CHARACTER
 
 SCSB     BSS    0           SOURCE FILE ENTRY
          LISTER SCS,6,COLON=
 COLON    LISTER ,1
          LISTER ,9,(,SEPARAT=)
 SEP1     LISTER ,1
          LISTER ,1,(,)
 DIRECT   LISTER ,10,(         =)
 FIELD    LISTER ,20
 SEP2     LISTER ,1
          LISTER ,8,(SEPARAT=)
 SEP3     LISTER ,1
          LISTER ,6,COLON=,E,CAPL
 
 SCSC     BSS    20          UNPACKED DATA FIELD
 SMA      SPACE  4,15
**        SMA - ISSUE *SDAU* ACCOUNT FILE MESSAGE.
*
*         ENTRY  (AV) = NEW ASSIGNED VSN TABLE ADDRESS.
*                     = 0 IF NO NEW VSNS.
*                       TABLE TERMINATED BY A ZERO WORD.
*
*         EXIT   MESSAGE ISSUED TO ACCOUNT FILE.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS  COD, SFN.
*
*         MACROS MOVEBIT, MESSAGE.
 
 
 SMA      SUBR               ENTRY/EXIT
          SA1    LF
          NZ     X1,SMAX     IF LOCAL FILE MODE
          SA1    AV
          ZR     X1,SMAX     IF NO NEW VSNS
          SX6    X1          SAVE TABLE ADDRESS
          SA6    SMAA
          SA1    FM          GET FAMILY NAME
          RJ     SFN         SPACE FILL NAME
          SA6    SMAB        SET FAMILY NAME
          MOVEBIT  SMAB,/SMA/FAMILY,42,,/SMAU/FAMILY
          SA1    UN          GET USER NAME
          RJ     SFN         SPACE FILL NAME
          SA6    SMAB        SET USER NAME
          MOVEBIT  SMAB,/SMA/USER,UNKL*6,,/SMAU/USER
          SA1    SMAA        SET FIRST VSN
          MOVEBIT  X1+/CAT/FVSN,/SMA/FVSN,VSKL*6,/UPB/FVSN,/SMAU/FVSN
          SA1    QN          GET SEQUENCE NUMBER
          SX6    100000B
          IX1    X6+X1
          RJ     COD         CONVERT TO OCTAL DISPLAY
          SA6    SMAD        SET SEQUENCE NUMBER IN MESSAGE
          MOVEBIT  A6,/SMA/SEQNO,5*6,29,/SMAU/SEQNO
 SMA1     SA1    SMAA        INCREMENT TABLE ADDRESS
          SX6    X1+4
          SA6    A1
          SA1    X1+/CAT/VSN
          ZR     X1,SMAX     IF END OF TABLE
          MOVEBIT  A1,/SMA/VSN,VSKL*6,/UPB/VSN,/SMAU/VSN  SET VSN
          IFNE   TMSG,0,1
          MESSAGE  SMAC,TMSG/1S12,R  ISSUE DAYFILE MESSAGE
          EQ     SMA1        CHECK NEXT VSN
 
 SMAA     BSS    1           NEW ASSIGNED VSN TABLE ADDRESS
 SMAB     BSS    1           SPACE FILLED NAME
 SMAC     BSS    0           ACCOUNT FILE MESSAGE
          LISTER SMA,6,(SDAU, )
 FAMILY   LISTER ,7          FAMILY NAME
          LISTER ,1,(/)
 USER     LISTER ,7          USER NAME
          LISTER ,1,(/)
 SEQNO    LISTER ,5          SEQUENCE NUMBER
          LISTER ,1,(/)
 FVSN     LISTER ,6          FIRST VSN
          LISTER ,2,(, )
 VSN      LISTER ,6          VSN
          LISTER ,1,(.),E
 SMAD     BSS    1           SEQUENCE NUMBER
 SMB      SPACE  4,15
**        SMB - ISSUE *SDCR* CONDITIONAL RELEASE ACCOUNT FILE MESSAGE.
*
*         ENTRY  (X1) = USER NAME OF FILE RELEASED.
*                (X2) = FIRST VSN OF FILE RELEASED.
*                (X3) = UNCONDITIONAL RELEASE DATE.
*
*         EXIT   MESSAGE ISSUED TO ACCOUNT FILE.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS  SFN.
*
*         MACROS EDATE, MESSAGE, MOVEBIT.
 
 SMB      SUBR               ENTRY/EXIT
          BX6    X1          SAVE USERNAME
          SA6    SMBA
          BX6    X2          SAVE VSN
          SA6    SMBB
          BX6    X3          SAVE RELEASE DATE
          SA6    SMBC
          SA1    LF
          NZ     X1,SMBX     IF LOCAL FILE MODE
          SA1    FM          SET FAMILY
          RJ     SFN         SPACE FILL NAME
          SA6    SMBD
          MOVEBIT  SMBD,/SMB/FAMILY,42,,/SMBU/FAMILY
          SA1    SMBA        SET USERNAME
          RJ     SFN         SPACE FILL NAME
          SA6    SMBD
          MOVEBIT  SMBD,/SMB/USER,42,,/SMBU/USER
          MOVEBIT  SMBB,/SMB/FVSN,36,,/SMBU/FVSN
          SA1    SMBC        SET RELEASE DATE
          NZ     X1,SMB1     IF RELEASE DATE SET
          SA1    =10H.
          BX6    X1
          EQ     SMB2        ISSUE MESSAGE
 
 SMB1     EDATE  X1
 SMB2     MX0    18          REMOVE SLASHES FROM DATE
          BX1    X0*X6
          LX6    6
          BX6    -X0*X6
          BX1    X1+X6
          MX0    30
          BX1    X0*X1
          LX6    6
          BX6    -X0*X6
          BX1    X1+X6
          RJ     SFN         SPACE FILL NAME
          SA6    SMBD
          MOVEBIT  SMBD,/SMB/URDATE,60,,/SMBU/URDATE
          IFNE   TMSG,0,1
          MESSAGE  SMBE,TMSG/1S12,R  ISSUE DAYFILE MESSAGE
          EQ     SMBX        RETURN
 
 SMBA     BSS    1           USERNAME
 SMBB     BSS    1           FIRST VSN
 SMBC     BSS    1           PACKED RELEASE DATE
 SMBD     BSS    1           SPACED FILLED NAME
 SMBE     BSS    0           ACCOUNT FILE MESSAGE
          LISTER SMB,6,(SDCR, )
 FAMILY   LISTER ,7
          LISTER ,1,(/)
 USER     LISTER ,7
          LISTER ,1,(/)
          LISTER ,5,(00001)
          LISTER ,1,(/)
 FVSN     LISTER ,6
          LISTER ,2,(, )
 URDATE   LISTER ,10,,E
 SMC      SPACE  4,15
**        SMC - ISSUE *SDAD* OR *SDRV* ACCOUNT FILE MESSAGE.
*
*         ENTRY  (B2) = 0 IF *SDAD*.
*                     .NE. 0 IF *SDRV*.
*                (VCAT) = REVISED/ADDED VSN ENTRY.
*
*         EXIT   MESSAGE ISSUED TO ACCOUNT FILE.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS  COD, SFN.
*
*         MACROS MESSAGE, MOVEBIT, RJUST.
 
 
 SMC      SUBR               ENTRY/EXIT
          SA1    LF
          NZ     X1,SMCX     IF LOCAL FILE MODE
          SA1    =4HSDAD     SET MESSAGE TYPE
          ZR     B2,SMC1     IF *SDAD*
          SA1    =4HSDRV
 SMC1     MOVEBIT  A1,/SMC/TYPE,/SMCC/TYPE*6,,/SMCU/TYPE
          SA1    FM          GET FAMILY NAME
          RJ     SFN         SPACE FILE NAME
          SA6    SMCA        SET FAMILY NAME
          MOVEBIT  SMCA,/SMC/FAMILY,42,,/SMCU/FAMILY
          MOVEBIT  /ADD/VSN,/SMC/VSN,VSKL*6,,/SMCU/VSN  SET VSN
          MOVEBIT  /ADD/PRN,/SMC/PRN,VSKL*6,,/SMCU/PRN  SET PRN
          SA1    VCAT+1      GET STATUS BITS
          RJUST  X1,X1,18,17
          SX6    B1
          LX6    18-0
          BX1    X6+X1
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          SA6    SMCA        SET STATUS BITS
          MOVEBIT  SMCA,/SMC/STATUS,36,35,/SMCU/STATUS
          IFNE   TMSG,0,1
          MESSAGE  SMCB,TMSG/1S12,R  ISSUE DAYFILE MESSAGE
          EQ     SMCX        RETURN
 
 SMCA     BSS    1           SPACE FILLED NAME
 SMCB     BSS    0           ACCOUNT FILE MESSAGE
 TYPE     LISTER SMC,4,SDAD  MESSAGE TYPE
          LISTER ,2,(, )
 FAMILY   LISTER ,7          FAMILY NAME
          LISTER ,2,(, )
 VSN      LISTER ,6          VSN
          LISTER ,2,(, )
 PRN      LISTER ,6          PRN
          LISTER ,2,(, )
 STATUS   LISTER ,6,000000   STATUS BITS
          LISTER ,1,(.),E
 SMD      SPACE  4,15
**        SMD - ISSUE *SDRM* ACCOUNT FILE MESSAGE.
*
*         ENTRY  (B6) = ADDRESS OF VSN ENTRY BUFFER.
*                (B7) = BUFFER LENGTH.
*
*         EXIT   MESSAGE ISSUED TO ACCOUNT FILE.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  SFN.
*
*         MACROS MESSAGE, MOVEBIT.
 
 
 SMD      SUBR               ENTRY/EXIT
          SA1    LF
          NZ     X1,SMDX     IF LOCAL FILE MODE
          SX6    B6          SAVE BUFFER ADDRESS
          SA6    SMDA
          SX6    B7          SAVE BUFFER LENGTH
          SA6    SMDB
          SX6    B0          PRESET RELATIVE ADDRESS IN BUFFER
          SA6    SMDC
          SA1    FM          GET FAMILY NAME
          RJ     SFN         SPACE FILL NAME
          SA6    SMDD        SET FAMILY NAME
          MOVEBIT  SMDD,/SMD/FAMILY,42,,/SMDU/FAMILY
 SMD1     SA1    SMDB        CHECK IF END OF TABLE
          SA2    SMDC
          IX1    X2-X1
          PL     X1,SMDX     IF END OF TABLE
          SX6    X2+B1       INCREMENT RELATIVE ADDRESS
          SA6    A2
          SA1    SMDA        GET ADDRESS OF VSN
          IX1    X1+X2
          MOVEBIT  X1,/SMD/VSN,VSKL*6,/UPB/VSN,/SMDU/VSN
          IFNE   TMSG,0,1
          MESSAGE  SMDE,TMSG/1S12,R  ISSUE DAYFILE MESSAGE
          EQ     SMD1        CHECK NEXT VSN
 
 SMDA     BSS    1           VSN BUFFER ADDRESS
 SMDB     BSS    1           VSN BUFFER LENGTH
 SMDC     BSS    1           RELATIVE ADDRESS IN VSN BUFFER
 SMDD     BSS    1           SPACE FILLED NAME
 SMDE     BSS    0           ACCOUNT FILE MESSAGE
          LISTER SMD,6,(SDRM, )
 FAMILY   LISTER ,7          FAMILY NAME
          LISTER ,2,(, )
 VSN      LISTER ,6          VSN
          LISTER ,1,(.),E
 SMF      SPACE  4,15
**        SMF - ISSUE *SDAM* ACCOUNT FILE MESSAGE.
*
*         ENTRY  (FV) = FIRST VSN OF FILE AMENDED.
*                (ST) = VSN STATUS BITS OF FILE AMENDED.
*                (UN) = USER NAME OF FILE AMENDED.
*
*         EXIT   ACCOUNT FILE MESSAGE ISSUED.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS  COD, SFN.
*
*         MACROS MOVEBIT, MESSAGE.
 
 
 SMF      SUBR               ENTRY/EXIT
          SA1    LF
          NZ     X1,SMFX     IF LOCAL FILE MODE
          SA1    FM          GET FAMILY NAME
          RJ     SFN         SPACE FILL NAME
          SA6    SMFA        SET FAMILY NAME
          MOVEBIT  SMFA,/SMF/FAMILY,42,,/SMFU/FAMILY
          SA1    UN          GET USER NAME
          RJ     SFN         SPACE FILL NAME
          SA6    SMFA        SET USER NAME
          MOVEBIT  SMFA,/SMF/USER,UNKL*6,,/SMFU/USER
          MOVEBIT  FV,/SMF/FVSN,VSKL*6,,/SMFU/FVSN  SET FIRST VSN
          SA1    ST          GET STATUS BITS
          SX6    B1
          LX6    18-0
          BX1    X1+X6
          RJ     COD         CONVERT TO OCTAL DISPLAY
          SA6    SMFA        SET STATUS BITS
          MOVEBIT  SMFA,/SMF/STATUS,36,35,/SMFU/STATUS
          IFNE   TMSG,0,1
          MESSAGE  SMFB,TMSG/1S12,R  ISSUE DAYFILE MESSAGE
          EQ     SMFX        RETURN
 
 SMFA     BSS    1           SPACE FILLED NAME
 SMFB     BSS    0           ACCOUNT FILE MESSAGE
          LISTER SMF,6,(SDAM, )
 FAMILY   LISTER ,7          FAMILY NAME
          LISTER ,2,(, )
 USER     LISTER ,7          USER NAME
          LISTER ,2,(, )
 FVSN     LISTER ,6          FIRST VSN
          LISTER ,2,(, )
 STATUS   LISTER ,6,000000   VSN STATUS BITS
          LISTER ,1,(.),E
 SNS      SPACE  4,10
**        SNS - SAVE NEEDED STORAGE.
*
*         ENTRY  NONE.
*
*         EXIT   CATALOG BUFFERS, SPECIAL WORKING STORAGE, AND TABLE
*                OF ASSIGNED VSNS SAVED IN HOLD BUFFER *HBUF*.
*
*         USES   A - 1, 2, 6.
*                B - 2, 3.
*                X - 1, 2, 6.
 
 
 SNS      SUBR               ENTRY/EXIT
          SB2    HBUF        FWA OF STORAGE BUFFER
          SA2    THBP-1      FWA OF TABLE OF MEMORY PARTITIONS-1
 
 SNS1     SA2    A2+B1       MEMORY PARTITION TO SAVE FROM TABLE
          ZR     X2,SNSX     IF ALL MEMORY SAVED
          SA1    X2-1
          SA2    A2+B1       WORD COUNT FROM TABLE
          SB3    X2
 
 SNS2     SA1    A1+B1       GET WORD TO SAVE
          BX6    X1
          SA6    B2          WORD SAVED IN BUFFER
          SB2    B2+B1       INCREMENT BUFFER ADDRESS
          SB3    B3-B1       DECREMENT WORD COUNT
          NZ     B3,SNS2     IF MORE WORDS TO SAVE
          EQ     SNS1        CONTINUE
 SUI      SPACE  4,10
**        SUI - SET UTILITY INTERLOCK.
*
*         EXIT   UTILITY INTERLOCK SET IN TAPE CATALOG.
*
*         USES   A - 1.
*                X - 1.
*
*         MACROS CALLTFM, RESETP.
*
*         EXIT   UTILITY INTERLOCK SET ON TAPE CATALOG FILE.
*
*         USES   A - 1.
*                X - 1.
*
*         MACROS CALLTFM, RESETP.
 
 
 SUI      SUBR               ENTRY/EXIT
          SA1    LF
          NZ     X1,SUIX     IF LOCAL FILE MODE
          RESETP N1          SET UTILITY INTERLOCK
          CALLTFM  X2,SUAS
          EQ     SUIX        RETURN
 TOG      SPACE  4,10
**        TOG - TOGGLE FILE LEVEL LEFT SCREEN DISPLAY.
*
*         ENTRY  (TG) = 0 IF *HELP* DISPLAY ON LEFT SCREEN.
*                     = PAGE NUMBER IF FILE LEVEL DISPLAY.
*
*         EXIT   (TG) TOGGLED IF FILE LEVEL.
*                LEFT SCREEN TOGGLED IF FILE LEVEL.
*
*         USES   A - 1, 6.
*                X - 1, 2, 6.
 
 
 TOG      SUBR               ENTRY/EXIT
          SA1    TG
          ZR     X1,TOGX     IF *HELP* DISPLAY
          SX6    X1+B1       SET NEXT PAGE
          SX2    X6-TOGAL
          NG     X2,TOG1     IF NOT BEYOND LAST PAGE
          SX1    B0          SET FIRST PAGE
          SX6    B1
 TOG1     SA6    TG          RESET PAGE
          SA1    TOGA+X1     RESET DISPLAY ADDRESS
          BX6    X1
          SA6    /KLEFT/NEXT
          EQ     TOGX        RETURN
 
 TOGA     BSS    0
          LOC    1
          KNEXT  KFILLS1,NOLAB
          KNEXT  KFILLS2,NOLAB
          KNEXT  KFILLS3,NOLAB
 TOGAL    EQU    *
          LOC    *O
 UDT      SPACE  4,15
**        UDT - UNPACK DATE/TIME.
*
*         ENTRY  (X1) = PACKED DATE/TIME.
*                (B3) =  70 IF UNPACKING DATE
*                     = 100 IF UNPACKING TIME
*
*         EXIT   (X6) = DATE/TIME LEFT JUSTIFIED IN YYMMDD OR HHMMSS
*                       FORMAT.
*
*         USES   A - 1, 6.
*                B - 3, 6.
*                X - 0, 1, 3.
*
*         CALLS  CDD.
 
 
 UDT3     SA1    =6L         SET NO DATE
          BX6    X1
 
 UDT      SUBR               ENTRY/EXIT
          NZ     X1,UDT1     IF NON-ZERO DATE/TIME
          SB6    B3-70
          ZR     B6,UDT3     IF DATE
 UDT1     SX6    B0          CLEAR UNPACKED BUFFER
          SA6    UDTB
          LX1    -12+60      POSITION PACKED DATE/TIME
          SB6    B1+B1       SET FOR THREE TIMES THROUGH LOOP
 UDT2     MX0    12          SAVE REMAINDER OF PACKED DATE/TIME
          BX6    X0*X1
          SA6    UDTA
          SX1    X1+B3       INSURE TWO DISPLAY DIGITS
          RJ     CDD         CONVERT CONSTANT TO DECIMAL DISPLAY
          MX0    -12         UPDATE UNPACKED DATE/TIME
          SA1    UDTB
          LX1    12
          BX6    -X0*X6
          BX6    X1+X6
          SA6    A1
          SA1    UDTA        GET REMAINDER OF PACKED DATE/TIME
          LX1    6
          SB3    100         INSURE TWO DISPLAY DIGITS
          SB6    B6-B1
          PL     B6,UDT2     IF MORE TO CONVERT
          LX6    24
          EQ     UDTX        RETURN
 
 UDTA     BSS    1           PACKED DATE/TIME
 UDTB     BSS    1           UNPACKED DATE/TIME
 UFA      SPACE  4,15
**        UFA - UNPACK FILE AUDIT.
*
*         ENTRY  (N3 - N3+15B) = AUDIT FET.
*                (B2) = ASSIGNED VSN BUFFER ADDRESS.
*                (B6) = FILE CATALOG BUFFER ADDRESS.
*
*         EXIT   (X4) = 0 IF FILE AUDIT UNPACKED.
*                     .NE. 0 IF END OF AUDIT.
*                (X6) = RANDOM ADDRESS OF FILE CATALOG.
*                FILE CATALOG IMAGE SET IN BUFFER.
*                ASSIGNED VSN ENTRIES SET IN BUFFER.
*
*         USES   A - 1, 6.
*                B - 6.
*                X - 1.
*
*         MACROS CALLTFM, MOVEBIT, READFET, RJUST.
 
 
 UFA      SUBR               ENTRY/EXIT
          SX6    B2          SAVE VSN BUFFER ADDRESS
          SA6    UFAA
          SX6    B6          SAVE FILE BUFFER ADDRESS
          SA6    UFAB
 UFA1     READFET  N3,B6,TCEL  SET FILE CATALOG IN BUFFER
          ZR     X1,UFA2     IF CATALOG FOUND
          SA1    X2          CHECK IF AUDIT COMPLETE
          RJUST  X1,X4,1,1
          NZ     X4,UFAX     IF AUDIT COMPLETE
          CALLTFM  X2,AUCS   REISSUE AUDIT REQUEST
          NZ     X4,UFAX     IF END OF AUDIT
          SA1    UFAB        RESET FILE BUFFER ADDRESS
          SB6    X1
          EQ     UFA1        SET FILE CATALOG IN BUFFER
 
 UFA2     SA1    B6-TCEL+/CAT/REELC  GET REEL COUNT
          RJUST  X1,X6,/BTC/REELC,/UPB/REELC
          LX6    2
          SA1    UFAA        GET VSN BUFFER ADDRESS
          READFET  X2,X1,X6  SET ASSIGNED VSN ENTRIES IN BUFFER
          READFET  X2,UFAC,1 GET CATALOG RANDOM ADDRESS
          SA1    LF
          ZR     X1,UFA3     IF NOT LOCAL FILE MODE
          SA2    UFAB        CLEAR FILE BUSY INTERLOCK
          MOVEBIT  (=0),X2+/CAT/FBIL,/BTC/FBIL,,/UPB/FBIL
 UFA3     SA1    UFAC
          RJUST  X1,X6,24,23
          SX4    B0          FLAG UNPACK COMPLETE
          EQ     UFAX        RETURN
 
 UFAA     BSS    1           VSN BUFFER ADDRESS
 UFAB     BSS    1           FILE CATALOG BUFFER ADDRESS
 UFAC     BSS    1           CATALOG RANDOM ADDRESS
 UFC      SPACE  4,20
**        UFC - UNPACK FILE CATALOG INTO DIRECT CELLS.
*
*         ENTRY  (X6) = CATALOG RANDOM ADDRESS.
*                (X7) = PREVIOUS FILE RANDOM ADDRESS.
*                (B7) = VSN COUNT.
*
*         EXIT   (CA) = FILE CATALOG ADDRESS.
*                (EV) = EXTERNAL VSN.
*                (FI) = FILE IDENTIFIER.
*                (FV) = FIRST VSN.
*                (NI) = FILE IDENTIFIER.
*                (PA) = PREVIOUS FILE RANDOM ADDRESS.
*                (QN) = SEQUENCE NUMBER.
*                (RC) = REEL COUNT.
*                (ST) = VSN STATUS BITS.
*                (SV) = SYMBOLIC ACCESS FLAG.
*                (VC) = VSN COUNT.
*
*         USES   A - 1, 6, 7.
*                X - 0, 1, 6.
*
*         MACROS MOVEBIT.
 
 
 UFC      SUBR               ENTRY/EXIT
          SA6    CA          SET FILE CATALOG RANDOM ADDRESS
          SA7    PA          SET PREVIOUS FILE CATALOG RANDOM ADDRESS
          SX6    B7          SET VSN COUNT
          SA6    VC
          NZ     B7,UFC1     IF VSNS ASSIGNED
          SA6    FV          CLEAR FIRST VSN
          SA6    ST          CLEAR VSN STATUS
          EQ     UFC2        SET FILE IDENTIFIER
 
 UFC1     MOVEBIT  TAVS+/CAT/VSN,FV,/BTC/VSN,/UPB/VSN  SET FIRST VSN
          SX0    277777B     SET VSN STATUS BITS
          SA1    TAVS+1
          BX1    X0*X1
          MOVEBIT  A1,ST,18,17,17
 UFC2     MOVEBIT  /ADD/FI,FI,/BTC/FI,/UPB/FI  SET FILE ID
          MOVEBIT  /ADD/FI,NI,/BTC/FI,/UPB/FI
          MOVEBIT  /ADD/EVSN,EV,/BTC/EVSN,/UPB/EVSN
          MOVEBIT  /ADD/QN,QN,/BTC/QN,/UPB/QN,/BTC/QN-1
          MOVEBIT  /ADD/SV,SV,/BTC/SV,/UPB/SV,/BTC/SV-1
          MOVEBIT  /ADD/REELC,RC,/BTC/REELC,/UPB/REELC,/BTC/REELC-1
          MOVEBIT  /ADD/D,DE,/BTC/D,/UPB/D,/BTC/D-1
          EQ     UFCX        RETURN
 USL      SPACE  4,10
**        USL - USER LEVEL PROCESSOR.
*
*         EXIT   PROGRAM SET FOR USER LEVEL DIRECTIVES.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS  KFI, RAE.
 
 
 USL      SUBR               ENTRY/EXIT
          RJ     RAE         REPLACE ALTERNATE USER ENTRIES
          SX6    B0          FLAG INITIAL AUDIT
          SA6    AA
          SA1    NV
          NZ     X1,USL1     IF NO VERIFY MODE
          RJ     KFI         SET FILE-IDS IN K-DISPLAY
 USL1     SX6    LVUS        SET USER LEVEL
          SA6    LV
          SA1    UN          SET USER NAME IN K-DISPLAY
          BX6    X1
          SA6    /KUSELS/USER
          SA1    USLA        RESET LEFT SCREEN POINTER
          BX6    X1
          SA6    /KLEFT/NEXT
          SA1    USLB        RESET RIGHT SCREEN POINTER
          BX6    X1
          SA6    /KRIGHT/NEXT
          SA1    =H*     USER *  SET LEVEL IN HELP DISPLAY
          BX6    X1
          SA6    /KRIGHT/LV
          EQ     USLX        RETURN
 
 USLA     KNEXT  KUSELS,NOLAB
 USLB     KNEXT  KUSERS,NOLAB
 VSA      SPACE  4,15
**        VSA - VSN AUDIT LIST PROCESSOR.
*
*         ENTRY  (VCAT) = VSN ENTRY IMAGE.
*
*         EXIT   VSN INFORMATION COPIED TO OUTPUT FILE.
*
*         USES   A - 1.
*                B - 3.
*                X - 0, 1.
*
*         CALLS  SFN.
*
*         MACROS MOVEBIT, SETSORC, WLINES.
 
 
 VSA      SUBR               ENTRY/EXIT
          MX0    -18
          SA1    /ADD/URDATE GET RELEASE DATE
          BX1    -X0*X1
          SB3    70
          RJ     UDT         UNPACK DATE/TIME
          SA6    VSAB        SET RELEASE DATE
          MOVEBIT  VSAB,/ALS/RELDATE,6*6,59,/ALSU/RELDATE
          SA1    /ADD/URDATE CHECK RELEASE DATE
          MX0    -18
          BX6    -X0*X1
          SX1    1R
          ZR     X6,VSA0.1   IF NO RELEASE DATE
          SA1    /ADD/NEWRDT CHECK RELEASE DATE FORMAT
          LJUST  X1,X6,/BTC/NEWRDT,/UPB/NEWRDT
          SX1    1R*
          PL     X6,VSA0.1   IF OLD FORMAT
          SX1    1R
 VSA0.1   MOVEBIT  A1,/ALS/NEWRDT,1*6,5,/ALSU/NEWRDT
          SA1    =18H                   PRESET USER AND CHARGE AS BLANK
          MOVEBIT  A1,/ALS/VUSER,18*6,,/ALSU/VUSER
          SA1    UN          GET USER NAME
          RJ     SFN         SPACE FILL NAME
          BX1    X6          SET USER NAME IN LISTING
          MOVEBIT  A1,/ALS/VUSER,UNKL*6,,/ALSU/VUSER
          SA1    /ADD/CN     GET CHARGE NUMBER
          RJ     SFN         SPACE FILL NAME
          BX1    X6
          MOVEBIT  A1,/ALS/VCHG,CNKL*6,,/ALSU/VCHG
          SA1    /ADD/FVSN   GET FIRST VSN
          RJ     SFN         SPACE FILL NAME
          BX1    X6          SET FIRST VSN IN LISTING
          MOVEBIT  A1,/ALS/FVSN,VSKL*6,,/ALSU/FVSN
          MX0    VSKL*6      CHECK IF LAST SCRATCH VSN
          SA1    /ADD/NVSN
          BX1    X0-X1
          BX1    X0*X1
          ZR     X1,VSA1     IF LAST SCRATCH VSN
          SA1    A1
 VSA1     RJ     SFN         SPACE FILL NAME
          BX1    X6          SET NEXT VSN IN LISTING
          MOVEBIT  A1,/ALS/NVSN,VSKL*6,,/ALSU/NVSN
          SA1    UN
          NZ     X1,VSA2     IF VSN ASSIGNED
          SA1    =18H *NOT ASSIGNED*     SET MESSAGE IN LISTING
          MOVEBIT  A1,/ALS/VUSER,18*6,,/ALSU/VUSER
 VSA2     MOVEBIT  /ADD/VSN,/ALS/VSN,/ALSC/VSN*6,/UPB/VSN,/ALSU/VSN
          SA1    /ADD/ERRFLAG  CHECK ERROR FLAG
          RJUST  X1,X1,/BTC/ERRFLAG,/UPB/ERRFLAG
          ZR     X1,VSA3     IF ERROR FLAG NOT SET
          SA1    =5HERROR
          EQ     VSA5        SET VSN STATUS IN LISTING
 
 VSA3     SA1    /ADD/MAINT  CHECK MAINTENANCE FLAG
          RJUST  X1,X1,/BTC/MAINT,/UPB/MAINT
          ZR     X1,VSA4     IF MAINTENANCE FLAG NOT SET
          SA1    =5HHOLD
          EQ     VSA5        SET VSN STATUS IN LISTING
 
 VSA4     SA1    =5HAVAIL
 VSA5     MOVEBIT A1,/ALS/STATUS,5*6,,/ALSU/STATUS
          SETSORC  A,LVVS    SET SOURCE VALUES IN AUDIT LISTING
          WLINES VSAA,1      WRITE TO OUTPUT FILE
          EQ     VSAX        RETURN
 
 VSAA     BSS    0           AUDIT LISTING
          LISTER ALS,2
 VSN      LISTER ,6          VSN
          LISTER ,1
 PRN      LISTER ,6          INTERNAL VSN (PRN)
          LISTER ,1
 VT       LISTER ,4          VSN TAPE TYPE
          LISTER ,1
 STATUS   LISTER ,6,AVAIL    STATUS
          LISTER ,1
 USAGE    LISTER ,2,00       USAGE COUNT
          LISTER ,1
 OWNER    LISTER ,6,CENTER   OWNERSHIP TYPE
          LISTER ,1
 SITE     LISTER ,3,ON       SITE STATUS
          LISTER ,1
 SYSTEM   LISTER ,6,NO       SYSTEM VSN FLAG
          LISTER ,1
 VUSER    LISTER ,7          USER NAME
          LISTER ,1
 VCHG     LISTER ,10         CHARGE NUMBER
          LISTER ,1
 NEWRDT   LISTER ,1          NEW RELEASE DATE FORMAT
 RELDATE  LISTER ,6          RELEASE DATE
          LISTER ,1
 FVSN     LISTER ,6          FIRST VSN
          LISTER ,1
 NVSN     LISTER ,6,,E       NEXT VSN
 
 VSAB     CON    0           RELEASE DATE IMAGE
 VSL      SPACE  4,10
**        VSL - VSN LEVEL PROCESSOR.
*
*         EXIT   PROGRAM SET FOR VSN LEVEL DIRECTIVES.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         MACROS MOVE.
 
 
 VSL      SUBR               ENTRY/EXIT
          SX6    LVVS        SET VSN LEVEL
          SA6    LV
          SA1    VS          SET VSN IN K-DISPLAY
          BX6    X1
          SA6    /KVSNLS/VSN
          SA1    VF          CHECK VSN IN CATALOG FLAG
          SA2    VSLA        PRESET MESSAGE ADDRESS
          ZR     X1,VSL1     IF VSN NOT IN CATALOG
          SA2    VSLB        RESET MESSAGE ADDRESS
 VSL1     MOVE   3,A2,/KVSNLS/MESS
          MOVEBIT /ADD/VT,VTT,/BTC/VT,/UPB/VT,/BTC/VT-1
          MOVEBIT /ADD/SYSTEM,SVF,/BTC/SYSTEM,/UPB/SYSTEM,/BTC/SYSTEM-1
          RJ     KST         SET VSN STATUS IN K-DISPLAY
          SA1    VSLC        RESET LEFT SCREEN POINTER
          BX6    X1
          SA6    /KLEFT/NEXT
          SA1    VSLD        RESET RIGHT SCREEN POINTER
          BX6    X1
          SA6    /KRIGHT/NEXT
          SA1    =H*      VSN *  SET LEVEL IN HELP DISPLAY
          BX6    X1
          SA6    /KRIGHT/LV
          EQ     VSLX        RETURN
 
 VSLA     DATA   30HVSN NOT CURRENTLY IN CATALOG.
 VSLB     DATA   30HVSN CURRENTLY IS IN CATALOG.
 VSLC     KNEXT  KVSNLS,NOLAB
 VSLD     KNEXT  KVSNRS,NOLAB
 VSM      SPACE  4,15
**        VSM - VSN MACHINE READABLE LIST PROCESSOR.
*
*         ENTRY  (VCAT) = VSN ENTRY IMAGE.
*
*         EXIT   VSN INFORMATION COPIED TO MACHINE READABLE OUTPUT
*                FILE.
*
*         USES   A - 1, 2.
*                B - 3.
*                X - 0, 1, 2.
*
*         CALLS  SFN, UDT.
*
*         MACROS MOVEBIT, RJUST, SETSORC, WRITEC.
 
 
 VSM      SUBR               ENTRY/EXIT
          SA1    /ADD/VASF   CHECK VSN ASSIGNED FLAG
          RJUST  X1,X1,/BTC/VASF,/UPB/VASF
          ZR     X1,VSM4     IF VSN NOT ASSIGNED TO A FILE
          SA2    /ADD/RECOVER  CHECK FOR RECOVERED STATUS
          LX2    59-/UPB/RECOVER
          SA1    =C*N*
          PL     X2,VSM1     IF NOT RECOVERED
          SA1    =C*S*
 VSM1     MOVEBIT A1,/MLS/RECOVER,1*6,59,/MLSU/RECOVER
          SA2    VCAT+VEVS   CHECK IF FILE RESERVED
          LX2    59-17
          ERRNZ  400000B-RTVS  INCORRECT BIT POSITION
          SA1    =C*R*
          NG     X2,VSM2     IF FILE RESERVED
          SA1    =C*N*
 VSM2     MOVEBIT  A1,/MLS/RESF,1*6,59,/MLSU/RESF  SET RESERVED STATUS
          SA1    UN          SET USER NAME IN LISTING
          RJ     SFN         SPACE FILL NAME
          BX1    X6
          MOVEBIT  A1,/MLS/USER,/MLSC/USER*6,,/MLSU/USER
          SETSORC  M,LVFI    SET SOURCE VALUES IN MACHINE READ LIST
          SA1    /MLS/FI     CHECK FOR EXTRA END OF LINES
          SB3    /MLSU/FI
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /MLS/PI
          SB3    /MLSU/PI
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    /ADD/TTYP   CHECK TAPE DEVICE TYPE
          RJUST  X1,X6,/BTC/TTYP,/UPB/TTYP
          SA1    VSMB+X6     GET MNEMONIC
          MOVEBIT  A1,/MLS/TTYP,/MLSC/TTYP*6,,/MLSU/TTYP
          EQ     VSM5        ADD VSN INFORMATION
 
 VSM4     MOVEBIT  (=50H),/MLS/USER,50*6,,/MLSU/USER  SET BLANKS
          MOVEBIT  (=50H),A2,50*6,,B2
          MOVEBIT  (=47H),A2,47*6,,B2
          MOVEBIT  (=19H),/MLS/LB,19*6,,/MLSU/LB
          MOVEBIT  (=1HN),/MLS/RESF,1*6,59,/MLSU/RESF
          MOVEBIT  (=1HN),/MLS/RECOVER,1*6,59,/MLSU/RECOVER
 VSM5     MOVEBIT  /ADD/VSN,/MLS/VSN,/MLSC/VSN*6,/UPB/VSN,/MLSU/VSN
          SA1    /ADD/FVSN   GET FIRST VSN
          RJ     SFN         SPACE FILL NAME
          BX1    X6          SET FIRST VSN IN LISTING
          MOVEBIT  A1,/MLS/FVSN,VSKL*6,,/MLSU/FVSN
          MX0    VSKL*6      CHECK IF LAST SCRATCH VSN
          SA1    /ADD/NVSN
          BX1    X0*X1
          BX1    X0-X1
          ZR     X1,VSM6     IF LAST SCRATCH VSN
          SA1    A1
          BX1    X0*X1
 VSM6     RJ     SFN         SPACE FILL NAME
          BX1    X6          SET NEXT VSN IN LISTING
          MOVEBIT  A1,/MLS/NVSN,VSKL*6,,/MLSU/NVSN
          SA1    /ADD/REELNO GET REEL NUMBER
          RJUST  X1,X1,/BTC/REELNO,/UPB/REELNO
          SX1    X1+100
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          LJUST  X6,X1,12,11 SET REEL NUMBER IN LISTING
          MOVEBIT  A1,/MLS/REELNO,/MLSC/REELNO*6,,/MLSU/REELNO
          SA1    /ADD/URDATE GET RELEASE DATE
          MX0    -18
          BX1    -X0*X1
          SB3    70          SET DATE FLAG FOR UDT
          RJ     UDT         UNPACK DATE
          BX1    X6          SET RELEASE DATE IN LISTING
          MOVEBIT  A1,/MLS/URDATE,6*6,,/MLSU/URDATE
          SA1    /ADD/URDATE CHECK RELEASE DATE
          MX0    -18
          BX6    -X0*X1
          SX1    1R
          ZR     X6,VSM7     IF NO RELEASE DATE
          SA1    /ADD/NEWRDT CHECK IF NEW RELEASE DATE FORMAT
          LJUST  X1,X6,/BTC/NEWRDT,/UPB/NEWRDT
          SX1    1R*
          PL     X6,VSM7     IF OLD FORMAT
          SX1    1R
 VSM7     MOVEBIT  A1,/MLS/NEWRDT,1*6,5,/MLSU/NEWRDT
          SETSORC  M,LVVS    SET SOURCE VALUES IN MACHINE READ LIST
          WRITEC SS,VSMA     WRITE ENTRY TO MACHINE READABLE FILE
          EQ     VSMX        RETURN
 
 
 VSMA     BSS    0           MATCHING READABLE LISTING
          LISTER MLS,1,2     RECORD TYPE
 FAMILY   LISTER ,7          FAMILY NAME
 USER     LISTER ,7          USER NAME
 CN       LISTER ,7          CHARGE NUMBER
 PN       LISTER ,20         PROJECT NUMBER
 FI       LISTER ,17         FILE IDENTIFIER
 CT       LISTER ,7,PRIVATE  FILE CATEGORY
 CDATE    LISTER ,6,YYMMDD   CREATION DATE
 CTIME    LISTER ,6,HHMMSS   CREATION TIME
 ADATE    LISTER ,6,YYMMDD   LAST ACCESS DATE
 ATIME    LISTER ,6,HHMMSS   LAST ACCESS TIME
 MDATE    LISTER ,6,YYMMDD   LAST MODIFICATION DATE
 MTIME    LISTER ,6,HHMMSS   LAST MODIFICATION TIME
 M        LISTER ,6,READ     PERMISSION MODE
 ACOUNT   LISTER ,10,0000000000  ACCESS COUNT
 F        LISTER ,2,I        FORMAT
 CV       LISTER ,2,AS       CONVERSION MODE
 TTYP     LISTER ,2,NT       TAPE DEVICE TYPE
 D        LISTER ,2,PE       DENSITY
          LISTER ,3          BLANKS
 UC       LISTER ,10         USER CONTROL WORD
          LISTER ,4          BLANKS
 CE       LISTER ,1,C        ERROR FLAG
          LISTER ,1          BLANKS
 PW       LISTER ,7          PASSWORD
          LISTER ,3          BLANKS
 VSN      LISTER ,6          VSN
 PRN      LISTER ,6          PRN
 FVSN     LISTER ,6          FIRST VSN
 NVSN     LISTER ,6          NEXT VSN
 MAINT    LISTER ,5,AVAIL    MAINTENANCE FLAG
 SITE     LISTER ,3,ON       SITE STATUS
 OWNER    LISTER ,6,CENTER   OWNERSHIP TYPE
 ERRFLAG  LISTER ,1,C        ERROR FLAG
 REELNO   LISTER ,2,00       REEL NUMBER
 LB       LISTER ,2,KL       LABEL TYPE
 PI       LISTER ,17         PHYSICAL FILE IDENTIFIER
 USAGE    LISTER ,2,00       USAGE COUNT
 URDATE   LISTER ,6          RELEASE DATE
 RESF     LISTER ,1,N        RESERVED FLAG
 RECOVER  LISTER ,1,N        RECOVER FLAG
 NEWRDT   LISTER ,1          NEW RELEASE DATE FORMAT
 SYSTEM   LISTER ,3,NO       SYSTEM VSN FLAG
 VT       LISTER ,4,MTNT,E   VSN TAPE TYPE
 
 VSMB     BSS    0           TABLE OF TAPE DEVICE TYPES
          CON    0LMT        7-TRACK TAPE
          CON    0LCT        CARTRIDGE TAPE
          CON    0LNT        9-TRACK TAPE
          CON    0LAT        ACS CARTRIDGE TAPE
 VSS      SPACE  4,15
**        VSS - VSN SOURCE LISTING PROCESSOR.
*
*         ENTRY  (VCAT) = VSN ENTRY IMAGE.
*
*         EXIT   VSN INFORMATION COPIED TO SOURCE FILE.
*
*         USES   A - 1.
*                X - 1.
*
*         CALLS  SCS.
*
*         MACROS MOVEBIT, SETSORC, WRITEC.
 
 
 VSS      SUBR               ENTRY/EXIT
          MOVEBIT  /ADD/VSN,/SLS/VSN,VSKL*6,,/SLSU/VSN
          SETSORC  S,LVVS    SET SOURCE VALUES IN SOURCE LISTING
          WRITEC S,VSSA      WRITE FIRST LINE OF SOURCE ENTRY
          SA1    /DTAB/PRN   ADD PRN TO SOURCE ENTRY
          RJ     SCS         PROCESS SPECIAL CHARACTER SOURCE ENTRY
          WRITEC S,VSSB      WRITE LAST LINE OF SOURCE ENTRY
          EQ     VSSX        RETURN
 
 VSSA     BSS    0           FIRST LINE OF VSN SOURCE ENTRY
          LISTER SLS,4,VSN=
 VSN      LISTER ,6          VSN
          LISTER ,4,(,VT=)
 VT       LISTER ,4,MTNT     VSN ENTRY TAPE TYPE
          LISTER ,7,(,USAGE=)
 USAGE    LISTER ,2,00       USAGE COUNT
          LISTER ,9,(,ERRFLAG=)
 ERRFLAG  LISTER ,5,CLEAR    ERROR FLAG
          LISTER ,7,(,MAINT=)
 MAINT    LISTER ,9,AVAILABLE  MAINTENANCE FLAG
          LISTER ,6,(,SITE=)
 SITE     LISTER ,3,ON,E,CAPL  SITE STATUS
 
 VSSB     BSS    0           LAST LINE OF VSN SOURCE ENTRY
          LISTER ,6,OWNER=
 OWNER    LISTER ,6,CENTER   OWNERSHIP TYPE
          LISTER ,8,(,SYSTEM=)
 SYSTEM   LISTER ,3,NO       SYSTEM VSN FLAG
          LISTER ,3,(,GO),E,CAPL
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCCIO
*CALL     COMCDXB
*CALL     COMCEDT
*CALL     COMCMVE
*CALL     COMCRDC
*CALL     COMCRDW
*CALL     COMCSFM
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSYS
 USBB     BSS    CSPL+10     STRING BUFFER
*CALL     COMCUSB
*CALL     COMCWTC
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  UNIVERSAL DIRECTIVE PROCESSORS.
 UNIDIR   SPACE  4,10
**        UNIVERSAL DIRECTIVE PROCESSORS.
*
*         ENTRY  FROM *DIP*.
*                (AI) = ALTERNATE INPUT FILE NAME.
*                (IF) = INPUT FILE FET ADDRESS.
*                (TG) = FILE LEVEL K-DISPLAY PAGE NUMBER.
*                (BF) = BRIEF/NOBRIEF FLAG FOR HEADER DISPLAY.
*
*         EXIT   (EF) = 0 IF NO DIRECTIVE ERROR.
 DIS      SPACE  4,10
**        DIS - PROCESS *DISPLAY* DIRECTIVE.
 
 
 DIS2     SX6    B1          SET FILE LEVEL TOGGLE
          SA6    TG
          SA1    DISA        SET NORMAL LEFT SCREEN CONTROL WORD
          BX6    X1
          SA6    KCW
 
 DIS      SUBR               ENTRY/EXIT
          SA1    OP          CHECK OPTION
          SX1    X1-KOPT
          ZR     X1,DIS2     IF *OP=K*
          SA1    BF          CHECK *BRIEF* FLAG
          NZ     X1,DIS1     IF *BRIEF* MODE SET
          NEWPAGE  PDIS,PDISL  FORCE NEW PAGE
          WWORDS /KLEFT/START,/KLEFT/LENGTH
 DIS1     SA1    /KLEFT/NEXT GET ADDRESS OF REMAINDER OF DISPLAY
          SX2    X1
          SA1    X1-1        GET LENGTH OF REMAINDER OF DISPLAY
          SB6    X1
          WWORDS X2,B6       WRITE REMAINDER OF LEFT SCREEN DISPLAY
          NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE ON NEXT DIRECTIVE
          EQ     DISX        RETURN
 
 DISA     VFD    24/KBUF,18/KRIGHT,18/KLEFT  CONTROL WORD IMAGE
 STO      SPACE  4,10
**        STO - PROCESS *STOP* DIRECTIVE.
*
*         SET TERMINATION DIRECTIVES (DROP) IN THE STRING BUFFER.
*
*         EXIT   (USBB) = SERIES OF *DROP* DIRECTIVES.
*                (SP) = BUFFER POINTER.
*                (SB) = BUFFER ADDRESS.
*                (SM) = BUFFER MAXIMUM ADDRESS.
*
*         USES   A - 6.
*                X - 6.
*
*         MACROS MOVE.
 
 
 STO      SUBR               ENTRY/EXIT
          MOVE   TFSAL,TFSA,USBB  SET TERMINATION DIRECTIVES
          SX6    USBB-1      SET BUFFER POINTER
          SA6    SP
          SX6    X6+B1       SET BUFFER ADDRESS
          SA6    SB
          SX6    USBB+TFSAL  SET BUFFER MAXIMUM ADDRESS
          SA6    SM
          EQ     STOX        RETURN
 HEL      SPACE  4,10
**        HEL - PROCESS *HELP* DIRECTIVE.
 
 
 HEL1     SX6    B0          FLAG *HELP* DISPLAY
          SA6    TG
          SA1    HELA        SET *HELP* CONTROL WORD
          BX6    X1
          SA6    KCW
 
 HEL      SUBR               ENTRY/EXIT
          SA1    OP          CHECK OPTION
          SX1    X1-KOPT
          ZR     X1,HEL1     IF *OP=K*
          NEWPAGE  PHEL,PHELL  FORCE NEW PAGE
          WWORDS /KRIGHT/START,/KRIGHT/LENGTH  WRITE HEADER
          SA1    /KRIGHT/NEXT  GET ADDRESS OF REMAINDER OF DISPLAY
          SX2    X1
          SA1    X1-1        GET LENGTH OF REMAINDER OF DISPLAY
          SB6    X1
          WWORDS X2,B6       WRITE REMAINDER OF RIGHT SCREEN DISPLAY
          NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE ON NEXT DIRECTIVE
          EQ     HELX        RETURN
 
 HELA     VFD    24/KBUF,18/KRIGHT,18/KRIGHT  CONTROL WORD IMAGE
 REA      SPACE  4,10
**        REA - PROCESS *READ* DIRECTIVE.
 
 
 REA1     SX6    B0          CLEAR ALTERNATE INPUT FILE NAME
          SA6    AI
 REA2     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 REA      SUBR               ENTRY/EXIT
          SA1    IF          CHECK INPUT FET ADDRESS
          SX1    X1-I
          SB5    ERDI        SET ERROR MESSAGE ADDRESS
          NZ     X1,REA2     IF ALTERNATE INPUT FILE
          SA1    DIPB        SET FILE NAME IN FET
          SX6    B1
          BX6    X1+X6
          SA6    RD
          SX2    A6
          RJ     CFC         CHECK FOR FILE NAME CONFLICT
          SB5    EFNC        SET ERROR MESSAGE ADDRESS
          NZ     X4,REA1     IF CONFLICT
          SX6    X2          SET INPUT FILE FET
          SA6    IF
          SA1    SB          SAVE INPUT STRING BUFFER POINTERS
          SX6    X1
          SA6    TFSB+0
          SA1    SM
          SX6    X1
          SA6    A6+B1
          SA1    SP
          SX6    X1
          SA6    A6+B1
          MOVE   USBBL,USBB,TFSC  SAVE INPUT STRING BUFFER
          SX6    B0          PRESET INPUT STRING BUFFER POINTERS
          SA6    SB
          SA6    SM
          SA6    SP
          EQ     REAX        RETURN
 REW      SPACE  4,10
**        REW - PROCESS *REWIND* DIRECTIVE.
 
 
 REW      SUBR               ENTRY/EXIT
          SX2    R
          RJ     CFC         CHECK FOR FILE NAME CONFLICT
          ZR     X4,REW1     IF NO CONFLICT
          RECALL X4          REWIND FILE
          REWIND X2,R
          EQ     REWX        RETURN
 
 REW1     REWIND R,R         REWIND FILE
          EQ     REWX        RETURN
          TITLE  FAMILY LEVEL DIRECTIVE PROCESSORS.
          SPACE  4
          QUAL   LVFA
 FAMDIR   SPACE  4,10
**        FAMILY LEVEL DIRECTIVE PROCESSORS.
*
*         ENTRY  FROM *DIP*.
*                (REC1) = IMAGE OF FIRST TAPE CATALOG FILE RECORD.
*
*         EXIT   (EF) = 0 IF NO DIRECTIVE ERROR.
 ACH      SPACE  4,10
**        ACH - PROCESS *AUDITCH* DIRECTIVE.
 
 
 ACH      SUBR               ENTRY/EXIT
          NEWPAGE  PFIA,PFIAL  SET NEW PAGE HEADER
 ACH1     RCREC  N2,5
          GRENTRY  N2,ACHA   GET RECORD ENTRY FROM CATALOG
          ZR     X6,ACH3     IF NO USERNAMES
 ACH2     GRENTRY  N2,ACHA   GET RECORD ENTRY FROM CATALOG
          ZR     X6,ACH3     IF END OF USERNAMES
          SA1    TI
          NZ     X1,ACH3     IF TERMINAL INTERRUPT
          MX0    42          GET USERNAME
          SA1    ACHA
          BX6    X0*X1
          SA6    UN          STORE USERNAME TO AUDIT
          USERAUD  A,CN      PROCESS CHARGE AUDIT
          EQ     ACH2        CHECK NEXT USERNAME
 
 ACH3     NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE
          EQ     ACHX        RETURN
 
 ACHA     BSS    1           SECONDARY USERNAME POINTER
 AFM      SPACE  4,10
**        AFM - PROCESS *ALTFAM* DIRECTIVE.
 
 AFM2     ISSMSG ENVF,E      ISSUE ERROR MESSAGE
 
 AFM      SUBR               ENTRY/EXIT
          SA1    LF
          ZR     X1,AFM2     IF NOT LOCAL FILE MODE
          MX0    42
          SRCHTAB  TAFM,AFMA,PAFL  SEARCH FOR FAMILY NAME
          ZR     X4,AFMX     IF ALREADY IN TABLE
          SRCHTAB  TAFM,=0,B2,B3,B4  SEARCH FOR EMPTY ENTRY
          ZR     X4,AFM1     IF EMPTY ENTRY FOUND
          ISSMSG EAFM,E      ISSUE ERROR MESSAGE
          EQ     AFMX        RETURN
 
 AFM1     SA2    AFMA        SET FAMILY NAME IN TABLE
          BX6    X2
          SA6    A1
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          EQ     AFMX        RETURN
 
 AFMA     BSS    1           ALTERNATE FAMILY NAME
 AUN      SPACE  4,10
**        AUN - PROCESS *AUDITUN* DIRECTIVE.
 
 
 AUN3     NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE FOR NEXT DIRECTIVE
 
 AUN      SUBR               ENTRY/EXIT
          NEWPAGE  PFIA,PFIAL  SET NEW PAGE HEADER
          SA1    UN
          ZR     X1,AUN1     IF MULTIPLE VSNS
          USERAUD  A         PROCESS USER AUDIT LIST
          EQ     AUN3        FORCE NEW PAGE
 
 AUN1     RCREC  N2,5
          GRENTRY  N2,AUNA   GET RECORD ENTRY
          ZR     X6,AUN3     IF END OF USER NAMES
 AUN2     GRENTRY  N2,AUNA   GET RECORD ENTRY
          ZR     X6,AUN3     IF END OF USER NAMES
          SA1    TI
          NZ     X1,AUN3     IF TERMINAL INTERRUPT
          MX0    42          GET USER NAME
          SA1    AUNA
          BX6    X0*X1
          SA6    UN
          USERAUD  A         PROCESS USER AUDIT LIST
          EQ     AUN2        CHECK NEXT USER NAME
 
 AUNA     BSS    1           SECONDARY USER NAME POINTER IMAGE
 AVS      SPACE  4,10
*         AVS - PROCESS *AUDITVS* DIRECTIVE.
 
 
 AVS4     NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE FOR NEXT DIRECTIVE
 
 AVS      SUBR               ENTRY/EXIT
          NEWPAGE  PVSA,PVSAL  FORCE NEW PAGE
          SA1    VS
          ZR     X1,AVS1     IF MULTIPLE VSNS
          SX6    B0
          RJ     GVE         GET VSN ENTRY
          NZ     X4,AVSX     IF NOT FOUND
          RJ     GUV         GET USER INFORMATION ON VSN
          RJ     VSA         PROCESS VSN OUTPUT LIST
          EQ     AVS4        FORCE NEW PAGE
 
 AVS1     SA1    LF
          ZR     X1,AVS2     IF NOT LOCAL FILE MODE
          RJ     RVE         REPLACE VSN ENTRIES
 AVS2     RCREC  N1,4        GET RECORD ENTRY OF DUMMY VSN
          GRENTRY  N1,VCAT
          ZR     X6,AVS4     IF NO MORE ENTRIES
 AVS3     GRENTRY  N1,VCAT
          ZR     X6,AVS4     IF NO MORE ENTRIES
          SA1    TI
          NZ     X1,AVS4     IF TERMINAL INTERRUPT
          RJ     GUV         GET USER INFORMATION ON VSN
          RJ     VSA         PROCESS VSN OUTPUT LIST
          EQ     AVS3        GET NEXT ENTRY
 BRF      SPACE  4,10
**        BRF - PROCESS *BRIEF* DIRECTIVE.
 
 
 BRF      SUBR               ENTRY/EXIT
          SA1    BF          CHECK BRIEF FLAG
          SX6    B1
          SA6    A1          SET FLAG FOR BRIEF
          EQ     BRFX        RETURN
 CAF      SPACE  4,10
**        CAF - PROCESS *CALTFAM* DIRECTIVE.
 
 
 CAF1     ISSMSG ENVF,E      ISSUE ERROR MESSAGE
 
 CAF      SUBR               ENTRY/EXIT
          SA1    LF
          ZR     X1,CAF1     IF NOT LOCAL FILE MODE
          MX0    42
          SRCHTAB  TAFM,CAFA,PAFL  SEARCH FOR FAMILY NAME
          NZ     X4,CAFX     IF NOT IN TABLE
          SB7    B7+B3       MOVE END OF TABLE OVER DELETED FAMILY
          SB2    B2-B7
          MOVE   B2,A1+B3,A1
          SX6    B0          CLEAR LAST ENTRY IN TABLE
          SA6    TAFM+PAFL-1
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          EQ     CAFX        RETURN
 
 CAFA     BSS    1           ALTERNATE FAMILY NAME
 CAT      SPACE  4,10
**        CAT - PROCESS *CATERR* DIRECTIVE.
 
 
 CAT1     MOVEBIT  CATB,TCMB,40*6  SET NEW ERROR MESSAGE
 CAT2     RJ     KFM         SET FAMILY LEVEL K-DISPLAY
 
 CAT      SUBR               ENTRY/EXIT
          MOVEBIT  CATA,TSTT,1,0,2  SET/CLEAR ERROR STATUS
          SA1    CATA
          NZ     X1,CAT1     IF SET ERROR STATUS
          CLEAR  TCMB,MBML   CLEAR MESSAGE BUFFER
          EQ     CAT2        REWRITE FIRST RECORD
 
 CATA     BSS    1           CATALOG ERROR STATUS
 CATB     DATA   38LERROR SET BY TFSP.
 DRO      SPACE  4,10
**        DRO - PROCESS *DROP* DIRECTIVE.
 
 
 DRO      SUBR               ENTRY/EXIT
          EQ     END         END *TFSP*
 FAM      SPACE  4,10
**        FAM - PROCESS *FAMNAME* DIRECTIVE.
 
 
 FAM      SUBR               ENTRY/EXIT
          MOVEBIT  FAMA,TFMN,7*6  SET FAMILY NAME
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          EQ     FAMX        RETURN
 
 FAMA     BSS    1           NEW FAMILY NAME
 FOR      SPACE  4,10
**        FOR - PROCESS *FOREIGN* DIRECTIVE.
 
 
 FOR      SUBR               ENTRY/EXIT
          MOVEBIT  FORA,TSTT,1,0,13  SET FOREIGN STATUS
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          EQ     FORX        RETURN
 
 FORA     BSS    1           FOREIGN STATUS
 GLO      SPACE  4,10
**        GLO - PROCESS *GLOBAL* DIRECTIVE.
 
 
 GLO      SUBR               ENTRY/EXIT
          MOVEBIT  GLOA,TSTT,1,0,12  SET GLOBAL STATUS
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          EQ     GLOX        RETURN
 
 GLOA     BSS    1           GLOBAL STATUS
 INV      SPACE  4,10
**        INV - PROCESS *INCORRECT* DIRECTIVE.
 
 
 INV      SUBR               ENTRY/EXIT
          MX0    42
          SRCHTAB  TVUN,UN,UNCL  SEARCH FOR USER NAME
          NZ     X4,INVX     IF NOT IN TABLE
          SB7    B7+B3       MOVE END OF TABLE OVER DELETED USER
          SB2    B2-B7
          MOVE   B2,A1+B3,A1
          SX6    B0          CLEAR LAST ENTRY IN TABLE
          SA6    TVUN+UNCL-1
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          EQ     INVX        RETURN
 ISV      SPACE  4,10
**        ISV - PROCESS *ISV* DIRECTIVE.
*
*         EXIT   SCRATCH VSN-S INITIALIZED.
*
*         CALLS  KFM.
*
*         MACROS CALLTFM, RCREC.
 
 
 ISV      SUBR               ENTRY\EXIT
          CALLTFM  N1,ISFS   INITIALIZE SCRATCH VSNS
          RCREC  N1,1,REC1   REREAD FIRST RECORD
          RJ     KFM         UPDATE K-DISPLAY BUFFER
          EQ     ISVX        RETURN
 LKF      SPACE  4,10
**        LKF - PROCESS *LINKFAM* DIRECTIVE.
 
 
 LKF1     ISSMSG ENVF,E      * DIRECTIVE NOT VALID ON FAST ATTACH *
 
 LKF      SUBR               ENTRY/EXIT
          SA1    LF
          ZR     X1,LKF1     IF NOT LOCAL FILE MODE
          MOVEBIT  LKFA,TLFM,7*6  SET LINKED FAMILY NAME
          RJ     KFM         UPDATE FAMILY K-DISPLAY
          EQ     LKFX        EXIT
 
 LKFA     BSS    1           LINKED FAMILY NAME
 MCH      SPACE  4,10
**        MCH - PROCESS *MREADCH* DIRECTIVE.
 
 
 MCH      SUBR               ENTRY/EXIT
          CHKFIL SS          CHECK FOR MACHINE READABLE FILE
          ZR     X1,MCHX     IF NO FILE WAS SPECIFIED
 MCH1     RCREC  N2,5
          GRENTRY  N2,MCHA   GET USERNAMES TO AUDIT
          ZR     X6,MCH3     IF NO USERNAMES
 MCH2     GRENTRY  N2,MCHA   GET USERNAMES TO AUDIT
          ZR     X6,MCH3     IF END OF USERNAMES TO AUDIT
          SA1    TI
          NZ     X1,MCH3     IF TERMINAL INTERRUPT
          SA1    MCHA        GET USERNAME
          MX0    42
          BX6    X0*X1       MASK USERNAME TO AUDIT
          SA6    UN
          USERAUD  M,CN      PROCESS NEXT USERNAME TO MACHINE FILE
          EQ     MCH2        CHECK NEXT USERNAME TO AUDIT
 
 MCH3     WRITER SS          WRITE END OF RECORD ON FILE
          EQ     MCHX        RETURN
 
 MCHA     BSS    1           SECONDARY USERNAME POINTER
 MID      SPACE  4,10
**        MID - PROCESS *MID* DIRECTIVE.
 
 
 MID1     ISSMSG EDFE,E      ISSUE ERROR MESSAGE
 
 MID      SUBR               ENTRY/EXIT
          SA1    MIDA        CHECK FOR TWO CHARACTERS
          RJUST  X1,X1,6,11
          ZR     X1,MID1     IF ONLY ONE CHARACTER
          MOVEBIT  MIDA,TIDM,2*6,11  SET MACHINE ID
          RJ     KFM         SET FAMILY LEVEL K-DISPLAY
          EQ     MIDX        RETURN
 
 MIDA     BSS    1           NEW MACHINE ID
 MUN      SPACE  4,10
**        MUN - PROCESS *MREADUN* DIRECTIVE.
 
 
 MUN3     WRITER SS          WRITE END OF RECORD
 
 MUN      SUBR               ENTRY/EXIT
          CHKFIL SS          CHECK MACHINE READABLE FILE
          ZR     X1,MUNX     IF NO FILE
          SA1    UN
          ZR     X1,MUN1     IF MULTIPLE VSNS
          USERAUD  M         PROCESS USER MACHINE READABLE LIST
          EQ     MUN3        WRITE END OF RECORD
 
 MUN1     RCREC  N2,5
          GRENTRY  N2,MUNA   GET RECORD ENTRY OF DUMMY USER
          ZR     X6,MUN3     IF END OF USER NAMES
 MUN2     GRENTRY  N2,MUNA   GET RECORD ENTRY
          ZR     X6,MUN3     IF END OF USER NAMES
          SA1    TI
          NZ     X1,MUN3     IF TERMINAL INTERRUPT
          MX0    42          GET USER NAME
          SA1    MUNA
          BX6    X0*X1
          SA6    UN
          USERAUD  M         PROCESS USER MACHINE READABLE LIST
          EQ     MUN2        CHECK NEXT USER NAME
 
 MUNA     BSS    1           SECONDARY USER NAME POINTER IMAGE
 MVS      SPACE  4,10
*         MVS - PROCESS *MREADVS* DIRECTIVE.
 
 
 MVS4     WRITER SS          SET END OF RECORD
 
 MVS      SUBR               ENTRY/EXIT
          CHKFIL SS
          ZR     X1,MVSX     IF NO MACHINE READABLE FILE
          SA1    VS
          ZR     X1,MVS1     IF MULTIPLE VSNS
          SX6    B0
          RJ     GVE         GET VSN ENTRY
          NZ     X4,MVSX     IF NOT FOUND
          RJ     GUV         GET USER INFORMATION ON VSN
          RJ     VSM         PROCESS VSN MACHINE READABLE LIST
          EQ     MVS4        SET END OF RECORD
 
 MVS1     SA1    LF
          ZR     X1,MVS2     IF NOT LOCAL FILE MODE
          RJ     RVE         REPLACE VSN ENTRIES
 MVS2     RCREC  N1,4        GET RECORD ENTRY OF DUMMY VSN
          GRENTRY  N1,VCAT
          ZR     X6,MVS4     IF NO MORE ENTRIES
 MVS3     GRENTRY  N1,VCAT
          ZR     X6,MVS4     IF NO MORE ENTRIES
          SA1    TI
          NZ     X1,MVS4     IF TERMINAL INTERRUPT
          RJ     GUV         GET USER INFORMATION ON VSN
          RJ     VSM         PROCESS VSN MACHINE READABLE LIST
          EQ     MVS3        GET NEXT ENTRY
 NBF      SPACE  4,10
**        NBF - PROCESS *NOBRIEF* DIRECTIVE.
 
 
 NBF      SUBR               ENTRY/EXIT
          SA1    BF          CLEAR BRIEF FLAG
          SX6    B0
          SA6    A1          SET BRIEF FLAG
          EQ     NBFX        RETURN
 PGA      SPACE  4,10
**        PGA - PROCESS *PURGALL* DIRECTIVE.
 
 
 PGA4     MX1    42          SET GENERAL INTERLOCK
          RJ     IUN         INTERLOCK USER NAME
 
 PGA      SUBR               ENTRY/EXIT
          SA1    UN
          RJ     IUN         INTERLOCK USER NAME
 PGA1     SAFET  UN,,,FCST   SET AUDIT FET
          NZ     X4,PGA4     IF NO MORE FILES
          SB6    FCAT        SET BUFFER ADDRESSES
          SB2    TAVS
          RJ     UFA         UNPACK FILE AUDIT
          SA1    /ADD/NCAT   CHECK IF MULTI-FILE
          RJUST  X1,X1,/BTC/NCAT,/UPB/NCAT
          NZ     X1,PGA2     IF MULTI-FILE
          RJ     SUI         SET UTILITY INTERLOCK
          RELVSN UN,TAVS     RELEASE FILE VIA VSN
          SA1    /ADD/REELC  SET VSN BUFFER LENGTH
          RJUST  X1,X1,/BTC/REELC,/UPB/REELC
          EQ     PGA3        DELETE VSN ENTRIES
 
 PGA2     GFILEV UN,TAVS,1,FCAT,FCAT,TAVS  GET MULTI-FILE
          SX6    B7          SAVE VSN COUNT
          SA6    PGAA
          RJ     SUI         SET UTILITY INTERLOCK
          RELVSN UN,TAVS     RELEASE FILE VIA VSN
          SA1    PGAA        SET VSN BUFFER LENGTH
 PGA3     LX1    2           LIST VSN ENTRIES
          LISTAB TAVS,PGAB,X1,,TSVL,VSKL*6
          SX1    X1-TAVS
          AX1    2
          DELVSN PGAB,X1     DELETE VSN ENTRIES
          RJ     ISV         INTIALIZE SCRATCH VSNS
          RJ     CUI         CLEAR UTILITY INTERLOCK
          EQ     PGA1        CHECK FOR MORE FILES
 
 PGAA     BSS    1           VSN COUNT
 PGAB     BSS    60          ASSIGNED VSNS
 PGO      SPACE  4,10
**        PGO - PROCESS GO DIRECTIVE.
*
*         EXIT   FIRST PRU OF CATALOG READ, MODIFIED AND REWRITTEN.
*                EXIT TO *END*.
*
*         CALLS  END.
*
*         USES   X3, X4.
*
*         CALLS  MSV.
*
*         MACROS RCREC, WCREC.
 
 
 PGO      SUBR               ENTRY/EXIT
          RCREC  N1,1,REC1,1  READ FIRST RECORD
          SX3    TSST        SET MODIFIED VALUE TABLE ADDRESS
          SX4    REC1+TBHL   SET SYSTEM TABLE ADDRESS
          RJ     MSV         MOVE SYSTEM TABLE VALUES
          WCREC  N1,1,REC1,1  REWRITE FIRST RECORD
          EQ     END         END *TFSP*
 PTF      SPACE  4,10
**        PTF - PROCESS *PURGE* DIRECTIVE.
 
 PTF5     ISSMSG B5,E        ISSUE ERROR MESSAGE
          RJ     CUI         CLEAR UTILITY INTERLOCK
 
 PTF      SUBR               ENTRY/EXIT
          RJ     RVE         REPLACE VSN ENTRIES
          SX6    B0
          RJ     GVE         GET VSN ENTRY
          SB5    EVNC
          NZ     X4,PTF5     IF VSN IS NOT IN CATALOG
          RJ     GUV         GET USER INFORMATION FOR THIS VSN
          SB5    EVNF
          ZR     X1,PTF3     IF VSN NOT ASSIGNED TO TAPE FILE
          MOVEBIT  /ADD/FVSN,VS,VSKL*6,/UPB/FVSN  SET FIRST VSN
          SAFET  UN,VS,,SCST  GENERATE FET AUDIT
          SB5    EVNC
          NZ     X4,PTF5     IF ERROR IN CATALOG FOR THIS FILE
          SB6    FCAT        SET BUFFER ADDRESSES FOR FILE AUDIT
          SB2    TAVS
          RJ     UFA         UNPACK FILE AUDIT
          SA1    /ADD/NCAT   CHECK IF MULTI-FILE
          RJUST  X1,X1,/BTC/NCAT,/UPB/NCAT
          NZ     X1,PTF1     IF MULTI-FILE SET
          RJ     SUI         SET UTILITY INTERLOCK
          RELVSN UN,TAVS     RELEASE FILE VIA VSN
          SA1    /ADD/REELC  SET VSN BUFFER LENGTH
          RJUST  X1,X1,/BTC/REELC,/UPB/REELC
          EQ     PTF2        DELETE VSN ENTRIES
 
 PTF1     GFILEV UN,TAVS,1,FCAT,FCAT,TAVS  GET MULTI FILE
          SX6    B7          SAVE THE VSN COUNT
          SA6    PTFA
          RJ     SUI         SET UTILITY INTERLOCK
          RELVSN UN,TAVS     RELEASE FILE VIA-VSN
          SA1    PTFA        VSN BUFFER LENGTH
 PTF2     LX1    2           LIST OF VSN ENTRIES
          LISTAB TAVS,PTFB,X1,,TSVL,VSKL*6
          DELVSN PTFB,X1-PTFB  DELETE ENTRIES
          EQ     PTF4        INITIALIZE SCRATCH VSNS
 
 PTF3     RJ     SUI         SET UTILITY INTERLOCK
          DELVSN VS,1
          ZR     X4,PTF4     IF NO ERRORS
          SB5    EVNC        PRESET ERROR ADDRESS
          SX4    X4-/EMSG/VNF
          ZR     X4,PTF5     IF NOT IN CATALOG
          SB5    EVAA        RESET ERROR MESSAGE ADDRESS
          EQ     PTF5        ISSUE ERROR MESSAGE
 
 PTF4     RJ     ISV         INITIALIZE SCRATCH VSNS
          RJ     CUI         CLEAR UTILITY INTERLOCK
          ISSMSG IVRC,I      ISSUE INFORMATIVE MESSAGE
          EQ     PTFX        RETURN
 
 PTFA     BSS    1           VSN COUNT
 PTFB     BSS    60          ASSIGNED VSNS
 REL      SPACE  4,10
**        REL - PROCESS *RELEASE* DIRECTIVE.
 
 
 REL1     ISSMSG B5,E        ISSUE ERROR MESSAGE
          RJ     CUI         CLEAR UTILITY INTERLOCK
 
 REL      SUBR               ENTRY/EXIT
          RJ     SUI         SET UTILITY INTERLOCK
          SX6    B0
          RJ     GVE         GET VSN ENTRY
          SB5    EVNC
          NZ     X4,REL1     IF VSN NOT IN CATALOG
          RJ     GUV         GET USER INFORMATION FOR VSN
          SB5    EVNF
          ZR     X1,REL1     IF VSN NOT ASSIGNED
          MOVEBIT  /ADD/FVSN,VS,VSKL*6,/UPB/FVSN  SET FIRST VSN
          RELVSN UN,VS       RELEASE FILE VIA VSN
          RJ     CUI         CLEAR UTILITY INTERLOCK
          ISSMSG IFRC,I      ISSUE INFORMATIVE MESSAGE
          EQ     RELX        RETURN
 REM      SPACE  4,10
**        REM - PROCESS *REMOVE* DIRECTIVE.
 
 
 REM2     ISSMSG B5,E        ISSUE ERROR MESSAGE
          RJ     CUI         CLEAR UTILITY INTERLOCK
 
 REM      SUBR               ENTRY/EXIT
          RJ     RVE         REPLACE VSN ENTRIES
          RJ     SUI         SET UTILITY INTERLOCK
          DELVSN VS,1        DELETE VSN
          ZR     X4,REM1     IF NO ERRORS
          SB5    EVNC        PRESET ERROR MESSAGE ADDRESS
          SX4    X4-/EMSG/VNF
          ZR     X4,REM2     IF VSN NOT IN CATALOG
          SB5    EVAA        RESET ERROR MESSAGE ADDRESS
          EQ     REM2        ISSUE ERROR MESSAGE
 
 REM1     RJ     ISV         INITIALIZE SCRATCH VSNS
          RJ     CUI         CLEAR UTILITY INTERLOCK
          ISSMSG IVRC,I      ISSUE INFORMATIVE MESSAGE
          EQ     REMX        RETURN
 SCH      SPACE  4,10
**        SCH - PROCESS *SOURCCH* DIRECTIVE.
 
 
 SCH      SUBR               ENTRY/EXIT
          CHKFIL S           CHECK IF FILE SPECIFIED
          ZR     X1,SCHX     IF FILE NOT SPECIFIED
 SCH1     RCREC  N2,5
          GRENTRY  N2,SCHA   GET DUMMY USER RECORD
          ZR     X6,SCH3     IF NO USERNAMES
 SCH2     GRENTRY  N2,SCHA   GET USERNAMES
          ZR     X6,SCH3     IF END OF USERNAMES
          SA1    TI
          NZ     X1,SCH3     IF TERMINAL INTERRUPT
          MX0    42
          SA1    SCHA
          BX6    X0*X1       MASK USERNAME TO PROCESS
          SA6    UN
          USERAUD  S,CN      PROCESS USER SOURCE LISTING
          EQ     SCH2        CHECK IF MORE USERS TO PROCESS
 
 SCH3     WRITER  S          WRITE END OF RECORD
          EQ     SCHX        RETURN
 
 SCHA     BSS    1           SECONDARY USERNAME POINTER
 SOU      SPACE  4,10
**        SOU - PROCESS *SOURCE* DIRECTIVE.
 
 
 SOU4     WRITER S           WRITE END OF RECORD
 
 SOU      SUBR               ENTRY/EXIT
          CHKFIL S           CHECK SOURCE FILE
          ZR     X1,SOUX     IF NO FILE
          RCREC  N1,4
          GRENTRY  N1,VCAT   GET RECORD ENTRY FOR DUMMY VSN
          ZR     X6,SOU2     IF END OF VSNS
 SOU1     GRENTRY  N1,VCAT   GET RECORD ENTRY
          ZR     X6,SOU2     IF END OF VSNS
          RJ     VSS         PROCESS SOURCE VSN ENTRY
          SA1    TI
          NZ     X1,SOU4     IF TERMINAL INTERRUPT
          EQ     SOU1        GET NEXT VSN
 
 SOU2     RCREC  N2,5
          GRENTRY  N2,SOUA   GET RECORD ENTRY OF DUMMY USER NAME
          ZR     X6,SOU4     IF END OF USER NAMES
 SOU3     GRENTRY  N2,SOUA   GET RECORD ENTRY
          ZR     X6,SOU4     IF END OF USER NAMES
          SA1    TI
          NZ     X1,SOU4     IF TERMINAL INTERRUPT
          MX0    42          GET USER NAME
          SA1    SOUA
          BX6    X0*X1
          SA6    UN
          SA6    SOUC
          WRITEC S,SOUB      WRITE USER DIRECTIVE
          USERAUD  SNV       PROCESS USER SOURCE LIST WITH NO VSNS
          WRITEC S,(=C*DROP*)  WRITE *DROP* DIRECTIVE
          EQ     SOU3        CHECK NEXT USER NAME
 
 SOUA     BSS    1           SECONDARY USER NAME POINTER IMAGE
 SOUB     DATA   H*USER =*   INITIAL DIRECTIVE
 SOUC     DATA   C*       *
 SUN      SPACE  4,10
**        SUN - PROCESS *SOURCUN* DIRECTIVE.
 
 
 SUN3     WRITER S           WRITE END OF RECORD
 
 SUN      SUBR               ENTRY/EXIT
          CHKFIL S           CHECK SOURCE FILE
          ZR     X1,SUNX     IF NO FILE
          SA1    UN
          ZR     X1,SUN1     IF MULTIPLE VSNS
          USERAUD  S         PROCESS USER SOURCE LIST
          EQ     SUN3        WRITE END OF RECORD
 
 SUN1     RCREC  N2,5
          GRENTRY  N2,SUNA   GET RECORD ENTRY OF DUMMY USER
          ZR     X6,SUN3     IF END OF USER NAMES
 SUN2     GRENTRY  N2,SUNA   GET RECORD ENTRY
          ZR     X6,SUN3     IF END OF USER NAMES
          SA1    TI
          NZ     X1,SUN3     IF TERMINAL INTERRUPT
          MX0    42          GET USER NAME
          SA1    SUNA
          BX6    X0*X1
          SA6    UN
          USERAUD  S         PROCESS USER SOURCE LIST
          EQ     SUN2        CHECK NEXT USER NAME
 
 SUNA     BSS    1           SECONDARY USER NAME POINTER IMAGE
 SVS      SPACE  4,10
*         SVS - PROCESS *SOURCVS* DIRECTIVE.
 
 
 SVS4     WRITER S           SET END OF RECORD
 
 SVS      SUBR               ENTRY/EXIT
          CHKFIL S
          ZR     X1,SVSX     IF NO SOURCE FILE
          SA1    VS
          ZR     X1,SVS1     IF MULTIPLE VSNS
          SX6    B0
          RJ     GVE         GET VSN ENTRY
          NZ     X4,SVSX     IF NOT FOUND
          RJ     GUV         GET USER INFORMATION ON VSN
          RJ     VSS         PROCESS VSN SOURCE LIST
          EQ     SVS4        SET END OF RECORD
 
 SVS1     SA1    LF
          ZR     X1,SVS2     IF NOT LOCAL FILE MODE
          RJ     RVE         REPLACE VSN ENTRIES
 SVS2     RCREC  N1,4        GET RECORD ENTRY OF DUMMY VSN
          GRENTRY  N1,VCAT
          ZR     X6,SVS4     IF NO MORE ENTRIES
 SVS3     GRENTRY  N1,VCAT
          ZR     X6,SVS4     IF NO MORE ENTRIES
          SA1    TI
          NZ     X1,SVS4     IF TERMINAL INTERRUPT
          RJ     GUV         GET USER INFORMATION ON VSN
          RJ     VSS         PROCESS VSN SOURCE LIST
          EQ     SVS3        GET NEXT ENTRY
 USE      SPACE  4,10
**        USE - PROCESS *USER* DIRECTIVE.
 
 
 USE      SUBR               ENTRY/EXIT
          RJ     RVE         REPLACE VSN ENTRIES
          SA1    UN          GET USER NAME
          RJ     IUN         INTERLOCK USER NAME
          SX6    B1          SET USER NAME NOT FOUND
          SA6    UF
          RJ     USL         PROCESS USER LEVEL
          EQ     USEX        RETURN
 VAL      SPACE  4,10
**        VAL - PROCESS *VALIDAT* DIRECTIVE.
 
 
 VAL2     RJ     KFM         SET FAMILY LEVEL K-DISPLAY
 
 VAL      SUBR               ENTRY/EXIT
          MX0    42
          SRCHTAB  TVUN,UN,UNCL  SEARCH FOR USER NAME
          ZR     X4,VAL2     IF ALREADY IN TABLE
          SRCHTAB  TVUN,=0,B2,B3,B4  SEARCH FOR EMPTY ENTRY
          NZ     X4,VAL1     IF NO ROOM LEFT IN TABLE
          SA2    UN          SET USER NAME IN TABLE
          BX6    X2
          SA6    A1
          EQ     VAL2        REWRITE FIRST RECORD
 
 VAL1     ISSMSG EVUM,E      ISSUE ERROR MESSAGE
          EQ     VAL2        REWRITE FIRST RECORD
 VSN      SPACE  4,10
**        VSN - PROCESS *VSN* DIRECTIVE.
 
 
 VSN6     RJ     GUV         GET USER INFORMATION FOR VSN
          RJ     SUI         SET UTILITY INTERLOCK
          GFILEV UN,VS,1,FCAT,PCAT,TAVS  GET TAPE FILE ENTRY
          SA1    /ADD/FBIL
          LJUST  X1,X1,/BTC/FBIL,/UPB/FBIL
          NZ     X1,VSN7     IF FILE BUSY
          SA1    /ADD/REELNO  CHECK REEL NUMBER OF VSN
          RJUST  X1,X1,/BTC/REELNO,/UPB/REELNO
          SX1    X1-1
          ZR     X1,VSN6.1   IF FIRST REEL EQUALS CURRENT REEL
          SA1    TAVS+/CAT/VSBF  CHECK IF FIRST VSN BUSY
          RJUST  X1,X1,/BTC/VSBF,/UPB/VSBF
          NZ     X1,VSN7     IF FIRST VSN BUSY
 VSN6.1   SX6    B7          SAVE VSN COUNT
          SA6    VC
          SA1    UN
          RJ     IUN         INTERLOCK USER NAME
          RJ     CUI         CLEAR UTILITY INTERLOCK
          SB2    1R#         REPLACE USER NAME IN ERROR MESSAGE
          SB3    VSNA
          SB5    -IVRB
          SA1    UN
          RJ     SNM         SET NAME IN MESSAGE
          RJ     RVE         REPLACE VSN ENTRIES
          ISSMSG VSNA,I      ISSUE INFORMATIVE MESSAGE
          SX6    B1
          EQ     VSN4        SET VSN IN CATALOG FLAG
 
 VSN7     RJ     CUI         CLEAR UTILITY INTERLOCK
          RJ     RVE         REPLACE VSN ENTRIES
 VSN8     SX6    B0          CLEAR VSN INTERLOCK FLAG
          SA6    VI
          SB5    EVSB        *VSN BUSY*
          ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 VSN      SUBR               ENTRY/EXIT
          SX6    B0
          SA6    VI          CLEAR VSN INTERLOCK
          SA6    VC          CLEAR VSN COUNT
          SA1    NV
          NZ     X1,VSN1     IF NO VERIFY MODE
          SX6    B1          FLAG VSN INTERLOCK
          RJ     GVE         GET VSN ENTRY
          ZR     X4,VSN2     IF VSN IN CATALOG
 VSN1     MOVE   TSVL,DVSC,VCAT  SET DEFAULT VSN ENTRY
          MOVEBIT  VS,/ADD/VSN,/BTC/VSN,,/UPB/VSN
          MOVEBIT  VS,/ADD/PRN,/BTC/PRN,,/UPB/PRN
          ISSMSG IVNC,I      ISSUE INFORMATIVE MESSAGE
          SX6    B0
          EQ     VSN4        CLEAR VSN IN CATALOG FLAG
 
 VSN2     SA1    /ADD/VSBF   CHECK IF VSN IS BUSY
          RJUST  X1,X1,/BTC/VSBF,/UPB/VSBF
          SX6    B1
          ZR     X1,VSN3     IF VSN NOT BUSY
          SA6    VI          SET VSN BUSY FLAG
 VSN3     RJ     RVB         REPLACE VSN IN BUFFER
          SA1    /ADD/VASF   CHECK IF VSN IS ASSIGNED
          RJUST  X1,X1,/BTC/VASF,/UPB/VASF
          NZ     X1,VSN5     IF VSN ASSIGNED
          SA1    VI
          NZ     X1,VSN8     IF VSN IS BUSY AND NOT ASSIGNED
          ISSMSG IVIC,I      ISSUE INFORMATIVE MESSAGE
          SX6    B1
 VSN4     SA6    VF          SET/CLEAR VSN IN CATALOG FLAG
          RJ     VSL         PROCESS VSN LEVEL
          EQ     VSNX        RETURN
 
*         PROCESS VSN WITH FILE CATALOG ASSIGNED.
 
 VSN5     SA1    VI
          ZR     X1,VSN6     IF VSN NOT BUSY, BUT ASSIGNED
          SA1    LF
          NZ     X1,VSN8     IF LOCAL FILE MODE
          SX1    ASVS        CHECK FOR SCRATCH VSN
          SA2    VCAT+VEVS
          BX1    X1*X2
          ZR     X1,VSN6     IF *VSN* NOT SCRATCH
          SA1    VCAT+VEFV
          SA2    MX
          MX3    -9
          MX7    -4
          BX3    -X3*X1      EXTRACT EJT ORDINAL
          LX1    -12
          BX7    -X7*X1      EXTRACT MACHINE INDEX-1
          BX7    X7-X2
          NZ     X7,VSN8     IF NOT ASSIGNED ON THIS MACHINE
          RJ     IJM         ISSUE JSN MESSAGE
          SX6    B1          SET VSN IN CATALOG
          EQ     VSN4        SET VSN IN CATALOG FLAG
 
 VSNA     DATA   C* VSN RESERVED BY #######.*
 IJM      SPACE  4,10
**        IJM - ISSUE JSN MESSAGE.
*
*         ENTRY  (X3) = EJT ORDINAL.
*
*         EXIT   VSN INTERLOCKED MESSAGE ISSUED.
*
*         USES   B - 2, 3, 5.
*                X - 0, 1, 2.
*
*         CALLS  RCW, SNM.
*
*         MACROS ISSMSG.
 
 
 IJM      SUBR               ENTRY/EXIT
          SX2    EJTP        READ EJT POINTERS
          RJ     RCW
          SX2    EJTE        SET EJT ENTRY LENGTH
          LX1    24
          IX2    X3*X2
          SX1    X1
          IX2    X1+X2
          ERRNZ  JSNE-0
          RJ     RCW         READ EJT *JSNE* WORD
          MX0    24          SET JSN
          BX1    X0*X1
          SB2    1R?
          SB3    IJMA        SET MESSAGE ADDRESS
          SB5    -IVSI       SET TEMPLATE ADDRESS
          RJ     SNM         SET NAME IN MESSAGE
          ISSMSG IJMA,I
          EQ     IJMX        RETURN
 
 IJMA     DATA   C* VSN INTERLOCKED.  JSN IS ????.*
 
          QUAL   *
          TITLE  VSN LEVEL DIRECTIVE PROCESSORS.
          SPACE  4
          QUAL   LVVS
 VSNDIR   SPACE  4,10
**        VSN LEVEL DIRECTIVE PROCESSORS.
*
*         ENTRY  FROM *DIP*.
*                (VF) = 0 IF VSN NOT IN CATALOG.
*                (VS) = VSN NAME.
*                (VCAT) = VSN ENTRY IMAGE.
*
*         EXIT   (EF) = 0 IF NO DIRECTIVE ERROR.
 ADD      SPACE  4,10
**        ADD - PROCESS *ADD* DIRECTIVE.
 
 
 ADD1     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 ADD      SUBR               ENTRY/EXIT
          SA1    VF          CHECK VSN FLAG
          SB5    EVAI        SET ERROR MESSAGE ADDRESS
          NZ     X1,ADD1     IF VSN ALREADY IN CATALOG
          RJ     ARV         ADD/REVISE VSN ENTRY
          SB2    B0
          RJ     SMC         ISSUE *SDAD* ACCOUNT FILE MESSAGE
          ISSMSG IVAC,I      ISSUE INFORMATIVE MESSAGE
          RJ     FAL         PROCESS FAMILY LEVEL
          EQ     ADDX        RETURN
 DRO      SPACE  4,10
**        DRO - PROCESS *DROP* DIRECTIVE.
 
 
 DRO      SUBR               ENTRY/EXIT
          SA1    VF
          ZR     X1,DRO1     IF VSN NOT IN CATALOG
          SA1    LF
          NZ     X1,DRO1     IF LOCAL FILE MODE
          RJ     RVE         REPLACE VSN ENTRIES
          SA1    VC
          ZR     X1,DRO1     IF NOT ASSIGNED VSN
          MX1    UNKL*6
          RJ     IUN         INTERLOCK USER NAME
 DRO1     ISSMSG IVNP,I      ISSUE INFORMATIVE MESSAGE
          RJ     FAL         PROCESS FAMILY LEVEL
          EQ     DROX        RETURN
 OWN      SPACE  4,10
**        OWN - PROCESS *OWNER* DIRECTIVE.
 
 
 OWN      SUBR               ENTRY/EXIT
          SA1    /ADD/OWNER  GET NEW OWNERSHIP
          RJUST  X1,X1,/BTC/OWNER,/UPB/OWNER
          ZR     X1,OWNX     IF CENTER-OWNED VSN
          SA1    /ADD/SYSTEM GET SYSTEM VSN FLAG
          RJUST  X1,X1,/BTC/SYSTEM,/UPB/SYSTEM
          ZR     X1,OWNX     IF SYSTEM VSN FLAG NOT SET
          SX1    B0+         RESET OWNERSHIP TO CENTER-OWNED
          MOVEBIT  A1,/ADD/OWNER,/BTC/OWNER,/BTC/OWNER-1,/UPB/OWNER
          ISSMSG ESVC,E      * SYSTEM VSN CANNOT BE USER-OWNED.*
          EQ     OWNX        RETURN
 PGO      SPACE  4,10
**        PGO - PROCESS *GO* DIRECTIVE.
*
*         ENTRY (VF) = 0, IF VSN NOT IN CATALOG.
*
*         EXIT   VSN ADDED OR REVISED.
*
*         USES   A - 1.
*                X - 1.
*
*         CALLS  ADD, REV.
 
 
 PGO1     RJ     ADD         ADD VSN ENTRY
 
 PGO      SUBR               ENTRY/EXIT
          SA1    VF
          ZR     X1,PGO1     IF VSN NOT IN CATALOG
          RJ     REV         REVISE VSN
          EQ     PGOX        RETURN
 REV      SPACE  4,10
**        REV - PROCESS *REVISE* DIRECTIVE.
 
 
 REV7     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 REV      SUBR               ENTRY/EXIT
          SA1    VF          CHECK VSN FLAG
          SB5    EVNA        SET ERROR MESSAGE ADDRESS
          ZR     X1,REV7     IF VSN NOT IN CATALOG
          SA1    VC
          NZ     X1,REV4     IF ASSIGNED VSN
          RJ     ARV         ADD/REPLACE VSN ENTRY
 REV1     SB2    B1
          RJ     SMC         ISSUE *SDRV* ACCOUNT FILE MESSAGE
          SA4    ER
          PL     X4,REV2     IF NO *ERROR* MESSAGE SET
          BX4    -X4
          SB5    X4
          EQ     REV7        ISSUE *ERROR* MESSAGE
 
 REV2     SB5    X4
          NZ     B5,REV3     IF *INFORM* MESSAGE ALREADY SET
          SB5    IVSR        SET *INFORM* MESSAGE
 REV3     ISSMSG B5,I        ISSUE *INFORM* MESSAGE
          RJ     FAL         PROCESS FAMILY LEVEL
          EQ     REVX        RETURN
 
 REV4     MX0    VSKL*6      FIND ENTRY IN VSN TABLE
          SA3    VC
          ERRNZ  TSVL-4      VSN ENTRY LENGTH NOT 2**2
          LX3    2
          SRCHTAB  TAVS,VS,X3,TSVL
          MOVE   TSVL,VCAT,A1  REPLACE VSN ENTRY IN TABLE
          SX0    UOVS+TVVS   RESET OWNERSHIP AND SITE STATUSES
          SA1    VCAT+VEVS
          BX1    X0*X1
          SA2    VC
          LX2    2
 REV5     SX2    X2-TSVL
          NG     X2,REV6     IF END OF VSN TABLE
          SA3    X2+TAVS+VEVS  RESET STATUS BITS
          BX6    -X0*X3
          BX6    X6+X1
          SA6    A3
          EQ     REV5        CHECK NEXT VSN
 
 REV6     SA1    VC          REPLACE VSNS ASSIGNED TO TAPE FILE
          LX1    2
          REPVSN TAVS,X1
          MX1    UNKL*6
          RJ     IUN         INTERLOCK USER NAME
          EQ     REV1        ISSUE *SDRV* MESSAGE
 STA      SPACE  4,10
**        STA - PROCESS *STATUS* DIRECTIVE
 
 
 STA4     RJ     KST         SET VSN STATUS IN K-DISPLAY
 
 STA      SUBR               ENTRY/EXIT
          SA1    ME
          ZR     X1,STA2     IF AVAILABLE
          SX1    X1-1
          ZR     X1,STA1     IF CLEANED
          SX1    X1-1
          ZR     X1,STA3     IF HOLD
          MOVEBIT (=1),/ADD/ERRFLAG,/BTC/ERRFLAG,0,/UPB/ERRFLAG
          MOVEBIT (=1),/ADD/MAINT,/BTC/MAINT,0,/UPB/MAINT
          EQ     STA4        SET STATUS IN K-DISPLAY
 
 STA1     MOVEBIT (=0),/ADD/USAGE,/BTC/USAGE,59,/UPB/USAGE
 STA2     MOVEBIT (=0),/ADD/ERRFLAG,/BTC/ERRFLAG,0,/UPB/ERRFLAG
          MOVEBIT (=0),/ADD/MAINT,/BTC/MAINT,0,/UPB/MAINT
          EQ     STA4        SET STATUS IN K-DISPLAY
 
 STA3     MOVEBIT (=0),/ADD/ERRFLAG,/BTC/ERRFLAG,0,/UPB/ERRFLAG
          MOVEBIT (=1),/ADD/MAINT,/BTC/MAINT,0,/UPB/MAINT
          EQ     STA4        SET STATUS IN K-DISPLAY
 SYS      SPACE  4,10
**        SYS - PROCESS *SYSTEM* DIRECTIVE.
 
 
 SYS      SUBR               ENTRY/EXIT
          SA1    /ADD/SYSTEM GET NEW SYSTEM VSN FLAG
          RJUST  X1,X1,/BTC/SYSTEM,/UPB/SYSTEM
          SA3    VF          CHECK IF VSN ALREADY IN CATALOG
          ZR     X3,SYS2     IF VSN NOT IN CATALOG
          SA2    SVF
          BX6    X1-X2
          ZR     X6,SYSX     IF SYSTEM VSN FLAG DID NOT CHANGE
          SB5    ECSV        * CANNOT CHANGE SYSTEM VSN FLAG.*
 SYS1     SA1    SVF         RESET OLD *SYSTEM* VALUE INTO VSN ENTRY
          MOVEBIT  A1,/ADD/SYSTEM,/BTC/SYSTEM,/BTC/SYSTEM-1,/UPB/SYSTEM
          ISSMSG B5,E        ISSUE ERROR MESSAGE
          EQ     SYSX        RETURN
 
 SYS2     ZR     X1,SYSX     IF SYSTEM VSN FLAG NOT SET
          SA1    /ADD/OWNER  CHECK VSN OWNERSHIP
          RJUST  X1,X1,/BTC/OWNER,/UPB/OWNER
          ZR     X1,SYSX     IF CENTER-OWNED VSN
          SB5    ESVC        * SYSTEM VSN CANNOT BE USER-OWNED.*
          EQ     SYS1        RESET OLD VALUE AND ISSUE ERROR MESSAGE
 VTY      SPACE  4,10
**        VTY - PROCESS *VT* DIRECTIVE.
 
 
 VTY      SUBR               ENTRY/EXIT
          SA1    VF          CHECK IF VSN ALREADY IN CATALOG
          ZR     X1,VTYX     IF VSN NOT IN CATALOG
          SA1    /ADD/VT     GET NEW VSN TAPE TYPE
          RJUST  X1,X1,/BTC/VT,/UPB/VT
          SA2    VTT
          BX6    X1-X2
          ZR     X6,VTYX     IF VSN TAPE TYPE DID NOT CHANGE
          SA1    VTT         RESET OLD *VT* VALUE INTO VSN ENTRY
          MOVEBIT  A1,/ADD/VT,/BTC/VT,1,/UPB/VT
          ISSMSG ECTD,E      * CANNOT CHANGE TAPE TYPE / DENSITY.*
          EQ     VTYX        RETURN
          SPACE  4,10
          QUAL   *
          TITLE  USER LEVEL DIRECTIVE PROCESSORS.
          SPACE  4
          QUAL   LVUS
 USEDIR   SPACE  4,10
**        USER LEVEL DIRECTIVE PROCESSORS.
*
*         ENTRY  FROM *DIP*.
*                (AA) = AUDIT RANDOM ADDRESS FOR K-DISPLAY.
*                (UF) = 0 IF FILES ASSIGNED TO USER.
*                (UN) = USER NAME.
*
*         EXIT   (EF) = 0 IF NO DIRECTIVE ERROR.
 ACN      SPACE  4,10
**        ACN - PROCESS *AUDITCN* DIRECTIVE.
 
 
 ACN      SUBR               ENTRY/EXIT
          NEWPAGE  PFIA,PFIAL  SET PAGE HEADER
          USERAUD  A,CN      PROCESS USER AUDIT LIST
          NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE FOR NEXT DIRECTIVE
          EQ     ACNX        FORCE NEW PAGE
 AFI      SPACE  4,10
**        AFI - PROCESS *AUDITFI* DIRECTIVE.
 
 
 AFI      SUBR               ENTRY/EXIT
          NEWPAGE  PFIA,PFIAL  FORCE NEW PAGE
          GFILE  UN,FI,FCAT,PCAT,TAVS  GET FILE VIA FILE ID
          NZ     X4,AFIX     IF FILE NOT FOUND
          RJ     FIA         PROCESS FILE AUDIT
          NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE FOR NEXT DIRECTIVE
          EQ     AFIX        RETURN
 AFV      SPACE  4,10
**        AFV - PROCESS *AUDITFV* DIRECTIVE.
 
 
 AFV      SUBR               ENTRY/EXIT
          NEWPAGE  PFIA,PFIAL  FORCE NEW PAGE
          USERAUD  A,,VS     PROCESS USER AUDIT LIST
          NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE FOR NEXT DIRECTIVE
          EQ     AFVX        RETURN
 DRO      SPACE  4,10
**        DRO - PROCESS *DROP* DIRECTIVE.
 
 
 DRO      SUBR               ENTRY/EXIT
          MX1    42          SET GENERAL USER NAME INTERLOCK
          RJ     IUN         INTERLOCK USER NAME
          ISSMSG IULC,I      ISSUE INFORMATIVE MESSAGE
          RJ     FAL         PROCESS FAMILY LEVEL
          EQ     DROX        RETURN
 FIL      SPACE  4,10
**        FIL - PROCESS *FILE* DIRECTIVE.
 
 
 FIL3     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 FIL      SUBR               ENTRY/EXIT
          SA4    NV          GET FILE VIA FILE ID
          GFILE  UN,FI,FCAT,PCAT,TAVS,X4
          ZR     X4,FIL1     IF FILE FOUND
          SX6    B0          PRESET URDATE FIELD
          SA6    TAVS+/CAT/URDATE
          SA6    TAVS+/CAT/NEWRDT
          RJ     UFC         UNPACK FILE CATALOG INTO DIRECT CELLS
          ISSMSG IFNR,I      ISSUE INFORMATIVE MESSAGE
          SX6    B0
          EQ     FIL2        CLEAR RESERVE FLAG
 
 FIL1     RJ     UFC         UNPACK FILE CATALOG INTO DIRECT CELLS
          SA1    /ADD/FBIL   CHECK IF FILE IS BUSY
          RJUST  X1,X1,/BTC/FBIL,/UPB/FBIL
          SB5    EFIB
          NZ     X1,FIL3     IF FILE IS BUSY
          ISSMSG IFIR,I      ISSUE INFORMATIVE MESSAGE
          SX6    B1          SET RESERVE FLAG
 FIL2     SA6    RF
          SA1    VC          CLEAR NEXT VSN ENTRY IN TABLE
          LX1    2
          SX6    B0
          SA6    X1+TAVS
          SA6    AV          CLEAR NEW VSN TABLE ADDRESS
          RJ     KVQ         SET FIRST VSN AND SEQUENCE IN K-DISPLAY
          RJ     KAV         SET ASSIGNED VSNS IN K-DISPLAY
          RJ     //FIL       PROCESS FILE LEVEL
          EQ     FILX        RETURN
 FIV      SPACE  4,10
**        FIV - PROCESS *FILEV* DIRECTIVE.
 
 
 FIV4     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 FIV      SUBR               ENTRY/EXIT
          MX0    VSKL*6      SET FIRST VSN
          SA1    FV
          BX6    X0*X1
          SA6    A1
          SA6    VS
          BX3    -X0*X1      SET SEQUENCE NUMBER
          SA4    NV          GET FILE VIA VSN
          GFILEV UN,FV,X3,FCAT,PCAT,TAVS,X4
          ZR     X4,FIV2     IF FILE FOUND
          PL     X4,FIV1     IF DEFAULT IS SET
          SX4    X4+B1       CHECK IF INCORRECT SEQUENCE NUMBER
          SB5    EIQN
          ZR     X4,FIV4     IF INCORRECT SEQUENCE NUMBER
          SB5    EVNV
          EQ     FIV4        ISSUE ERROR MESSAGE
 
 FIV1     RJ     UFC         UNPACK FILE CATALOG INTO DIRECT CELLS
          RJ     SDD         SET DEFAULT DENSITY
          ISSMSG IFNR,I      ISSUE INFORMATIVE MESSAGE
          SX6    B0          CLEAR NEW VSN TABLE ADDRESS
          SA6    AV
          SA1    QN
          SX1    X1-1
          NZ     X1,FIV3     IF NOT FIRST FILE
          SX6    TAVS        SET NEW VSN TABLE ADDRESS
          SA6    AV
          SX6    B0
          EQ     FIV3        CLEAR RESERVE FLAG
 
 FIV2     RJ     UFC         UNPACK FILE CATALOG INTO DIRECT CELLS
          SA1    /ADD/FBIL   CHECK IF FILE IS BUSY
          RJUST  X1,X1,/BTC/FBIL,/UPB/FBIL
          SB5    EFIB
          NZ     X1,FIV4     IF FILE IS BUSY
          ISSMSG IFIR,I      ISSUE INFORMATIVE MESSAGE
          SX6    B0          CLEAR NEW VSN TABLE ADDRESS
          SA6    AV
          SX6    B1          SET RESERVE FLAG
 FIV3     SA6    RF
          SA1    VC          CLEAR NEXT VSN ENTRY IN TABLE
          LX1    2
          SX6    B0
          SA6    X1+TAVS
          RJ     KVQ         SET FIRST VSN AND SEQUENCE IN K-DISPLAY
          RJ     KAV         SET ASSIGNED VSNS IN K-DISPLAY
          RJ     //FIL       PROCESS FILE LEVEL
          EQ     FIVX        RETURN
 MCN      SPACE  4,10
**        MCN - PROCESS *MREADCN* DIRECTIVE.
 
 
 MCN      SUBR               ENTRY/EXIT
          CHKFIL SS          CHECK MACHINE READABLE FILE
          ZR     X1,MCNX     IF NO FILE
          USERAUD  M,CN      PROCESS MACHINE READABLE LIST
          WRITER SS          WRITE END OF RECORD
          EQ     MCNX        RETURN
 MFI      SPACE  4,10
**        MFI - PROCESS *MREADFI* DIRECTIVE.
 
 
 MFI      SUBR               ENTRY/EXIT
          CHKFIL SS
          ZR     X1,MFIX     IF NO MACHINE READABLE FILE
          GFILE  UN,FI,FCAT,PCAT,TAVS  GET FILE VIA FILE ID
          NZ     X4,MFIX     IF FILE NOT FOUND
          RJ     PMF         PROCESS FILE MACHINE READABLE
          WRITER SS          SET END OF RECORD
          EQ     MFIX        RETURN
 MFV      SPACE  4,10
**        MFV - PROCESS *MREADFV* DIRECTIVE.
 
 
 MFV      SUBR               ENTRY/EXIT
          CHKFIL SS
          ZR     X1,MFVX     IF NO MACHINE READABLE FILE
          USERAUD  M,,VS     PROCESS MACHINE READABLE LIST
          WRITER SS          SET END OF RECORD
          EQ     MFVX        RETURN
 RLF      SPACE  4,10
**        RLF - PROCESS *RELEASF* DIRECTIVE.
 
 
 RLF1     ISSMSG EFNI,E      ISSUE ERROR MESSAGE
 
 RLF      SUBR               ENTRY/EXIT
          GFILE  UN,FI,FCAT,PCAT,TAVS  GET FILE VIA FILE ID
          NZ     X4,RLF1     IF FILE NOT FOUND
          MOVEBIT  TAVS+/CAT/VSN,VS,/BTC/VSN,/UPB/VSN  SET VSN
          RELVSN UN,VS       RELEASE FILE VIA VSN
          ISSMSG IFRC,I      ISSUE INFORMATIVE MESSAGE
          SAFET  UN,,,FCST   CHECK IF FILES ASSIGNED
          SX6    X4          SET/CLEAR USER NAME FOUND FLAG
          SA6    UF
          RJ     USL         PROCESS USER LEVEL
          EQ     RLFX        RETURN
 RLV      SPACE  4,10
**        RLV - PROCESS *RELEASV* DIRECTIVE.
 
 
 RLV3     ISSMSG EFNI,E      ISSUE ERROR MESSAGE
 
 RLV      SUBR               ENTRY/EXIT
          SX6    B0
          RJ     GVE         GET VSN ENTRY
          NZ     X4,RLV3     IF VSN NOT IN CATALOG
          SA1    /ADD/FVSN   CHECK FIRST VSN
          LJUST  X1,X6,/BTC/FVSN,/UPB/FVSN
          SA1    LF
          ZR     X1,RLV1     IF NOT LOCAL FILE MODE
          MX0    VSKL*6
          SA1    VS          SAVE VSN
          BX6    X0*X1
          SA6    A1
          BX3    -X0*X1
          EQ     RLV2        RELEASE VSN
 
 RLV1     SA6    VS          SET VSN TO FIRST VSN
          SX3    B1+
 RLV2     RELVSN UN,VS,X3    RELEASE VSN
          NZ     X4,RLV3     IF FILE NOT FOUND
          ISSMSG IFRC,I      ISSUE INFORMATIVE MESSAGE
          SAFET  UN,,,FCST   CHECK IF FILES ASSIGNED
          SX6    X4          SET/CLEAR USER NAME FOUND FLAG
          SA6    UF
          RJ     USL         PROCESS USER LEVEL
          EQ     RLVX        RETURN
 SCN      SPACE  4,10
**        SCN - PROCESS *SOURCCN* DIRECTIVE.
 
 
 SCN      SUBR               ENTRY/EXIT
          CHKFIL S           CHECK SOURCE FILE
          ZR     X1,SCNX     IF NO FILE
          USERAUD  S,CN      PROCESS USER SOURCE LIST
          WRITER S           WRITE END OF RECORD
          EQ     SCNX        RETURN
 SFI      SPACE  4,10
**        SFI - PROCESS *SOURCFI* DIRECTIVE.
 
 
 SFI      SUBR               ENTRY/EXIT
          CHKFIL S
          ZR     X1,SFIX     IF NO SOURCE FILE
          GFILE  UN,FI,FCAT,PCAT,TAVS  GET FILE VIA FILE ID
          NZ     X4,SFIX     IF FILE NOT FOUND
          SX6    B0          FLAG DO NOT SKIP FIRST VSN
          RJ     PSF         PROCESS FILE SOURCE
          WRITER S           SET END OF RECORD
          EQ     SFIX        RETURN
 SFV      SPACE  4,10
**        SFV - PROCESS *SOURCFV* DIRECTIVE.
 
 
 SFV      SUBR               ENTRY/EXIT
          CHKFIL S
          ZR     X1,SFVX     IF NO SOURCE FILE
          USERAUD  S,,VS     PROCESS USER SOURCE LIST
          WRITER S           SET END OF RECORD
          EQ     SFVX        RETURN
 SDD      SPACE  4,15
**        SDD - SET DEFAULT DENSITY IN FILE CATALOG.
*
*         ENTRY  (VS) = VSN.
*                FILE CATALOG ENTRY IN *FCAT* BUFFER.
*
*         EXIT   (DE) = DEFAULT FILE DENSITY FOR VSN TAPE TYPE.
*                NEW FILE DENSITY SET IN FILE CATALOG ENTRY.
*                VSN ENTRY IN *VCAT* BUFFER.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*
*         CALLS  GVE.
*
*         MACROS MOVEBIT, RJUST.
 
 
 SDD      SUBR               ENTRY/EXIT
          RJ     GVE         GET VSN ENTRY
          SA1    /ADD/VT     GET VSN TAPE TYPE
          RJUST  X1,X1,/BTC/VT,/UPB/VT
          SA1    X1+SDDA     SET DEFAULT DENSITY FOR TAPE TYPE
          BX6    X1
          SA6    DE
          MOVEBIT  A1,/ADD/D,/BTC/D,5,/UPB/D
          EQ     SDDX        RETURN
 
 
 SDDA     BSS    0           DEFAULT DENSITIES (INDEXED BY TAPE TYPE)
          CON    44B         PE DENSITY (MT/NT TAPE TYPE)
          CON    26B         CE DENSITY (CT TAPE TYPE)
          CON    0
          CON    66B         AE DENSITY (AT TAPE TYPE)
 
          QUAL   *
          TITLE  FILE LEVEL DIRECTIVE PROCESSORS.
          SPACE  4
          QUAL   LVFI
 FIL      SPACE  4,30
**        FILE LEVEL DIRECTIVE PROCESSORS.
*
*         ENTRY  (AV) = ADDRESS OF NEW VSNS WITHIN *TAVS*.
*                (CA) = RANDOM ADDRESS OF FILE CATALOG.
*                (CN) = CHARGE NUMBER.
*                (EV) = EXTERNAL VSN.
*                (FC) = MAXIMUM FRAME COUNT.
*                (FI) = ORIGINAL FILE IDENTIFIER.
*                (FV) = FIRST VSN.
*                (NI) = NEW FILE IDENTIFIER.
*                (NS) = NOISE SIZE.
*                (PA) = PREVIOUS FILE RANDOM ADDRESS.
*                (QN) = SEQUENCE NUMBER.
*                (RC) = REEL COUNT.
*                (RF) = 0 IF FILE NOT RESERVED.
*                (ST) = ASSIGNED VSNS STATUS BITS.
*                (SV) = 0 IF NOT SYMBOLIC ACCESS.
*                (UF) = 0 IF FILES ASSIGNED TO USER.
*                (UN) = USER NAME.
*                (VC) = VSN COUNT.
*                (FCAT) = FILE CATALOG IMAGE.
*                (TAVS) = ASSIGNED VSNS IMAGE.
*
*         EXIT   (EF) = 0 IF NO DIRECTIVE ERROR.
 AAU      SPACE  4,10
**        AAU - PROCESS *AUDITAU* DIRECTIVE.
 
 
 AAU3     NEWPAGE  PDIR,PDIRL,NP  FORCE NEW PAGE FOR NEXT DIRECTIVE
 
 AAU      SUBR               ENTRY/EXIT
          SA1    UN          GET USER NAME
          RJ     SFN         SPACE FILL NAME
          BX1    X6          SET USER NAME IN HEADER
          MOVEBIT  A1,/PAUA/USER,UNKL*6,,/PAUAU/USER
          MOVEBIT  FI,/PAUA/FILE,FIKL*6,,/PAUAU/FILE  SET FILE ID
          SA1    /PAUA/FILE  CHECK FOR EXTRA END OF LINES
          SB3    /PAUAU/FILE
          RJ     CFI         CHECK FILE IDENTIFIER IN OUTPUT
          SA1    FV          GET FIRST VSN
          RJ     SFN         SPACE FILL NAME
          BX1    X6          SET FIRST VSN IN HEADER
          MOVEBIT  A1,/PAUA/FVSN,VSKL*6,,/PAUAU/FVSN
          SA1    QN          GET SEQUENCE NUMBER
          SX1    X1+10000
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          MX0    -24         SET SEQUENCE NUMBER IN HEADER
          BX1    -X0*X6
          MOVEBIT  A1,/PAUA/QN,4*6,23,/PAUAU/QN
          NEWPAGE  PAUA,PAUAL  FORCE NEW PAGE
          SA1    AU
          ZR     X1,AAU1     IF MULTIPLE USER AUDIT
          RJ     GAE         GET ALTERNATE USER ENTRY
          SA1    RF
          ZR     X1,AAU3     IF FILE NOT RESERVED
          NZ     X4,AAU3     IF ALTERNATE USER NOT FOUND
          RJ     AUA         PROCESS ALTERNATE USER AUDIT
          EQ     AAU3        RETURN
 
 AAU1     RJ     RAE         REPLACE ALTERNATE USER ENTRIES
          SA1    /ADD/AUCAT  GET ADMIT CATALOG RANDOM ADDRESS
          RJUST  X1,X1,/BTC/AUCAT,/UPB/AUCAT
          ZR     X1,AAU3     IF NO ADMIT CATALOG
          RCREC  N4,X1
 AAU2     GRENTRY  N4,ACAT   GET RECORD ENTRY
          ZR     X6,AAU3     IF NO MORE ENTRIES
          SA1    TI
          NZ     X1,AAU3     IF TERMINAL INTERRUPT
          RJ     AUA         PROCESS ALTERNATE USER AUDIT
          EQ     AAU2        GET NEXT ENTRY
 AUS      SPACE  4,10
**        AUS - PROCESS *AUSER* DIRECTIVE.
 
 
 AUS7     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 AUS      SUBR               ENTRY/EXIT
          SA1    NV
          NZ     X1,AUS1     IF NO VERIFY MODE
          SA1    RF          CHECK RESERVE FLAG
          SB5    EFNR        SET ERROR MESSAGE ADDRESS
          ZR     X1,AUS7     IF FILE NOT RESERVED
          RJ     GAE         GET ALTERNATE USER ENTRY
          ZR     X4,AUS5     IF ENTRY FOUND
          ISSMSG IANA,I      ISSUE INFORMATIVE MESSAGE
          SX6    B0
          EQ     AUS6        CLEAR ALTERNATE USER FLAG
 
 AUS1     SA1    RF
          NZ     X1,AUS4     IF FILE RESERVED
          SA1    SV
          NZ     X1,AUS2     IF SYMBOLIC ACCESS
          SA3    QN          GET FILE VIA VSN
          GFILEV UN,FV,X3,FCAT,PCAT,TAVS
          SB5    EFNR
          NZ     X4,AUS7     IF FILE NOT RESERVED
          EQ     AUS3        UNPACK FILE CATALOG
 
 AUS2     GFILE  UN,FI,FCAT,PCAT,TAVS  GET FILE VIA FILE ID
          SB5    EFNR
          NZ     X4,AUS7     IF FILE NOT RESERVED
 AUS3     RJ     UFC         UNPACK FILE CATALOG INTO DIRECT CELLS
          SX6    B1          SET RESERVED FLAG
          SA6    RF
          SA1    VC          CLEAR NEXT VSN ENTRY IN TABLE
          LX1    2
          SX6    B0
          SA6    X1+TAVS
          SA6    AV          CLEAR NEW VSN TABLE ADDRESS
          RJ     KVQ         SET FIRST VSN AND SEQUENCE IN K-DISPLAY
          RJ     KAV         SET ASSIGNED VSNS IN K-DISPLAY
 AUS4     MOVE   TAEL,DAUC,ACAT  SET DEFAULT ALTERNATE USER
          MOVEBIT  AU,/ADD/AUSER,/BTC/AUSER,,/UPB/AUSER
          SX6    B0
          EQ     AUS6        CLEAR ALTERNATE USER FLAG
 
 AUS5     ISSMSG IAIA,I      ISSUE INFORMATIVE MESSAGE
          SX6    B1          SET ALTERNATE USER FLAG
 AUS6     SA6    AF
          RJ     AUL         PROCESS ALTERNATE USER
          EQ     AUSX        RETURN
 ALT      SPACE  4,10
**        ALT - PROCESS *AMEND* DIRECTIVE.
 
 
 ALT1     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 ALT      SUBR               ENTRY/EXIT
          SA1    RF          CHECK RESERVE FLAG
          SB5    EFNR        SET ERROR MESSAGE ADDRESS
          ZR     X1,ALT1     IF FILE NOT RESERVED
          RJ     RAF         RESERVE/AMEND FILE CATALOG ENTRY
          ISSMSG IFAL,I      ISSUE INFORMATIVE MESSAGE
          RJ     SMF         ISSUE *SDAM* ACCOUNT FILE MESSAGE
          RJ     USL         PROCESS USER LEVEL
          EQ     ALTX        RETURN
 AVS      SPACE  4,10
**        AVS - PROCESS *AVSN* DIRECTIVE.
 
 
 AVS8     ISSMSG B5,E        ISSUE ERROR MESSAGE
          REPVSN VCAT,TSVL   REPLACE VSN ENTRY
          EQ     AVSX        RETURN
 
 AVS9     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 AVS      SUBR               ENTRY/EXIT
          SA1    /ADD/NCAT   CHECK IF LAST FILE
          RJUST  X1,X1,/BTC/NCAT,/UPB/NCAT
          SB5    EAVM
          NZ     X1,AVS9     IF NOT LAST FILE
          SA3    VC          CHECK VSN BUFFER LENGTH
          LX3    2
          ZR     X3,AVS2     IF NO VSNS ASSIGNED
          SA1    RC
          NZ     X1,AVS1     IF REELS ASSIGNED TO THIS FILE
          SA2    X3+TAVS-4   COMPARE TO LAST VSN
          SA4    VS
          BX4    X4-X2
          LJUST  X4,X4,VSKL*6,59
          NZ     X4,AVS1     IF NOT LAST VSN
          SX6    X1+B1       INCREMENT REEL COUNT
          SA6    A1
          SA1    VS          SET EXTERNAL VSN
          BX6    X1
          SA6    EV
          SX6    A2          SET NEW VSN TABLE ADDRESS
          SA6    AV
          EQ     AVS7        CLEAR NEXT ENTRY
 
 AVS1     MX0    VSKL*6      CHECK IF VSN IS ALREADY ASSIGNED
          SRCHTAB  TAVS,VS,X3,4
          SB5    EVAA
          ZR     X4,AVS9     IF ALREADY ASSIGNED
          MOVE   TSVL,DVSC,VCAT  SET DEFAULT VSN ENTRY
 AVS2     LISTVSN  VS,VCAT,1 GET VSN ENTRY
          SB5    EVNC
          NZ     X4,AVS9     IF VSN NOT FOUND
          SA1    /ADD/VSBF   CHECK IF VSN IS BUSY
          RJUST  X1,X1,/BTC/VSBF,/UPB/VSBF
          SB5    EVSB
          NZ     X1,AVS9     IF VSN IS BUSY
          SA1    /ADD/VT     GET TAPE TYPE BITS FOR VSN ENTRY
          RJUST  X1,X1,/BTC/VT,/UPB/VT
          SA2    /ADD/TTYP   GET TAPE TYPE FIELD FROM TAPE FILE CATALOG
          RJUST  X2,X2,/BTC/TTYP,/UPB/TTYP
          SX6    X2-2
          NZ     X6,AVS2.1   IF NOT *NT*
          SX2    B0+         SET TAPE TYPE TO *MT/NT*
 AVS2.1   BX1    X1-X2       COMPARE TAPE TYPES
          SB5    ENMT
          NZ     X1,AVS8     IF TAPE TYPES DO NOT MATCH
          SA1    LF
          NZ     X1,AVS3     IF LOCAL FILE MODE
          SA1    /ADD/NVSN   CHECK IF LAST VSN
          LJUST  X1,X1,/BTC/NVSN,/UPB/NVSN
          SB5    EVAA
          NZ     X1,AVS8     IF NOT LAST VSN
 AVS3     SA1    VC
          ZR     X1,AVS5     IF NO VSNS ASSIGNED
          SA1    /ADD/VASF   CHECK IF VSN IS ASSIGNED
          RJUST  X1,X1,/BTC/VASF,/UPB/VASF
          SB5    EVAA
          NZ     X1,AVS8     IF VSN ALREADY ASSIGNED
          SA1    VCAT+VEVS
          SX0    SVVS
          SB5    ESVM
          BX2    X0*X1
          NZ     X2,AVS8     IF SYSTEM VSN
          SX0    UOVS+TVVS   CHECK IF STATUSES MATCH
          SA2    ST
          BX1    X1-X2
          BX2    X0*X1
          SB5    ENMS
          NZ     X2,AVS8     IF STATUSES DO NOT MATCH
          SX0    CTVS+ACVS   CHECK IF TAPE TYPES MATCH
          SB5    ENMT
          BX2    X0*X1
          NZ     X2,AVS8     IF TAPE TYPES DO NOT MATCH
          SA3    VC          INCREMENT VSN COUNT
          SX6    X3+B1
          SA6    A3
          LX3    2
          SA1    AV
          NZ     X1,AVS4     IF NOT FIRST ADDED VSN
          SX6    X3+TAVS     SET NEW VSN TABLE ADDRESS
          SA6    A1
 AVS4     MOVE   TSVL,VCAT,X3+TAVS  SET NEW VSN IN TABLE
          SA1    RC          INCREMENT REEL COUNT
          SX6    X1+B1
          SA6    A1
          NZ     X1,AVS7     IF NOT FIRST REEL
          SA1    VS          SET EXTERNAL VSN
          BX6    X1
          SA6    EV
          EQ     AVS7        CLEAR NEXT ENTRY
 
 AVS5     SA1    /ADD/VASF
          RJUST  X1,X1,/BTC/VASF,/UPB/VASF
          NZ     X1,AVS6     IF VSN ASSIGNED
          SA1    TAVS+/CAT/URDATE  RESTORE RELEASE DATE
          MOVEBIT  A1,/ADD/URDATE,/BTC/URDATE,/UPB/URDATE,/UPB/URDATE
          SA1    TAVS+/CAT/NEWRDT  RESTORE NEW RELEASE DATE FLAG
          MOVEBIT  A1,/ADD/NEWRDT,/BTC/NEWRDT,/UPB/NEWRDT,/UPB/NEWRDT
          SX6    TAVS        SET NEW VSN TABLE ADDRESS
          SA6    AV
          MOVE   TSVL,VCAT,TAVS  SET NEW VSN IN TABLE
          SX6    B1          SET VSN COUNT
          SA6    VC
          SA6    RC          SET REEL COUNT
          SA1    VS          SET EXTERNAL VSN
          BX6    X1
          SA6    EV
          EQ     AVS7        CLEAR NEXT ENTRY
 
 AVS6     SA1    /ADD/NVSN   CHECK IF LAST VSN
          LJUST  X1,X1,/BTC/NVSN,/UPB/NVSN
          SB5    EVAA
          NZ     X1,AVS8     IF NOT LAST VSN
          GFILEV UN,VS,10000,PCAT,PCAT,TAVS  GET LAST FILE
          SX4    X4+B1
          SB5    EVAA
          NG     X4,AVS8     IF VSN NOT AVAILABLE
          SA7    PA          SET PREVIOUS FILE RANDOM ADDRESS
          SX6    B6+B1       SET SEQUENCE NUMBER
          SA6    QN
          SX6    B7          SET VSN COUNT
          SA6    VC
          LX6    2           SET NEW VSN TABLE ADDRESS
          SX6    X6+TAVS-4
          SA6    AV
          SX6    B1          SET REEL COUNT
          SA6    RC
          SA1    VS          SET EXTERNAL VSN
          BX6    X1
          SA6    EV
 AVS7     SA1    VC          CLEAR NEXT VSN ENTRY
          LX1    2
          SX6    B0
          SA6    X1+TAVS
          SX0    UOVS+TVVS+CTVS+ACVS  SET STATUS BITS
          SA1    VCAT+1
          BX1    X0*X1
          MOVEBIT  A1,ST,18,17,17
          MOVEBIT  TAVS+/CAT/VSN,FV,/BTC/VSN  SET FIRST VSN
          RJ     //PFC       PACK FILE CATALOG
          RJ     KVQ         SET FIRST VSN AND SEQUENCE IN K-DISPLAY
          RJ     KAV         SET ASSIGNED VSNS IN K-DISPLAY
          EQ     AVSX        RETURN
 DEN      SPACE  4,10
**        DEN - PROCESS *D* DIRECTIVE.
 
 
 DEN      SUBR               ENTRY/EXIT
          SA1    /ADD/EVSN
          MX0    36
          BX1    X0*X1
          ZR     X1,DENX     IF NO VSN-S ASSIGNED
          SA1    /ADD/TTYP   GET NEW TAPE TYPE
          RJUST  X1,X1,/BTC/TTYP,/UPB/TTYP
          SA2    DE
          AX2    4
          BX6    X1-X2
          ZR     X6,DENX     IF NEW DENSITY DOES NOT CHANGE TAPE TYPE
          SA1    DE          RESET OLD VALUE INTO TAPE CATALOG ENTRY
          MOVEBIT  A1,/ADD/D,/BTC/D,5,/UPB/D
          ISSMSG ECTD,E      * CANNOT CHANGE TAPE TYPE / DENSITY.*
          EQ     DENX        RETURN
 DRO      SPACE  4,10
**        DRO - PROCESS *DROP* DIRECTIVE.
 
 
 DRO      SUBR               ENTRY/EXIT
          SA1    VC          REPLACE ORIGINAL VSNS
          LX1    2
          REPVSN TAVS,X1
          ISSMSG IFNP,I      ISSUE INFORMATIVE MESSAGE
          RJ     USL         PROCESS USER LEVEL
          EQ     DROX        RETURN
 PGO      SPACE  4,10
**        PGO - PROCESS *GO* DIRECTIVE.
*
*         ENTRY  (RF) = 0, IF FILE NOT RESERVED.
*
*         EXIT   VSN AMENDED OR RESERVED.
*
*         USES   A - 1.
*                X - 1.
*
*         CALLS ALT, RES.
 
 
 PGO1     RJ     RES         RESERVE FILE
 
 PGO      SUBR               ENTRY/EXIT
          SA1    RF
          ZR     X1,PGO1     IF FILE NOT RESERVED
          RJ     ALT         AMEND FILE
          EQ     PGOX        RETURN
 PFI      SPACE  4,10
**        PFI - PROCESS *FI* DIRECTIVE.
 
 
 PFI4     MOVEBIT  NI,/ADD/FI,/BTC/FI,,/UPB/FI  RESET NEW FILE ID
          ISSMSG EFIC,E      ISSUE ERROR MESSAGE
 
 PFI      SUBR               ENTRY/EXIT
          SA1    SV
          ZR     X1,PFI3     IF NOT SYMBOLIC ACCESS
          MOVEBIT  /ADD/FI,PFIA,/BTC/FI,/UPB/FI  GET NEW FILE ID
          SA1    PFIA        COMPARE FILE IDS
          SA2    A1+B1
          SA3    FI
          BX3    X3-X1
          NZ     X3,PFI1     IF NOT THE SAME AS ORIGINAL FILE ID
          SA3    A1+B1
          BX3    X3-X2
          ZR     X3,PFI3     IF THE SAME AS ORIGINAL FILE ID
 PFI1     SA3    NI
          BX3    X3-X1
          NZ     X3,PFI2     IF NOT THE SAME AS NEW FILE ID
          SA3    A3+B1
          BX3    X3-X2
          NZ     X3,PFI3     IF THE SAME AS NEW FILE ID
 PFI2     SA1    NV
          NZ     X1,PFI3     IF NO VERIFY MODE
          SAFET  UN,,PFIA,SCST  CHECK IF FILE EXISTS
          ZR     X4,PFI4     IF ANOTHER FILE HAS THAT NAME
 PFI3     MOVEBIT  /ADD/FI,NI,/BTC/FI,/UPB/FI  SET NEW FILE ID
          EQ     PFIX        RETURN
 
 PFIA     BSS    2           NEW FILE IDENTIFIER
 PSV      SPACE  4,10
**        PSV - PROCESS *SV* DIRECTIVE.
 
 
 PSV3     MOVEBIT  SV,/ADD/SV,/BTC/SV,/BTC/SV-1,/UPB/SV
          ISSMSG EFIC,E      ISSUE ERROR MESSAGE
 
 PSV      SUBR               ENTRY/EXIT
          SA1    /ADD/SV     CHECK IF SYMBOLIC ACCESS
          RJUST  X1,X1,/BTC/SV,/UPB/SV
          ZR     X1,PSV2     IF CHANGE TO NOT SYMBOLIC ACCESS
          SA1    SV          CHECK IF ALREADY SYMBOLIC ACCESS
          NZ     X1,PSVX     IF ALREADY SYMBOLIC ACCESS
          SA1    NI          CHECK NEW FILE IDENTIFIER
          SA2    A1+B1
          SA3    =10H
          BX3    X3-X1
          ZR     X3,PSV3     IF INCORRECT FILE ID
          SA3    FI
          BX3    X3-X1
          NZ     X3,PSV1     IF NOT THE SAME AS ORIGINAL FILE ID
          SA3    A3+B1
          BX3    X3-X2
          ZR     X3,PSV2     IF THE SAME AS ORIGINAL FILE ID
 PSV1     SA1    NV
          NZ     X1,PSV2     IF NO VERIFY MODE
          SAFET  UN,,NI,SCST CHECK FILE EXISTS
          ZR     X4,PSV3     IF FILE ALREADY EXISTS
 PSV2     MOVEBIT  /ADD/SV,SV,/BTC/SV,/UPB/SV,/BTC/SV-1
          EQ     PSVX        RETURN
 RDA      SPACE  4,10
**        RDA - CONVERT RDATE TO URDATE.
*
*         USES   X - ALL.
*                A - 2, 4.
*                B - 3, 4, 5, 6.
*
*         CALLS  URD.
*
*         MACROS MOVEBIT.
 
 
 RDA      SUBR               ENTRY/EXIT
          SA2    RDAA        GET CONDITIONAL RELEASE DATE
          SX6    B0
          ZR     X2,RDA7     IF NO RELEASE DATE
          SX5    CRDP        GET TERM
          MX0    -12
          BX1    -X0*X5
          MX0    -6          UNPACK DATE
          BX3    -X0*X2
          SB3    X3          DAY
          AX2    6
          BX3    -X0*X2
          SB4    X3          MONTH
          AX2    6
          BX2    -X0*X2
          SB5    X2          YEAR
          MX0    -2          MASK FOR LEAP YEAR
 
*         ADVANCE YEAR.
 
 RDA1     SX4    X1-366D     (TERM REMAINING) - (DAYS IN LEAP YEAR)
          NG     X4,RDA4     IF LESS THAN 1 YEAR REMAINING
          SB5    B5+B1       ADD 1 YEAR TO EXPIRATION DATE
          SX3    B5+B1
          SB6    B1+B1
          BX2    -X0*X3
          ZR     X2,RDA2     IF CURRENT YEAR IS A LEAP YEAR
          SX2    X3+B1       YEAR + 1 + LEAP YEAR OFFSET
          BX2    -X0*X2
          NZ     X2,RDA3     IF NEXT YEAR IS NOT A LEAP YEAR
          LE     B4,B6,RDA3  IF BEFORE LEAP DAY
          SX1    X1-1        SUBTRACT 1 DAY TO OFFSET LEAP DAY
          EQ     RDA3        SUBTRACT 1 YEAR FROM TERM
 
 RDA2     GT     B4,B6,RDA3  IF AFTER LEAP DAY
          SX1    X1-1        SUBTRACT 1 DAY TO OFFSET LEAP DAY
 RDA3     SX1    X1-365D     SUBTRACT 1 YEAR FROM TERM
          EQ     RDA1        CONTINUE PROCESSING
 
*         ADVANCE MONTH.
 
 RDA4     SA4    RDAB-1+B4     GET DAYS IN CURRENT MONTH
          SX7    B4-2
          NZ     X7,RDA5     IF CURRENT MONTH NOT FEBRUARY
          SX2    B5+2
          BX7    -X0*X2
          NZ     X7,RDA5     IF NOT LEAP YEAR
          SX4    X4+B1       ADD LEAP DAY
 RDA5     SX2    B3+
          IX2    X4-X2       DAYS TO END OF CURRENT MONTH
          IX3    X1-X2       SUBTRACT FROM TERM REMAINING
          NG     X3,RDA6     IF NOT ENOUGH TERM REMAINING TO FILL MONTH
          ZR     X3,RDA6     IF TERM EXACTLY FILLS CURRENT MONTH
          SB3    B0+
          SB4    B4+B1       INCREMENT MONTH
          BX1    X3          SET NEW TERM
          SX7    B4-13
          NZ     X7,RDA4     IF NOT END OF YEAR
          SB5    B5+B1       INCREMENT YEAR
          SB4    B1          SET MONTH TO JANUARY
          EQ     RDA4        CONTINUE
 
*         RETURN NEW PACKED DATE.
 
 RDA6     SB3    X1+B3       SET DAYS
          SX6    B5          ADD IN YEAR
          LX6    6
          SX6    X6+B4       ADD IN MONTH
          LX6    6
          SX6    X6+B3       ADD IN DAY
 RDA7     SA6    RDAA
          MOVEBIT A6,TAVS+/CAT/URDATE,/BTC/URDATE,17,/UPB/URDATE
          RJ     URD         PROCESS UNCONDITIONAL RELEASE DATE
          EQ     RDAX        RETURN
 
 RDAA     CON    0           PACKED CONDITIONAL/UNCONDITIONAL DATE
 
 RDAB     BSS    0           TABLE OF DAYS IN MONTH
          LOC    1
          CON    31          JANUARY
          CON    28          FEBRUARY
          CON    31          MARCH
          CON    30          APRIL
          CON    31          MAY
          CON    30          JUNE
          CON    31          JULY
          CON    31          AUGUST
          CON    30          SEPTEMBER
          CON    31          OCTOBER
          CON    30          NOVEMBER
          CON    31          DECEMBER
          LOC    *O
 RES      SPACE  4,10
**        RES - PROCESS *RESERVE* DIRECTIVE.
 
 
 RES2     ISSMSG B5,E        ISSUE ERROR MESSAGE
 
 RES      SUBR               ENTRY/EXIT
          SA1    RF          CHECK RESERVE FLAG
          SB5    EFAR        SET ERROR MESSAGE ADDRESS
          NZ     X1,RES2     IF FILE ALREADY RESERVED
          SA1    RC
          SB5    ERDM        *REQUIRED DATA MISSING.*
          ZR     X1,RES2     IF NO VSNS ASSIGNED
          SA1    UF
          ZR     X1,RES1     IF USER NAME ALREADY IN FILE
          RESETP N2          INSERT USER NAME
          WRITFET  X2,UN,1
          CALLTFM  X2,IUES
 RES1     RJ     RAF         RESERVE/AMEND FILE CATALOG ENTRY
          ISSMSG IFRE,I      ISSUE INFORMATIVE MESSAGE
          SX6    B0          FLAG USER NAME FOUND
          SA6    UF
          RJ     USL         PROCESS USER LEVEL
          EQ     RESX        RETURN
 URD      SPACE  4,10
**        URD - SET URDATE FLAG.
*
*         EXIT   (RS) = 1.
*
*         USES   X - 6.
*                A - 6.
*
*         MACROS MOVEBIT.
 
 
 URD      SUBR               ENTRY/EXIT
          SX6    B1          FLAG *URDATE* ISSUED
          SA6    RS
          SA1    TAVS+/CAT/URDATE  CHECK RELEASE DATE
          RJUST  X1,X6,/BTC/URDATE,/UPB/URDATE
          SA1    =1
          NZ     X6,URD1     IF DATE SET
          SA1    =0
 URD1     MOVEBIT  A1,TAVS+/CAT/NEWRDT,/BTC/NEWRDT,0,/UPB/NEWRDT
          EQ     URDX        RETURN
 
          QUAL   *
          TITLE  ALTERNATE USER LEVEL PROCESSORS.
          SPACE  4
          QUAL   LVAU
 AUS      SPACE  4,15
**        ALTERNATE USER LEVEL DIRECTIVE PROCESSORS.
*
*         ENTRY  FROM *DIP*.
*                (AF) = 0 IF ALTERNATE USER NOT ADMITTED.
*                (AU) = ALTERNATE USER NAME.
*                (FV) = FIRST VSN.
*                (QN) = SEQUENCE NUMBER.
*                (UN) = USER NAME.
*                (ACAT) = ALTERNATE USER CATALOG IMAGE.
*                (FCAT) = FILE CATALOG IMAGE.
*
*         EXIT   (EF) = 0 IF NO DIRECTIVE ERROR.
 ADM      SPACE  4,10
**        ADM - PROCESS *ADMIT* DIRECTIVE.
 
 
 ADM      SUBR               ENTRY/EXIT
          RJ     RAB         REPLACE ALTERNATE USER IN BUFFER
          SA1    AF          CHECK ADMIT FLAG
          SB5    IAUU        PRESET INFORMATIVE MESSAGE ADDRESS
          NZ     X1,ADM2     IF OLD ADMIT ENTRY
          SA1    /ADD/AUCAT  CHECK ADMIT RANDOM ADDRESS
          RJUST  X1,X1,/BTC/AUCAT,/UPB/AUCAT
          NZ     X1,ADM1     IF NOT FIRST ALTERNATE USER
          RJ     RAE         REPLACE ALTERNATE USER ENTRIES
          SA3    QN          RESET ADMIT RANDOM ADDRESS
          GFILEV UN,FV,X3,ADMA,PCAT,TAVS
          MOVEBIT  ADMA+/CAT/AUCAT,/ADD/AUCAT,24
 ADM1     SB5    IAUA
 ADM2     ISSMSG B5,I        ISSUE INFORMATIVE MESSAGE
          RJ     FIL         PROCESS FILE LEVEL
          EQ     ADMX        RETURN
 
 ADMA     BSS    TCEL        FILE CATALOG IMAGE
 DRO      SPACE  4,10
**        DRO - PROCESS *DROP* DIRECTIVE.
 
 
 DRO      SUBR               ENTRY/EXIT
          ISSMSG IANP,I      ISSUE INFORMATIVE MESSAGE
          RJ     FIL         PROCESS FILE LEVEL
          EQ     DROX        RETURN
 
          QUAL   *
          TITLE  K-DISPLAY AREA.
 KCW      SPACE  4,10
**        K-DISPLAY CONTROL WORD.
 
 
 KCW      VFD    24/KBUF,18/KRIGHT,18/KLEFT  CONTROL WORD
 KLEFT    SPACE  4,10
**        KLEFT - LEFT SCREEN K-DISPLAY HEADER.
 
 
 KLEFT    KSTART CW
          KLINE  ( ),E
 PROGRAM  KLINE  (    *TFSP* - TAPE FILE SUPERVISOR.),E
          KLINE  ( ),E
 SEPARAT  KLINE  ( SEPARAT=,          )
          KLINE  (SEPARATOR CHARACTER. (0-1 CHARACTERS.)),E
 COLON    KLINE  ( COLON  =           )
          KLINE  (COLON CHARACTER. (0-1 CHARACTERS.)),E
 READ     KLINE  ( READ   =           )
          KLINE  (ALTERNATE INPUT FILE.),E
          KNEXT  KFAMLS
 KRIGHT   SPACE  4,10
**        KRIGHT - RIGHT SCREEN K-DISPLAY HEADER.
 
 
 KRIGHT   KSTART CW
          KLINE  ( ),E
 PROGRAM  KLINE  (    *TFSP*)
 LV       KLINE  (   FAMILY LEVEL *HELP* DISPLAY.),E
          KLINE  ( ),E
          KLINE  ( HELP               )
          KLINE  (DISPLAY LEGAL DIRECTIVES.),E
          KLINE  ( DISPLAY            )
          KLINE  (TOGGLE OUT OF *HELP* DISPLAY.),E
          KLINE  ( SEPARAT = CHAR     )
          KLINE  (SET SEPARATOR CHARACTER.),E
          KLINE  (                    )
          KLINE  (DEFAULT IS COMMA.),E
          KLINE  ( COLON   = CHAR     )
          KLINE  (SET COLON CHARACTER. DEFAULT IS NONE.),E
          KLINE  ( READ    = FILENAM  )
          KLINE  (READ DIRECTIVES OFF OF LOCAL FILE.),E
          KLINE  ( REWIND  = FILENAM  )
          KLINE  (REWIND LOCAL FILE.),E
          KLINE  ( BRIEF/NOBRIEF      )
          KLINE  (ENABLE/DISABLE INFORMATIVE OUTPUT.),E
          KLINE  ( STOP               )
          KLINE  (TERMINATE TFSP.),E
          KNEXT  KFAMRS
 KFAMLS   SPACE  4,10
**        KFAMLS - LEFT SCREEN FAMILY LEVEL K-DISPLAY.
 
 
 KFAMLS   KSTART
          KLINE  ( ),E
 FAMNAME  KLINE  ( FAMNAME=           )
          KLINE  (FAMILY NAME. (1-7 CHARACTERS)),E
 LINKFAM  KLINE  ( LINKFAM=           )
          KLINE  (LINKED CATALOG FAMILY. (1-7 CHARACTERS)),E
 MID      KLINE  ( MID    =AA         )
          KLINE  (MACHINE ID. (2 CHARACTERS)),E
 CATERR   KLINE  ( CATERR =CLEAR      )
          KLINE  (ERROR STATUS. (CLEAR, SET)),E
 FOREIGN  KLINE  ( FOREIGN=NO         )
          KLINE  (FOREIGN STATUS. (NO, YES)),E
 GLOBAL   KLINE  ( GLOBAL =NO         )
          KLINE  (GLOBAL STATUS. (NO, YES)),E
          KLINE  ( ),E
 TFSPE    KLINE  ( TAPE CATALOG ERROR DISCOVERED AT  -  )
 TDATE    KLINE  (YY/MM/DD, HH.MM.SS.),E
 TFSPEL   EQU    *-TFSPE     LENGTH OF *TFSPE* MESSAGE
          KLINE  ( ),E
          KLINE  ( CURRENT MESSAGE BUFFER -),E
          KLINE  ( ),E
 MB       KLINE  (                                         ),E
          KLINE  ( ),E
 SIZE     KLINE  ( CATALOG SIZE = 00000000.   MT)
 SCM      KLINE  (/NT SCRATCH COUNT = 00000000.),E
 SCC      KLINE  ( CT SCRATCH COUNT = 00000000.)
 SCA      KLINE  ( AT SCRATCH COUNT = 00000000.),E
          KLINE  ( ),E
          KLINE  ( USER NAMES VALIDATED TO ACCESS),E
          KLINE  ( TAPE CATALOG FILE VIA *TFSP* -),E
          KLINE  ( ),E
 VALIDAT  BSS    0
          DUP    2
          KLINE  (                                ),E
          ENDD
          KLINE  ( ),E
          KLINE  ( FAMILIES PERMITTED TO ACCESS CATALOG -),E
          KLINE  ( ),E
 ALTFAM   KLINE  (                                ),E
          KNEXT  KMESS
 KFAMRS   SPACE  4,10
**        KFAMRS - RIGHT SCREEN FAMILY LEVEL K-DISPLAY.
 
 
 KFAMRS   KSTART
          KLINE  ( AUDITCH = CHARGNO  )
          KLINE  (AUDIT BY CHARGE NUMBER.),E
          KLINE  ( AUDITUN = USERNAM  )
          KLINE  (AUDIT USER. DEFAULT IS ALL USERS.),E
          KLINE  ( AUDITVS = VSN      )
          KLINE  (AUDIT VSN. DEFAULT IS ALL VSNS.),E
          KLINE  ( MREADCH = CHARGNO  )
          KLINE  (MACHINE READABLE *AUDITCH*.),E
          KLINE  ( MREADUN = USERNAM  )
          KLINE  (MACHINE READABLE *AUDITUN*.),E
          KLINE  ( MREADVS = VSN      )
          KLINE  (MACHINE READABLE *AUDITVS*.),E
          KLINE  ( SOURCCH = CHARGNO  )
          KLINE  (SOURCE OF CHARGE NUMBER.),E
          KLINE  ( SOURCUN = USERNAM  )
          KLINE  (SOURCE OF USER. DEFAULT IS ALL USERS.),E
          KLINE  ( SOURCVS = VSN      )
          KLINE  (SOURCE OF VSN.),E
          KLINE  ( SOURCE             )
          KLINE  (SOURCE OF ALL OF TAPE CATALOG FILE.),E
          KLINE  ( RELEASE = VSN      )
          KLINE  (RELEASE VSN AND ITS TAPE FILE.),E
          KLINE  ( REMOVE  = VSN      )
          KLINE  (REMOVE VSN FROM TAPE CATALOG FILE.),E
          KLINE  ( PURGALL = USERNAM  )
          KLINE  (RELEASE ALL TAPE FILES OF USER.),E
          KLINE  ( PURGE   = VSN      )
          KLINE  (PURGE TAPE FILES CONTAINING VSN.),E
          KLINE  ( VALIDAT = USERNAM  )
          KLINE  (VALIDATE USER TO USE *TFSP*.),E
          KLINE  ( INVALID = USERNAM  )
          KLINE  (INVALIDATE USER TO USE *TFSP*.),E
          KLINE  ( ALTFAM  = FAMILY )
          KLINE  (ALLOW ALTERNATE FAMILY ACCESS.),E
          KLINE  ( CALTFAM = FAMILY )
          KLINE  (DISALLOW ALTERNATE FAMILY ACCESS.),E
          KLINE  ( ISV                )
          KLINE  (INITIALIZE SCRATCH VSNS.),E
          KLINE  ( VSN     = VSN      )
          KLINE  (BEGIN VSN LEVEL DIRECTIVES.),E
          KLINE  ( USER    = USERNAM  )
          KLINE  (BEGIN USER LEVEL DIRECTIVES.),E
          KLINE  ( DROP               )
          KLINE  (TERMINATE *TFSP*.),E
          KLINE  ( GO                 )
          KLINE  (MAKE UPDATES AND TERMINATE *TFSP*.),E
          KEND
 KVSNLS   SPACE  4,10
**        KVSNLS - LEFT SCREEN VSN LEVEL K-DISPLAY.
 
 
 KVSNLS   KSTART
          KLINE  ( VSN    = )
 VSN      KLINE  (      ),E
          KLINE  ( ),E
          KLINE  (          )
 MESS     KLINE  (VSN NOT CURRENTLY IN CATALOG.),E
          KLINE  ( ),E
 VT       KLINE  ( VT     =MTNT       )
          KLINE  (TAPE TYPE.  (MTNT, CT OR AT)),E
 PRN      KLINE  ( PRN    =           )
          KLINE  (PHYSICAL VSN (PRN).  (1-6 CHARACTERS)),E
 STATUS   KLINE  ( STATUS =AVAILABLE  )
          KLINE  (STATUS. (AVAILABLE,CLEANED,HOLD,ERROR)),E
 SITE     KLINE  ( SITE   =ON         )
          KLINE  (SITE STATUS. (ON, OFF)),E
 OWNER    KLINE  ( OWNER  =CENTER     )
          KLINE  (OWNERSHIP TYPE. (CENTER, USER)),E
 SYSTEM   KLINE  ( SYSTEM =NO         )
          KLINE  (SYSTEM VSN FLAG. (NO, YES)),E
 USAGE    KLINE  ( USAGE  =0          )
          KLINE  (USAGE COUNTER. (0 - 63)),E
          KNEXT  KMESS
 KVSNRS   SPACE  4,10
**        KVSNRS - RIGHT SCREEN VSN LEVEL K-DISPLAY.
 
 
 KVSNRS   KSTART
          KLINE  ( ADD                )
          KLINE  (PROCESS ADDING VSN TO CATALOG.),E
          KLINE  ( REVISE             )
          KLINE  (PROCESS REVISING VSN IN CATALOG.),E
          KLINE  ( DROP               )
          KLINE  (IGNORE ADD/REVISE OF VSN.),E
          KLINE  ( GO                 )
          KLINE  (ADD OR REVISE VSN.),E
          KEND
 KUSELS   SPACE  4,10
**        KUSELS - LEFT SCREEN USER LEVEL K-DISPLAY.
*
*         ENTRY  (KUSELS) = LENGTH OF DISPLAY FOR TERMINAL OUTPUT.
 
 
 KUSELS   KSTART
          KLINE  ( USER   = )
 USER     KLINE  (       ),E
          KLINE  ( ),E
          KLINE  ( TAPE FILES -),E
          KLINE  ( ),E
 FILE     BSS    0
          DUP    9
          KLINE  (                                        )
          KLINE  (                 ),E
          ENDD
          KNEXT  KMESS
 KUSERS   SPACE  4,10
**        KUSERS - RIGHT SCREEN USER LEVEL K-DISPLAY.
 
 
 KUSERS   KSTART
          KLINE  ( AUDITCN = CHARGNO  )
          KLINE  (AUDIT TAPE FILES WITH CHARGE NUMBER.),E
          KLINE  ( AUDITFI = FILEID   )
          KLINE  (AUDIT TAPE FILE.),E
          KLINE  ( AUDITFV = VSN      )
          KLINE  (AUDIT TAPE FILES WITH VSN.),E
          KLINE  ( MREADCN = CHARGNO  )
          KLINE  (MACHINE READABLE *AUDITCN*.),E
          KLINE  ( MREADFI = FILEID   )
          KLINE  (MACHINE READABLE *AUDITFI*.),E
          KLINE  ( MREADFV = VSN      )
          KLINE  (MACHINE READABLE *AUDITFV*.),E
          KLINE  ( SOURCCN = CHARGNO  )
          KLINE  (SOURCE OF TAPE FILES WITH CHARGE NUMBER.),E
          KLINE  ( SOURCFI = FILEID   )
          KLINE  (SOURCE OF TAPE FILE.),E
          KLINE  ( SOURCFV = VSN      )
          KLINE  (SOURCE OF TAPE FILES WITH VSN.),E
          KLINE  ( RELEASF = FILEID   )
          KLINE  (RELEASE BY TAPE FILE.),E
          KLINE  ( RELEASV = VSN      )
          KLINE  (RELEASE BY VSN.),E
          KLINE  ( FILE    = FILEID   )
          KLINE  (BEGIN FILE LEVEL DIRECTIVES.),E
          KLINE  ( FILEV   = VSN/QN   )
          KLINE  (BEGIN FILE LEVEL DIRECTIVES.),E
          KLINE  ( DROP               )
          KLINE  (END USER LEVEL DIRECTIVES.),E
          KEND
 KFILLS1  SPACE  4,10
**        KFILLS1 - LEFT SCREEN FILE LEVEL K-DISPLAY, PAGE 1.
 
 
 KFILLS1  KSTART
          KLINE  ( USER   = )
 USER     KLINE  (       ),E
          KLINE  ( FVSN   = )
 FVSN     KLINE  (      ),E
          KLINE  ( QN     = )
 QN       KLINE  (    ),E
          KLINE  ( FILE   = )
 FILE     KLINE  (                     PAGE 1 OF 3),E
          KLINE  ( ),E
          KLINE  (          )
 MESS     KLINE  (FILE NOT CURRENTLY RESERVED.  ),E
          KLINE  ( ),E
 SV       KLINE  ( SV     =           )
          KLINE  (SYMBOLIC ACCESS. (NO, SET)),E
 RECOVER  KLINE  ( RECOVER=           )
          KLINE  (RECOVERED STATUS. (NO, YES)),E
 CN       KLINE  ( CN     =           )
          KLINE  (CHARGE NUMBER. (0-10 CHARACTERS)),E
 PN       KLINE  ( PN     =                     )
          KLINE  (PROJECT NUMBER.(0-20 CHARS)),E
 CE       KLINE  ( CE     =CLEAR      )
          KLINE  (ERROR FLAG. (CLEAR, SET)),E
 UC       KLINE  ( UC     =           )
          KLINE  (USER CONTROL WORD. (0-10 CHARACTERS)),E
 TSITE    KLINE  ( TSITE  =ON         )
          KLINE  (SITE STATUS. (ON, OFF)),E
 URDATE   KLINE  ( URDATE =           )
          KLINE  (RELEASE DATE. (YYMMDD)),E
 TOWNER   KLINE  ( TOWNER =CENTER     )
          KLINE  (OWNERSHIP TYPE. (CENTER, USER)),E
          KLINE  ( ASSIGNED VSNS - ),E
 AVSN     BSS    0
          DUP    10
          KLINE  (                              )
          KLINE  (                        ),E
          ENDD
          KNEXT  KMESS
 KFILLS2  SPACE  4,10
**        KFILLS2 - LEFT SCREEN FILE LEVEL K-DISPLAY, PAGE 2.
 
 
 KFILLS2  KSTART
          KLINE  ( USER   = )
 USER     KLINE  (       ),E
          KLINE  ( FVSN   = )
 FVSN     KLINE  (      ),E
          KLINE  ( QN     = )
 QN       KLINE  (    ),E
          KLINE  ( FILE   = )
 FILE     KLINE  (                     PAGE 2 OF 3),E
          KLINE  ( ),E
          KLINE  (          )
 MESS     KLINE  (FILE NOT CURRENTLY RESERVED.  ),E
          KLINE  ( ),E
 FI       KLINE  ( FI     =                     )
          KLINE  (LOGICAL FILE IDENTIFIER.),E
          KLINE  (                    (1-17 CHARACTERS)),E
 PW       KLINE  ( PW     =           )
          KLINE  (PASSWORD. (0-7 CHARACTERS)),E
 CT       KLINE  ( CT     =PRIVATE    )
          KLINE  (ACCESS CATEGORY.),E
          KLINE  (                    )
          KLINE  ((PRIVATE, SPRIV, PUBLIC)),E
 M        KLINE  ( M      =READ       )
          KLINE  (ACCESS MODE. (READ, WRITE, NULL)),E
 AC       KLINE  ( AC     =NO         )
          KLINE  (ALTERNATE CATLIST. (NO, YES)),E
 ACOUNT   KLINE  ( ACOUNT =0000       )
          KLINE  (ACCESS COUNT. (0-"MXAC")),E
 CDATE    KLINE  ( CDATE  =           )
          KLINE  (CREATION DATE. (YYMMDD)),E
 CTIME    KLINE  ( CTIME  =           )
          KLINE  (CREATION TIME. (HHMMSS)),E
 ADATE    KLINE  ( ADATE  =           )
          KLINE  (LAST ACCESS DATE. (YYMMDD)),E
 ATIME    KLINE  ( ATIME  =           )
          KLINE  (LAST ACCESS TIME. (HHMMSS)),E
 MDATE    KLINE  ( MDATE  =           )
          KLINE  (LAST MODIFICATION DATE. (YYMMDD)),E
 MTIME    KLINE  ( MTIME  =           )
          KLINE  (LAST MODIFICATION TIME. (HHMMSS)),E
          KNEXT  KMESS
 KFILLS3  SPACE  4,10
**        KFILLS3 - LEFT SCREEN FILE LEVEL K-DISPLAY, PAGE 3.
*
*         ENTRY  (KFILLS3) = LENGTH OF DISPLAY FOR TERMINAL OUTPUT.
 
 
 KFILLS3  KSTART
          KLINE  ( USER   = )
 USER     KLINE  (       ),E
          KLINE  ( FVSN   = )
 FVSN     KLINE  (      ),E
          KLINE  ( QN     = )
 QN       KLINE  (    ),E
          KLINE  ( FILE   = )
 FILE     KLINE  (                     PAGE 3 OF 3),E
          KLINE  ( ),E
          KLINE  (          )
 MESS     KLINE  (FILE NOT CURRENTLY RESERVED.  ),E
          KLINE  ( ),E
 PI       KLINE  ( PI     =                     )
          KLINE  (PHYSICAL FILE IDENTIFIER.),E
          KLINE  (                    (1-17 CHARACTERS)),E
 CR       KLINE  ( CR     =           )
          KLINE  (CREATION DATE. (YYDDD)),E
 CV       KLINE  ( CV     =AS         )
          KLINE  (CONVERSION MODE. (AS, EB)),E
 D        KLINE  ( D      =PE         )
          KLINE  (DENSITY. (PE, GE, HI, HY, HD, CE, AE)),E
 E        KLINE  ( E      =00         )
          KLINE  (GENERATION VERSION NUMBER. (0-99)),E
 F        KLINE  ( F      =I          )
          KLINE  (FORMAT. (I, LI, S, L, SI, F)),E
 FA       KLINE  ( FA     =           )
          KLINE  (ACCESSIBILITY. (0-1 CHARACTERS)),E
 FC       KLINE  ( FC     ="MXFC"       )
          KLINE  (F-FORMAT MAX BLOCK SIZE. (1-"MXFC")),E
 G        KLINE  ( G      =0001       )
          KLINE  (GENERATION NUMBER. (1-9999)),E
 LB       KLINE  ( LB     =KL         )
          KLINE  (LABEL TYPE. (KL, KU, NS)),E
 NS       KLINE  ( NS     =0          )
          KLINE  (NOISE SIZE. (0-31)),E
 RT       KLINE  ( RT     =           )
          KLINE  (RETENTION DATE. (YYDDD)),E
 SI       KLINE  ( SI     =           )
          KLINE  (SET IDENTIFIER. (0-6 CHARACTERS)),E
 SN       KLINE  ( SN     =0001       )
          KLINE  (SECTION NUMBER. (1-9999)),E
          KNEXT  KMESS
 KFILRS   SPACE  4,10
**        KFILRS - RIGHT SCREEN FILE LEVEL K-DISPLAY.
 
 
 KFILRS   KSTART
          KLINE  ( AUDITAU = USERNAM  )
          KLINE  (AUDIT ALTERNATE USER.),E
          KLINE  ( AVSN    = VSN      )
          KLINE  (ASSIGN VSN TO TAPE FILE.),E
          KLINE  ( AUSER   = USERNAM  )
          KLINE  (BEGIN ALTERNATE USER LEVEL DIRECTIVES.),E
          KLINE  ( RESERVE            )
          KLINE  (PROCESS RESERVE OF TAPE FILE.),E
          KLINE  ( AMEND              )
          KLINE  (PROCESS AMEND OF TAPE FILE.),E
          KLINE  ( DROP               )
          KLINE  (IGNORE RESERVE/AMEND OF TAPE FILE.),E
          KLINE  ( GO                 )
          KLINE  (RESERVE OR AMEND TAPE FILE.),E
          KEND
 KAUSLS   SPACE  4,10
**        KAUSLS - LEFT SCREEN ALTERNATE USER LEVEL K-DISPLAY.
 
 
 KAUSLS   KSTART
          KLINE  ( USER   = )
 USER     KLINE  (       ),E
          KLINE  ( FILE   = )
 FILE     KLINE  (                  ),E
          KLINE  ( AUSER  = )
 AUSER    KLINE  (       ),E
          KLINE  ( ),E
          KLINE  (          )
 MESS     KLINE  (USER NOT CURRENTLY ADMITTED.  ),E
          KLINE  ( ),E
 AMODE    KLINE  ( AMODE  =WRITE      )
          KLINE  (PERMISSION MODE.),E
          KLINE  (                    )
          KLINE  ((IMPLICIT, WRITE, READ, NULL, SPECIAL)),E
 AACOUNT  KLINE  ( AACOUNT=0000       )
          KLINE  (ACCESS COUNT. (0-"MXAA")),E
 AADATE   KLINE  ( AADATE =           )
          KLINE  (LAST ACCESS DATE. (YYMMDD)),E
 AATIME   KLINE  ( AATIME =           )
          KLINE  (LAST ACCESS TIME. (HHMMSS)),E
          KNEXT  KMESS
 KAUSRS   SPACE  4,10
**        KAUSRS - RIGHT SCREEN ALTERNATE USER LEVEL K-DISPLAY.
 
 
 KAUSRS   KSTART
          KLINE  ( ADMIT              )
          KLINE  (PROCESS ALTERNATE USER ADMIT.),E
          KLINE  ( DROP               )
          KLINE  (IGNORE ALTERNATE USER ADMIT.),E
          KLINE  ( GO                 )
          KLINE  (PROCESS ALTERNATE USER ADMIT.),E
          KEND
 KMESS    SPACE  4,10
**        K-DISPLAY STATUS MESSAGES.
 
 
 KMESS    KSTART
          KLINE  ( ),E
 STATUS   KLINE  ( PROCESSING DIRECTIVES.),E
 DIRECT   KLINE  ( *********)
          KLINE  (                              ),E
 MESSAGE  KLINE  (                              )
          KLINE  (                              ),E
          KEND               END OF K-DISPLAY
 
*         INSURE DISPLAYS LESS THAN 40 LINES.
 
          ERRNG  37-/KLEFT/LINES-/KFAMLS/LINES-/KMESS/LINES
          ERRNG  37-/KLEFT/LINES-/KVSNLS/LINES-/KMESS/LINES
          ERRNG  37-/KLEFT/LINES-/KUSELS/LINES-/KMESS/LINES
          ERRNG  37-/KLEFT/LINES-/KFILLS1/LINES-/KMESS/LINES
          ERRNG  37-/KLEFT/LINES-/KFILLS2/LINES-/KMESS/LINES
          ERRNG  37-/KLEFT/LINES-/KFILLS3/LINES-/KMESS/LINES
          ERRNG  37-/KLEFT/LINES-/KAUSLS/LINES-/KMESS/LINES
          ERRNG  37-/KRIGHT/LINES-/KFAMRS/LINES
          ERRNG  37-/KRIGHT/LINES-/KUSERS/LINES
          ERRNG  37-/KRIGHT/LINES-/KFILRS/LINES
          ERRNG  37-/KRIGHT/LINES-/KAUSRS/LINES
 KDIS     SPACE  4,10
**        K-DISPLAY DIRECTIVE POINTERS.
 
 
          QUAL   KDIS
 
 AACOUNT  EQU    /KAUSLS/AACOUNT
 AADATE   EQU    /KAUSLS/AADATE
 AATIME   EQU    /KAUSLS/AATIME
 AC       EQU    /KFILLS2/AC
 ACOUNT   EQU    /KFILLS2/ACOUNT
 ADATE    EQU    /KFILLS2/ADATE
 AMODE    EQU    /KAUSLS/AMODE
 ATIME    EQU    /KFILLS2/ATIME
 CDATE    EQU    /KFILLS2/CDATE
 CE       EQU    /KFILLS1/CE
 CN       EQU    /KFILLS1/CN
 COLON    EQU    /KLEFT/COLON
 CR       EQU    /KFILLS3/CR
 CT       EQU    /KFILLS2/CT
 CTIME    EQU    /KFILLS2/CTIME
 CV       EQU    /KFILLS3/CV
 D        EQU    /KFILLS3/D
 E        EQU    /KFILLS3/E
 F        EQU    /KFILLS3/F
 FA       EQU    /KFILLS3/FA
 FC       EQU    /KFILLS3/FC
 FI       EQU    /KFILLS2/FI
 G        EQU    /KFILLS3/G
 LB       EQU    /KFILLS3/LB
 M        EQU    /KFILLS2/M
 MDATE    EQU    /KFILLS2/MDATE
 MTIME    EQU    /KFILLS2/MTIME
 NS       EQU    /KFILLS3/NS
 OWNER    EQU    /KVSNLS/OWNER
 PI       EQU    /KFILLS3/PI
 PN       EQU    /KFILLS1/PN
 PRN      EQU    /KVSNLS/PRN
 PW       EQU    /KFILLS2/PW
 READ     EQU    /KLEFT/READ
 RECOVER  EQU    /KFILLS1/RECOVER
 RT       EQU    /KFILLS3/RT
 SEPARAT  EQU    /KLEFT/SEPARAT
 SI       EQU    /KFILLS3/SI
 SITE     EQU    /KVSNLS/SITE
 SN       EQU    /KFILLS3/SN
 STATUS   EQU    /KVSNLS/STATUS
 SV       EQU    /KFILLS1/SV
 SYSTEM   EQU    /KVSNLS/SYSTEM
 TOWNER   EQU    /KFILLS1/TOWNER
 TSITE    EQU    /KFILLS1/TSITE
 UC       EQU    /KFILLS1/UC
 URDATE   EQU    /KFILLS1/URDATE
 USAGE    EQU    /KVSNLS/USAGE
 VT       EQU    /KVSNLS/VT
 
          QUAL   *
          TITLE  BUFFER AREA.
 BUFFER   SPACE  4,10
**        BUFFER ASSIGNMENTS.
 
 
          USE    BUFFERS
 
 BUF1     BSS    0           MAIN PROGRAM BUFFERS
 CBUF     BSS    CBUFL       CHARACTER BUFFER
 EBUF     BSS    EBUFL       ERROR MESSAGE BUFFER
 KBUF     BSS    KBUFL       K-DISPLAY INPUT BUFFER
 LBUF     BSS    FBUFL       OUTPUT FILE BUFFER
 PCAT     BSS    TCEL        PREVIOUS FILE CATALOG IMAGE
 N1BUF    BSS    N1BUFL      VSN TAPE CATALOG BUFFER
 N2BUF    BSS    N2BUFL      USER NAME TAPE CATALOG BUFFER
 N3BUF    BSS    N3BUFL      TAPE FILE TAPE CATALOG BUFFER
 N4BUF    BSS    N4BUFL      ALTERNATE USER NAME TAPE CATALOG BUFFER
 RBUF     BSS    RBUFL       REWIND FILE BUFFER
 REC1     BSS    100B        IMAGE OF FIRST TAPE CATALOG FILE RECORD
 TAVS     BSS    TAVSL       TABLE OF ASSIGNED VSNS
 TBUF     BSS    SBUFL       TERMINAL INTERRUPT FILE BUFFER
 TSMC     EQU    REC1+TBHL+TMSM  *MT/NT* SCRATCH COUNT
 TSCC     EQU    REC1+TBHL+TMSC  *CT* SCRATCH COUNT
 TSAC     EQU    REC1+TBHL+TMSA  *AT* SCRATCH COUNT
 TTCS     EQU    REC1+TBHL+TMCT  TAPE CATALOG SIZE
 TSST     BSS    TSTL        IMAGE OF SYSTEM TABLE
 TFMN     EQU    TSST+TMFM   FAMILY NAME
 TSTT     EQU    TFMN        STATUS WORD
 TIDM     EQU    TSST+TMID   MACHINE ID
 TCMB     EQU    TSST+TMMB   MESSAGE BUFFER
 TVUN     EQU    TSST+TMUN   VALIDATED USERS
 TLFM     EQU    TSST+TMLF   LINKED FAMILY NAME
 TAFM     EQU    TSST+TMPA   PERMITTED ALTERNATE FAMILIES
 SBUF     BSS    SBUFL       SCRATCH FILE BUFFER
 SSBUF    BSS    FBUFL       MACHINE READABLE/SOURCE FILE BUFFER
 UBUF     BSS    UBUFL       ALTERNATE USER ENTRY BUFFER
 VBUF     BSS    VBUFL       VSN ENTRY BUFFER
 WBUF     BSS    WBUFL       WORKING BUFFER
 HBUF     BSS    HBUFL       HOLD BUFFER
 BUF1E    BSS    0           END OF MAIN PROGRAM BUFFERS
          TITLE  PRESET AREA.
          SPACE  4
          ORG    BUF1        OVERWRITTEN BY ALL BUFFERS EXCEPT *IBUF*
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCWTS
*CALL     COMCZAP
          SPACE  4
          QUAL   PRESET
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMSPFM
 PRS      SPACE  4,10
**        PRS - PRESET *TFSP* AND *TFSPE*.
*
*         EXIT   TO *TFS*.
 
 
 PRS28    RJ     ZAP         ENTER *Z* DIRECTIVES INTO INPUT BUFFER
          EQ     TFS         ENTER MAIN PROGRAM
 
 BUF2     BSS    0           CAN BE OVERWRITTEN BY *IBUF*
 
*         ENTRY TO *TFSP*.
 
 TFSP     SB1    1           ENTRY
          RJ     ZFN         ZERO OUT FILE NAMES IN FETS
          MOVE   PRSAL,PRSA,/KFAMLS/TFSPE  CLEAR *TFSPE* MESSAGE
          RJ     GOT         GET ORIGIN TYPE
          SX1    X6-SYOT
          ZR     X1,PRS1     IF SYSTEM ORIGIN
          SX6    B0          DISABLE *FM* PARAMETER
          SA6    TPARSY
          SA6    TOPOK       DISABLE *OP=K*
 PRS1     SB5    TPAR        SET PARAMETER TABLE ADDRESS
          SA1    ACTR        SET NUMBER OF ARGUMENTS
          SB4    X1
          SA4    ARGR        SET START OF ARGUMENTS
          RJ     ARG         PROCESS ARGUMENTS
          SB5    MPER        SET ERROR MESSAGE ADDRESS
          NZ     X1,ABT      IF ARGUMENT ERROR
          SA1    LF
          ZR     X1,PRS2     IF NOT LOCAL FILE MODE
          SA1    FM
          SA4    =C*FM*      SET PARAMETER NAME
          NZ     X1,ABT      IF *FM* SPECIFIED
 PRS2     MX0    42          SEARCH FOR OPTION
          SRCHTAB  TOPO,OP
          ZR     X4,PRS3     IF OPTION FOUND
          SB5    MILO        SET ERROR MESSAGE ADDRESS
          BX4    X2          SET OPTION NAME
          EQ     ABT         ABORT WITH ERROR MESSAGE
 
 PRS3     BX6    -X0*X3      SET *OP* OPTION
          SA6    OP
          SX1    X6-IOPT
          ZR     X1,PRS5     IF *OP=I*
          SETFET I,(LFN=B0)  SET *I=0*
          EQ     PRS5        CHECK FILE NAMES
 
*         ENTRY TO *TFSPE*.
 
 TFSPE    SB1    1           ENTRY
          RJ     GOT         GET ORIGIN TYPE
          SX1    X6-SYOT
          ZR     X1,PRS4     IF SYSTEM ORIGIN
          ABTMSG MILA        ABORT *TFSP*
 
 PRS4     RJ     ZFN         ZERO OUT FILE NAMES IN FETS
          SA1    =10H   *TFSPE*  SET NAME OF PROGRAM IN K-DISPLAY
          BX6    X1
          SA6    /KLEFT/PROGRAM
          SA6    /KRIGHT/PROGRAM
          SA6    NPGB        SET NAME OF PROGRAM IN PAGE HEADER
          SX6    KOPT        SET *OP=K*
          SA6    OP
          SETFET I,(LFN=B0)  SET *I=0*
          SX6    B1          SET *TFSPE* FLAG
          SA6    TE
          SB5    TPAE        SET PARAMETER TABLE ADDRESS
          SA1    ACTR        SET NUMBER OF ARGUMENTS
          SB4    X1
          SA4    ARGR        SET START OF ARGUMENTS ADDRESS
          RJ     ARG         PROCESS ARGUMENTS
          SB5    MPER        SET ERROR MESSAGE ADDRESS
          NZ     X1,ABT      IF ARGUMENT ERRORS
 
*         PROCESS FILE NAMES.
 
 PRS5     RJ     GSF         GET SCRATCH FILE NAME
          SX1    B1          SET TERMINAL INTERRUPT FILE NAME
          BX6    X6+X1
          SA6    T
          SA1    OT          CHECK ORIGIN TYPE
          SX1    X1-TXOT
          NZ     X1,PRS6     IF NOT INTERACTIVE ORIGIN
          REQUEST  A6,TT,NOMSG  ASSIGN TO TERMINAL
          EQ     PRS7        REDUCE QUEUE PRIORITY
 
 PRS6     SA1    LF
          ZR     X1,PRS8     IF NOT LOCAL FILE MODE
 PRS7     SETRNR  OPROLL     REDUCE QUEUE PRIORITY
 PRS8     SA1    LF
          ZR     X1,PRS10    IF NOT LOCAL FILE MODE
          SA1    TE
          NZ     X1,PRS10    IF *TFSPE*
          MX0    42          CHECK TAPE CATALOG FILE NAMES
          SA1    N
          BX1    X0*X1
          NZ     X1,PRS11    IF NEW FILE NAME SPECIFIED
          SA1    P
          BX1    X0*X1
          NZ     X1,PRS9     IF OLD FILE NAME SPECIFIED
          SETFET N,(LFN==C*NEW*)  SET NEW TAPE CATALOG FILE NAME
          EQ     PRS11       SET REMAINING FETS
 
 PRS9     SETFET N,(LFN=P)   SET NEW TAPE CATALOG FILE NAME
          EQ     PRS11       SET REMAINING FETS
 
 PRS10    SETFET P,(LFN=B0)  SET OLD TAPE CATALOG FILE NAME
          SETFET N,(LFN==C*"TMFC"*)  SET NEW TAPE CATALOG FILE NAME
 PRS11    SA1    LF
          NZ     X1,PRS12    IF LOCAL FILE MODE
          SA1    TE
          NZ     X1,PRS12    IF *TFSPE*
          SETFET N1,(LFN=B0) SET FILE NAME FOR FETS
          SETFET N2,(LFN=B0)
          SETFET N3,(LFN=B0)
          SETFET N4,(LFN=B0)
          EQ     PRS13       SET TAPE CATALOG IMAGES
 
 PRS12    SETFET N1,(LFN=N)  SET FILE NAMES FOR FETS
          SETFET N2,(LFN=N)
          SETFET N3,(LFN=N)
          SETFET N4,(LFN=N)
 PRS13    SB5    MFNC        PRESET ERROR MESSAGE ADDRESS
          MX0    42          COMPARE TAPE CATALOG FILE NAMES
          SA3    P
          SA4    N
          BX3    X3-X4
          BX3    X0*X3
          SA2    PRSB        PRESET TABLE ADDRESS
          NZ     X3,PRS14    IF TAPE CATALOG NAMES DO NOT MATCH
          SA2    A2+B1       RESET TABLE ADDRESS
 PRS14    ZR     X2,PRS17    IF END OF TABLE
          SA4    X2          CHECK FILE NAME
          BX4    X0*X4
          ZR     X4,PRS16    IF NO FILE NAME
          SA1    A2+B1
 PRS15    ZR     X1,PRS16    IF END OF TABLE
          SA3    X1          COMPARE FILE NAMES
          BX3    X3-X4
          BX3    X0*X3
          ZR     X3,ABT      IF FILE NAME CONFLICT
          SA1    A1+B1
          EQ     PRS15       CHECK NEXT FET
 
 PRS16    SA2    A2+B1
          EQ     PRS14       CHECK NEXT FILE NAME
 
*         PRESET TABLES IN MAIN PROGRAM.
 
 PRS17    SB3    7           SPACE FILL COMMAND IMAGE
 PRS18    SA1    CCDR+B3
          RJ     SFN         SPACE FILL NAME
          SA6    A1
          SB3    B3-B1
          PL     B3,PRS18
          MOVEBIT  CCDR,NPGF,480,,41  MOVE IMAGE TO PAGE HEADER
          MACHID MI          SET MACHINE ID
          PDATE  PD          SET PACKED DATE AND TIME
          MOVEBIT  PD,DFIC+/CAT/CDATE,36,35,35  SET DEFAULT DATES
          MOVEBIT  PD,DFIC+/CAT/MDATE,36,35,35
          MOVEBIT  PD,DFIC+/CAT/ADATE,36,35,35
          MOVEBIT  PD,DAUC+/CAT/AADATE,36,35,35
          SA1    PD          GET PACKED TIME
          SX1    X1
          SB3    100
          RJ     UDT         UNPACK TIME
          SA6    DT          SAVE DISPLAY TIME
          SA1    PD          GET PACKED DATE
          AX1    18
          SB3    70
          RJ     UDT         UNPACK DATE
          SA6    DD          SAVE DISPLAY DATE
          DATE   NPGD        MOVE DATE INTO PAGE HEADER
          CLOCK  NPGD+1      MOVE TIME INTO PAGE HEADER
          SA1    TE
          ZR     X1,PRS19  IF NOT *TFSPE*
          MOVE   2,NPGD,/KFAMLS/TDATE  MOVE DATE/TIME TO MESSAGE
 PRS19    JDATE  JD          SET JULIAN DATE
          SA1    JD
          BX6    X1
          LX6    30
          SA6    A1
          MOVEBIT  JD,DFIC+/CAT/RT,30  SET DEFAULT DATES
          MOVEBIT  JD,DFIC+/CAT/CR,30,,29
          SA2    L
          RJ     CFS         CHECK FILE STATUS OF OUTPUT
          SA6    OS
          NG     X6,PRS20    IF MASS STORAGE OUTPUT
          SA1    =0          SET TERMINAL OUTPUT FOR AUDIT LISTING
          MOVEBIT  A1,/ALS/EOL1,12,,11
          SA1    =0
          MOVEBIT  A1,/ALS/EOL2,12,,11
          MOVEBIT  (=0),/PFIA/EOL1,/PFIAC/EOL1*6,,/PFIAU/EOL1
          MOVEBIT  (=0),/PFIA/EOL2,/PFIAC/EOL2*6,,/PFIAU/EOL2
 
*         PROCESS FAMILY NAME.
 
 PRS20    RJ     SFL         SET FAMILY NAME
          RJ     SFN         SPACE FILL NAME
          SA6    NPGC        SET FAMILY NAME IN PAGE HEADER
          BX1    X6          SET FAMILY NAME IN MACHINE READABLE ENTRY
          MOVEBIT  A1,/MLS/FAMILY,/MLSC/FAMILY*6,,/MLSU/FAMILY
          SA1    TE
          NZ     X1,PRS24    IF *TFSPE*
          SA1    LF
          ZR     X1,PRS23    IF NOT LOCAL FILE MODE
 
*         PROCESS *TFSP* - LOCAL FILE MODE.
 
          MX0    42          CHECK OLD TAPE CATALOG NAME
          SA1    P
          BX1    X0*X1
          NZ     X1,PRS21    IF FILE NAME SPECIFIED
          RJ     CDN         COPY DEFAULT NEW TAPE CATALOG FILE
          REPRIEVE  RPVA,SET,237B  SET EXTENDED REPRIEVE
          EQ     PRS26       INITIALIZE FILES
 
 PRS21    RJ     CPN         COPY OLD TAPE CATALOG TO NEW
          ZR     X4,PRS22    IF NOT EMPTY TAPE CATALOG
          ABTMSG METC        ABORT *TFSP*
 
 PRS22    RJ     RFP         READ FIRST PRU
          RJ     CIL         CLEAR INTERLOCKS ON FILE
          REPRIEVE  RPVA,SET,237B  SET EXTENDED REPRIEVE
          EQ     PRS26       INITIALIZE FILES
 
*         PROCESS *TFSP* - NOT LOCAL FILE MODE.
 
 PRS23    REPRIEVE  RPVA,SET,237B  SET EXTENDED REPRIEVE
          RJ     SIL         SET INTERLOCK ON FILE
          ZR     X4,PRS26    IF INTERLOCK SET
          ABTMSG X6          ABORT *TFSP*
 
*         PROCESS *TFSPE*.
 
 PRS24    REPRIEVE  RPVA,SET,237B  SET EXTENDED REPRIEVE
          SB3    PTWR        SELECT WRITE MODE REGULAR ATTACH
          RJ     ATT         ATTACH TAPE CATALOG FILE
          ZR     X4,PRS25    IF FILE ATTACHED
          ABTMSG MFNA        ABORT *TFSP*
 
 PRS25    RJ     CIL         CLEAR INTERLOCKS ON FILE
          SX6    B1          SET LOCAL FILE MODE FLAG
          SA6    LF
          RJ     CCF         CHECK COPY FILE
 PRS26    RJ     INF         INITIALIZE FILES
          SX6    B0          CHECK IF NO VERIFY MODE IS VALID
          SA1    LF
          ZR     X1,PRS27    IF NOT LOCAL FILE MODE
          SA1    P
          LJUST  X1,X1,42,59
          NZ     X1,PRS27    IF NOT *P=0*
          SA1    NV          KEEP NO VERIFY STATUS
          SX6    X1
 PRS27    SA6    NV          SET/CLEAR NO VERIFY STATUS
          SA1    OP          CHECK OPTION
          SX1    X1-ZOPT
          NZ     X1,TFS      IF NOT *OP=Z*
          SX2    I           SET INPUT FET ADDRESS
          EQ     PRS28       GET *Z* DIRECTIVES
 
 PRSA     BSS    0           CLEAR *TFSPE* MESSAGE IMAGE
          DUP    /KFAMLS/TFSPEL-1
          KLINE  (          )
          ENDD
          KLINE  (),E
 PRSAL    EQU    *-PRSA
 
 PRSB     BSS    0           TABLE OF FET ADDRESSES
          CON    P           OLD TAPE CATALOG FILE FET
          CON    N           NEW TAPE CATALOG FILE FET
          CON    I           INPUT FILE FET
          CON    L           OUTPUT FILE FET
          CON    S           SOURCE FILE FET
          CON    SS          MACHINE READABLE FILE FET
          CON    COPF        COPY FILE FOR *TFSPE*
          CON    0           END OF TABLE
 TFR      SPACE  4,10
**        TFR - PROCESS *TFSPR* COMMAND.
*
*         EXIT   TO END7 IF NO ERROR.
*                TO ABT IF ERROR.
*
*         USES   A - 1, 4, 6, 7.
*                X - 0, 1, 4, 6, 7.
*                B - 4, 5.
*
*         CALLS  ABT, ARG, END, GOT, SFL.
*
*         MACROS ABTMSG, MESSAGE, SYSTEM.
 
 
 TFSPR    BSS    0           ENTRY
          SB1    1
          RJ     GOT         GET ORIGIN TYPE
          SX6    X6-SYOT
          ZR     X6,TFR1     IF SYSTEM ORIGIN
          ABTMSG MILA        * INCORRECT ACCESS.*
 
 TFR1     RJ     ZFN         ZERO OUT FILE NAMES
          SA1    ACTR        READ ARGUMENT COUNT
          SA4    ARGR        SET ARGUMENT ADDRESS
          SB4    X1          SET ARGUMENT COUNT
          SB5    TPPR        SET ARGUMENT TABLE ADDRESS
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,TFR2     IF NO ERROR IN ARGUMENTS
          ABTMSG MPER        * PARAMETER ERROR.*
 
 TFR2     RJ     SFL         SET FAMILY NAME
          SX6    ISFS*10B    SET SUBFUNCTION CODE
          SA6    N
          SX6    30000B      SET PROCESS DOWN MACHINES OPTION
          SX7    TFRA        SET ERROR MESSAGE ADDRESS
          SA6    N+TFES
          SA7    N+5
          SYSTEM TFM,R,N,SSJF*100B  CLEAN UP CATALOG
          SA1    N           CHECK ERROR CODE
          MX0    -9
          LX0    17-8
          BX1    -X0*X1
          ZR     X1,END7     IF NO ERROR
          MESSAGE  TFRA      ISSUE ERROR MESSAGE
          EQ     ABT         ABORT
 
 TFRA     BSSZ   4           ERROR MESSAGE
 ABT      SPACE  4,10
**        ABT - *PRESET* ABORT PROCESSOR.
*
*         ENTRY  (B5) = ERROR MESSAGE ADDRESS.
*                (X4) = IMAGE TO INSERT IN ERROR MESSAGE.
*
*         EXIT   *TFSP* ABORTED.
 
 
 ABT      BSS    0           ENTRY
          MX0    42          GET LAST SEVEN CHARACTERS OF IMAGE
          BX1    X0*X4
          SB3    B5          SET ERROR MESSAGE ADDRESS
          SB2    1R$
          RJ     SNM         SET NAME IN MESSAGE
          ABTMSG B5          ABORT *TFSP*
 DMESS    SPACE  4,10
**        DAYFILE ERROR MESSAGES.
 
 
 MCRC     DATA   C$ *CF* PARAMETER REQUIRED WITH *CLEAR*.$
 MERC     DATA   C$ CATALOG ERROR REQUIRED WITH *CLEAR*.$
 METC     DATA   C* EMPTY TAPE CATALOG FILE.*
 MFNC     DATA   C* FILE NAME CONFLICT - $$$$$$$.*
 MILA     DATA   C* INCORRECT ACCESS.*
 MILO     DATA   C* INCORRECT OPTION - $$$$$$$.*
 MPER     DATA   C* PARAMETER ERROR - $$$$$$$.*
 FETS     SPACE  4,10
**        FILE ENVIRONMENT TABLES.
 
 
 P        BSS    0           OLD TAPE CATALOG FILE
 OLD      FILEB  PBUF,TBUFL,(FET=8),EPR
 
 N        BSS    0           NEW TAPE CATALOG FILE
 NEW      FILEB  NBUF,TBUFL,(FET=16),EPR
          REWORD N+CFPW,(42/,18/PBUF)
 WORKING  SPACE  4,10
**        WORKING STORAGE FOR PRESET.
 
 
 COPF     CON    0           COPY FILE NAME FOR *TFSPE*
 CLR      CON    0           *CLEAR* OPTION FOR *TFSPE*
 TOPO     SPACE  4,10
**        TOPO - TABLE OF OPTIONS FOR *OP* PARAMETER.
*
*         ENTRY  ONE WORD PER OPTION.
*                42/OP,18/VALUE
*
*                OP = OPTION LEFT JUSTIFIED.
*                VALUE = NUMERIC VALUE OF OPTION.
*
*                TABLE TERMINATED BY A ZERO WORD.
 
 
 TOPO     BSS    0
          VFD    42/0LI,18/IOPT  *I* OPTION
          VFD    42/0LZ,18/ZOPT  *Z* OPTION
 TOPOK    VFD    42/0LK,18/KOPT  *K* OPTION
*         CON    0           (NON-SYSTEM ORIGIN)
          CON    0           END OF TABLE
 TPAE     SPACE  4,10
**        TPAE - TABLE OF COMMAND PARAMETERS FOR *TFSPE*.
*
*         ENTRY  ONE WORD PER PARAMETER FORMATTED FOR *COMCARG*.
*
*                TABLE TERMINATED BY A ZERO WORD.
 
 
 TPAE     BSS    0           *TFSPE* PARAMETERS
 L        ARG    L,L         OUTPUT FILE
 S        ARG    S,S         SOURCE FILE
 SS       ARG    SS,SS       MACHINE READABLE FILE
 FM       ARG    FM,FM,400B  FAMILY
 CF       ARG    (=0LZFCCOPY),COPF  COPY FILE
 CLEAR    ARG    (-=1),CLR   CLEAR CATALOG OPTION
          CON    0           END OF TABLE
 TPAR     SPACE  4,10
**        TPAR - TABLE OF COMMAND PARAMETERS FOR *TFSP*.
*
*         ENTRY  ONE WORD PER PARAMETER FORMATTED FOR *COMCARG*.
*
*                TABLE TERMINATED BY A ZERO WORD.
 
 
 TPAR     BSS    0           *TFSP* PARAMETERS
 I        ARG    I,I         INPUT FILE
 N        ARG    N,N,400B    NEW TAPE CATALOG FILE
 P        ARG    P,P         OLD TAPE CATALOG FILE
 OP       ARG    OP,OP,400B  INPUT OPTION
 A        ARG    (-=1),AB    ABORT OPTION
 NV       ARG    (-=1),NV    NO VERIFY OPTION
 RT       ARG    (-=1),RT    RETRY ON UTILITY ACTIVE OPTION
 LF       ARG    (=-1),LF    LOCAL FILE OPTION
 L        ARG    L,L         OUTPUT FILE
 S        ARG    S,S         SOURCE FILE
 SS       ARG    SS,SS       MACHINE READABLE FILE
 TPARSY   BSS    0           SYSTEM ORIGIN PARAMETERS
 FM       ARG    FM,FM,400B  FAMILY
*         CON    0           (NON-SYSTEM ORIGIN)
          CON    0           END OF TABLE
 TPPR     SPACE  4,10
**        TPPR - TABLE OF COMMAND PARAMETERS FOR *TFSPR*.
 
 
 TPPR     BSS    0
 FM       ARG    FM,FM,400B  FAMILY.
          ARG
 ATT      SPACE  4,10
**        ATT - ATTACH FILE.
*
*         ENTRY  (B3) = 0 FILE MODE.
*                FAST ATTACH PERFORMED IF UPDATE OR READ/UPDATE MODE.
*                REGULAR ATTACH PERFORMED IF WRITE MODE.
*
*         EXIT   (X4) = 0 IF FILE IS ATTACHED.
*                (WBUF - WBUF+100B) = FIRST PRU OF FILE.
*
*         USES   X - 1, 4, 6.
*                A - 4, 6.
*
*         CALLS  RFP.
*
*         MACROS ATTACH, RJUST, ROLLOUT.
 
 
 ATT4     RJ     RFP         READ FIRST PRU
          SX4    B0          FLAG NO ERRORS
 
 ATT      SUBR               ENTRY/EXIT
          SX6    B3          SAVE MODE
          SA6    ATTA
 ATT1     SX1    B3-PTWR
          ZR     X1,ATT2     IF WRITE MODE
          ATTACH N,,,,ATTA,,,IP,FA  ATTACH FAST ATTACH FILE
          EQ     ATT3        CHECK IF FILE ATTACHED
 
 ATT2     ATTACH N,,,,ATTA,,,IP  ATTACH LOCAL FILE
 ATT3     SA4    N           CHECK IF FILE ATTACHED
          RJUST  X4,X4,8,17
          ZR     X4,ATT4     IF FILE ATTACHED
          SX1    X4-/ERRMSG/FBS
          NZ     X1,ATTX     IF NOT FILE BUSY
          ROLLOUT  =10
          EQ     ATT1        RETRY ATTACH
 
 ATTA     CON    PTRU        MODE OF ATTACH
 CCF      SPACE  4,20
**        CCF - CHECK COPY FILE.
*
*         EXIT   CURRENT TAPE CATALOG FILE COPIED TO COPY FILE IF *CF*
*                SPECIFIED ON COMMAND.
*                CURRENT TAPE CATALOG REWRITTEN AS EMPTY IF *CLEAR*
*                SPECIFIED ON COMMAND.
*
*         ERRORS ABORT WITH *MCRC* ERROR MESSAGE IF *CLEAR* SPECIFIED
*                WITHOUT *CF*.
*                ABORT WITH *MERC* ERROR MESSAGE IF *CLEAR* SPECIFIED
*                WITHOUT CATALOG ERROR.
*                ABORT IF UNABLE TO DEFINE COPY FILE.
*
*         USES   X - 0, 1, 5.
*                A - 1.
*
*         CALLS  CDN.
*
*         MACROS ABTMSG, DEFINE, MOVEBIT, READEI, READW, RETURN,
*                REWIND, SETFET, WRITER, WRITEW.
 
 CCF4     ABTMSG X5          ABORT PROGRAM
 
 CCF      SUBR               ENTRY/EXIT
          SA1    CLR
          ZR     X1,CCF1     IF *CLEAR* NOT SPECIFIED
          SA1    COPF
          SX5    MCRC        **CF* PARAMETER REQUIRED WITH *CLEAR**
          ZR     X1,CCF4     IF NO COPY FILE
          SX0    FETS        CHECK FOR CATALOG ERROR
          SA1    SYBL+TMFM
          BX1    X0*X1
          SX5    MERC        *CATALOG ERROR REQUIRED WITH *CLEAR**
          ZR     X1,CCF4     IF NO CATALOG ERROR
 CCF1     SA1    COPF
          ZR     X1,CCFX     IF NO COPY FILE
          MOVEBIT  A1,P,42   CREATE COPY FILE
          RETURN P,R
          SETFET P,(ERA=CCFA),(DTY=B0)
          DEFINE P,,,,,,,,,IP
          MX0    -8          CHECK FOR ERROR
          SA1    P
          AX1    10
          BX1    -X0*X1
          SX5    CCFA        *PFM* ERROR MESSAGE
          NZ     X1,CCF4     IF ERROR
          REWIND P,R         COPY TAPE CATALOG FILE
          REWIND N,R
          READEI N,R         INITIATE READ
 CCF2     READW  N,CCFC,CCFCL
          NG     X1,CCF3     IF EOI
          WRITEW P,CCFC,CCFCL
          EQ     CCF2        CONTINUE READ
 
 CCF3     SB7    B6-CCFC     COMPLETE RECORD
          WRITEW P,CCFC,B7
          WRITER P,R         WRITE EOR
          RETURN P
          SA1    CLR
          ZR     X1,CCFX     IF NOT *CLEAR* OPTION
          MOVE   100B,CCFB,BCW1  RESET FIRST PRU
          RJ     CDN         COPY DEFAULT TAPE CATALOG FILE
          EQ     CCFX        RETURN
 
 CCFA     BSS    4           *PFM* ERROR MESSAGE BLOCK
 CCFB     BSS    0           DEFAULT SYSTEM BLOCK FOR *CLEAR*
          LOC    0
 BWRT     VFD    6/RTSB,6/0,12/0,12/100B-TBHL,12/1,12/TBHL
 BWDT     VFD    24/0,36/
 BWRI     VFD    12/0,24/0,24/0
 BWUN     VFD    42/,18/0
          LOC    *O
          LOC    0
 TMFM     VFD    42/,18/FFTS+FETS  FOREIGN FAMILY, CATALOG ERROR
 TMID     VFD    12/,24/0,24/0
 TMCT     VFD    12/0,24/0,24/0
 TMSV     VFD    36/-0,24/0
 TMMB     DATA   38L CATALOG CLEARED BY *TFSPE*.
 TMUN     BSS    UNCL
          BSS    100B-TBHL-*
          LOC    *O
 
 CCFC     BSS    100B        WORKING BUFFER FOR COPY FILE
 CCFCL    EQU    *-CCFC      WORKING BUFFER LENGTH
 CDN      SPACE  4,10
**        CDN - COPY DEFAULT TAPE CATALOG FILE.
*
*         EXIT   (WBUF) COPIED TO NEW TAPE CATALOG FILE.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         MACROS MOVEBIT, REWIND, WRITER, WRITEW.
 
 
 CDN      SUBR               ENTRY/EXIT
          REWIND N,R         WRITE DEFAULT SYSTEM BLOCK
          MOVEBIT  MI,SYBL+TMID,12,11  SET MACHINE ID IN BLOCK
          MOVEBIT  CF,SYBL+TMFM,42  SET FAMILY NAME IN BLOCK
          SA1    PD          GET PACKED DATE/TIME
          BX6    X1
          SA6    BCW1+BWDT   SET DATE IN BUFFER CONTROL WORDS
          SA6    BCW2+BWDT
          SA6    BCW3+BWDT
          SA6    BCW4+BWDT
          SA6    BCW5+BWDT
          WRITEW N,WBUF,WBUFL
          WRITER N,R         WRITE EOR
          EQ     CDNX        RETURN
 CFS      SPACE  4,10
**        CFS - CHECK FILE STATUS.
*
*         ENTRY  (A2) = FET ADDRESS.
*                (X2) = FIRST WORD OF FET.
*
*         EXIT   (X6) = -1 IF MASS STORAGE FILE.
*                     = 0 IF NO FILE.
*                     = 1 IF TERMINAL FILE.
*
*         USES   X - 0, 2.
*
*         CALLS  STF.
 
 CFS1     SX6    B1          SET TERMINAL FILE STATUS
 
 CFS      SUBR               ENTRY/EXIT
          MX0    42          CHECK FILE NAME
          BX6    X0*X2
          ZR     X6,CFSX     IF NO FILE NAME
          SX2    A2
          RJ     STF         SET TERMINAL FILE
          ZR     X6,CFS1     IF TERMINAL FILE
          SX6    -B1         SET MASS STORAGE FILE STATUS
          EQ     CFSX        RETURN
 CIL      SPACE  4,10
**        CIL - CLEAR INTERLOCKS ON FILE.
*
*         ENTRY  (WBUF - WBUF+100B) = FIRST PRU OF FILE.
*
*         EXIT   UTILITY INTERLOCKS CLEARED.
*
*         CALLS  WFP.
*
*         MACROS MOVEBIT.
 
 
 CIL      SUBR               ENTRY/EXIT
          MOVEBIT  (=0),SYBL+TMFM,1,,0  CLEAR INTERLOCKS
          MOVEBIT  (=0),SYBL+TMID,24,,47
          MOVEBIT  (=0),WBUF+BWUN,UNKL*6
          RJ     WFP         REWRITE FIRST PRU
          EQ     CILX        RETURN
 CPN      SPACE  4,10
**        CPN - COPY OLD TAPE CATALOG TO NEW FILE.
*
*         EXIT   (X4) = 0 IF OLD TAPE CATALOG FILE COPIED TO NEW.
*
*         USES   A - 1, 2.
*                B - 7.
*                X - 1, 2.
*
*         CALLS  GFL.
*
*         MACROS READEI, READW, REWIND, WRITER, WRITEW.
 
 
 CPN      SUBR               ENTRY/EXIT
          SA2    P
          RJ     GFL         GET FILE LENGTH
          SX4    B1
          ZR     X1,CPNX     IF ZERO-LENGTH FILE
          MX0    42          COMPARE FILE NAMES
          SA1    N
          SA2    P
          BX1    X1-X2
          BX4    X0*X1
          ZR     X4,CPNX     IF SAME FILE NAMES
          REWIND N,R         COPY OLD TAPE CATALOG FILE TO NEW
          REWIND P,R
          READEI P,R         INITIATE READ
 CPN1     READW  P,WBUF,WBUFL
          NG     X1,CPN2     IF EOI
          WRITEW N,WBUF,WBUFL  WRITE DATA
          EQ     CPN1        CONTINUE READ
 
 CPN2     SB7    B6-WBUF     COMPLETE RECORD
          WRITEW N,WBUF,B7
          WRITER N,R         WRITE EOR
          SX4    B0
          EQ     CPNX        RETURN
 GFI      SPACE  4,10
**        GFI - GET FILE INFORMATION.
*
*         ENTRY  (X2) = FIRST WORD OF FET.
*
*         EXIT   (X2) = ADDRESS OF *FILINFO* BLOCK.
*
*         USES   A - 6.
*                X - 0, 2, 6.
*
*         MACROS FILINFO.
 
 
 GFI      SUBR               ENTRY/EXIT
          MX0    42          SET FILE NAME IN *FILINFO* BLOCK
          BX2    X0*X2
          SX6    50001B
          BX6    X2+X6
          SA6    GFIA
          FILINFO  GFIA      GET FILE INFORMATION
          EQ     GFIX        RETURN
 
 GFIA     BSS    5           *FILINFO* BLOCK
 GFL      SPACE  4,10
**        GFL - GET FILE LENGTH.
*
*         ENTRY  (X2) = FIRST WORD OF FET.
*
*         EXIT   (X1) = NUMBER OF PRUS IN FILE.
*
*         USES   A - 1.
*                X - 1.
*
*         CALLS  GFI.
*
*         MACROS RJUST.
 
 
 GFL      SUBR               ENTRY/EXIT
          RJ     GFI         GET FILE INFORMATION
          SA1    X2+3        GET FILE LENGTH
          RJUST  X1,X1,24,59
          EQ     GFLX        RETURN
 GOT      SPACE  4,10
**        GOT - GET JOB ORIGIN.
*
*         ENTRY  NONE.
*
*         EXIT   (X6) = ORIGIN TYPE.
*                (OT) = ORIGIN TYPE.
*
*         USES   A - 1, 6.
*                X - 1, 2.
 
 
 GOT      SUBR               ENTRY/EXIT
          MX0    -12         GET ORIGIN TYPE
          SA1    JOPR
          AX1    24
          BX6    -X0*X1
          SA6    OT
          EQ     GOTX        RETURN
 GSF      SPACE  4,10
***       GSF - GET SCRATCH FILE NAME.
*
*         EXIT   (X6) = UNASSIGNED SCRATCH FILE NAME.
*
*         USES   A - 1, 6.
*                X - 1, 4, 6.
*
*         MACROS PDATE, STATUS.
 
 
 GSF4     SX1    B1          SET FILE NAME IN FET
          BX6    X6+X1
          SA6    Z
          STATUS Z           CHECK FILE STATUS
          SX6    7776B
          SA1    Z
          BX6    X6*X1
          NZ     X6,GSF1     IF FILE EXISTS
          MX6    42          GET FILE NAME
          BX6    X6*X1
 
 GSF      SUBR               ENTRY/EXIT
 GSF1     SA1    GSFA
          NZ     X1,GSF2     IF BINARY NUMBER EXISTS
          SA1    GSFC        SET INITIAL BINARY
          BX6    X1
          SA6    GSFA
          PDATE  GSFB        GET PACKED DATE AND TIME
          MX6    -6          RANDOMIZE BINARY
          SA1    GSFB
          BX6    -X6*X1
          LX6    15
          SA1    GSFA
          BX6    X1-X6
          SA6    A1
          BX1    X6
 GSF2     SX6    B1          RESET BINARY
          IX6    X1-X6
          SA6    A1
 
*         CONVERT BINARY TO FILE NAME.
 
          SX6    B0
 GSF3     ZR     X1,GSF4     IF END OF BINARY
          MX4    -5          CONVERT 5 BINARY BITS TO CHARACTER CODE
          BX4    -X4*X1
          SX4    X4+B1
          BX6    X6+X4
          LX6    -6+60
          AX1    5
          EQ     GSF3        GET NEXT CHARACTER CODE
 
 GSFA     CON    0           BINARY NUMBER
 GSFB     CON    0           PACKED DATE AND TIME
 GSFC     CON    317777777777B
 
 Z        BSS    0           *STATUS* FET
 Z555555  FILEB  0,0,(FET=5)
 INF      SPACE  4,10
**        INF - INITIALIZE FILES.
*
*         EXIT   INPUT, OUTPUT, SOURCE, MACHINE READABLE, AND
*                NEW TAPE CATALOG FILES SET WITH ID=0.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  CFS, GFL.
*
*         MACROS SETID.
 
 
 INF      SUBR               ENTRY/EXIT
          SA2    I           GET INPUT FILE
          RJ     CFS         CHECK FILE STATUS
          SA6    IS          SAVE FILE STATUS
          SA1    OS          SAVE FILE STATUS
          PL     X1,INF1     IF TERMINAL FILE OR NO FILE
          SA2    L
          RJ     GFL         GET FILE LENGTH
          NZ     X1,INF1     IF NOT ZERO-LENGTH FILE
          SETFS  L,0         FORCE ID OF ZERO
 INF1     SA2    S           GET SOURCE FILE
          RJ     CFS         CHECK FILE STATUS
          PL     X6,INF2     IF TERMINAL FILE OR NO FILE
          SA2    S
          RJ     GFL         GET FILE LENGTH
          NZ     X1,INF2     IF NOT ZERO-LENGTH FILE
          SETFS  S,0         FORCE ID OF ZERO
 INF2     SA2    SS          GET MACHINE READABLE FILE
          RJ     CFS         CHECK FILE STATUS
          PL     X6,INF3     IF TERMINAL FILE OR NO FILE
          SA2    SS
          RJ     GFL         GET FILE LENGTH
          NZ     X1,INF3     IF NOT ZERO-LENGTH FILE
          SETFS  SS,0
 INF3     SA1    LF
          ZR     X1,INFX     IF NOT LOCAL FILE MODE
          SETFS  N,0         FORCE ID FOR NEW TAPE CATALOG TO ZERO
          EQ     INFX        RETURN
 RFP      SPACE  4,10
**        RFP - READ FIRST PRU OF FILE.
*
*         EXIT   (WBUF - WBUF+100B) = FIRST PRU OF FILE.
*
*         USES   A - 6.
*                X - 6.
*
*         MACROS READW, RECALL, RPHRLS.
 
 
 RFP      SUBR               ENTRY/EXIT
          RECALL N           READ FIRST PRU OF FILE
          SX6    RFPA
          SA6    N+5
          RPHRLS X2,R
          READW  X2,WBUF,100B
          EQ     RFPX        RETURN
 
 RFPA     CON    1           TABLE OF PRUS TO READ
          CON    0
 SFL      SPACE  4,10
**        SFL - SET FAMILY NAME.
*
*         EXIT   (X1) = FAMILY NAME.
*                (CF) = CURRENT (ORIGINAL) FAMILY NAME.
*                (FM) = SPECIFIED FAMILY NAME.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         CALLS  CFM.
*
*         MACROS GETPFP.
 
 
 SFL1     BX6    X1          SET FAMILY NAME
          SA6    FM
 
 SFL      SUBR               ENTRY/EXIT
          GETPFP SFLA        GET PERMANENT FILE PARAMETERS
          SA1    SFLA        GET CURRENT FAMILY NAME
          BX6    X1
          SA6    CF
          SA2    FM
          ZR     X2,SFL1     IF NO ALTERNATE FAMILY
          BX1    X2
          RJ     CFM         CHANGE FAMILY
          SA1    FM
          EQ     SFLX        RETURN
 
 SFLA     BSS    3           PARAMETER BLOCK
 SIL      SPACE  4,10
**        SIL - SET INTERLOCK ON FILE.
*
*         EXIT   (X4) = 0 IF INTERLOCK SET.
*                (X6) = ERROR MESSAGE ADDRESS IF INTERLOCK NOT SET.
*
*         USES   A - 1, 2.
*                X - 0, 1, 2, 3, 4, 6.
*
*         CALLS  ATT, GFI, RCW, WFP.
*
*         MACROS MOVEBIT, RETURN, RJUST, ROLLOUT, SRCHTAB.
 
 
 SIL      SUBR               ENTRY/EXIT
 SIL1     SB3    PTRU        SELECT READ/UPDATE FAST ATTACH
          RJ     ATT         ATTACH FILE
          SX6    MFNA
          NZ     X4,SILX     IF FILE NOT FOUND
          RETURN N,R         RETURN FILE
          SA1    SYBL+TMFM   CHECK UTILITY INTERLOCK BIT
          RJUST  X1,X6,1,0
          SA1    WBUF+BWUN   CHECK USER NAME FIELD
          MX0    42
          BX1    X0*X1
          BX1    X1+X6
          ZR     X1,SIL3     IF NOT INTERLOCKED
 SIL2     SA1    RT
          SX6    MTCI
          SX4    B1          SET FLAG FOR INTERLOCK SET
          ZR     X1,SILX     IF NO RETRY REQUESTED
          ROLLOUT  =10
          EQ     SIL1        RETRY REQUEST
 
 SIL3     SA1    OT          CHECK ORIGIN
          SX1    X1-SYOT
          ZR     X1,SIL4     IF SYSTEM ORIGIN
          MX0    42          CHECK IF USER IS VALIDATED
          SRCHTAB  SYBL+TMUN,SSJ=+UIDS,UNCL
          SX6    MILA
          NZ     X4,SILX     IF USER NOT VALIDATED
 SIL4     SB3    PTUP        SELECT UPDATE MODE FAST ATTACH
          RJ     ATT         ATTACH FILE
          SX6    MFNA
          NZ     X4,SILX     IF FILE NOT FOUND
          SA1    SYBL+TMFM   CHECK UTILITY INTERLOCK BIT
          RJUST  X1,X6,1,0
          SA1    WBUF+BWUN   CHECK USER NAME FIELD
          MX0    42
          BX1    X0*X1
          BX1    X1+X6
          ZR     X1,SIL5     IF NOT INTERLOCKED
          RETURN N,R         RETURN FILE
          EQ     SIL2        CHECK IF RETRY
 
 SIL5     SX2    ESTP        READ EST POINTER
          RJ     RCW
          LX1    24          SET EST FWA
          SX3    X1
          SA2    N
          RJ     GFI         GET FILE INFORMATION
          SA2    X2+2        GET EST ORDINAL OF CATALOG
          MX0    -9
          SX4    ESTE
          LX2    12
          BX2    -X0*X2      EXTRACT EST ORDINAL
          IX2    X2*X4
          IX2    X2+X3       SET EST ADDRESS
          RJ     RCW         READ EST ENTRY
          MX0    -12
          LX1    59-52
          PL     X1,SIL6     IF NOT SHARED DEVICE
          LX1    52-59
          BX1    -X0*X1
          LX1    3
          SX2    X1+DULL     SET ADDRESS OF MST *DULL* WORD
          RJ     RCW         READ MACHINE INDEX
          MX0    -4          SET MACHINE INDEX-1
          LX1    -24
          BX6    -X0*X1
          SA6    MX
          MOVEBIT  MX,WBUF+BWUN,4,3,15   SET MACHINE INDEX-1
 SIL6     MOVEBIT  (=-0),WBUF+BWUN,UNKL*6  SET USER NAME INTERLOCK
          RJ     WFP         REWRITE FIRST PRU
          RETURN N,R         RETURN FILE
          SX4    B0
          EQ     SILX        RETURN
 WFP      SPACE  4,10
**        WFP - REWRITE FIRST PRU OF FILE.
*
*         ENTRY  (WBUF - WBUF+100B) = NEW FIRST PRU OF FILE.
*
*         MACROS REWIND, REWRITE, WRITEW.
 
 
 WFP      SUBR               ENTRY/EXIT
          REWIND N,R         REWRITE FIRST PRU
          REWRITE  X2,*
          WRITEW X2,WBUF,100B
          REWRITE  X2,R
          EQ     WFPX        RETURN
 ZFN      SPACE  4,10
**        ZFN - ZERO OUT FILE NAMES IN FETS.
*
*         EXIT   FILE NAMES IN FETS *N*, *SS*, *UB*, AND *VB* CLEARED.
*
*         MACROS SETFET.
 
 
 ZFN      SUBR               ENTRY/EXIT
          SETFET N,(LFN=B0)  CLEAR NEW TAPE CATALOG FILE NAME
          SETFET SS,(LFN=B0) CLEAR MACHINE READABLE FILE NAME
          SETFET VB,(LFN=B0) CLEAR VSN ENTRY BUFFER FET
          SETFET UB,(LFN=B0) CLEAR ALTERNATE USER NAME BUFFER FET
          EQ     ZFNX        RETURN
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCARG
*CALL     COMCLFM
*CALL     COMCPFM
*CALL     COMCSTF
 WBUF     SPACE  4,10
**        WBUF - WORKING BUFFER FOR TAPE CATALOG FILES.
*
*         PRESET WITH FIRST FOUR BLOCKS OF TAPE CATALOG FILE.
 
 
 WBUF     BSS    0
 
*         FIRST PRU - SYSTEM BLOCK.
 
 BCW1     BSS    0           BUFFER CONTROL WORD - BLOCK 1
          LOC    0
 BWRT     VFD    6/RTSB,6/0,12/0,12/100B-TBHL,12/1,12/TBHL
 BWDT     VFD    24/0,36/
 BWRI     VFD    12/0,24/0,24/0
 BWUN     VFD    42/,18/0
          LOC    *O
 SYBL     BSS    0           SYSTEM BLOCK
          LOC    0
 TMFM     VFD    42/,18/0
 TMID     VFD    12/,24/0,24/0
 TMCT     VFD    12/0,24/0,24/0
 TMSM     VFD    36/-0,24/0
 TMMB     BSSZ   MBML
 TMUN     BSSZ   UNCL
 TMLF     VFD    42/0,18/0
 TMPA     BSSZ   PAFL
 TMSC     VFD    36/-0,24/0
 TMSA     VFD    36/-0,24/0
          BSS    100B-TBHL-*
          LOC    *O
 
*         SECOND PRU - PRIMARY VSN BLOCK.
 
 BCW2     BSS    0           BUFFER CONTROL WORD - BLOCK 2
          LOC    0
 BWRT     VFD    6/RTVB,6/1,12/100B-TBHL-TPIL,12/TPIL,12/1,12/TBHL
 BWDT     VFD    24/0,36/
 BWRI     VFD    12/0,24/0,24/0
 BWUN     VFD    42/,18/0
          LOC    *O
 PVBL     BSS    0           PRIMARY VSN BLOCK
          LOC    0
          VFD    12/1,24/0,6/0,18/4  DUMMY VSN ENTRY
          BSS    100B-TBHL-*
          LOC    *O
 
*         THIRD PRU - PRIMARY USER NAME BLOCK.
 
 BCW3     BSS    0           BUFFER CONTROL WORD - BLOCK 3
          LOC    0
 BWRT     VFD    6/RTUB,6/1,12/100B-TBHL-TPIL,12/TPIL,12/1,12/TBHL
 BWDT     VFD    24/0,36/
 BWRI     VFD    12/0,24/0,24/0
 BWUN     VFD    42/,18/0
          LOC    *O
 PUBL     BSS    0           PRIMARY USER NAME BLOCK
          LOC    0
          VFD    12/1,30/0,18/5  DUMMY USER NAME ENTRY
          BSS    100B-TBHL-*
          LOC    *O
 
*         FOURTH PRU - SECONDARY VSN BLOCK.
 
 BCW4     BSS    0           BUFFER CONTROL WORD - BLOCK 4
          LOC    0
 BWRT     VFD    6/RTVB,6/2,12/100B-TBHL-TSVL,12/TSVL,12/1,12/TBHL
 BWDT     VFD    24/0,36/
 BWRI     VFD    12/0,24/0,24/0
 BWUN     VFD    42/,18/0
          LOC    *O
 SVBL     BSS    0           SECONDARY VSN BLOCK
          LOC    0
          VFD    12/1,24/0,24/0  DUMMY VSN ENTRY
          VFD    36/0,6/0,18/0
          VFD    36/0,24/0
          VFD    36/0,24/0
          BSS    100B-TBHL-*
          LOC    *O
 
*         FIFTH PRU - SECONDARY USER NAME INDEX.
 
 BCW5     BSS    0           BUFFER CONTROL WORD BLOCK 5
          LOC    0
 BWRT     VFD    6/RTUB,6/2,12/100B-TBHL-TSUL,12/TSUL,12/1,12/TBHL
 BWDT     VFD    24/0,36/
 BWRI     VFD    12/0,24/0,24/0
 BWUN     VFD    42/,18/0
          LOC    *O
 SUBL     BSS    0           SECONDARY VSN BLOCK
          LOC    0
          VFD    12/1,30/0,18/0  DUMMY USER NAME ENTRY
          BSS    100B-TBHL-*
          LOC    *O
 WBUFL    EQU    *-WBUF      LENGTH OF WORKING BUFFER
 BUFFERS  SPACE  4,10
**        FILE BUFFERS.
 
 
 PBUF     BSS    TBUFL
 NBUF     BSS    TBUFL
          SPACE  4
          QUAL
 ENTRY    SPACE  4,10
**        ENTRY POINTS.
 
 
 TFSP     EQU    /PRESET/TFSP
 TFSPE    EQU    /PRESET/TFSPE
 TFSPR    EQU    /PRESET/TFSPR
 RFL=     SPACE  4,10
**        FIELD LENGTH.
 
 
 D1       MAX    BUF1E,/PRESET/BUF2
 IBUF     EQU    D1          INPUT FILE BUFFER
 D1       MAX    IBUF+FBUFL,*
 RFL=     EQU    D1          REQUIRED FIELD LENGTH
          SPACE  4
          END