DFTERM
          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 
