Retro1.org codex

          IDENT  DFTERM1,OVLA,DFTERM,01,00 
          ABS
          SST
          SYSCOM B1
*COMMENT  DFTERM - DAYFILE TERMINATION PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  DFTERM - DAYFILE TERMINATION PROCESSOR.
          SPACE  4
***       DFTERM - DAYFILE TERMINATION PROCESSOR.
*         A. J. BEEKMAN.     75/03/07.
*         R. J. THIELEN.     75/03/07.
          SPACE  4
***       *DFTERM* IS A UTILITY PROGRAM THAT TERMINATES INACTIVE OR
*         ACTIVE DAYFILES AND MAKES THEM PERMANENT ON THE DEVICE ON
*         WHICH THEY CURRENTLY RESIDE AND/OR PROVIDES A LIST OF ALL
*         PERMANENT DAYFILES WITH INFORMATION RELATIVE TO EACH.
          SPACE  4
***       *DFTERM* MAY BE CALLED FROM THE CONSOLE BY THE QUEUED FILE
*         SUPERVISOR PROGRAM (X.QFSP.) OR BY CONTROL CARD FROM SYSTEM
*         ORIGIN.  *DFTERM* WILL ALSO BE CALLED BY A CONTROL CARD CALL
*         TO *DFLIST*.  THE CONTROL CARD FORMATS ARE -
*                DFLIST.
*                DFTERM(P1=A1,P2=A2,...,PN=AN,PO=N)
*         WHERE *PO=N* IS A PARAMETER THAT DISALLOWS *K* DISPLAY INPUT,
*         AND P1 - PN ARE ANY OF THE FOLLOWING VALID PARAMETERS -
*
*         FT = FILE TYPE TO TERMINATE (DEFAULT IS DAYFILE).
*                DAYFILE = SYSTEM DAYFILE.
*                ACCOUNT = SYSTEM ACCOUNT FILE.
*                ERRLOG = SYSTEM ERROR LOG FILE.
*                MAINLOG = SYSTEM MAINTENANCE LOG FILE.
*         I  = ALTERNATE DIRECTIVE INPUT FILE. THIS IS A CONTROL
*                STATEMENT PARAMETER SPECIFYING WHAT FILE SHOULD
*                BE READ FOR INPUT DIRECTIVES.  THESE DIRECTIVES
*                CONSIST OF ANY LEGAL K-DISPLAY INPUT OR COMMANDS.
*                THESE DIRECTIVES WILL BE PROCESSED AFTER THE
*                CONTROL STATEMENT DIRECTIVES BUT BEFORE ANY
*                K-DISPLAY INPUT IS ACCEPTED.
*         FM = FAMILY/PACK NAME (DEFAULT IS SYSTEM DAYFILE FAMILY/PACK).
*         DN = DEVICE NUMBER (DEFAULT IS SYSTEM DAYFILE DEVICE).
*                THE FM AND DN PARAMETERS ARE USED TO DEFINE ON WHICH
*                DEVICE THE FILE RESIDES WHEN TERMINATING AN INACTIVE
*                DAYFILE OR ON WHICH DEVICE THE NEW DAYFILE WILL RESIDE
*                WHEN TERMINATING AN ACTIVE DAYFILE.  IF FM OR DN IS
*                NOT DEFINED WHEN TERMINATING AN ACTIVE DAYFILE, THE
*                NEW DAYFILE WILL RESIDE ON THE SAME FAMILY/PACK AND
*                SAME DEVICE AS THE OLD ONE.
*         OP = FILE MODE OPTION (DEFAULT IS A).
*                A = TERMINATE ACTIVE DAYFILE.
*                I = TERMINATE INACTIVE DAYFILE.
*         NM = NAME OF PERMANENT FILE (1 - 5 CHARACTERS).
*                THE CHARACTERS SPECIFIED BY NM WILL BE ADDED TO ONE
*                OF THE PREFIXES DF, AC, OR ER ACCORDING TO THE TYPE
*                OF DAYFILE SPECIFIED.  IF NM IS NOT SPECIFIED, OR THE
*                SPECIFIED NAME IS A DUPLICATE NAME, *DFTERM* WILL
*                AUTOMATICALLY ASSIGN A NAME FOR THE FILE.  THE
*                ASSIGNED NAME WILL CONSIST OF ONE OF THE PREVIOUSLY
*                MENTIONED PREFIXES ACCORDING TO DAYFILE TYPE FOLLOWED
*                BY A ONE CHARACTER SEQUENCE CHARACTER (A - 9) AND
*                A FOUR DIGIT DATE (MONTH AND DAY) OF CREATION.
*                *DFTERM* WILL SEARCH THE CATALOG FOR ALL PERMANENT
*                DAYFILE NAMES OF THIS TYPE, THEN ASSIGN THE SEQUENCE
*                CHARACTER ONE HIGHER THAN THE HIGHEST CHARACTER
*                FOUND.  IF THE HIGHEST CHARACTER (9) IS NOT AVAILABLE,
*                *DFTERM* WILL SEARCH FOR THE LOWEST CHARACTER
*                AVAILABLE AND ASSIGN THAT CHARACTER.
*         L  = FILE NAME TO RECEIVE OUTPUT (DEFAULT IS OUTPUT).
*
*         THE *USRN* MICRO CAN BE DEFINED AS ANY SEVEN CHARACTER OR
*         LESS USER NUMBER WHICH SHOULD BE PERMITTED IN WRITE MODE TO
*         ALL TERMINATED DAYFILES.  IF *USRN* IS NULL, NO PERMITS WILL
*         BE ISSUED.  IF USING A PRIVATE PACK, *USRN* MUST BE SPECIFIED
*         AND MUST BE THE SAME USER NUMBER AS THAT OF THE PRIVATE PACK
*         IF NEW ACTIVE DAYFILES ARE TO BE STARTED ON THE PACK.
*         WITHOUT THIS CONDITION SATISFIED, CURRENT DAYFILES MAY BE
*         TERMINATED ON THE PACK, BUT NO NEW DAYFILES ACTIVATED ON
*         IT.  THE TAG *PDUI* CAN BE SET TO THE USER INDEX ON WHICH
*         PERMANENT DAYFILES SHOULD BE DEFINED (MUST BE GREATER THAN
*         377700B).  *USRN* AND *PDUI* ARE FOUND IN *COMSIOQ*.
          SPACE  4
**        ENTRY CONDITIONS.
*
*         DFTERM IS ENTERED VIA RETURN JUMP FROM *QFSP*.
*
*         *TARA* = FWA OF THE PARAMETER TABLE.
*         *TEQA* = FWA OF THE MASS STORAGE EQUIPMENT TABLE.
*         *TSDA* = FWA OF THE SECONDARY DEVICE MASK TABLE.
          SPACE  4
***       DAYFILE MESSAGES.
*
*         THE FOLLOWING MESSAGES ARE ISSUED BOTH TO THE DAYFILE AND
*         THE *K* DISPLAY.  SPECIAL CASES FOR ISSUANCE OF THE MESSAGE
*         ARE IN PARENTHESES.
*
*
*         * AUTOMATIC NAME ASSIGNMENT IMPOSSIBLE.* = *DFTERM* WAS
*         UNABLE TO DETERMINE AN AVAILABLE NAME FOR THE TERMINATED
*         DAYFILE.  ENTER A VALID NAME FOR THE FILE VIA THE *K*
*         DISPLAY.
*
*         * CANNOT CATLIST FAMILY/PACK - FAMPCK.* = *DFTERM* WAS UNABLE
*         TO CATLIST THE FAMILY/PACK.  CHECK THAT CATALOGS EXIST ON THE
*         FAMILY/PACK AND RETRY OPERATION.  (*DFLIST*).
*
*         * DAYFILE BUSY.* = DAYFILE TO BE TERMINATED WAS FOUND TO
*         BE ATTACHED TO ANOTHER JOB.  RETRY OPERATION.
*
*         * DAYFILE STATUS INDEFINITE.* = AN ERROR EXIT HAS OCCURED
*         CAUSING *DFTERM* TO ABORT WHILE IN THE PROCESS OF
*         TERMINATING A DAYFILE.  THE STATUS OF THE DAYFILE IS
*         QUESTIONABLE.  CONTACT AN ANALYST IMMEDIATELY.  (DAYFILE
*         ONLY).
*
*         * DFTERM ABORTED.* = AN ERROR EXIT HAS CAUSED *DFTERM*
*         TO ABORT.  CHECK THE DAYFILE FOR MORE INFORMATION.
*         (DAYFILE ONLY).
*
*         * ERROR - TERMINATED DAYFILE ON LOCAL FILE ZZZDAYF.* = AN
*         ERROR OCCURRED WHILE DEFINING THE PERMANENT FILE FOR THE
*         TERMINATED DAYFILE WHICH REMAINS ON LOCAL FILE *ZZZDAYF*.
*         SEE DAYFILE FOR *PFM* ERROR MESSAGE.
*
*         * INACTIVE DAYFILE NOT FOUND ON DEVICE.* = NO INACTIVE
*         DAYFILE OF THE SPECIFIED TYPE WAS FOUND ON THE SPECIFIED
*         DEVICE.  ENTER THE CORRECT FAMILY AND DEVICE NUMBER VIA THE
*         *K* DISPLAY.
*
*         * INACTIVE DAYFILE ON DEVICE.* = INACTIVE DAYFILE ALREADY
*         EXISTS ON DEVICE ON WHICH NEW ACTIVE DAYFILE IS TO BE
*         CREATED.  ENTER ANOTHER DEVICE VIA *K* DISPLAY PARAMETERS.
*
*         * INVALID DEVICE SPECIFIED.* = THE DEVICE SPECIFIED BY THE
*         CONTROL PARAMETERS IS NOT A VALID DAYFILE DEVICE.
*
*         * NO ACTIVE DAYFILE FOUND.* = NO ACTIVE DAYFILE OF SPECIFIED
*         TYPE FOUND IN *QFSP* EQUIPMENT TABLE.  STOP THIS *DFTERM*
*         RUN, START UP ANOTHER *DFTERM*, AND RETRY OPERATION.  IF
*         ERROR STILL EXISTS, CHECK SYSTEM FOR LOSS OF DAYFILE.
*
*         * NO PERMANENT DAYFILES.* = NO PERMANENT DAYFILES EXIST ON
*         ANY PERMANENT FILE DEVICE.
*
*         * NOT ENOUGH MASS STORAGE.* = NOT ENOUGH MASS STORAGE
*         EXISTS ON SPECIFIED DEVICE TO ENABLE CREATION OF NEW
*         ACTIVE DAYFILE.  ENTER NEW DEVICE VIA *K* DISPLAY.
*
*         * PERMANENT DAYFILE DEFINED AS XXXXXXX.* = DAYFILE HAS BEEN
*         TERMINATED AND DEFINED UNDER NAME XXXXXXX.
*
*         * PRIVATE PACK/PERMIT UN CONFLICT.* = USER NUMBER OF
*         PRIVATE PACK IS NOT THE SAME AS THE USER NUMBER SPECIFIED
*         FOR PERMITS.  NO NEW ACTIVE DAYFILES MAY BE STARTED ON THIS
*         PRIVATE PACK IN THIS CASE.
*
*         * REMOVABLE DEVICE/NO ACTIVE DAYFILES.* = DEVICE SPECIFIED
*         BY *K* DISPLAY PARAMETERS IS A REMOVABLE DEVICE, AND OPTION
*         IS TO TERMINATE AN ACTIVE DAYFILE.  NO ACTIVE DAYFILES ARE
*         ALLOWED TO RESIDE ON REMOVABLE DEVICES.  ENTER NEW DEVICE
*         VIA *K* DISPLAY PARAMETERS.
*
*         * UNCORRECTABLE RMS ERROR.* = ERROR WAS DETECTED READING
*         THE EOI.  RETRY OPERATION.
*
*         * WAITING FOR PF UTILITY.* = PF UTILITY IN OPERATION WHEN
*         *PFM* CALLED.  *DFTERM* WILL RETRY OPERATION UNTIL
*         UTILITY IS COMPLETED.  (CONTROL POINT AREA MESSAGE ONLY).
          SPACE  4
***       *K* DISPLAY OPERATOR MESSAGES.
*
*         *NO OUTPUT FILE EXISTING.* = NO OUTPUT FILE HAS BEEN
*         CREATED PREVIOUS TO ENTERING *OUT* COMMAND.
*
*         *OUTPUT FILE RELEASED.* = OUTPUT FILE RELEASED TO PRINTER.
*
*         *PERMANENT DAYFILE LIST COMPLETE.* = PERMANENT DAYFILE LIST
*         WRITTEN TO OUTPUT FOR *DFLIST* OR TO *K* DISPLAY BUFFER
*         FOR *DFTERM*.
          SPACE  4
*         COMMON DECKS.
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSPFM
*CALL     COMSSFM
          LIST   X
*CALL     COMSIOQ
*CALL     COMSQFS
          LIST   -X
          TITLE  PROGRAM CONSTANTS.
*         CONSTANTS.
 
 CBUFL    EQU    101B        CATALOG BUFFER LENGTH
 DBUFL    EQU    1           DAYFILE BUFFER LENGTH
 KBUFL    EQU    300B        *K* DISPLAY BUFFER LENGTH
 OBUFL    EQU    1001B       OUTPUT BUFFER LENGTH
 PDCBL    EQU    MSMX+2      PERMANENT DAYFILE CONTROL BUFFER LENGTH
 PDLBL    EQU    7           PERMANENT DAYFILE LIST LINE BUFFER LENGTH
 DSPBL    EQU    7           *DSP* PARAMETER BLOCK LENGTH
 PPOS     EQU    TPPA+PPLN   PAGE POSITION (LINE NUMBER)
 PDFE     EQU    TPPA+PPPD   PRINT DENSITY FORMAT EFFECTOR
 KDLC     EQU    KMLL-6      *K* DISPLAY LINE COUNT
 FRDC     EQU    20B         *DSP* DISPOSITION CODE FLAG
          TITLE  RESERVED LOCATIONS AND FETS.
*         RESERVED LOCATIONS.
 
          ORG    OVLA
 
 DNUM     CON    0           DAYFILE NUMBER
 PNUM     CON    0           PAGE NUMBER
 LIST     CON    0           RECORD COUNT ON OUTPUT
 ANAM     CON    0           AUTOMATICALLY ASSIGNED DAYFILE NAME
 SNAM     CON    0           SPECIFIED DAYFILE NAME
 FMPC     CON    0           FAMILY/PACK NAME OF TERMINATION DEVICE
 APIN     CON    0           AUXILIARY PACK INFORMATION
 CFAM     CON    0           CURRENT USER FAMILY NAME
 CPCK     CON    0           CURRENT USER PACK NAME
 DFSF     CON    0           DAYFILE STATUS FLAG
          SPACE  4
*         FETS.
 
 C        BSS    0           CATALOG READ FILE
 CATALOG  FILEB  CBUF,CBUFL,EPR,(FET=15)
 
 D        BSS    0           DAYFILE TERMINATION FILE
 ZZZDAYF  FILEB  DBUF,DBUFL,EPR,(FET=20B)
 
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OBUF,OBUFL,(FET=7)
 DFTERM   TITLE  MAIN ROUTINE.
**        DFTERM - MAIN ROUTINE.
*
*         ENTRY  PARAMETER TABLE FWA - *TARA*.
*                MASS STORAGE TABLE FWA - *TEQA*.
*                SECONDARY DEVICE MASK TABLE FWA - *TSDA*.
*
*         EXIT   (X5) = *K* DISPLAY MESSAGE ADDRESS.
*                (X2) = *K* DISPLAY BUFFER ADDRESS.
 
 
 DFTERM   SUBR               ENTRY/EXIT
          SB1    1
          MEMORY CM,,R,BUFFL
          SX6    MPER        SET *PFM* ERROR RETURN ADDRESS
          SA6    D+10
          SA1    TARA+ARFC   CLEAR FORCE *K* DISPLAY FLAG
          MX0    -1
          LX0    55-0
          BX6    X1*X0
          SA6    A1
 
*         INITIALIZE FAMILY AND PACK NAMES.
 
          SX6    B1          CLEAR FAMILY/PACK NAME
          LX6    18
          SA6    SFDA+1
          BX7    X7-X7       CLEAR USER INDEX
          SA7    A6+B1
          RJ     GCF         GET CURRENT FAMILY AND PACK
 
*         SET PROCESSOR ADDRESS.
 
          SA2    TARA+ARFC   SET FUNCTION PROCESSOR ADDRESS
          SA3    TFCN+X2
          SB7    X3
          SX2    X2
          ZR     X2,DFT2     IF *GO* COMMAND
 
*         SET OUTPUT FILE NAME.
 
          RECALL O
          SA1    O           GET CURRENT FILE NAME
          SA3    TARA+ARLL
          MX0    42
          BX4    X1-X3
          BX2    X0*X4
          BX6    X6-X6       INITIALIZE LIST FLAG
          ZR     X2,DFT1     IF NO FILE NAME CHANGE
          SA6    LIST
 DFT1     SX1    3
          BX6    X3+X1
          SA6    A1
 
*         CALL FUNCTION PROCESSOR.
 
 DFT2     RETURN D,R
          RJ     SPR         JUMP TO PROCESSOR
          SA2    TARA+ARFC   CHECK FOR HIDDEN ERROR
          SX3    X2+
          NZ     X3,DFT3     IF NOT *GO* COMMAND
          SA1    GOPC
          NZ     X1,DFT3     IF TERMINATION COMPLETE
          MESSAGE X5
          SA1    TARA+ARFC   SET FORCE *K* DISPLAY FLAG
          MX0    1
          LX0    55-59
          BX6    X0+X1
          SA6    A1
          SA2    DFSF        GET DAYFILE STATUS FLAG
          NG     X2,DFT3     IF TERMINATED DAYFILE PERMANENT
          ZR     X2,DFT3     IF DAYFILE NOT TERMINATED
          SETFS  D,0         INSURE LOCAL FILE IS RETAINED
          EQ     DFT4        SET RETURN PARAMETERS
 
*         SET PARAMETERS FOR RETURN TO *QFSP*.
 
 DFT3     RETURN D,R
 DFT4     RETURN C,R
          PACKNAM  CPCK      SET USER PACK
          ENFAM  CFAM        SET USER FAMILY
          EREXIT 0           CLEAR ERROR EXIT
          SX2    B7          SET *K* DISPLAY BUFFER ADDRESS
          EQ     DFTERMX
          SPACE  4
**        FUNCTION TABLE.
*
*         INDEX INTO TABLE IS FUNCTION CODE FROM *QFSP*.
 
 TFCN     BSS    0           FUNCTION PROCESSOR ADDRESS TABLE
          LOC    0
          CON    GOP         TERMINATE DAYFILES PROCESSOR (*GO*)
          CON    0
          CON    LSP         LIST DAYFILES PROCESSOR (*LIST*)
          CON    OTP         DISPOSE OUTPUT FILE PROCESSOR (*OUT*)
          LOC    *O
 GOP      TITLE  COMMAND PROCESSOR SUBROUTINES.
***       GO.
*                TERMINATE ACTIVE OR INACTIVE DAYFILE AND DEFINE AS
*                A DIRECT ACCESS PERMANENT FILE ON THE DEVICE ON
*                WHICH IT CURRENTLY RESIDES.  IF ACTIVE DAYFILE
*                TERMINATION, CREATE NEW ACTIVE DAYFILE ON DEVICE
*                SPECIFIED BY *K* DISPLAY PARAMETERS.  DEFINE
*                TERMINATED DAYFILE AS PRIVATE FILE WITH READ MODE
*                PERMISSION.  ALSO, PERMIT AN ASSEMBLY-TIME DEFINED
*                USER NUMBER IN WRITE MODE.
 
**        GOP - TERMINATE DAYFILES PROCESSOR.
*
*         EXIT   (X5) = *K* DISPLAY MESSAGE ADDRESS.
*                (B7) = 0 (NO *K* DISPLAY BUFFER).
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 7.
*                X - ALL.
*
*         CALLS  ADN, DTD, PUN, TOD, VED.
*
*         MACROS EREXIT, SYSTEM.
 
 
 GOP      SUBR               ENTRY/EXIT
          SA3    TARA+ARFT   DAYFILE TYPE
          SA4    TARA+ARDN   GET EST ORDINAL
          BX6    X6-X6       CLEAR ACTIVE DAYFILE EQUIPMENT AND FLAG
          SA6    GOPB
          SA6    A6+B1
          MX0    -12
          BX4    -X0*X4
          SA2    TARA+AROP   OPTION
          BX3    -X0*X3
          BX2    -X0*X2
 
*         VALIDATE DAYFILE TERMINATION.
 
          RJ     VED         VALIDATE EXISTENCE OF DAYFILE ON DEVICE
          NZ     X5,GOPX     IF ERROR
          LX3    12
          LX4    48          SAVE EQUIPMENT AND DAYFILE TYPE
          BX7    X4+X3
          SA7    GOPA
          SA7    D+7
          EREXIT ERR1        SET MINOR ERROR EXIT ADDRESS
 
*         ASSIGN NAME TO DAYFILE.
 
          RJ     ADN         ASSIGN DAYFILE NAME
          NZ     X5,GOPX     IF ERROR
          BX6    X2          INSERT NAME IN FET
          SA6    D+CFPN
          EREXIT ERR         SET MAJOR ERROR EXIT ADDRESS
 
*         TERMINATE DAYFILE.
 
          RJ     TOD         TERMINATE OLD DAYFILES
          NZ     X5,GOPX     IF ERROR
 
*         FINISH DAYFILE TERMINATION.
 
          SA5    TARA+AROP   OPTION
          MX0    -12
          BX5    -X0*X5
          SA1    GOPB
          ZR     X5,GOP1     IF INACTIVE DAYFILE TERMINATION
          ZR     X1,GOP1     IF NO EQUIPMENT SWITCH
          MX0    12          SET ACTIVE DAYFILE EST ORDINAL
          SA2    GOPA
          BX2    -X0*X2
          BX1    X0*X1
          BX6    X1+X2
          SA6    A2+
 
*         CLEAR FIRST TRACK BYTE IN SECTOR OF LOCAL AREAS.
 
 GOP1     SA2    A1-B1       SET EQUIPMENT AND DAYFILE TYPE IN FET
          BX7    X2
          SA7    D+7
          SYSTEM SFM,R,D,CDBF*100B
          ZR     X5,GOP2     IF INACTIVE DAYFILE TERMINATION
 
*         PROTECT ACTIVE DAYFILE.
 
          SA2    GOPA        SET DAYFILE TYPE IN FET
          MX0    12
          BX7    -X0*X2
          SA7    D+7
          SYSTEM SFM,R,D,PADF*100B
 
*         DEFINE TERMINATED DAYFILE.
 
 GOP2     EREXIT ERR1        SET MINOR ERROR EXIT ADDRESS
          SX6    B1          SET DAYFILE STATUS FLAG
          SA6    DFSF
          BX6    X6-X6       CLEAR EST ORDINAL
          SA6    D+7
          RJ     DTD         DEFINE TERMINATED DAYFILE
          NZ     X5,GOPX     IF ERROR
 
*         PERMIT USER NUMBER.
 
          SX6    B0+         CLEAR DAYFILE STATUS FLAG
          SA6    DFSF
          RJ     PUN         PERMIT SPECIFIED USER NUMBER
          NZ     X5,GOPX     IF ERROR
          SX5    DTDA        SET *K* DISPLAY MESSAGE
          SB7    B0
          SX6    B1          SET COMPLETION FLAG
          SA6    GOPC
          EQ     GOPX
 
 GOPA     CON    0           EQUIPMENT AND DAYFILE TYPE
 GOPB     CON    0           ACTIVE DAYFILE EST ORDINAL
 GOPC     CON    0           TERMINATION COMPLETE FLAG
 LSP      EJECT
***       LIST.
*                PRODUCE LISTING OF PERTINENT INFORMATION FOR ALL
*                PERMANENT DAYFILES ON THE SYSTEM.  SET OUTPUT FOR
*                RELEASE IF *DFLIST* CALL.  ADD LIST TO CURRENT OUTPUT
*                FILE AND BUILD *K* DISPLAY BUFFER FROM THE LIST IF
*                *DFTERM* CALL.
 
**        LSP - LIST PERMANENT DAYFILES PROCESSOR.
*
*         ENTRY  (LIST) = RECORD COUNT ON OUTPUT FILE.
*
*         EXIT   (B7) = ADDRESS OF *K* DISPLAY BUFFER IF *DFTERM* CALL.
*                     = 0 IF *DFLIST* OR IF ERROR.
*                (X5) = *K* DISPLAY MESSAGE ADDRESS.
*                (LIST) INCREASED IF PERMANENT DAYFILES EXIST.
*
*         USES   A - 1, 5, 6.
*                B - 7.
*                X - 1, 5, 6.
*
*         CALLS  BOF, CFT, GKD, IPH.
*
*         MACROS BKSP, EREXIT, READEI, SETFS.
 
 
 LSP      SUBR               ENTRY/EXIT
 
*         BUILD OUTPUT.
 
          RJ     CFT         CREATE FAMILY NAME TABLE
          RJ     IPH         INITIALIZE PAGE HEADER AND PAGE CONTROL
          EREXIT ERR1        SET MINOR ERROR EXIT ADDRESS
          RJ     BOF         BUILD OUTPUT FILE
          NZ     X5,LSPX     IF ERROR
          SA1    TARA+ARFC
          PL     X1,LSP1     IF NOT DFLIST CALL
 
*         SET OUTPUT FOR DFLIST CALL.
 
          SETFS  O,0
          SX5    =C*PERMANENT DAYFILE LIST COMPLETE.*
          SB7    B0+         SET NO *K* DISPLAY
          EQ     LSPX
 
*         CREATE *K* DISPLAY BUFFER.
 
 LSP1     SA5    LIST        INCREASE RECORD COUNT
          SX6    X5+B1
          SA6    A5
          BKSP   O           SET BEGINNING OF CURRENT RECORD
          READEI X2
          RJ     GKD         GENERATE *K* DISPLAY
          EQ     LSPX
 OTP      EJECT
***       OUT.
*                RELEASE OUTPUT FILE TO PRINTER IF ONE HAS BEEN
*                WRITTEN.
 
**        OTP - DISPOSE OUTPUT FILE PROCESSOR.
*
*         ENTRY  (LIST) .NE. 0 IF OUTPUT FILE WRITTEN.
*
*         EXIT   (LIST) = 0 (OUTPUT FLAG).
*                (X5) = *K* DISPLAY MESSAGE ADDRESS.
*                (B7) = 0 (NO *K* DISPLAY BUFFER).
*
*         USES   A - 2, 6.
*                B - 7.
*                X - 2, 5, 6.
*
*         MACROS ROUTE.
 
 
 OTP      SUBR               ENTRY/EXIT
          SA2    LIST        CHECK IF OUTPUT EXISTS
          ZR     X2,OTP1     IF NO OUTPUT FILE
          BX6    X6-X6       CLEAR OUTPUT FLAG AND RECORD COUNT
          SA6    A2
 
*         RELEASE OUTPUT FILE.
 
          SX6    B0+         CLEAR *DSP* PARAMETER BLOCK
          SB7    DSPBL-1
 OTP0     SA6    DSPB+B7
          SB7    B7-1
          PL     B7,OTP0     IF NOT END OF BLOCK
          SA2    O           GET FILE NAME
          MX6    42
          BX6    X6*X2
          SA6    DSPB        *DSP* PARAMETER BLOCK
          SA2    OTPA
          BX6    X2
          SA6    A6+B1
          ROUTE  DSPB,RECALL
          SX5    =C*OUTPUT FILE RELEASED.         *
          SB7    B0+
          EQ     OTPX
 
 OTP1     SX5    =C*NO OUTPUT FILE EXISTING.      *
          SB7    B0+
          EQ     OTPX
 
 
 OTPA     VFD    24/0,12/2HPR,6/0,18/FRDC
 SPR      EJECT
**        SPR - SET PROCESSOR RETURN JUMP.
*
*         ENTRY  (B7) = ADDRESS OF PROCESSOR.
*                (SPR) = RETURN JUMP ADDRESS.
*
*         EXIT   RETURN JUMP ADDRESS SET IN PROCESSOR.
*                JUMPS TO COMMAND PROCESSOR.
*
*         USES   A - 1, 6.
*                X - 1, 6.
 
 
 SPR      SUBR               ENTRY/EXIT
          SA1    SPRX        SET RETURN ADDRESS
          BX6    X1
          SA6    B7
          JP     B7+1        JUMP TO SUBROUTINE
 ADN      TITLE  PRIMARY SUBROUTINES.
**        ADN - ASSIGN AUTOMATIC DAYFILE NAME.
*
*         ENTRY  (FMPC) = FAMILY OR PACK NAME.
*
*         EXIT   (X2) = SPECIFIED DAYFILE NAME IF NOT A DUPLICATE,
*                       AUTOMATICALLY ASSIGNED NAME OTHERWISE.
*                (X5) = 0 IF NAME ASSIGNED.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 7.
*                X - 0, 1, 2, 3, 5, 6, 7.
*
*         CALLS  CAN.
 
 
 ADN      SUBR               ENTRY/EXIT
          SX6    B0+         CLEAR SPECIFIED NAME FLAG
          SA6    SNAM
 
*         FORM SPECIFIED NAME FROM KEYWORD AND SPECIFIED CHARACTERS.
 
          SA2    TARA+ARFT   GET DAYFILE TYPE CODE
          MX0    -12
          BX2    -X0*X2
          SA3    TDNK+X2     SET DAYFILE NAME KEYWORD
          SA1    TARA+ARNM   CHECK IF CHARACTERS SPECIFIED
          ZR     X1,ADN1     IF NONE SPECIFIED
          MX0    30          COMBINE NAME KEY AND SPECIFIED CHARACTERS
          BX1    X0*X1
          LX1    -12
          BX6    X3+X1
          SA6    SNAM
 
*         FORM AUTOMATIC DAYFILE NAME SKELETON.
 
 ADN1     DATE   ANAM
          SA2    ANAM        FORM LAST FOUR CHARACTERS OF NAME
          LX2    6
          MX0    12
          LX0    -18
          BX1    X0*X2       MONTH
          LX2    6
          LX0    -12
          BX2    X0*X2       DAY
          BX6    X1+X2
          BX7    X3+X6
          SA7    A2
 
*         SET INFORMATION IN FET.
 
          SA2    FMPC        SET FAMILY/PACK AND USER INDEX
          MX0    42
          SX3    X2          MASK IN AUXILIARY PACK FLAG
          BX2    X0*X2
          LX3    17
          SX1    PDUI
          BX2    X2+X3
          BX6    X1+X2
          SA6    C+14
 
*         CHECK FOR AVAILABLE NAME.
 
          RJ     CAN         CHECK CATALOG FOR AVAILABLE NAME
          NZ     X5,ADNX     IF ERROR
          SA2    SNAM
          ZR     X2,ADN2     IF NO SPECIFIED NAME
          SX6    X2
          BX5    X5-X5
          NZ     X6,ADN2     IF DUPLICATE FILE NAME
          EQ     ADNX
 
*         FIND NEXT SEQUENCE CHARACTER IF AUTOMATIC ASSIGNMENT.
 
 ADN2     SA1    CANB        CHECK FOR NEXT SEQUENCE CHARACTER
          SX6    1R9
          LX1    59-35
          NG     X1,ADN4     IF MAXIMUM CHARACTER USED
 ADN3     LX1    1
          NG     X1,ADN6     IF LATEST SEQUENCE CHARACTER FOUND
          SX6    X6-1        DECREMENT SEQUENCE CHARACTER
          SX7    X6-1
          NZ     X7,ADN3     IF NOT ALL CHARACTERS CHECKED
          EQ     ADN6
 
*         CHECK FOR LOWEST AVAILABLE SEQUENCE CHARACTER.
 
 ADN4     SX6    1RA         CHECK FOR LOWEST CHARACTER
          LX1    59-24-0
 ADN5     PL     X1,ADN6     IF CHARACTER AVAILABLE
          LX1    59
          SX6    X6+B1       INCREMENT CHARACTER
          SX7    X6-1R9
          NZ     X7,ADN5     IF NOT AT MAXIMUM CHARACTER
          SB7    B0+
          SX5    =C* AUTOMATIC NAME ASSIGNMENT IMPOSSIBLE.*
          EQ     ADNX
 
 ADN6     SA1    ANAM        ADD SEQUENCE CHARACTER TO SKELETON NAME
          LX6    42
          BX2    X6+X1
          SX5    B0
          EQ     ADNX
 BOF      SPACE  4,15
**        BOF - BUILD OUTPUT FILE.
*
*         ENTRY  (PPOS) = PAGE POSITION (SET TO END OF PAGE).
*                (PNUM) = PAGE NUMBER (SET TO 1).
*                (DNUM) = DAYFILE NUMBER (SET TO 1).
*                (PDFE+1) = SET IF PRINT DENSITY FORMAT EFFECTOR
*                           NOT YET WRITTEN.
*
*         EXIT   (X5) = 0 IF DAYFILES EXIST.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*
*         USES   A - 1, 6, 7.
*                B - 7.
*                X - 0, 1, 2, 5, 6, 7.
*
*         CALLS  BDL, CDD.
*
*         MACROS MESSAGE, WRITEC, WRITER.
 
 
 BOF      SUBR               ENTRY/EXIT
 
*         BUILD LIST LINES.
 
 BOF1     SX1    PDCB        PERMANENT DAYFILE LIST CONTROL BLOCK
          SX2    PDLB        AREA TO RECEIVE LIST LINE
          RJ     BDL         BUILD DAYFILE LIST LINE
          NZ     X5,BOFX     IF ERROR
          NZ     X6,BOF3     IF END OF DAYFILE LIST
          SA1    DNUM        INCREMENT DAYFILE NUMBER
          SX6    X1+B1
          SA6    A1
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    30          PUT IN LIST LINE
          MX0    -24
          SA1    PDLB
          BX1    -X0*X1
          BX6    X0*X6
          BX7    X1+X6
          SA7    A1
          SA1    PPOS        CHECK PAGE POSITION
          SA2    A1+B1
          IX2    X1-X2
          NG     X2,BOF2     IF NOT END OF PAGE
 
*         WRITE PAGE HEADER.
 
          SA1    PNUM        INCREMENT PAGE NUMBER
          SX6    X1+B1
          SA6    A1
          RJ     CDD         CONVERT TO DISPLAY CODE
          MX1    -18         PUT PAGE NUMBER IN PAGE HEADER
          BX6    -X1*X6
          SA1    =5LPAGE
          LX6    12
          BX6    X1+X6
          SA6    BOFA+6
          SA1    PDFE+1      GET PRINT DENSITY FORMAT CONTROL FLAG
          BX7    X7-X7
          SA7    A1
          WRITEW O,A1-B1,X1  CONDITIONALLY WRITE FORMAT EFFECTOR
          WRITEC O,BOFA      WRITE PAGE HEADING
          WRITEC O,BOFB      WRITE SECOND HEADING LINE
          WRITEC O,(=C*        *)  WRITE BLANK LINE
          SX1    4           SET PAGE HEADING LINE COUNT
 
*         WRITE LIST LINE.
 
 BOF2     SX6    X1+1        COUNT OUTPUT LINE
          SA6    PPOS
          WRITEC O,PDLB,PDLBL WRITE DAYFILE LINE
          EQ     BOF1        GET NEXT LINE
 
*         END DAYFILE LIST.
 
 BOF3     SA1    DNUM        CHECK DAYFILE COUNT
          SX1    X1-2
          NG     X1,BOF4     IF NO DAYFILES LISTED
          WRITER O,R
          BX5    X5-X5       SET NO MESSAGE
          EQ     BOFX
 
 BOF4     SX5    =C* NO PERMANENT DAYFILES.       *
          SB7    B0
          MESSAGE X5
          EQ     BOFX
 
 BOFA     DATA   C*1CATALOG OF PERMANENT DAYFILES (000000). 00/00/00  00
,.00.00 PAGE 000*            FIRST DAYFILE PAGE HEADER
 BOFB     DATA   C*0 NUM  TYPE    FM/PN   DN PFNAME    DATE     TIME   L
,ENGTH*
 CFT      SPACE  4,7
**        CFT - CREATE FAMILY/PACK NAME TABLE.
*
*         EXIT   (PDCB) = FIRST WORD OF FAMILY/PACK NAME TABLE.
*
*         USES   A - 1, 2, 6.
*                B - 2, 3, 4, 5, 6.
*                X - 0, 1, 2, 6, 7.
 
 
 CFT      SUBR               ENTRY/EXIT
          SX6    C           SET FET ADDRESS
          SA6    PDCB
          SB2    PDCB+2      SET ADDRESS FOR FAMILY/PACK NAME TABLE
          SB3    B0          SET OUTPUT TABLE EMPTY
          SB5    B0          INITIALIZE TO EQUIPMENT ZERO
          SX2    PDUI        SET SHIFT COUNT FOR MASK TEST
          MX6    -3
          BX2    -X6*X2
          SB6    X2-59
 
*         SEARCH EQUIPMENT TABLE FOR MASS STORAGE FAMILIES/PACKS.
 
 CFT1     SA1    TEQA+B5     GET AN EQUIPMENT ENTRY
          ZR     X1,CFT4     IF END OF EQUIPMENT TABLE
          SB5    B5+1        ADVANCE EQUIPMENT
          SX2    B1
          IX2    X1+X2
          ZR     X2,CFT1     IF NOT MASS STORAGE EQUIPMENT
          SA2    TMSA+B5-1   GET DEVICE MASK FOR EQUIPMENT
          AX6    X2,B6
          PL     X6,CFT1     IF USER INDEX NOT ON THIS DEVICE
          MX6    42          GET FAMILY/PACK NAME
          BX6    X6*X1
          LX1    59-2
          SB4    B0+         INITIALIZE AT START OF OUTPUT TABLE
          PL     X1,CFT2     IF NOT AUXILIARY DEVICE
          SX1    B1+         SET AUXILIARY PACK FLAG
          LX1    17
          BX6    X6+X1
          SX7    B5-B1       ADD EST ORDINAL
          BX6    X6+X7
 
*         CHECK IF FAMILY/PACK ALREADY IN TABLE.
 
 CFT2     GE     B4,B3,CFT3  IF END OF OUTPUT TABLE
          SA1    B2+B4       GET A NAME FROM OUTPUT TABLE
          BX2    X1-X6
          ZR     X2,CFT1     IF NAMES MATCH (ALREADY IN TABLE)
          SB4    B4+1        ADVANCE OUTPUT TABLE INDEX
          EQ     CFT2        LOOP TO CHECK NEXT NAME
 
 CFT3     SA6    B2+B3       PUT NAME IN OUTPUT TABLE
          SB3    B3+B1       COUNT TABLE ENTRY
          EQ     CFT1        LOOP TO CHECK MORE EQUIPMENT
 
 CFT4     SX6    B3+         FAMILY/PACK NAME COUNT
          LX6    18
          SA6    B2-B1
 
*         ADD USER INDEX TO TABLE FOR FAMILY ENTRIES.
 
          MX0    -18
          SB4    B0
          SX2    PDUI        PERMANENT DAYFILE USER INDEX
 CFT5     GE     B4,B3,CFTX  IF END OF FAMILY/PACK NAME TABLE
          SA1    B2+B4       GET FAMILY/PACK NAME
          SB4    B4+B1       ADVANCE INDEX
          BX7    -X0*X1
          NZ     X7,CFT5     IF AUXILIARY PACK
          BX6    X1+X2       ADD USER INDEX
          SA6    A1
          EQ     CFT5        PROCESS NEXT FAMILY/PACK
 DTD      SPACE  4,11
**        DTD - DEFINE TERMINATED DAYFILE.
*
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*
*         USES   A - 1, 2, 7.
*                B - 7.
*                X - 0, 1, 2, 3, 5, 6, 7.
*
*         CALLS  ERP, SFN.
*
*         MACROS DEFINE, MESSAGE.
 
 
 DTD      SUBR               ENTRY/EXIT
 
*         DEFINE DAYFILE AS PERMANENT.
 
 DTD1     DEFINE D,,,,,,R,,,,,,IE,,,Y
          SA2    D           CHECK FOR ERROR
          MX0    8
          LX0    18
          BX6    X0*X2
          NZ     X6,DTD2     IF *PFM* ERROR
 
*         SET UP PERMANENT DAYFILE MESSAGE.
 
          MX0    42          SET PERMANENT FILE NAME IN MESSAGE
          SA2    D+8
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          SA1    DTDA+3
          BX6    X0*X6
          BX3    -X0*X1
          BX7    X3+X6
          SA7    A1
          MESSAGE DTDA
          BX5    X5-X5       SET NO ERROR
          EQ     DTDX
 
*         PROCESS ERROR.
 
 DTD2     BX7    -X0*X2      CLEAR ERROR BITS
          SA7    A2
          RJ     ERP         ERROR PROCESSOR
          ZR     X5,DTD1     IF RETRY OPERATION
          MESSAGE  X5        ISSUE *PFM* ERROR MESSAGE
          SX5    DTDB        * ERROR - TERMINATED DAYFILE ON LOCAL...*
          SB7    B0+
          EQ     DTDX
 
 DTDA     DATA   C* PERMANENT DAYFILE DEFINED AS        .*
 DTDB     DATA   C* ERROR - TERMINATED DAYFILE ON LOCAL FILE ZZZDAYF.*
 GCF      SPACE  4,7
**        GCF - GET CURRENT FAMILY AND PACK NAMES.
*
*         EXIT   (CPCK) = CURRENT PACK NAME.
*                (CFAM) = CURRENT FAMILY NAME.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 6, 7.
*
*         MACROS SYSTEM.
 
 
 GCF      SUBR               ENTRY/EXIT
          SX6    PFCW        INITIALIZE *RSB* REQUEST BLOCK
          SX7    PKNW
          SA6    GCFB
          SA7    A6+B1
          SYSTEM RSB,R,GCFA
          SA1    GCFB        SET FAMILY EST ORDINAL
          LX1    -12
          MX2    -9
          BX6    -X2*X1
          SA1    TEQA+X6     SET FAMILY FROM TABLE
          MX0    42
          BX6    X0*X1
          SA6    CFAM
          SA1    GCFB+1      SAVE CURRENT PACK AND TYPE
          BX6    X1
          SA6    CPCK
          EQ     GCFX
 
 
 GCFA     VFD    12/0,12/2,18/0,18/GCFB  *RSB* STATUS WORD
 GCFB     CON    PFCW
          CON    PKNW
 GKD      SPACE  4,10
**        GKD - GENERATE *K* DISPLAY BUFFER.
*
*         ENTRY  FORMATTED DAYFILE INFORMATION IN OUTPUT BUFFER.
*
*         EXIT   (B7) = ADDRESS OF *K* DISPLAY BUFFER.
*                (X5) = *K* DISPLAY MESSAGE ADDRESS.
*
*         USES   A - 3, 4, 5, 6, 7.
*                B - 7.
*                X - 0, 1, 3, 4, 5, 6, 7.
*
*         MACROS MOVE, READC.
 
 
 GKD      SUBR               ENTRY/EXIT
 
*         SET HEADER FOR *K* DISPLAY.
 
          READC  O,KBUF+1    SKIP HEADER ON OUTPUT FILE
          MOVE   GKDCL,GKDC,KBUF+1
          SX6    KBUF+1+GKDCL SET LINE NUMBER
          SA6    GKDA
          SX7    KDLC        SET LINE COUNT FOR *K* DISPLAY
          SA7    GKDB
 
*         MOVE CODED LINES TO *K* DISPLAY BUFFER.
 
 GKD1     READC  O,CENB      READ ONE LINE
          NG     X1,GKD2     IF EOF/EOI
          SA3    CENB        MASK OFF CARRIAGE CONTROL CHARACTERS
          MX0    6
          BX7    -X0*X3
          SA4    =1L
          BX6    X4+X7
          SA6    A3
          SX1    B6-CENB     CALCULATE NUMBER OF WORDS
          SA3    GKDA        RESET LINE NUMBER
          IX6    X3+X1
          SA6    A3
          MOVE   X1,CENB,X3
          SA3    GKDB        DECREMENT LINE COUNT
          SX6    X3-1
          SA6    A3+
          NZ     X6,GKD1     IF NOT MAXIMUM NUMBER LINES TRANSFERRED
          SA5    GKDA        *MORE DAYFILES, ENTER OUT FOR LIST*
          MOVE   GKDDL,GKDD,X5
          SX7    X5+GKDDL    UPDATE LINE NUMBER
          SA7    A5+
 
*         SET END OF BUFFER.
 
 GKD2     SA3    GKDA        SET ZERO WORD TO END BUFFER
          BX6    X6-X6
          SA6    X3
          SB7    KBUF        SET *K* DISPLAY BUFFER ADDRESS
          SX5    =C*PERMANENT DAYFILE LIST COMPLETE.*
          EQ     GKDX
 
 GKDA     CON    KBUF        *K* DISPLAY BUFFER LINE ADDRESS
 GKDB     CON    0           *K* DISPLAY LINE COUNT
 GKDC     DATA   C*        *
          DATA   C*                 PERMANENT DAYFILE CATALOG*
 GKDD     DATA   C*        *
 GKDCL    EQU    *-GKDC
          DATA   C*               MORE PERMANENT DAYFILES.    *
          DATA   C/               ENTER *OUT* FOR A FULL LIST./
          CON    0           END OF *K* DISPLAY
 GKDDL    EQU    *-GKDD
 IPH      SPACE  4,15
**        IPH - INITIALIZE PAGE HEADER AND PAGE CONTROL.
*
*         EXIT   (PPOS) SET TO END OF PAGE.
*                (PNUM) SET TO PAGE 1.
*                (DNUM) SET TO DAYFILE NUMBER 1.
*                (PDFE+1) SET TO 1 (FORMAT EFFECTOR NOT YET OUTPUT).
*
*         USES   A - 1, 6, 7.
*                X - 1, 2, 6, 7.
*
*         CALLS  COD.
*
*         MACROS CLOCK, DATE.
 
 
 IPH      SUBR               ENTRY/EXIT
 
*         SET DATE AND TIME IN PAGE HEADER.
 
          DATE   BOFA+4      PUT DATE IN PAGE HEADING
          SA1    BOFA+4
          SX2    1R.&1R      CLEAR PERIOD AT RIGHT OF DATE
          BX6    X1-X2
          SA6    A1
          CLOCK  BOFA+5      PUT TIME IN PAGE HEADING
          SA1    BOFA+5
          SX2    1R.&1R      CLEAR PERIOD AT RIGHT OF TIME
          BX6    X1-X2
          SA6    A1
 
*         SET USER INDEX IN PAGE HEADER.
 
          SX1    PDUI        PUT PERMANENT DAYFILE USER INDEX IN HEADER
          RJ     COD
          LX6    12
          SA1    BOFA+3
          MX2    36
          LX2    -12
          BX6    X2*X6
          BX1    -X2*X1
          BX6    X1+X6
          SA6    A1
 
*         SET PAGE POSITION, PAGE NUMBER AND DAYFILE NUMBER.
 
          SX7    99999       FORCE END OF PAGE
          SX6    B1
          SA7    PPOS
          SA6    PNUM        SET TO PAGE 1
          SA6    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
          SA6    DNUM        SET TO DAYFILE 1
          EQ     IPHX
 PUN      SPACE  4,11
**        PUN - PERMIT SPECIFIED USER NUMBER WITH WRITE PERMISSION.
*
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*
*         USES   A - 1, 2, 7.
*                B - 7.
*                X - 0, 1, 2, 5, 6, 7.
*
*         CALLS  ERP.
*
*         MACROS PERMIT.
 
 
 PUN      SUBR               ENTRY/EXIT
          SA1    PUNA        CHECK IF USER NUMBER SPECIFIED
          SX5    B0+         SET NO ERROR
          ZR     X1,PUNX     IF NO USER NUMBER
 
*         CHECK FOR PRIVATE PACK.
 
          SA2    FMPC        CHECK AUXILIARY DEVICE FLAG
          SX6    X2+
          ZR     X6,PUN1     IF FAMILY
          SA2    APIN
          MX0    42
          BX6    X0*X2
          NZ     X6,PUNX     IF PRIVATE PACK
 
*         PERMIT SPECIFIED USER NUMBER.
 
 PUN1     PERMIT D,,PUNA,0,,,,IE
          BX7    X7-X7       CLEAR USER NUMBER FROM FET
          SA2    D           CHECK FOR ERROR
          MX0    8
          SA7    D+CFOU
          LX0    18
          BX6    X0*X2
          ZR     X6,PUNX     IF NO ERROR
          BX7    -X0*X2      CLEAR ERROR BITS
          SA7    A2
 
*         PROCESS ERROR.
 
          RJ     ERP         ERROR PROCESSOR
          ZR     X5,PUN1     IF RETRY OPERATION
          SB7    B0+
          EQ     PUNX
 
 PUNA     VFD    42/0L"USRN",18/0  USER NUMBER TO PERMIT
 TOD      SPACE  4,11
**        TOD - TERMINATE OLD DAYFILES.
*
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*
*         USES   A - 2, 4, 5.
*                B - 2, 3, 7.
*                X - 0, 2, 4, 5, 6.
*
*         MACROS MESSAGE, SYSTEM, WAIT.
 
 
 TOD      SUBR               ENTRY/EXIT
 TOD0     SX5    B0+         SET NO ERROR
          SA4    TARA+AROP   OPTION
          MX0    -12
          BX4    -X0*X4
          ZR     X4,TOD1     IF INACTIVE DAYFILE TERMINATION
 
*         TERMINATE ACTIVE DAYFILE.
 
          SYSTEM SFM,R,D,TAFF*100B
          EQ     TOD2
 
*         TERMINATE INACTIVE DAYFILE.
 
 TOD1     SYSTEM SFM,R,D,ATDF*100B
 TOD2     SA2    D           CHECK FOR ERROR
          MX0    4
          LX0    14
          BX6    X0*X2
          SB7    B0
          ZR     X6,TODX     IF NO ERROR
 
*         PROCESS DAYFILE TERMINATION ERRORS.
 
          LX6    -10
          SA5    TSEP+X6     GET *SFM* ERROR MESSAGE ADDRESS
          SB3    X6
          EQ     B1,B3,TOD4  IF DAYFILE BUSY
          SB2    3
          EQ     B2,B3,TOD3  IF INACTIVE DAYFILE NOT FOUND
          MESSAGE  X5        ISSUE *SFM* ERROR MESSAGE
          SX5    TODA        * DAYFILE STATUS INDEFINITE.*
 TOD3     EQ     TODX        RETURN
 
*         PROCESS DAYFILE BUSY ERROR.
 
 TOD4     MESSAGE (=C* WAITING FOR BUSY DAYFILE.*),2,R
          WAIT   100         DELAY
          EQ     TOD0        RETRY
 
 
 TODA     DATA   C* DAYFILE STATUS INDEFINITE.             *
 VED      SPACE  4,21
**        VED - VALIDATE EXISTENCE OF DAYFILE ON DEVICE.
*
*         ENTRY  (X2) = OPTION.
*                (X3) = DAYFILE TYPE.
*                (X4) = EST ORDINAL.
*
*         EXIT   (X3) = DAYFILE TYPE.
*                (X4) = EST ORDINAL.
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*                (FMPC) = FAMILY/PACK NAME FOR PERMANENT DAYFILE.
*                (APIN) = AUXILIARY PACK INFORMATION.
*                (GOPB) = EST ORDINAL OF ACTIVE DAYFILE IF
*                         ACTIVE TERMINATION.
*
*         USES   A - 1, 6.
*                B - 7.
*                X - 0, 1, 2, 5, 6.
*
*         CALLS  SAD, VVD.
 
 
 VED      SUBR               ENTRY/EXIT
 
*         VERIFY THAT DAYFILE MAY BE TERMINATED AS SPECIFIED.
 
          ZR     X4,VED4     IF AN INVALID EST ORDINAL
          RJ     VVD         VERIFY VALID DEVICE FOR DAYFILE
          SB7    B0+         SET NO *K* DISPLAY BUFFER
          NZ     X5,VEDX     IF VALIDITY ERROR
          SA6    FMPC        SAVE FAMILY/PACK NAME
          ZR     X2,VED2     IF INACTIVE DAYFILE TERMINATION
 
*         FIND ACTIVE DAYFILE FAMILY/PACK AND EQUIPMENT.
 
          SX6    X7-3
          ZR     X6,VEDX     IF ACTIVE DAYFILE CURRENTLY ON DEVICE
          RJ     SAD         SEARCH FOR ACTIVE DAYFILE
          NZ     B4,VED3     IF NO ACTIVE DAYFILE FOUND
          SX6    B2          SAVE ACTIVE DAYFILE EST ORDINAL
          LX6    48
          SX2    B1
          BX6    X2+X6
          SA6    GOPB
 
*         SET FAMILY/PACK INFORMATION.
 
          MX0    42          SAVE FAMILY/PACK NAME OF ACTIVE DAYFILE
          BX6    X0*X1
          LX1    -2          ADD AUXILIARY PACK FLAG
          BX2    X2*X1
          BX6    X6+X2
          SA6    FMPC
          BX5    X5-X5       SET NO ERROR
          ZR     X2,VED1     IF NOT AUXILIARY PACK
          SA1    TMSA+B2     SET AUXILIARY PACK INFORMATION
          MX0    48
          BX1    X0*X1
          SX6    B2
          BX6    X1+X6
          SA6    APIN
 VED1     ZR     X7,VEDX     IF NO INACTIVE DAYFILE ON DEVICE
          SX5    =C* INACTIVE DAYFILE ON DEVICE.     *
          EQ     VEDX
 
*         CHECK FOR INACTIVE DAYFILE ON SPECIFIED DEVICE.
 
 VED2     SX6    X7-1
          ZR     X6,VEDX     IF INACTIVE DAYFILE ON DEVICE
          SX5    =C* INACTIVE DAYFILE NOT FOUND ON DEVICE.*
          EQ     VEDX
 
 VED3     SX5    =C* NO ACTIVE DAYFILE FOUND.      *
          EQ     VEDX
 
 VED4     SX5    =C* INVALID DEVICE SPECIFIED.        *
          EQ     VEDX        RETURN
 BDL      TITLE  SECONDARY SUBROUTINES.
**        BDL - BUILD DAYFILE LINE.
*
*         ENTRY  (X1) = ADDRESS OF LIST CONTROL BLOCK.
*                (X2) = ADDRESS OF AREA TO RECEIVE LIST LINE.
*
*         EXIT   (X6) = 0 IF LIST LINE AVAILABLE.
*                     = 1 IF END OF LIST.
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*
*         USES   A - 0, 1, 2, 5, 6, 7.
*                B - 2, 3, 6, 7.
*                X - 1, 2, 3, 5, 6, 7.
*
*         CALLS  DDD, EDI, FDE, GCD, RCE.
 
 
 BDL      SUBR               ENTRY/EXIT
          SA0    X1+B1       SET ADDRESS OF CATALOG LIST INDEX
          SX6    X2          SAVE ADDRESS OF OUTPUT AREA
          SA6    BDLA
          SA2    A0          GET CATALOG LIST INDEX
          SX1    X2
          NZ     X1,BDL2     IF NOT INITIALIZE CALL
 
*         INITIALIZE POINTERS FOR READING OF CATALOG.
 
 BDL1     SA1    A0          GET CATALOG LIST INDEX
          SX6    B1
          IX7    X1+X6       ADVANCE INDEX
          SB2    X7
          AX1    18          GET LIST LENGTH
          SB3    X1+
          BX5    X5-X5       CLEAR ERROR FLAG
          GT     B2,B3,BDLX  IF END OF CATALOG LIST
          SA7    A1+         SAVE CATALOG LIST INDEX
          RJ     GCD         GET CATALOG DESCRIPTION
          MX2    43          SAVE FAMILY/PACK NAME
          BX6    X2*X1
          SA6    BDLB+2
          BX2    -X2*X1      USER INDEX
          LX1    X6          FAMILY/PACK NAME
          RJ     DDD         DETERMINE DEFAULT DEVICE
          SA5    A0+         CATALOG LIST INDEX
          LX6    36
          MX1    -36         CLEAR OLD DEFAULT DEVICE NUMBER
          BX5    -X1*X5
          BX6    X6+X5
          SA6    A5
          BX1    X1-X1       SET INITIAL CATALOG READ
 
*         OBTAIN CATALOG INFORMATION.
 
 BDL2     SA2    A0-1        GET FET ADDRESS
          SB6    CENB        ADDRESS OF AREA TO RECEIVE CATALOG ENTRY
          RJ     RCE         READ A CATALOG ENTRY
          NZ     X5,BDLX     IF ERROR DURING CATALOG
          NZ     X1,BDL1     IF CATALOG ENTRY NOT READ
          SA1    CENB        EXTRACT DAYFILE INFORMATION FROM CATALOG
          SB2    BDLB
          RJ     EDI
          SX1    B1+         SET FOR NON-INITIAL CATALOG READ
          ZR     X6,BDL2     IF NOT A DAYFILE
          SA1    B2          CHECK DEVICE NUMBER
          MX3    6
          LX3    -42
          BX6    X3*X1
          NZ     X6,BDL3     IF NON-ZERO DEVICE NUMBER
          SA2    A0          SUBSTITUTE DEFAULT DEVICE NUMBER
          LX2    -24
          BX2    X3*X2
          BX6    X1+X2
          SA6    A1+
 
*         FORMAT DAYFILE ENTRY.
 
 BDL3     SB6    B2          DAYFILE INFORMATION
          SA1    BDLA        OUTPUT ADDRESS
          SB7    X1
          RJ     FDE         FORMAT DAYFILE ENTRY
          BX6    X6-X6       SET LINE AVAILABLE STATUS
          BX5    X5-X5       CLEAR ERROR FLAG
          EQ     BDLX        EXIT
 
 BDLA     CON    0           OUTPUT STRING ADDRESS
 BDLB     BSS    3           DAYFILE ENTRY BUFFER
 CAN      SPACE  4,16
**        CAN - CHECK CATALOG FOR AVAILABLE NAME.
*
*         ENTRY  (SNAM) = USER SPECIFIED NAME.
*                (ANAM) = SKELETON OF AUTOMATIC ASSIGNMENT NAME.
*
*         EXIT   (CANB) = AUTOMATIC ASSIGNMENT SEQUENCE CHARACTER MASK.
*                (SNAM) = 1 IF DUPLICATE SPECIFIED NAME.
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*
*         USES   A - 2, 3, 4, 6.
*                B - 3, 6.
*                X - ALL.
*
*         CALLS  RCE.
 
 
 CAN      SUBR               ENTRY/EXIT
          BX6    X6-X6       CLEAR MASK
          SA6    CANB
 
*         READ CATALOG ENTRIES.
 
          BX1    X1-X1       SET INITIAL CALL FOR CATALOG READ
 CAN1     SX2    C           READ CATALOG ENTRY
          SB6    CENB
          RJ     RCE
          NZ     X5,CANX     IF ERROR ON INITIAL CATALOG
          NZ     X1,CANX     IF END OF CATALOG ENTRIES
          SA3    CENB        CHECK NAME
 
*         CHECK FOR DUPLICATE SPECIFIED NAME.
 
          SA4    SNAM        CHECK SPECIFIED NAME
          ZR     X4,CAN2     IF NONE SPECIFIED
          MX0    42
          BX6    X3-X4
          BX7    X0*X6
          SX6    B1          SET FLAG
          NZ     X7,CAN2     IF NOT A DUPLICATE
          SA6    A4+
 
*         BUILD AUTOMATIC SEQUENCE CHARACTER MASK.
 
 CAN2     SA4    CANA        CHECK FOR PERMANENT DAYFILES
          SA2    ANAM
          BX4    X4*X3
          BX1    X4-X2
          NZ     X1,CAN1     IF NOT PERMANENT DAYFILE
          AX3    42          SET UP MASK FOR SEQUENCE LETTER
          MX0    -6
          BX5    -X0*X3
          SB3    X5
          MX4    1
          LX1    X4,B3
          SA3    A4+B1       PREVIOUS SEQUENCE CHARACTER MASK
          BX6    X3+X1       ADD SEQUENCE CHARACTER TO MASK
          SA6    A3
          EQ     CAN1        LOOP FOR NEXT CATALOG
 
 CANA     CON    77770077777777000000B
 CANB     CON    0           SEQUENCE CHARACTER MASK
 CDN      SPACE  4,10
**        CDN - CATAGORIZE DAYFILE NAME.
*
*         ENTRY  (X1) = 42/DAYFILE NAME, 18/
*
*         EXIT   (X1) = UNCHANGED.
*                (X6) = DAYFILE TYPE CODE.
*                     = 0 IF NOT A DAYFILE NAME.
*
*         USES   A - 2, 7.
*                X - 2, 3, 6, 7.
 
 
 CDN      SUBR               ENTRY/EXIT
          SX6    TDNKL       SET TO END OF KEY TABLE
          SX3    B1+
          MX2    12          SAVE KEY PART OF DAYFILE NAME
          BX7    X2*X1
          SA7    TDNK
 
*         FIND NAME KEY IN TABLE.
 
 CDN1     IX6    X6-X3       DECREMENT TABLE INDEX
          SA2    TDNK+X6     GET KEY FROM TABLE
          BX2    X2-X7       COMPARE FILE NAME KEY WITH TABLE KEY
          NZ     X2,CDN1     IF NO MATCH
          EQ     CDNX
 DDD      SPACE  4,11
**        DDD - DETERMINE DEFAULT DEVICE.
*
*         ENTRY  (X1) = FAMILY/PACK NAME.
*                (X2) = USER INDEX.
*
*         EXIT   (X6) = DEFAULT DEVICE NUMBER.
*                     = 0 IF NONE FOUND OR IF AUXILIARY PACK.
*
*         USES   A - 2, 3.
*                B - 2, 3.
*                X - 2, 3, 6.
 
 
 DDD      SUBR               ENTRY/EXIT
          BX6    X6-X6       INITIALIZE DEFAULT DEVICE NUMBER
          SX3    X1
          NZ     X3,DDDX     IF AUXILIARY DEVICE
 
*         GET USER INDEX MASK BITS.
 
          MX6    -3
          BX2    -X6*X2
          SB2    X2-59       MASK TEST SHIFT COUNT
          SB3    B0+         EST ORDINAL
 
*         CHECK FOR CORRECT FAMILY NAME.
 
 DDD1     SA2    TEQA+B3     GET ENTRY FOR EQUIPMENT B3
          ZR     X2,DDDX     IF END OF TABLE
          SB3    B3+B1       ADVANCE EST ORDINAL
          SX3    -B1
          IX3    X2-X3
          MX6    42
          ZR     X3,DDD1     IF NOT MASS STORAGE EQUIPMENT
          BX3    X6*X2
          IX6    X1-X3
          NZ     X6,DDD1     IF NOT CORRECT FAMILY
 
*         CHECK FOR USER INDEX ON DEVICE.
 
          SA3    TMSA+B3-1   GET DEVICE MASK FOR EQUIPMENT B3-1
          AX6    X3,B2
          AX2    12          GET DEVICE NUMBER
          PL     X6,DDD1     IF USER INDEX NOT ON THIS DEVICE
          MX3    -6
          BX6    -X3*X2
          EQ     DDDX
 EDI      SPACE  4,24
**        EDI - EXTRACT DAYFILE INFORMATION.
*
*         ENTRY  (A1) = ADDRESS OF CATALOG ENTRY TO EXTRACT INFORMATION
*                       FROM.
*                (X1) = FIRST WORD OF CATALOG ENTRY.
*                (B2) = ADDRESS OF 2 WORD BLOCK TO RECEIVE DAYFILE
*                       INFORMATION.
*
*         EXIT   (B2) = UNCHANGED.
*                (X6) = DAYFILE TYPE CODE.
*                     = 0 IF NOT A DAYFILE CATALOG ENTRY.
*                DATA BLOCK SET UP AS FOLLOWS AT ADDRESS (B2).
*                42/DAYFILE NAME, 6/DN, 12/DC
*                24/LF, 18/CD, 18/CT
*                     DN = DEVICE NUMBER OF DAYFILE.
*                     DC = DAYFILE TYPE CODE.
*                     LF = LENGTH OF DAYFILE.
*                     CD = PACKED CREATION DATE.
*                     CT = PACKED CREATION TIME.
*
*         USES   A - 2, 3, 6, 7.
*                X - 1, 2, 3, 6, 7.
*
*         CALLS  CDN.
 
 
 EDI      SUBR               ENTRY/EXIT
 
*         PACK NAME AND DEVICE NUMBER.
 
          MX6    42          GET FILE NAME
          BX1    X6*X1
          SA2    A1+4        GET DEVICE NUMBER
          MX6    6
          LX6    -18
          BX2    X6*X2
          LX2    -24         PACK FILE NAME AND DEVICE NUMBER
          BX1    X1+X2
 
*         PACK LENGTH, DATE, AND TIME.
 
          SA2    A1+B1       GET FILE LENGTH
          SA3    A2+B1       GET CREATION DATE AND TIME
          MX6    24
          BX3    -X6*X3
          BX6    X6*X2
          BX6    X6+X3       SAVE FILE LENGTH, DATE AND TIME
          SA6    B2+B1
          LX2    59-11
          NG     X2,EDI1     IF A DIRECT ACCESS FILE
 
*         SET NON-DAYFILE TYPE.
 
          BX6    X1          SAVE FILE NAME, DEVICE, AND 0 DAYFILE CODE
          SA6    B2
          BX6    X6-X6       SET NON-DAYFILE TYPE CODE
          EQ     EDIX
 
*         SET DAYFILE TYPE.
 
 EDI1     RJ     CDN         CATAGORIZE DAYFILE NAME
          BX7    X1+X6       SAVE FILE NAME, DEVICE, AND DAYFILE CODE
          SA7    B2
          EQ     EDIX
 ERP      SPACE  4,17
**        ERP - ERROR PROCESSOR FOR *PFM* CALLS.
*
*         ENTRY  (X6) = *PFM* ERROR CODE.
*
*         EXIT   (X5) = *K* DISPLAY ERROR MESSAGE ADDRESS.
*                     = 0 IF RETRY OPERATION.
*
*         USES   A - 6.
*                X - 1, 5, 6.
*
*         CALLS  ADN.
*
*         MACROS MESSAGE, RECALL.
 
 
 ERP      SUBR               ENTRY/EXIT
          LX6    -10
          SX1    X6-/ERRMSG/FAP
          ZR     X1,ERP1     IF FILE ALREADY PERMANENT ERROR
          SX1    X6-/ERRMSG/PFA
          ZR     X1,ERP2     IF PF UTILITY ACTIVE ERROR
          SX5    MPER        SET ERROR MESSAGE ADDRESS
          EQ     ERPX        RETURN
 
*         PROCESS FILE ALREADY PERMANENT ERROR.
 
 ERP1     RJ     ADN         ASSIGN DAYFILE NAME
          NZ     X5,ERPX     IF AUTOMATIC ASSIGNMENT IMPOSSIBLE
          BX6    X2          INSERT NEW NAME IN FET
          SA6    D+CFPN
          EQ     ERPX
 
*         PROCESS PF UTILITY ACTIVITY ERROR.
 
 ERP2     RECALL             WAIT FOR END OF PF UTILITY
          MESSAGE (=C* WAITING FOR PF UTILITY.*),2,R
          BX5    X5-X5
          EQ     ERPX
 ERR      SPACE  4,3
**        ERR - PROCESS ERROR EXIT.
*
*         ENTRY  TO *ERR1* IF STATUS OF DAYFILE IS NOT INDEFINITE.
*
*         MACROS ABORT, ENFAM, MESSAGE, PACKNAM.
 
 
 ERR      MESSAGE  TODA      *DAYFILE STATUS INDEFINITE.*
 ERR1     MESSAGE (=C* DFTERM ABORTED.*)
          PACKNAM CPCK       SET USER PACK
          ENFAM  CFAM        SET USER FAMILY
          ABORT
 FDE      SPACE  4,20
**        FDE - FORMAT DAYFILE ENTRY.
*
*         ENTRY  (B6) = ADDRESS OF DAYFILE INFORMATION.
*                42/FILE NAME, 6/DN, 12/DC
*                24/LF, 18/CD, 18/CT
*                42/FAMILY OR PACK NAME, 1/F, 17/0
*                       DN = DEVICE NUMBER FOR FILE.
*                       DC = DAYFILE TYPE CODE.
*                       LF = LENGTH OF DAYFILE.
*                       CD = CREATION DATE OF FILE.
*                       CT = CREATION TIME OF FILE.
*                       F = AUXILIARY PACK FLAG
*                (B7) = ADDRESS OF AREA TO RECEIVE FORMATTED OUTPUT.
*
*         EXIT   (B7) = ADDRESS OF FORMATTED DAYFILE INFORMATION.
*
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  COD, SFN.
*
*         MACROS EDATE, ETIME.
 
 
 FDE      SUBR               ENTRY/EXIT
 
*         FORMAT FAMILY/PACK NAME.
 
          SA1    B6+2        GET FAMILY/PACK NAME
          MX0    42
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    30          SAVE NAME
          SA6    B7+2
 
*         FORMAT DAYFILE TYPE AND DEVICE NUMBER.
 
          SA1    B6          GET DAYFILE TYPE
          MX2    -3
          BX2    -X2*X1
          SA2    TDFT+X2
          MX3    -30
          BX6    -X3*X6
          LX2    18
          BX7    X3*X2
          BX6    X7+X6       SAVE LOWER PART OF DAYFILE TYPE
          SA6    B7+B1
          BX6    X2          SAVE UPPER PART OF DAYFILE TYPE
          LX1    -12         GET DEVICE NUMBER
          SA6    B7+
          MX0    -6
          BX1    -X0*X1
          SX1    X1+100B     FORCE TWO DIGITS
          RJ     COD         CONVERT TO OCTAL
          SA1    B7+2        MERGE WITH FAMILY/PACK NAME
          MX3    -12
          BX6    -X3*X6
          LX3    30
          LX6    30
          BX1    X3*X1
          BX6    X1+X6
          SA6    A1          PUT DEVICE NUMBER IN OUTPUT STRING
 
*         FORMAT FILE NAME.
 
          SA1    B6          GET FILE NAME
          MX6    42
          BX1    X6*X1
          RJ     SFN         SPACE FILL FILE NAME
          LX6    24
          SA6    B7+3        PUT LOWER PART OF FILE NAME IN OUTPUT
          MX0    30
          BX6    -X0*X6
          SA1    A6-B1       SAVE UPPER PART OF FILE NAME
          BX1    X0*X1
          BX7    X1+X6
          SA7    A1
 
*         FORMAT DATE AND TIME.
 
          MX6    -18         GET CREATION DATE
          SA1    B6+B1
          LX1    -18
          BX1    -X6*X1
          EDATE  X1          EDIT DATE
          LX6    42
          SA6    B7+4        SAVE LOWER PART OF DATE IN OUTPUT
          SA1    A6-B1       SAVE UPPER PART OF DATE IN OUTPUT
          MX2    24
          BX1    X2*X1
          BX6    -X2*X6
          BX6    X1+X6
          SA6    A1
          SA1    B6+B1       GET CREATION TIME
          MX6    -18
          BX1    -X6*X1
          ETIME  X1          EDIT TIME
          LX6    48          SAVE LOWER PART OF TIME IN OUTPUT
          SA6    B7+5
          SA1    A6-B1       SAVE UPPER PART OF TIME IN OUTPUT
          MX2    12
          BX1    X2*X1
          BX6    -X2*X6
          BX6    X1+X6
          SA6    A1
 
*         FORMAT FILE LENGTH.
 
          SA1    B6+B1       GET FILE LENGTH
          LX1    -36
          MX6    -24
          BX1    -X6*X1
          RJ     COD         CONVERT FILE LENGTH TO OCTAL
          MX2    -42         SAVE FILE LENGTH
          BX7    -X2*X6
          LX7    12
          MX2    6
          SA1    B7+5
          BX1    X2*X1
          BX6    X1+X7
          SA6    A1
          EQ     FDEX
 GCD      SPACE  4,14
**        GCD - GET CATALOG DESCRIPTION.
*
*         ENTRY  (A0) = CATALOG LIST INDEX.
*                (B2) = TABLE INDEX.
*
*         EXIT   (X1) = TABLE ENTRY.
*                (A0) = CATALOG LIST INDEX.
*                (B2) = TABLE INDEX.
*                (APIN) = AUXILIARY PACK INFORMATION.
*                (FET+14) = 42/FAMILY OR PACK, 1/F, 17/USER INDEX.
*                       F = AUXILIARY PACK FLAG.
*
*         USES   A - 1, 2, 6, 7.
*                X - 1, 2, 3, 6, 7.
 
 
 GCD      SUBR               ENTRY/EXIT
          SA1    A0+B2       GET CATALOG DESCRIPTION
          MX3    1           CHECK AUXILIARY DEVICE FLAG
          LX3    18
          BX7    X3*X1
          ZR     X7,GCD1     IF FAMILY
 
*         GET AUXILIARY PACK INFORMATION.
 
          MX3    -17         GET EST ORDINAL
          BX7    -X3*X1
          BX3    X3*X1       SET USER INDEX IN ENTRY
          SX2    PDUI
          BX1    X3+X2
          SA2    TMSA+X7     SET AUXILIARY PACK INFORMATION
          MX3    48
          BX6    X3*X2
          BX7    X7+X6
          SA7    APIN
 
*         PUT DESCRIPTION IN FET.
 
 GCD1     BX6    X1
          SA2    A0-B1       GET FET ADDRESS
          SA6    X2+14       PUT CATALOG DESCRIPTION IN FET
          EQ     GCDX
 RCE      SPACE  4,23
**        RCE - READ CATALOG ENTRY.
*
*         ENTRY  (X1) = 0 FOR INITIALIZATION CALL.
*                     .NE. 0 FOR CONTINUATION CALL.
*                (X2) = FET ADDRESS.
*                (B6) = ADDRESS OF AREA TO RECEIVE CATALOG ENTRY.
*                (FET+14) = 42/FAMILY OR PACK NAME, 1/F, 17/USER INDEX.
*                       F = AUXILIARY PACK FLAG.
*
*         EXIT   (X2) = FET ADDRESS.
*                (X1) = 0 IF CATALOG ENTRY AVAILABLE.
*                     .NE. 0 IF END OF CATALOG.
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (B7) = 0 IF ERROR.
*                FAMILY/PACK NAME AND USER INDEX MAY BE CHANGED IN
*                CONTROL POINT AREA.
*
*         USES   A - 1, 6.
*                B - 7.
*                X - 1, 2, 5, 6.
*
*         CALLS  SFD, SFN.
*
*         MACROS CATLIST, MESSAGE, READW.
 
 
 RCE      SUBR               ENTRY/EXIT
          NZ     X1,RCE2     IF NOT INITIALIZATION CALL
          SX6    B0+
          SA6    X2+CFCN
 
*         READ CATALOG ENTRIES INTO BUFFER.
 
 RCE1     SA1    X2+B1       REWIND BUFFER POINTERS
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          SB7    X2+         SAVE FET ADDRESS
          SA1    X2+14       SET FAMILY/PACK DESCRIPTION
          RJ     SFD
          SX2    B7          RESTORE FET ADDRESS
          CATLIST  X2,,,,,,,IE
          SA1    C           CHECK FOR ERROR
          MX6    8
          LX6    18
          BX1    X6*X1
          ZR     X1,RCE2     IF NO ERROR
 
*         ISSUE ERROR MESSAGE.
 
          MX5    42          SET FAMILY/PACK NAME IN MESSAGE
          SA1    X2+14
          BX1    X5*X1
          SB7    B0
          RJ     SFN         SPACE FILL NAME
          BX6    X5*X6
          SA1    RCEA+3
          BX1    -X5*X1
          BX6    X1+X6
          SA6    A1
          SX5    RCEA        SET MESSAGE ADDRESS
          SA1    TARA+ARFC   ISSUE DAYFILE MESSAGE ON *DFLIST*
          PL     X1,RCEX     IF NO *PO=N* PARAMETER
          SX6    X1-2
          NZ     X6,RCEX     IF NOT LIST
          MESSAGE X5
          EQ     RCEX
 
*         READ ONE CATALOG ENTRY.
 
 RCE2     READW  X2,B6,NWCE  READ A CATALOG ENTRY
          BX5    X5-X5       CLEAR ERROR FLAG
          ZR     X1,RCEX     IF CATALOG ENTRY TRANSFERRED
          SX1    X1+B1
          ZR     X1,RCE1     IF NOT END OF CATALOG
          EQ     RCEX
 
 RCEA     DATA   C* CANNOT CATLIST FAMILY/PACK -        .*
 SAD      SPACE  4,12
**        SAD - SEARCH FOR ACTIVE DAYFILE.
*
*         ENTRY  (B3) = SHIFT COUNT FOR DAYFILE BITS IN TABLE *TEQA*.
*
*         EXIT   (B2) = EST ORDINAL OF ACTIVE DAYFILE.
*                (B4) = 0 IF ACTIVE DAYFILE FOUND.
*                     = 1 IF NOT FOUND.
*                (X1) = FAMILY/PACK NAME WORD FOR ACTIVE DAYFILE.
*
*         USES   A - 1.
*                B - 2, 4.
*                X - 1, 5, 6.
 
 
 SAD      SUBR               ENTRY/EXIT
          SB2    B0+         SET EST ORDINAL
          SB4    B1+         SET NO ACTIVE DAYFILE FLAG
 
*         SEARCH TABLE FOR ACTIVE DAYFILE OF SPECIFIED TYPE.
 
 SAD1     SA1    TEQA+B2     SEARCH TABLE
          ZR     X1,SADX     IF END OF TABLE
          SB2    B2+B1       ADVANCE EQUIPMENT
          SX5    B1+
          IX5    X5+X1
          ZR     X5,SAD1     IF NOT MASS STORAGE
          AX6    B3,X1       CHECK FOR ACTIVE DAYFILE
          SX5    B1+B1
          BX6    X5*X6
          ZR     X6,SAD1     IF ACTIVE DAYFILE NOT ON DEVICE
 
*         SET EST ORDINAL AND FAMILY/PACK NAME WORD.
 
          SB2    B2-B1       SET EST ORDINAL
          SB4    B0          CLEAR FLAG
          EQ     SADX
 SAI      SPACE  4,10
**        SAI - SET AUXILIARY PACK INFORMATION IN FETS.
*
*         ENTRY  (APIN) = 42/USER NUMBER, 6/UNITS, 12/EQUIPMENT.
*
*         EXIT   CATALOG (C) AND DAYFILE (D) FETS SET UP WITH DEVICE
*                TYPE IN WORD 1, USER NUMBER, IF ANY, FOR PRIVATE PACK
*                IN WORD 9, AND NUMBER OF PHYSICAL UNITS IN WORD 12.
*
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 6, 7.
*
*         MACROS RDVT.
 
 
 SAI      SUBR               ENTRY/EXIT
 
*         SET USER NUMBER FOR PACK IN FETS.
 
          SA1    APIN        SET USER NUMBER
          MX0    42
          BX7    X0*X1
          SA7    C+CFOU
          SA7    D+CFOU
 
*         SET NUMBER OF PHYSICAL UNITS IN FETS.
 
          AX1    12          GET NUMBER UNITS - 1
          MX0    -6
          BX7    -X0*X1
          SX6    X7+B1       SET UNITS
          SA6    C+CFPK
          SA6    D+CFPK
 
*         GET DEVICE TYPE.
 
          SA2    A1          SET EQUIPMENT
          MX0    -12
          BX2    -X0*X2
          RDVT   D,X2
          SA2    D+1         SET DEVICE TYPE IN CATALOG FET
          SA1    C+1
          MX0    12
          BX6    X0*X2
          BX1    -X0*X1
          BX7    X1+X6
          SA7    A1
          EQ     SAIX
 SFD      SPACE  4,16
**        SFD - SET FAMILY DESCRIPTION.
*
*         ENTRY  (X1) = 42/FAMILY OR PACK NAME, 1/F, 17/USER INDEX.
*                       F = AUXILIARY PACK FLAG.
*
*         EXIT   FAMILY/PACK NAME AND/OR USER INDEX SET IN CONTROL
*                POINT AREA IF REQUESTED VALUE WAS DIFFERENT THAN THE
*                CURRENT VALUE STORED INTERNALLY TO *SFD*.  ILLEGAL
*                VALUES FOR CURRENT FAMILY NAME AND CURRENT USER INDEX
*                ARE STORED INITIALLY TO FORCE A CALL TO *CPM* ON THE
*                FIRST CALL TO *SFD*.
*                AUXILIARY PACK INFORMATION IS SET IN THE FETS IF
*                NECESSARY.
*
*         USES   A - 2, 6.
*                X - 0, 2, 3, 5, 6, 7.
*
*         CALLS  SAI.
*
*         MACROS ENFAM, PACKNAM, SETUI.
 
 
 SFD      SUBR               ENTRY/EXIT
 
*         COMPARE CURRENT AND REQUESTED FAMILY AND USER INDEX.
 
          MX3    -17         REQUESTED USER INDEX
          BX6    -X3*X1
          SA2    SFDA+2      CURRENT USER INDEX
          BX5    X3*X1       REQUESTED FAMILY/PACK NAME
          IX7    X2-X6
          ZR     X7,SFD1     IF REQUESTED USER INDEX ALREADY SET
          SA6    A2          SET NEW USER INDEX
          SETUI  X6
 
*         CHECK IF FAMILY OR PACK REQUESTED.
 
 SFD1     SX6    X5+         CHECK AUXILIARY DEVICE FLAG
          SA2    SFDA+B1     CURRENT FAMILY/PACK
          NZ     X6,SFD2     IF AUXILIARY PACK
 
*         SET FAMILY NAME IF NECESSARY.
 
          BX7    X5-X2
          BX6    X5          SET NEW FAMILY NAME
          ZR     X7,SFDX     IF REQUESTED FAMILY ALREADY SET
          SA6    A2
          SA6    A6-B1
          BX6    X6-X6       CLEAR ALTERNATE USER NUMBER IN FET
          SA6    C+CFOU
          PACKNAM 0          CLEAR PACK NAME
          ENFAM  SFDA
          EQ     SFDX        RETURN
 
*         SET PACK NAME IF NECESSARY.
 
 SFD2     SX6    B1          SET AUXILIARY PACK FLAG
          MX0    42
          BX5    X0*X5
          BX6    X5+X6
          BX7    X6-X2
          ZR     X7,SFDX     IF REQUESTED PACK ALREADY SET
          SA6    A2
          BX6    X5          SET PACK NAME IN CONTROL POINT AREA
          SA6    A6-B1
          PACKNAM SFDA
          RJ     SAI         SET AUXILIARY PACK INFORMATION
          EQ     SFDX        RETURN
 
 SFDA     BSS    1           SCRATCH AREA FOR ENFAM MACRO
          VFD    42/1,18/0   CURRENT FAMILY/PACK NAME
          VFD    42/0,18/0   CURRENT USER INDEX
 VVD      SPACE  4,26
**        VVD - VERIFY VALID DEVICE FOR DAYFILE EXISTENCE.
*
*                CHECK FOR AUXILIARY OR REMOVABLE DEVICES.  ACTIVE
*                DAYFILES MAY NOT EXIST ON REMOVABLE DEVICES.  ALSO,
*                NEW ACTIVE DAYFILES MAY NOT BE STARTED ON PRIVATE
*                PACKS UNLESS THE USER NUMBER SPECIFIED FOR PERMITS
*                MATCHES THE USER NUMBER OF THE PRIVATE PACK.
*
*         ENTRY  (X2) = OPTION.
*                (X3) = DAYFILE TYPE.
*                (X4) = EST ORDINAL.
*
*         EXIT   (X2) = OPTION.
*                (X3) = DAYFILE TYPE.
*                (X4) = EST ORDINAL.
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
*                (X6) = FAMILY/PACK NAME FOR EQUIPMENT.
*                (X7) = DAYFILE EXISTENCE BITS FOR SPECIFIED TYPE.
*                (B3) = SHIFT COUNT FOR DAYFILE BITS.
*                (APIN) = AUXILIARY PACK INFORMATION.
*                       42/USER NUMBER, 6/UNITS, 12/EST ORDINAL.
*
*         USES   A - 1, 5, 6.
*                B - 2, 3.
*                X - 0, 1, 5, 6, 7.
 
 
 VVD      SUBR               ENTRY/EXIT
 
*         CHECK IF LEGAL DEVICE FOR TERMINATION.
 
          SA1    TEQA+X4     GET EQUIPMENT ENTRY
          BX7    X7-X7       CHECK IF AUXILIARY DEVICE
          LX1    59-2
          PL     X1,VVD1     IF NOT AUXILIARY DEVICE
          SA5    TMSA+X4     SET AUXILIARY PACK INFORMATION
          MX0    48
          BX5    X0*X5
          BX6    X5+X4
          SX7    B1          SET AUXILIARY DEVICE FLAG
          SA6    APIN
          MX0    42          GET USER NUMBER
          BX6    X0*X6
          ZR     X6,VVD1     IF NOT PRIVATE PACK
          SA5    PUNA        CHECK IF LEGAL PACK FOR TERMINATION
          BX6    X5-X6
          ZR     X6,VVD1     IF PRIVATE PACK UN SAME AS PERMIT
          SX5    =C* PRIVATE PACK/PERMIT UN CONFLICT.*
          EQ     VVDX
 
 VVD1     LX1    2-1
          PL     X1,VVD2     IF NOT REMOVABLE DEVICE
          NZ     X2,VVD3     IF ACTIVE DAYFILE TERMINATION
 
*         GET FAMILY/PACK NAME AND DAYFILE EXISTENCE BITS.
 
 VVD2     SA1    A1          GET FAMILY/PACK NAME
          MX0    42
          BX6    X0*X1
          BX6    X6+X7       ADD AUXILIARY DEVICE FLAG
          SX5    X3-1        SET SHIFT COUNT FOR DAYFILE RESIDENCE BITS
          SB2    10
          LX5    X5,B1
          SB3    X5+
          MX0    -2          GET DAYFILE TYPE BITS FOR DEVICE
          SB3    B2-B3
          AX1    B3
          BX7    -X0*X1
          BX5    X5-X5       SET NO ERROR
          EQ     VVDX
 
 VVD3     SX5    =C* REMOVABLE DEVICE/NO ACTIVE DAYFILES.*
          EQ     VVDX
          TITLE  DAYFILE NAME TABLES.
**        TDNK - TABLE OF DAYFILE NAME KEYS.
*
*         INDEX INTO TABLE IS DAYFILE TYPE CODE (ZERO IF NOT A DAYFILE
*         NAME).
 
 TDNK     BSS    0           TABLE OF DAYFILE NAME KEYS
          LOC    0
          BSS    1           INPUT KEY (USED BY SEARCH ALGORITHM)
          DATA   2LDF        MASTER DAYFILE TYPE
          DATA   2LAC        ACCOUNT DAYFILE TYPE
          DATA   2LER        ERROR LOG DAYFILE TYPE
          DATA   2LML        MAINTENANCE LOG DAYFILE TYPE
 TDNKL    BSS    0           TABLE LENGTH
          LOC    *O
          SPACE  4,3
**        TDFT - TABLE OF DAYFILE TYPE NAMES.
*
*         INDEX INTO TABLE IS DAYFILE TYPE CODE (ZERO IF NOT A DAYFILE).
 
 TDFT     BSS    0           TABLE OF DAYFILE TYPES
          LOC    0
          DATA   10LNONE        NOT DAYFILE
          DATA   10LDAYFILE     MASTER DAYFILE
          DATA   10LACCOUNT     ACCOUNT DAYFILE
          DATA   10LERRLOG      ERROR LOG DAYFILE
          DATA   10LMAINLOG     MAINTENANCE LOG DAYFILE
          LOC    *O
          TITLE  ERROR PROCESSING TABLES.
**        TSEP - TABLE OF *SFM* ERROR PROCESSING.
*
*         INDEX INTO TABLE IS *SFM* ERROR CODE.
*         QUANTITY REPRESENTS ERROR MESSAGE ADDRESS.
 
 TSEP     BSS    0           TABLE OF *SFM* ERROR PROCESSING
          LOC    0
          BSS    1
          CON    MS01        FILE BUSY
          CON    MS02        NOT ENOUGH MASS STORAGE
          CON    MS03        FILE NOT FOUND
          CON    MS04        UNCORRECTABLE RMS ERROR
          LOC    *O
          TITLE  ERROR PROCESSING MESSAGES.
**        *SFM* ERROR MESSAGES.
 
 MS01     DATA   C* DAYFILE BUSY.                *
 MS02     DATA   C* NOT ENOUGH MASS STORAGE.     *
 MS03     DATA   C* INACTIVE DAYFILE NOT FOUND ON DEVICE.     *
 MS04     DATA   C* UNCORRECTABLE RMS ERROR.     *
 
**        *PFM* ERROR MESSAGES.
 
 MPER     BSS    4           *PFM* ERROR MESSAGE RETURN BLOCK
          TITLE  COMMON DECKS.
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCEDT
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCPFM
*CALL     COMCRDC
*CALL     COMCRDW
*CALL     COMCSFM
*CALL     COMCSFN
*CALL     COMCSYS
*CALL     COMCWTC
*CALL     COMCWTW
          TITLE  BUFFERS.
          USE    LITERALS
 
*         BUFFERS.
 
 CENB     BSS    NWCE        CATALOG ENTRY BUFFER
 PDCB     BSS    PDCBL       PERMANENT DAYFILE LIST CONTROL BUFFER
 PDLB     BSS    PDLBL       PERMANENT DAYFILE LIST LINE BUFFER
 KBUF     VFD    11/0,1/1,1/1,5/0,18/KTIA,24/0  K-DISPLAY BUFFER
 DBUF     EQU    *+KBUFL     TERMINATED DAYFILE BUFFER
 CBUF     EQU    DBUF+DBUFL  CATALOG BUFFER
 OBUF     EQU    CBUF+CBUFL  OUTPUT BUFFER
 DSPB     EQU    OBUF+OBUFL  *DSP* PARAMETER BLOCK
 BUFFL    EQU    DSPB+DSPBL  END OF BUFFERS
          SPACE  4,10
          ERRPL  *-RFL       IF DEFAULT FIELD LENGTH TOO SMALL
          SPACE  4
          END    DFTERM