TFSP
          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 
