Retro1.org codex

          IDENT  DAYFILE,FETS
          ABS
          SST
          SYSCOM B1
          ENTRY  AFD
          ENTRY  DAYFILE
          ENTRY  DFD
          ENTRY  ELD
          ENTRY  GETLOG
          ENTRY  MAINLOG
          ENTRY  ARG=
          ENTRY  RFL=
          ENTRY  SSJ=
          ENTRY  UTL=
 
*COMMENT  DAYFILE - DUMP DAYFILES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  DAYFILE - DUMP DAYFILES.
          SPACE  4
***       DAYFILE - DUMP DAYFILES.
*         J. C. BOHNHOFF.    75/02/15.
*         S. L. KSANDER.     75/08/16.
*         P. L. VERELL.      79/11/07.
          SPACE  4
***              *DAYFILE* ACCESSES THE INDICATED DAYFILE AND COPIES
*         IT TO THE REQUESTED FILE.  CERTAIN PORTIONS OF DAYFILES MAY
*         BE SELECTIVELY COPIED.
          SPACE  4
***       THE COMMAND -
*
*         AFD(OPT)           DUMP ACCOUNT DAYFILE. **
*         DAYFILE(OPT)       DUMP USER JOB DAYFILE.
*         DFD(OPT)           DUMP SYSTEM DAYFILE. **
*         ELD(OPT)           DUMP ERROR LOG DAYFILE. **
*         GETLOG(OPT)        DUMP ERROR LOG AND BML FOR *HPA*.  **
*         MAINLOG(OPT)       DUMP MAINTENANCE LOG. **
*
*         **     THESE CALLS ARE ALLOWED ONLY IF -
*                CALLER HAS SYSTEM ORIGIN, OR CALLER HAS SYSTEM
*                ORIGIN PRIVILEGES AND SYSTEM IS IN DEBUG MODE.
*
*         WHERE  OPT =       OPTIONS. ANY OF THE FOLLOWING -
*
*                L           FILE TO WHICH DAYFILE IS DUMPED.  FOR
*                            *GETLOG*, THIS IS THE *ERRLOG* FILE.  THE
*                            DEFAULT IS *ERR* FOR *GETLOG* AND IS
*                            *OUTPUT* FOR ALL OTHER ENTRY POINTS.  IF
*                            EQUATED THEN THE FILE NAME MAY BE ANY
*                            VALID FILE NAME.  IF, BY ONE OF THE ABOVE
*                            MEANS, THE FILE NAME IS SET TO *OUTPUT*,
*                            PAGINATION OCCURS.  THE TITLE LINE OF
*                            EACH PAGE CONTAINS THE TIME AND DATE OF
*                            THE DUMP, THE TIME FIELD OF THE FIRST
*                            DAYFILE ENTRY ON THE PAGE, AND THE PAGE
*                            NUMBER.  IF EITHER OR BOTH OF THE PD OR
*                            PL ARGUMENTS ARE SPECIFIED, PAGINATION
*                            ALWAY OCCURS, REGARDLESS OF THE OUTPUT
*                            FILE NAME.  PAGES ARE NEVER GIVEN IF THE
*                            OUTPUT FILE IS ASSIGNED TO AN INTERACTIVE
*                            TERMINAL.
*
*                FR          SELECT PARTIAL DUMP FROM SPECIFIED LINE.
*                            IF FR IS EQUATED TO A LITERAL VALUE, THE
*                            DUMP WILL BEGIN AT THE LINE CONTAINING
*                            THE LAST OCCURRENCE OF THE LITERAL.
*                            DAYFILE LINES ARE EXAMINED BY COMPARING
*                            THE FIRST CHARACTERS OF THE FIELD
*                            SPECIFIED BY OP WITH THE LITERAL.  THE
*                            LITERAL MAY BE UP TO 30 CHARACTERS.  THE
*                            LITERAL IS DELIMITED BY DOLLAR SIGNS.  A
*                            LITERAL DOLLAR SIGN IS REPRESENTED BY TWO
*                            CONSECUTIVE DOLLAR SIGNS.  FR NEED NOT BE
*                            A LITERAL IF THE STRING BEING SEARCHED
*                            FOR IS ALSO A LEGITIMATE FILE NAME.
*
*                OP          SELECT DAYFILE FIELD FOR SEARCH.
*                            THE DEFAULT IS *OP = I* FOR TERMINAL
*                            OUTPUT FILES, *OP = F* FOR OTHER FILES.
*                            IF *FR* IS SPECIFIED, THE DEFAULT IS
*                            *OP = M*.
*                            OP MAY BE EQUATED TO ANY OF THE FOLLOWING
*                            SINGLE CHARACTERS -
*                                      T  FOR TIME FIELD
*                                      J  FOR JOB NAME FIELD
*                                         (INCORRECT FOR USER DAYFILE)
*                                      M  FOR MESSAGE FIELD
*                                         (INCORRECT FOR MAINTENANCE
*                                         LOG)
*                                      I  FROM LAST DUMP
*                                      P  FROM LAST DUMP BY THIS JOB
*                                         (INCORRECT FOR USER DAYFILE)
*                                      F  FULL DUMP
*                            OP SELECTS ONLY THE STARTING POSITION OF
*                            THE SEARCH IN EACH LINE.  THEREFORE, THE
*                            FIELD TO BE SEARCHED FOR MAY CROSS T,J,M
*                            BOUNDARIES.  FOR EXAMPLE -
*                               DAYFILE(FR=$ 11.03.21.COMPASS$,OP=T)
*                            IS PROPER.
*
*                PD          SELECT PRINT DENSITY.  IF PD IS ABSENT,
*                            SET PRINT DENSITY TO A VALUE DETERMINED
*                            BY THE JOB DEFAULT PRINT DENSITY (PD).
*                            PD MAY BE EQUATED TO 3, 4, 6 OR 8.  VALUES
*                            OF 4 AND 8 ARE NOT INTENDED FOR USE WITH
*                            DEVICES NOT SUPPORTING 8 LPI.  THIS
*                            PARAMETER HAS NO MEANING, AND IS NOT
*                            CHECKED, IF THE OUTPUT IS TO A TIME-
*                            SHARING TERMINAL.  THIS OPTION IS NOT
*                            VALID FOR *GETLOG* OR *MAINLOG* CALLS.
*
*                PL          SELECT PAGE SIZE.  IF PL IS ABSENT, SIZE
*                            IS DETERMINED FROM THE JOB DEFAULT PAGE
*                            SIZE (PS) AS FOLLOWS -
*                                       PD  PL (IN LINES)
*                                       --  --
*                                        3  PS/2
*                                        4  PS/2
*                                        6  PS
*                                        8  PS
*                            IF PL IS EQUATED TO A NUMERIC VALUE, THE
*                            PAGE SIZE IS SET ACCORDINGLY.  IF THE
*                            VALUE IS ZERO, THE PAGE SIZE IS SELECTED
*                            ACCORDING TO THE ABOVE TABLE.  PL
*                            SPECIFIES THE NUMBER OF DAYFILE LINES TO
*                            BE PRINTED PER PAGE, NOT NUMBER OF TOTAL
*                            LINES.  THE PAGE TITLE IS TWO LINES.
*                            THIS PARAMETER HAS NO MEANING, AND IS
*                            NOT CHECKED, IF THE OUTPUT IS TO A TIME-
*                            SHARING TERMINAL.  THIS OPTION IS NOT
*                            VALID FOR *GETLOG* OR *MAINLOG* CALLS.
*
*                I           FILE FROM WHICH DAYFILE IS READ.  IF
*                            ABSENT, THE FILE IS THE RESPECTIVE
*                            DAYFILE CURRENTLY MANAGED BY THE SYSTEM.
*                            FOR *GETLOG*, THIS APPLIES ONLY TO THE
*                            *BML* FILE.
*
*                B           BINARY FILE RECEIVING THE REFORMATTED
*                            MAINTENANCE LOG.  IF ABSENT, THE FILE
*                            IS *BML*.  THIS OPTION IS APPLICABLE
*                            ONLY TO *MAINLOG* AND *GETLOG* CALLS.
*
*                JT          JOB TERMINATION OPTION.
*                            D  IF SPECIFIED, A DEFFERRED ROUTE
*                               WILL BE PERFORMED ON THE FILE
*                               TO WHICH THE DAYFILE IS TO BE
*                               COPIED, AND PAGINATION WILL BE
*                               PERFORMED.
*                               THIS OPTION IS VALID ONLY FOR
*                               THE *DAYFILE* COMMAND.
*
*                E           FILE TO WHICH THE EST IS WRITTEN, FOR
*                            *GETLOG* ONLY.
*
*
*                OP=I, OP=P PROCESSING.
*         TO LOCATE THE LAST DUMP ENTRY, THE DAYFILE IS SEARCHED FOR
*         ONE OF THE NORMAL COMPLETION MESSAGES LISTED BELOW DEPENDING
*         UPON WHICH DAYFILE IS TO BE ACCESSED.
*
*                INTERACTIVE TERMINATION OF *DAYFILE,FR[=XXXX].*
*         WHENEVER AN INTERRUPT IS RECEIVED FROM AN INTERACTIVE TERMINAL
*         OUTPUT IS STOPPED AND A COMPLETION MESSAGE IS ISSUED TO THE
*         APPROPRIATE DAYFILES.  THIS ALLOWS THE USER TO SUPPRESS THE
*         LISTING OF A LONG DUMP WHILE RETAINING THE CAPABILITY TO DUMP
*         FROM THE LAST PREVIOUS DUMP (THE ONE THAT WAS INTERRUPTED).
*
*                POSITIONAL ARGUMENT PROCESSING.
*         IT IS NOT NECESSARY TO SPECIFY THE ABOVE KEYWORDS (L,FR,OP,..)
*         ARGUMENT VALUES MAY ASSUME THEIR ASSOCIATION WITH THESE KEY-
*         WORDS BY THEIR POSITION ON THE COMMAND.
*         FOR EXAMPLE -
*                DAYFILE(SAM,ERROR,M)
*         IS EQUIVALENT TO -
*                DAYFILE(L=SAM,FR=ERROR,OP=M)
*         THE ORDER OF THE ARGUMENTS MUST BE -
*                1) L VALUE
*                2) FR VALUE (MAY BE A LITERAL)
*                3) OP VALUE
*                4) PD VALUE
*                5) PL VALUE
*                6) I VALUE
*                7) B VALUE
*                8) D OPTION
*         VALUES MAY BE LEFT UNSPECIFIED AS -
*                DAYFILE(,,,8)
*                ( SAME AS DAYFILE(PD=8) )
*         KEYWORD TYPE ARGUMENTS MAY BE INTERMIXED WITH POSITIONAL
*         ARGUMENTS.  FOR EXAMPLE -
*                DAYFILE(SAM,PD=8,10)
*         IS EQUIVALENT TO -
*                DAYFILE(L=SAM,PD=8,PL=10)
*
*                NUMERIC ARGUMENT VALUES.
*         NUMERIC ARGUMENTS MAY BE SPECIFIED IN EITHER OCTAL OR DECIMAL
*         BASE.  A RADIX SYMBOL *B* OR *D* MAY IMMEDIATELY FOLLOW THE
*         NUMBER TO SPECIFY OCTAL OR DECIMAL BASE RESPECTIVELY.  IF
*         THE RADIX SYMBOL IS ABSENT, DECIMAL IS ASSUMED.  THE SINGLE
*         CHARACTER *B* OR *D* IS TAKEN TO MEAN ZERO, SO -
*                DFD(PL=B)
*         IS EQUIVALENT TO -
*                DFD(PL=0B) OR DFD(PL=D) OR DFD(PL=0D) OR DFD(PL=0)
*
*                FILES *SCR* AND *SCR1* ARE USED INTERNALLY.
          SPACE  4
***       DAYFILE MESSAGES ISSUED.
*
*         NORMAL COMPLETION.
*
*         *SIAD.*            (ACCOUNT DAYFILE ONLY)
*
*         * ACCOUNT DAYFILE PROCESSED.*
*
*         * USER DAYFILE PROCESSED.*
*
*         * SYSTEM DAYFILE PROCESSED.*
*
*         * ERROR LOG PROCESSED.*
*
*         * GETLOG PROCESSED.*  (ALSO WRITTEN TO *ERRLOG*).
*
*         * MAINTENANCE LOG PROCESSED.*
*
*         * ENTRYPT - LOCAL DAYFILE PROCESSED.*
*                *I=LFN* PROCESSING COMPLETED NORMALLY.
*
*         THE ABOVE MESSAGE DESCRIPTIONS ARE GIVEN WHEN
*         A DAYFILE DUMP HAS BEEN PERFORMED ON THE SPECIFIED
*         DAYFILE.  IF NO ADDITIONAL DAYFILE MESSAGES WERE ISSUED,
*         THE DUMP WAS SUCCESSFUL.
*
*
*         IN THE FOLLOWING MESSAGE DESCRIPTIONS, THE GENERIC LABEL
*         *ENTRYPT* REFERS TO THE ENTRY POINT NAME (AFD, DAYFILE,
*         DFD, ELD, OR MAINLOG) DISPLAYED IN EACH MESSAGE.
*
*         INFORMATIVE MESSAGES.
*
*         * ENTRYPT - DATA LOST.*
*                INDICATES THAT A DAYFILE READ ERROR HAS OCCURRED.
*                PROCESSING CONTINUES WITH THE FIRST AVAILABLE GOOD
*                DAYFILE MESSAGE.
*
*         * ENTRYPT - RECOVERY SECTOR ENCOUNTERED.*
*                INDICATES THAT A RECOVERY SECTOR HAS BEEN
*                ENCOUNTERED, DENOTING THE BOUNDARY OF A DEADSTART
*                RECOVERY.  ANY DAYFILE MESSAGE FRAGMENT PRECEEDING
*                THIS BOUNDARY IS DISCARDED.  PROCESSING CONTINUES
*                WITH THE FIRST MESSAGE AFTER THE BOUNDARY.
*
*
*         ABNORMAL COMPLETION.
*
*         * DAYFILE - INPUT FILE CANNOT BE EXECUTE ONLY.*
*                THE FILE SPECIFIED AS CONTAINING THE DAYFILE TO
*                PROCESS IS AN EXECUTE ONLY TYPE FILE, AND CANNOT
*                BE READ.
*
*         * ENTRYPT - INPUT FILE NOT FOUND.*
*                THE FILE SPECIFIED BY THE *I=FILENAME* PARAMETER IS NOT
*                A LOCAL FILE.
*
*         * DAYFILE - JOB FIELD DISALLOWED ON USER DAYFILE.*
*                OP=J OR OP=P IS SPECIFIED.  JOB NAMES DO NOT APPEAR
*                IN THE USER DAYFILE.
*
*         * DAYFILE - INTERACTIVE INPUT FILE NOT ALLOWED.*
*                *I=* SPECIFIES A TERMINAL INPUT FILE, WHICH IS NOT
*                ALLOWED.
*
*         * ENTRYPT - ARGUMENT ERROR.*
*                AN UNKNOWN KEYWORD WAS ENCOUNTERED OR COMMAND
*                WAS ILL-FORMATTED.
*
*         * ENTRYPT - BUFFER TOO SMALL.*
*                THE AMOUNT OF *CM RESIDENT* DAYFILE RETURNED BY *SFM*
*                IS LARGER THAN THE ALLOWED INTERNAL BUFFER.
*                RECOMMEND CHANGING VALUE OF *CBUFL*, IF THIS
*                MESSAGE OCCURS.
*
*         * ENTRYPT - *FR* INCORRECT FOR THIS OPTION.*
*                OP=I OR OP=P IS SPECIFIED.  INCREMENTAL DAYFILE DUMPS
*                HAVE A PREDETERMINED SEARCH VALUE, THUS *FR* IS NOT
*                NEEDED.
*
*         * ENTRYPT - INCORRECT PAGE SIZE FORMAT.*
*                THE VALUE ASSOCIATED WITH THE PL ARGUMENT IS NOT
*                NUMERIC.
*
*         * ENTRYPT - INCORRECT PRINT DENSITY.*
*                PD IS NOT 3, 4, 6 OR 8.
*
*         * ENTRYPT - INCORRECT PRINT DENSITY FORMAT.*
*                THE VALUE ASSOCIATED WITH THE PD ARGUMENT IS NOT
*                NUMERIC.
*
*         * DAYFILE - INCORRECT JOB TERMINATION OPTION.*
*                THE VALUE OF THE *JT* OPTION SPECIFIED IS
*                NOT VALID.
*
*         * ENTRYPT - RESERVED FILE NAME.*
*                THE FILE NAME SPECIFIED FOR THE B, I OR L PARAMETER
*                IS A RESERVED FILE NAME.
*
*         * ENTRYPT - UNABLE TO ACCESS DAYFILE.*
*                THE SYSTEM DAYFILE THAT IS TO BE PROCESSED COULD NOT
*                BE ACCESSED DUE TO AN ERROR ENCOUNTERED BY *SFM*.
*
*         * ENTRYPT - UNKNOWN *OP* FIELD.*
*                *OP* IS NOT EQUATED TO A VALID OPTION CHARACTER.
*
*         * *FR* NOT FOUND.*
*                THE *FR* ARGUMENT WAS SELECTED, BUT THE DAYFILE SEARCH
*                WAS UNSATISFIED.  THIS IS ONLY INFORMATIVE.  THE FULL
*                DUMP IS GIVEN IN PLACE OF STARTING AT THE *FR*.
*                IF THIS CONDITION IS PRESENT, IT IS LISTED AS THE
*                FIRST LINE OF OUTPUT TO AN INTERACTIVE TERMINAL.
*
*         * ENTRYPT - INTERACTIVE BINARY OUT-FILE NOT ALLOWED.*
*                *B=* SPECIFIES A TERMINAL FILE, WHICH IS NOT
*                ALLOWED.
*
*         * MAINLOG - *FR* TIME VALUE INCORRECT.*
*                ERROR OCCURRED WHILE CONVERTING A DATE SUBMITTED IN
*                DISPLAY CODE TO A PACKED DATE IN BINARY FOR SEARCHING
*                ON A BINARY FILE.
*
*         * MAINLOG - *OP* OPTION INCORRECT.*
*                THE OPTION SPECIFIED THOUGH VALID FOR CODED DAYFILES
*                IS INCORRECT FOR BINARY DAYFILES.
*
*         * UNEXPECTED EOF/EOI ENCOUNTERED.
*                AN EOF OR EOI WAS ENCOUNTERED BEFORE THE PRU
*                COUNT HAD BEEN DEPLETED ON THE INPUT FILE.
*
*         * MAINLOG - *BML* FORMAT INCORRECT.
*                AN INCORRECT RECOVERY SECTOR WORD WAS DETECTED WHILE
*                PROCESSING THE *BML* FILE.
          SPACE  4
***       ERROR MESSAGES ISSUED TO OUTPUT.
*
*         *NOTICE*** DATA READ ERROR.
*                INDICATES MESSAGE(S) LOST DUE TO A DAYFILE
*                READ ERROR.
*
*         *NOTICE*** RECOVERY BOUNDARY.
*                INDICATES MESSAGE(S) LOST DUE TO CROSSING A
*                DEADSTART RECOVERY BOUNDARY.
 ESTFILE  SPACE  4,10
***       EST FILE FORMAT (*GETLOG* ONLY).
*
*         THE ENTIRE EST IS WRITTEN TO THE SPECIFIED FILE, TOGETHER
*         WITH THE FOLLOWING HEADER INFORMATION.
*
*T WD00   36/,12/ ESTSIZE,12/ ENTRYSIZE
*T,WD01   60/           UNUSED
*T,WD02   24/,36/ PACKED DATE AND TIME
*T,WD03   60/           SYSTEM TITLE LINE
*T,WD04   60/
*T,WD05   60/
*T,WD06   60/
*T,WD07   60/           SYSTEM VERSION
*T,WD10   60/
*T,WD11-N 60/           (EST ENTRIES)
*
*         ESTSIZE = NUMBER OF ENTRIES (LAST ORDINAL + 1).
*         ENTRYSIZE = NUMBER OF CM WORDS PER EST ENTRY.
 MACROS   SPACE  4,20
          TITLE  MACRO DEFINITIONS.
 INPUTC   SPACE  4,20
**        INPUTC - READ CODED MESSAGE FROM CONTROL WORD BLOCKS.
*
*         INPUTC FET,FWA,LEN
*
*         ENTRY  *FET* = FWA OF FET TO READ.
*                *FWA* = FWA OF WORKING STORAGE BUFFER.
*                *LEN* = LENGTH OF WORKING STORAGE BUFFER.
*
*         USES   X - 2.
*                B - 6, 7.
*
*         CALLS  RDC.
 
 
          PURGMAC  INPUTC
 INPUTC   MACRO  F,S,N
  MACREF INPUTC
  R= B6,S
  R= B7,N
  R= X2,F
  RJ RDC
 INPUTC ENDM
 INPUTW   SPACE  4,20
**        INPUTW - READ BINARY MESSAGE FROM CONTROL WORD BLOCKS.
*
*         INPUTW FET,FWA,LEN
*
*         ENTRY  *FET* = FWA OF FET TO READ.
*                *FWA* = FWA OF WORKING STORAGE BUFFER.
*                *LEN* = LENGTH OF WORKING STORAGE BUFFER.
*
*         USES   X - 2.
*                B - 6, 7.
*
*         CALLS  RDW.
 
 
          PURGMAC  INPUTW
 INPUTW   MACRO  F,S,N
  MACREF INPUTW
  R= B6,S
  R= B7,N
  R= X2,F
  RJ RDW
 INPUTW ENDM
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSDFS
*CALL     COMSMSC
*CALL     COMSMSC
*CALL     COMSSFM
*CALL     COMSSSJ
          TITLE  SYMBOL DEFINITIONS.
*         SSJ CONTROL.
 
 SSJ=     EQU    SSJP        SYSTEM PRIVILEGES ONLY
 UTL=     BSS    0           SYSTEM UTILITY SPECIAL ENTRY POINT
 
*         SYMBOL DEFINITIONS.
 
 
 MAXZ     MAX    MXML,MBML,MCML  FIND LARGEST MESSAGE SIZE
 WBUFL    EQU    MAXZ+5      WORKING BUFFER LENGTH
 CBUFL    EQU    MXDB+MBML+2 LENGTH OF CM HOLD AREA
 EBUFL    EQU    ESMX*ESTE+11B+1  EST BUFFER (*GETLOG* ONLY)
 BUFML    MAX    2001B,CBUFL+1
 IBUFL    EQU    BUFML       DAYFILE BUFFER LENGTH
 OBUFL    EQU    20001B      OUTPUT BUFFER LENGTH
 SBUFL    EQU    2001B       SCRATCH BUFFER LENGTH
 DFDF     EQU    1RS         DEFAULT DENSITY FORMAT CHARACTER
 FETL     EQU    10B         FET LENGTH
 PLEN     EQU    1000        START PAGE LINE NUMBER
          SPACE  4,10
*         DAYFILE TYPE CODES.
 
 GLTY     EQU    0           *GETLOG* - ERRLOG (CODED), BML (BINARY)
 ACTY     EQU    1           ACCOUNT (CODED FILE)
 UDTY     EQU    2           USER DAYFILE (CODED FILE)
 SDTY     EQU    3           SYSTEM DAYFILE (CODED FILE)
 ELTY     EQU    4           ERROR LOG (CODED FILE)
 MLTY     EQU    5           MAINTENANCE LOG (BINARY FILE)
          SPACE  4,10
*         NOTICE MESSAGE CODES.
 
 REMC     EQU    1           READ ERROR
 RSMC     EQU    2           RECOVERY SECTOR
          SPACE  4,10
*         FET INDEX DEFINITIONS TO CONTROL WORD PROCESSING INFORMATION.
 
 
 WRD      EQU    1           INDEX OF WORDS BEFORE CONTROL WORD
 ERF      EQU    2           INDEX TO EOR FLAG
 LWP      EQU    3           INDEX TO REMAINING MESSAGE
          SPACE  4,10
*         *SFM* ERROR CODES.
 
 DFB      EQU    1           DAYFILE BUSY
          TITLE  FETS AND GLOBAL STORAGE.
*         FETS.
 
 
          ORG    113B
 FETS     BSS    0
 
 E        BSS    0           EST FILE (*GETLOG* ONLY)
 EST      FILEB  EBUF,EBUFL
 
          CON    0           WORDS LEFT IN CURRENT MESSAGE
          CON    -1          EOR FLAG
          CON    -1          NUMBER OF WORDS BEFORE CONTROL WORD
 I        BSS    0           DAYFILE
 SCR      FILEB  IBUF,IBUFL,FET=FETL,EPR
 
 O        BSS    0           OUTPUT
 OUTPUT   RFILEB OBUF,OBUFL,FET=FETL
 
 S        BSS    0           SCRATCH
 SCR1     FILEB  SBUF,SBUFL,FET=FETL
 
 B        BSS    0           BINARY
 BML      FILEB  OBUF,OBUFL,FET=FETL
          SPACE  4,10
*         *DSP* PARAMETER BLOCK.
 
 
 PDRA     VFD    60/0        FILE NAME AND STATUS
          VFD    12/5000B,12/0,12/2LLP,6/0,18/121B  ROUTING CONTROL
          BSSZ   13
          SPACE  4,10
*         GLOBAL STORAGE.
 
 
 BNAM     BSSZ   1           BINARY FILE NAME
 CMFG     BSSZ   1           CM BUFFER PROCESSING FLAG
 DFTY     BSSZ   1           DAYFILE TYPE
 EFFG     BSSZ   1           CHECKPOINT EOR/EOF IN-PROCESS FLAG
 ENPT     CON    0           ENTRY POINT IDENTIFIER
 INAM     BSSZ   1           IN FILE NAME
 OMCA     CON    WBUF        OUTSTANDING MESSAGE CONTINUATION ADDRESS
 PRUS     CON    377777B     NUMBER OF PRU-S TO READ
 WCCM     CON    0           NUMBER OF WORDS IN CM BUFFER PORTION
*                            OF DAYFILE
 PAGE     CON    0           CURRENT PAGE NUMBER
 LINE     CON    PLEN        CURRENT LINE NUMBER
 LISF     CON    0           LIST FILE FLAG - =0 IF FILE IS TO BE
*                            PAGINATED
 LISV     CON    0           (LISF) IF *FR* OPTION SELECTED
 FROM     CON    0           =0 IF FULL DUMP, ELSE PARTIAL DUMP
 SEMS     CON    0,0,0       SEARCH MESSAGE
          CON    0           MESSAGE TERMINATOR
 SEMA     CON    0,0,0       SEARCH MESSAGE MASK
          CON    0           MASK TERMINATOR
 SEJN     CON    0           SEARCH JOB NAME
 SFOP     VFD    6/1RF,54/1  SEARCH FIELD OPTION / CHANGE FLAG
 FRFO     CON    1           =0 IF *FR* MESSAGE NOT FOUND
 SEWI     CON    2           STARTING MESSAGE SEARCH WORD INDEX
 PDEN     CON    1           PRINT DENSITY
 PLPP     CON    0L0+1       LINES PER PAGE DURING PRESET, OTHERWISE -
 PLPO     CON    0L0+1       ALTERNATE LINES PER PAGE FOR SEARCH FILE
*                            FORMAT AS DESCRIBED FOR *TPAS*.
 RFMT     VFD    6/DFDF,6/1R ,48/0  RESET FORMAT LINE
 IOUT     CON    1           =0 IF TERMINAL OUTPUT
 INTR     CON    0           NONZERO IF TERMINAL INTERRUPT
 JTOP     CON    0           JOB TERMINATION OPTION
          SPACE  4,10
*         PAGE TITLE LINE.
 
 HDR2     BSS    0
 JSNP     BSS    1           JSN FOR END OF JOB HEADER
 TITL     DATA   -0          TITLE AND VERSION FOR END OF JOB HEADER
 DENF     VFD    6/DFDF,54/0 DENSITY FORMAT CONTROL
 DENC     CON    1           PRINT DENSITY CONTROL WORD
 HEDR     BSS    0
 MODE     DATA   10H1    FULL
 TYPE     DATA   10HDAYFILE.
 DATE     DATA   0           DATE
 DAT2     BSS    0           DATE FOR END OF JOB HEADER
 TIME     DATA   0           TIME
 TIM2     BSS    0           TIME FOR END OF JOB HEADER
 INDX     DATA   10H*        *  TIME OF FIRST ENTRY ON PAGE
 PGNO     DATA   0           PAGE NUMBER
          DATA   0
          DATA   2L
 HEDRL    EQU    *-HEDR      LENGTH OF TITLE LINE
 HDR2L    EQU    *-HDR2      LENGTH OF END OF JOB HEADER
          TITLE  ENTRIES.
**        ENTRY PROCESSORS.
 AFD      SPACE  4,10
**        AFD - DUMP ACCOUNT DAYFILE.
 
 
 AFD      BSS    0           ENTRY
          SX6    ACTY        SET DAYFILE TYPE = ACCOUNT
          SA6    DFTY
          SA6    ENPT        SET ENTRY POINT = *AFD*
          SX4    AFDA        SET SEARCH STRING FOR PARTIAL DUMP
          RJ     PRS         PRESET PROGRAM
          SA1    =10H ACCOUNT.   SET TITLE
          SX4    =C*SIAD. *  SET TERMINATION MESSAGE
          RJ     DAF         PROCESS DUMP
          SX2    AFDB        ISSUE TERMINATION MESSAGE
          EQ     TRM         EXIT
 
 AFDA     DATA   C*SIAD.*    ACCOUNT FILE MESSAGE
 AFDB     DATA   C* ACCOUNT DAYFILE PROCESSED.*
 DAYFILE  SPACE  4,10
**        DAYFILE - DUMP USER DAYFILE.
 
 
 DAYFILE  BSS    0           ENTRY
          SX6    UDTY        SET DAYFILE TYPE = USER DAYFILE
          SA6    DFTY
          SA6    ENPT        SET ENTRY POINT = *DAYFILE*
          SX7    1           SET SEARCH INDEX
          SA7    SEWI
          SX4    DAYA        SET SEARCH STRING FOR PARTIAL DUMP
          RJ     PRS         PRESET PROGRAM
          SA1    =10H DAYFILE.   SET TITLE
          RJ     DAF         PROCESS DUMP
          SX2    DAYA        ISSUE TERMINATION MESSAGE
          EQ     TRM         EXIT
 
 DAYA     DATA   C* USER DAYFILE PROCESSED.*
 DFD      SPACE  4,10
**        DFD - DUMP SYSTEM DAYFILE.
 
 
 DFD      BSS    0           ENTRY
          SX6    SDTY        SET DAYFILE TYPE = SYSTEM DAYFILE
          SA6    DFTY
          SA6    ENPT        SET ENTRY POINT = *DFD*
          SX4    DFDA        SET SEARCH STRING FOR PARTIAL DUMP
          RJ     PRS         PRESET PROGRAM
          SA1    =10H DAYFILE.  SET TITLE
          RJ     DAF         PROCESS DUMP
          SX2    DFDA        ISSUE TERMINATION MESSAGE
          SB7    3           SET LOCAL DAYFILE ONLY OPTION
          EQ     TRM1        EXIT
 
 DFDA     DATA   C* SYSTEM DAYFILE PROCESSED.*
 ELD      SPACE  4,10
**        ELD - DUMP ERROR LOG.
 
 
 ELD      BSS    0           ENTRY
          SX6    ELTY        SET DAYFILE TYPE = ERRLOG
          SA6    DFTY
          SA6    ENPT        SET ENTRY POINT = *ELD*
          SX4    ELDA        SET SEARCH STRING FOR PARTIAL DUMP
          RJ     PRS         PRESET PROGRAM
          SA1    =10H ERRLOG.    SET TITLE
          RJ     DAF         PROCESS DUMP
          SX2    ELDA        ISSUE TERMINATION MESSAGE
          EQ     TRM         EXIT
 
 ELDA     DATA   C* ERROR LOG PROCESSED.*
 GETLOG   SPACE  4,10
**        GETLOG - DUMP ERROR LOG AND BML FOR *HPA*.
 
 
 GETLOG   BSS    0           ENTRY
          SA1    GTLC        CHANGE *L* DEFAULT TO *ERR*
          BX6    X1
          SA6    O
          SX6    GLTY        SET ENTRY POINT = *GETLOG*
          SA6    ENPT
 
*         PROCESS MAINTENANCE LOG.
 
          SX6    MLTY        SET DAYFILE TYPE = BML
          SA6    DFTY
          SX4    GTLA        SET SEARCH STRING FOR PARTIAL DUMP
          RJ     PRS         PRESET PROGRAM
          SA1    =10H GETLOG.    SET TITLE
          RJ     DAF         PROCESS DUMP
 
*         RESET PARAMETERS.
 
          MX7    0           CLEAR LOCAL FILE FLAG
          SA7    INAM
          SA7    CMFG        CLEAR *CM BUFFER* FLAG
          SA1    GTLD        RESTORE *SCR* FILENAME
          BX6    X1
          SX7    IBUF        RESTORE FIRST/IN/OUT/LIMIT
          MX0    42
          SA6    I
          SA1    A6+B1
          MX6    59          INITIALIZE CONTROL WORDS
          BX1    X0*X1
          BX7    X1+X7
          SA7    A6+B1
          ERRNZ  WRD-1       CANNOT USE *B1*
          ERRNZ  ERF-WRD-1   CANNOT USE *B1*
          SA6    A6-B1
          SX7    X7
          SA7    A7+B1
          SA6    A6-B1
          SX6    X7+IBUFL
          SA7    A7+B1
          SA6    A7+B1
 
*         PROCESS ERROR LOG.
 
          SX6    ELTY        SET DAYFILE TYPE = ERRLOG
          SA6    DFTY
          MOVE   3,GTLB,IBUF SET SEARCH STRING FOR PARTIAL DUMP
          MOVE   3,GTLB,SEMS
          MX6    48          SET SEARCH MASK
          BX7    X4-X4
          SA6    SEMA+1
          AX6    12
          SA7    A6+B1
          SA6    A6-B1
          SA1    =10H GETLOG.    SET TITLE
          RJ     DAF         PROCESS DUMP
          SX2    GTLB        ISSUE TERMINATION MESSAGE
          EQ     TRM         EXIT
 
 GTLA     VFD    12/2,48/0   BML MESSAGE FOR *GETLOG* EXECUTION
          VFD    12/DM0406,12/DS0113,36/0
          VFD    60/0
 GTLB     DATA   C* GETLOG PROCESSED.*
 GTLC     VFD    42/0LERR,18/3  *L* DEFAULT FILENAME
 GTLD     VFD    42/0LSCR,18/3  *I* FILENAME AFTER *BML* DUMPED
 MAINLOG  SPACE  4,10
**        MAINLOG - DUMP BINARY MAINTENANCE LOG.
 
 
 MAINLOG  BSS    0           ENTRY
          SX6    MLTY        SET DAYFILE TYPE = MAINLOG
          SA6    DFTY
          SA6    ENPT        SET ENTRY POINT = *MAINLOG*
          SX4    MLDA        SET SEARCH STRING FOR PARTIAL DUMP
          RJ     PRS         PRESET PROGRAM
          SA1    =10H MAINLOG.  SET TITLE
          RJ     DAF         PROCESS DUMP
          SX2    MLDB        ISSUE TERMINATION MESSAGE
          EQ     TRM         EXIT
 
 MLDA     VFD    12/2,48/0
          VFD    12/DM0406,12/DS0102,36/0
          VFD    60/0
 MLDB     DATA   C* MAINTENANCE LOG PROCESSED.*
 TRM      SPACE  4,10
**        TRM - COMMON TERMINATION ROUTINE.
*
*         ENTRY  (X2) = ADDRESS OF TERMINATION MESSAGE.
*                (B7) = DAYFILE OPTION, IF ENTERED AT *TRM1*.
*
*         MACROS MESSAGE.
 
 
 TRM      SB7    0           ISSUE MESSAGE TO USER/SYSTEM DAYFILES
 
*         ENTER WITH (B7) = DAYFILE OPTION.
 
 TRM1     SA1    INAM        CHECK DAYFILE TYPE
          ZR     X1,TRM2     IF ACTIVE DAYFILE PROCESSED
          SA1    ENPT
          SA1    NTAB+X1-GLTY  SET ENTRY POINT IN MESSAGE
          BX6    X1
          SA6    TRMA
          SX2    A6
 TRM2     MESSAGE  X2,B7     ISSUE TERMINATION MESSAGE
          ENDRUN
 
 TRMA     DATA   C* ENTRYPT - LOCAL DAYFILE PROCESSED.*
 DAF      TITLE  MAIN PROGRAM.
**        DAF - PROCESS DAYFILE DUMP.
*
*         MAIN LOOP.
*
*         ENTRY  (DFTY) = DAYFILE DUMP TYPE.
*                (X1) = DAYFILE NAME.
*
*         EXIT   DAYFILE DUMPED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*
*         CALLS  OPN, RIF, TSF, WOF, WUP.
*
*         MACROS MESSAGE, RECALL, ROUTE, WRITER.
 
 
 DAF      SUBR               ENTRY/EXIT
          BX6    X1          STORE DAYFILE NAME
          SA6    TYPE
 
*         PROCESS DAYFILE.
 
          RJ     OPN         OPEN DAYFILE
          SA1    TYPE        SET DAYFILE TYPE IN MESSAGE
          BX6    X1
          SA6    DAFA+1
          MESSAGE  DAFA,2    * COPYING - DAYFILE.*
 DAF1     RJ     RIF         READ IN-FILE
          NG     X1,DAF2     IF EOF/EOI
          RJ     WOF         WRITE OUT-FILE
          SA1    INTR
          NZ     X1,DAF5     IF TERMINAL INTERRUPT
          EQ     DAF1        PROCESS NEXT RECORD
 
*         CHECK SEARCH FILE.
 
 DAF2     SA1    FROM
          ZR     X1,DAF3     IF FULL DUMP
          RJ     TSF         TERMINATE SEARCH FILE
          SA1    DFTY
          SX1    X1-MLTY
          ZR     X1,DAF3     IF PROCESSING BINARY FILE
 
*         MARK END OF TERMINAL OUTPUT.
 
          SA1    LISF
          NZ     X1,DAF3     IF NOT PAGINATED OUTPUT
          SA1    RFMT        RESET PRINT FORMAT
          BX6    X1
          SA6    WBUF
          SA6    LISF        SET *NO FORMAT*
          BX6    X6-X6       SET FULL DUMP
          SB7    B1          INDICATE MESSAGE PRESENT
          SA6    FROM
          RJ     WOF         WRITE OUT-FILE
 
*         WRAP UP TERMINATION.
 
 DAF3     RJ     WUP         WRAP UP PROCESSING
          MESSAGE  (=C* *),2
          SX2    O           FLUSH OUT-FILE
          SA1    DFTY
          SX1    X1-MLTY
          NZ     X1,DAF4     IF NOT PROCESSING BINARY FILE
          SX2    B
 DAF4     WRITER X2
          SA1    JTOP        CHECK IF JOB TERMINATION ENTERED
          ZR     X1,DAFX     IF NOT ENTERED
          RECALL X2
          ROUTE  PDRA,R      ISSUE *DSP* REQUEST
          EQ     DAFX        RETURN
 
 DAF5     RJ     WUP         WRAP UP PROCESSING
          EQ     DAFX        RETURN
 
 
 DAFA     DATA   C* COPYING - DAYFILE. *
          TITLE  SUBROUTINES.
 ERR      SPACE  4,10
**        ERR - PROCESS ERROR.
*
*         ENTRY  (A0) = ADDRESS OF ERROR MESSAGE.
*
*         EXIT   ABORTS.
*                (ENPT) = ENTRY POINT NAME.
*                B = BINARY OUT-FILE FET.
*                O = CODED OUT-FILE FET.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6.
*
*         MACROS ABORT, MESSAGE, RECALL, ROUTE, WRITER.
 
 
 ERR      SA1    ENPT        SET ENTRY POINT NAME
          SA2    NTAB+X1-GLTY
          BX6    X2
          SA6    ERRA
          MX0    -12         GET MESSAGE TEXT
          SA1    A0
 ERR1     BX6    X1
          SA6    A6+B1
          BX2    -X0*X1
          SA1    A1+B1
          NZ     X2,ERR1     IF MORE
          SX2    O           FLUSH OUT-FILE
          SA1    DFTY
          SX1    X1-MLTY
          NZ     X1,ERR2     IF NOT PROCESSING BINARY FILE
          SX2    B
 ERR2     WRITER X2
          MESSAGE  ERRA,,R   ISSUE ERROR MESSAGE
          MESSAGE  (=C* *),2
          SA1    JTOP
          ZR     X1,ERR3     IF NOT JOB TERMINATION
          SA1    PDRA
          ZR     X1,ERR3     IF NO FILE NAME IN *DSP* PARAMETER BLOCK
          RECALL X2
          ROUTE  PDRA,R      ISSUE *DSP* CALL
 ERR3     ABORT
 
 ERRA     BSSZ   10B         MESSAGE BUILD AREA
 GEM      SPACE  4,20
**        GEM - GENERATE ERROR MESSAGE.
*
*         ENTRY  (B2) = ERROR MESSAGE CODE.
*                (DFTY) = DAYFILE TYPE.
*                (ENPT) = ENTRY POINT IDENTIFIER.
*
*         EXIT   ERROR MESSAGES ISSUED TO OUTPUT FILE AND DAYFILE.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 2, 3, 7.
*
*         CALLS  WOF.
*
*         MACROS MESSAGE.
*
*         NOTE   PRESERVES (X2)
 
 
 GEM      SUBR               ENTRY/EXIT
          BX7    X2          SAVE FET ADDRESS
          SX6    B2          SAVE MESSAGE CODE
          SA6    GEMA
          SA7    GEMB
 
*         GENERATE OUT-FILE ERROR MESSAGE.
 
 GEM1     SA2    DFTY        SET ERROR MESSAGE PARAMETERS
          SA1    ETAB+X2-GLTY
          SA2    X1+B2
          SB2    B0          TRANSFER MESSAGE TO WORKING BUFFER
          SB3    X2          START ADDRESS
          AX2    18
          SB7    X2          LENGTH OF MESSAGE
 GEM2     SA5    B3+B2
          BX6    X5
          SA6    WBUF+B2
          SB2    B2+B1
          LT     B2,B7,GEM2  IF NOT END OF MESSAGE
          RJ     WOF         WRITE MESSAGE TO OUTPUT FILE
 
*         ISSUE DAYFILE VERSION OF ERROR MESSAGE.
 
          SA1    GEMA        GET MESSAGE CODE
          SB2    X1+
          SA1    ENPT        SET ENTRY POINT NAME
          SA1    NTAB+X1
          BX6    X1
          SA2    DTAB+B2     GET MESSAGE TEXT
          SA6    X2          INSERT ENTRY POINT NAME INTO TEXT
          MESSAGE  X2
          SA2    GEMB        REPLACE FET ADDRESS
          EQ     GEMX        RETURN
 
 
 GEMA     BSSZ   1           MESSAGE CODE HOLD
 GEMB     BSSZ   1           FET ADDRESS
 
 NTAB     BSS    0           ENTRY POINT NAME TABLE
          LOC    GLTY
 GLTY     DATA   10H  GETLOG -
 ACTY     DATA   10H     AFD -
 UDTY     DATA   10H DAYFILE -
 SDTY     DATA   10H     DFD -
 ELTY     DATA   10H     ELD -
 MLTY     DATA   10H MAINLOG -
          LOC    *O
          SPACE  4,10
**        NOTE:
*                THE MESSAGES REFERENCED BY THE FOLLOWING TABLES ARE
*                ORDERED ONE-FOR-ONE AND MUST BE MAINTAINED THAT WAY.
*
*                *DTAB* - LIST OF THE DAYFILE VERSIONS OF THE MESSAGES.
*                *CFTB* - LIST OF THE CODED OUT-FILE VERSIONS OF THE
*                         MESSAGES.
*                *BFTB* - LIST OF THE BINARY OUT-FILE VERSIONS OF THE
*                         MESSAGES.
 
 DTAB     BSS    1           DAYFILE MESSAGE TEXT ADDRESS TABLE
          CON    DFRE
          CON    DFSE
 
*         TEXT TABLE FOR DAYFILE VERSION OF NOTICE MESSAGES.
 
 DFRE     DATA   40C XXXXXXX - DATA LOST.
 DFSE     DATA   40C XXXXXXX - RECOVERY SECTOR ENCOUNTERED.
 
 ETAB     BSS    1           DAYFILE TYPE TO MESSAGE SET - MAP TABLE
          CON    CFTB        ACCOUNT
          CON    CFTB        USER DAYFILE
          CON    CFTB        SYSTEM DAYFILE
          CON    CFTB        ERROR LOG
          CON    BFTB        MAINTENANCE LOG
 
 CFTB     BSS    1           CODED FILE MESSAGE ADDRESS TABLE
          VFD    12/2000B+CREI,12/0,18/CREL,18/CFRE
 
*         TEXT TABLE FOR CODED FILE NOTICE MESSAGES.
 
 CFRE     DATA   30H NOTICE*** DATA READ ERROR -
 CREI     EQU    *-CFRE
 CREL     EQU    *-CFRE
 
 BFTB     BSS    1           BINARY FILE MESSAGE ADDRESS TABLE.
          VFD    12/2000B+BREI,12/0,18/BREL,18/BFRE
          VFD    12/2000B+BRSI,12/0,18/BRSL,18/BFRS
 
*         TEXT TABLE FOR BINARY FILE NOTICE MESSAGES.
 
 BFRE     VFD    12/BREL,48/0
          VFD    12/2H  ,24/0,24/4HS.
          VFD    12/DM0406,12/DS0105,36/0
 BREI     EQU    *-BFRE
          VFD    60/0
 BREL     EQU    *-BFRE
 
 BFRS     VFD    12/BRSL,48/0
          VFD    12/2H  ,24/0,24/4HS.
          VFD    12/DM0406,12/DS0107,36/0
 BRSI     EQU    *-BFRS
          VFD    60/0
 BRSL     EQU    *-BFRS
 
 ICP      SPACE  4,20
**        ICP - INITIALIZE CM BUFFER PROCESSING.
*
*         ENTRY  (CMFG) = 0, IF *ICP* NOT PREVIOUSLY CALLED.
*                (CMFG) = 1, IF *ICP* PREVIOUSLY CALLED.
*                (INAM) .NE. 0, IF READ ALTERNATE INPUT FILE.
*                (WCCM) = NUMBER OF WORDS IN *CBUF*.
*                (X2) = FET ADDRESS.
*
*         EXIT   FET POINTERS POINTING TO *CBUF* DATA.
*                (X1) .LT. 0 IF NO DATA IN *CBUF*.
*                (X2) = FET ADDRESS.
*
*         USES   X - 0, 1, 3, 4, 5, 6, 7.
*                A - 1, 3, 5, 6, 7.
 
 
 ICP2     SX1    -2          SET EOI STATUS
 
 ICP      SUBR               ENTRY/EXIT
          SA1    CMFG
          NZ     X1,ICP2     IF NOT FIRST CALL TO *ICP*
          SX6    B1
          SA6    A1
          SA3    INAM
          NZ     X3,ICP2     IF READING ALTERNATE INPUT FILE
          RECALL X2
          SA5    DFTY        CHECK MESSAGE TYPE
          MX0    42
          SX5    X5-MLTY
          SA3    X2+B1       SET FIRST
          SA1    WCCM
          SX6    CBUF
          NZ     X5,ICP1     IF NOT PROCESSING BML
          SX6    BCWD        START OF BUFFER FOR BML
          SX1    X1+B1       CONTROL WORD
 ICP1     BX3    X0*X3
          BX7    X6+X3
          SA7    A3
          BX3    X1          CONVERT TO PP WORDS
          IX7    X6+X1       SET IN
          SX3    X3-1        REMOVE CONTROL WORD
          SA7    A7+B1
          BX4    X3
          LX3    2
          SA6    A7+B1       SET OUT
          SX7    CBUF+CBUFL  SET LIMIT
          SA7    A6+B1
          BX7    X1          SET NUMBER OF WORDS BEFORE CONTROL WORD
          SA7    X2-WRD
          SX6    B1          SET EOR FLAG
          IX7    X4+X3
          SA6    X2-ERF
          SA7    BCWD        SET FOR BML
          EQ     ICPX        RETURN
 OPN      SPACE  4,20
**        OPN - OPEN RESPECTIVE DAYFILE.
*
*         ENTRY  (BNAM) = 0, IF BINARY OUT-FILE NAME DEFAULTED.
*                       .NE. 0, IF NAME SPECIFIED.
*                (DFTY) = DAYFILE TYPE.
*
*         EXIT   RESPECTIVE DAYFILE ACCESSED.
*                BINARY FILE OPENED, IF MAINTENANCE LOG ACCESSED.
*                (BFCW) = BINARY FILE CONTROL WORD.
*                (WCDF) = DISK FILE WORD COUNT.
*                (WCCM) = CM BUFFER WORD COUNT.
*                EXITS TO SUBROUTINE *ERR*, IF ERROR DETECTED.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 0, 1, 2, 6, 7.
*                B - 4.
*
*         CALLS  STF.
*
*         MACROS DAYFILE, GETJN, MESSAGE, PDATE, READCW, READW
*                RECALL.
 
 
 OPN      SUBR               ENTRY/EXIT
          SA1    INAM
          ZR     X1,OPN2     IF IN-FILE DEFAULTED
 
*         CHECK INPUT FILE FILE NAME.
 
          MX0    42
          SA2    OPNB        SET FILE NAME IN *FILINFO* BLOCK
          BX5    X0*X1
          BX2    -X0*X2
          BX6    X5+X2
          SA6    A2+
          SA0    =C* INPUT FILE NOT FOUND.*
          FILINFO  OPNB      GET INFORMATION ON INPUT FILE
          SA2    OPNB+1
          MX1    -6
          ZR     X2,ERR      IF FILE NOT FOUND
          AX2    6
          SA0    =C* INPUT FILE CANNOT BE EXECUTE ONLY.*
          BX2    -X1*X2
          ZR     X2,ERR      IF INPUT FILE IS EXECUTE ONLY
 
*         SET SPECIFIED IN-FILE FILE NAME.
 
          SA2    I
          BX2    -X0*X2
          BX6    X5+X2
          SA6    A2+
          SX2    I
          RJ     STF         SET TERMINAL FILE
          SA0    =C* INTERACTIVE INPUT FILE NOT ALLOWED.*
          ZR     X6,ERR      IF TERMINAL FILE
          EQ     OPN11       INITIATE READ
 
*         ACCESS RESPECTIVE DAYFILE.
 
 OPN2     SA1    DFTY
          SB4    X1-ACTY
          NZ     B4,OPN3     IF NOT ACCOUNT
          DAYFILE  I,ACCOUNT
          EQ     OPN7        CHECK CM BUFFER
 
 OPN3     SB4    X1-UDTY
          NZ     B4,OPN4     IF NOT USER DAYFILE
          DAYFILE  I,USER
          EQ     OPN7        CHECK CM BUFFER
 
 OPN4     SB4    X1-SDTY
          NZ     B4,OPN5     IF NOT SYSTEM DAYFILE
          DAYFILE  I,DAYFILE
          EQ     OPN7        CHECK CM BUFFER
 
 OPN5     SB4    X1-ELTY
          NZ     B4,OPN6     IF NOT ERROR LOG
          DAYFILE  I,ERRLOG
          EQ     OPN7        CHECK CM BUFFER
 
 OPN6     DAYFILE  I,MAINLOG
 OPN7     SA1    X2          CHECK ERROR STATUS
          MX0    -4
          LX1    -10
          BX2    -X0*X1
          ZR     X2,OPN8     IF DAYFILE ATTACHED
          SX2    X2-DFB
          SA0    =C* UNABLE TO ACCESS DAYFILE.*
          NZ     X2,ERR      IF NOT *DAYFILE BUSY* ERROR
          RECALL
          MESSAGE  OPNA,2    *WAITING FOR DAYFILE.*
          EQ     OPN2        LOOP FOR RETRY
 
 OPN8     SA1    I+2         DETERMINE AMOUNT OF DATA IN CM BUFFER
          SA2    A1+B1
          IX6    X1-X2
          SA6    WCCM
          SA2    I+6         DETERMINE AMOUNT IN DISK FILE
          BX7    X2
          SA7    PRUS
          SX1    X6-CBUFL-1
          ZR     X6,OPN10    IF CM BUFFER EMPTY
          NG     X1,OPN9     IF CM BUFFER WILL FIT IN HOLD AREA
          SA0    =C* BUFFER TOO SMALL.*
          EQ     ERR         PROCESS ERROR
 
 OPN9     SX5    X6+         SAVE CM BUFFER LENGTH
          READW  I,CBUF,X5   SAVE CM BUFFER IMAGE
 OPN10    SA1    PRUS
          ZR     X1,OPN12    IF DISK FILE EMPTY
 OPN11    READCW I           INITIATE DISK FILE READ
 OPN12    SA1    DFTY
          SX1    X1-MLTY
          NZ     X1,OPNX     IF NOT MAINTENANCE LOG
 
*         OBTAIN THE CURRENT PACKED DATE/TIME AND THIS JOB-S JSN, AND
*         MERGE THESE FIELDS INTO THE BML ERROR MESSAGES, SHOULD AN
*         ERROR BE DETECTED.
 
          PDATE  OPNC        GET PACKED DATE/TIME
          GETJN  OPND        GET JSN
          SA1    OPNC        MERGE PACKED DATE/TIME INTO MESSAGES
          SA2    BFRE
          BX6    X1+X2
          SA6    A2
          SA6    BFRS
          ERRNZ  BREL-BRSL   ERROR IF MESSAGE LENGTHS DIFFER
          SA1    A1+B1       JSN
          ERRNZ  OPND-OPNC-1 ERROR IF FIELDS NOT ADJACENT
          MX0    24
          SA2    BFRE+1
          BX1    X0*X1
          LX1    -12         POSITION JSN
          BX6    X2+X1       MERGE JSN INTO MESSAGE
          SA6    A2
          SA6    BFRS+1
 
*         INITIATE BINARY FILE WRITE.
 
          SA1    BNAM
          ZR     X1,OPN13    IF FILE NAME DEFAULTED
          SA2    B
          MX0    42          SET FILE NAME
          BX1    X0*X1
          BX2    -X0*X2
          BX6    X1+X2
          SA6    A2+
 OPN13    SX2    B
          RJ     STF         SET TERMINAL FILE
          SA0    =C* INTERACTIVE BINARY OUT-FILE NOT ALLOWED.*
          ZR     X6,ERR      IF TERMINAL FILE
          EQ     OPNX        RETURN
 
 
 OPNA     DATA   C* WAITING FOR DAYFILE.*
 OPNB     VFD    42/0,6/5,11/0,1/1  BUFFER FOR *FILINFO* CALL
          BSS    4
 OPNC     VFD    60/0        PACKED DATE/TIME
 OPND     VFD    60/0        JSN
 RDC      SPACE  4,20
**        RDC - READ CODED LINE.
*
*         PROCESSES CALLS TO READ CODED LINE (*RDC=*).
*         DEBLOCKS DATA IF CONTROL WORD READS.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (B6) = FWA OF WORKING STORAGE BUFFER.
*                (B7) = WORKING STORAGE BUFFER LENGTH.
*                (INAM) = .NE. 0, IF READING ALTERNATE INPUT FILE.
*                (PRUS) = NUMBER OF SECTORS REMAINING TO BE READ.
*
*         EXIT   (X1) = STATUS RETURNED FROM RDC=.
*                (X2-LWP) = LWA+1 OF DATA TRANSFERRED.
*                (B6) = LWA+1 OF DATA TRANSFERRED.
*
*         USES   X - 1, 3, 4, 6, 7.
*                A - 0, 1, 3, 6, 7.
*                B - 2, 5, 6, 7.
*
*         CALLS  GEM, ICP, RDC=, RDW=, UOP.
 
 
 RDC9     SA3    RDCE        CHECK READ ERROR STATUS
          NG     X3,RDC7     IF READ ERROR ENCOUNTERED
 
 RDC      SUBR               ENTRY/EXIT
          SX6    B6          SAVE FWA OF WORKING STORAGE BUFFER
          SX7    B7          SAVE LENGTH OF WORKING STORAGE BUFFER
          SA6    RDCC
          SA7    RDCD
          SA6    RDCB
 RDC1     SA1    X2-WRD      GET NUMBER OF WORDS BEFORE CONTROL WORD
          SB5    X1
          SX7    B7          SAVE LENGTH OF WORKING STORAGE BUFFER
          SA7    RDCA
          SA7    RDCE        SET NO READ ERROR ENCOUNTERED
          NG     X1,RDC4     IF FIRST READ
          GE     B5,B7,RDC2  IF ENOUGH DATA TO FILL BUFFER
          SB7    B5          SET WORDS TO READ
          ZR     B5,RDC3     IF NO DATA
 RDC2     RJ     RDC=        READ CODED LINE
          SA3    RDCB        DETERMINE NUMBER OF WORDS TRANSFERRED
          SX6    B6
          SA6    A3          UPDATE FWA OF WORKING BUFFER
          IX6    X6-X3
          SA3    RDCA        UNUSED WORDS IN WORKING STORAGE BUFFER
          IX7    X3-X6
          SA7    A3
          SA3    X2-WRD      UPDATE WORDS LEFT IN PRU (NOT TRANSFERRED)
          IX6    X3-X6
          SA6    A3
          SA3    B6-B1       GET LAST WORD TRANSFERRED
          BX6    X4
          SA6    A3
          BX6    X3-X4
          ZR     X6,RDC9     IF COMPLETE MESSAGE
          ZR     X7,RDC9     IF WORKING STORAGE BUFFER FULL
 
*         PROCESS *CIO* TRAILING CONTROL WORD.
 
 RDC3     SB7    B1          READ TRAILING CONTROL WORD
          RJ     RDW=
          SB6    B6-B1       BACK UP LWA TO ALLOW FOR CONTROL WORD
          SA3    X2-ERF      CHECK EOR FLAG
          PL     X3,RDC4     IF NOT EOR BLOCK
          MX6    1           SET NEW READ FLAG
          SA6    X2-ERF
          SA6    X2-WRD
          NG     X1,RDC9     IF EOF/EOI ENCOUNTERED
          SX1    B6          SET EOR EXIT CONDITION
          EQ     RDC9        RETURN
 
*         CHECK SECTOR COUNT TO DETERMINE IF DATA SHOULD BE READ
*         FROM THE DISK FILE OR FROM *CBUF*.
 
 RDC4     SA1    PRUS        CHECK PRU COUNT
          SX6    B1
          IX6    X1-X6
          NZ     X1,RDC5     IF MORE PRU-S TO READ FROM DISK
          RJ     ICP         INITIALIZE CM BUFFER PROCESSING
          NG     X1,RDCX     IF EOF/EOI ENCOUNTERED
          EQ     RDC1        LOOP
 
 RDC5     SA6    A1          UPDATE SECTOR COUNT
 
*         PROCESS *CIO* HEADER CONTROL WORD.
 
          SB7    B1          READ CONTROL WORD
          RJ     RDW=
          PL     X1,RDC6     IF NOT EOF/EOI
          SA3    INAM
          NZ     X3,RDCX     IF EOF/EOI ON ALTERNATE INPUT FILE
          SA0    =C* UNEXPECTED EOF/EOI ENCOUNTERED.*
          EQ     ERR         PREMATURE EOF/EOI
 
 RDC6     SB6    B6-B1       BACK UP WORKING BUFFER
          SA1    B6          SET BLOCK SIZE FROM CONTROL WORD
          SX7    5
          BX3    X1
          SX4    X1+4        ROUND UP
          AX1    36
          SX6    X1
          IX7    X4/X7       SET NUMBER OF WORDS BEFORE CONTROL WORD
          IX6    X7-X6       SET EOR FLAG
          SA7    X2-WRD
          SA6    X2-ERF
          PL     X3,RDC8     IF NO ERRORS
 
*         THE READ ERROR PROCESS IGNORES ALL MESSAGES WHICH MAY
*         CONSIST OF ANY BAD SECTOR DATA.
 
          SX7    X7+B1
          RJ     UOP         UPDATE OUT POINTER
          MX6    1           SET NEW READ FLAGS
          SA6    X2-ERF
          SA6    A6+B1
          SA6    RDCE        FLAG READ ERROR
          SB2    REMC        *DATA LOST.*
          RJ     GEM         GENERATE ERROR MESSAGE
 RDC7     SA1    RDCC        RESET FWA OF WORKING STORAGE BUFFER
          SA3    RDCD        SET LENGTH OF REQUESTED TRANSFER
          SB6    X1
          BX6    X3
          SA6    RDCA
 RDC8     SA1    RDCA        RESET WORDS NEEDED
          SB7    X1
          EQ     RDC1        LOOP
 
 
 RDCA     CON    0           NUMBER OF WORDS LEFT TO TRANSFER
 RDCB     CON    0           UPDATE WORKING STORAGE BUFFER
 RDCC     CON    0           FWA OF WORKING STORAGE BUFFER
 RDCD     CON    0           LENGTH OF REQUESTED TRANSFER
 RDCE     CON    0           READ ERROR ENCOUNTERED
 RDW      SPACE  4,20
**        RDW - READ DATA.
*
*         PROCESSES CALLS THAT ARE FOR READ WORDS (*RDW=*).
*         DEBLOCKS DATA THAT ARE IN CONTROL WORD READS.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (B6) = FWA OF WORKING STORAGE BUFFER.
*                (B7) = WORKING STORAGE BUFFER LENGTH.
*                (INAM) = .NE. 0, IF READING ALTERNATE INPUT FILE.
*                (PRUS) = NUMBER OF SECTORS REMAINING TO BE READ.
*
*         EXIT   (X1) = STATUS RETURNED FROM RDW=.
*                (X2-LWP) = LWA+1 OF DATA TRANSFERRED.
*                (B6) = LWA+1 OF DATA TRANSFERRED.
*
*         USES   X - 0, 1, 3, 4, 5, 6, 7.
*                A - 0, 1, 3, 4, 5, 6, 7.
*                B - 2, 6, 7.
*
*         CALLS  GEM, ICP, RDW=, UOP.
 
 
 RDW10    SA6    A1          UPDATE WORDS LEFT IN PRU
          RJ     RDW=        READ WORDS
 
 RDW      SUBR               ENTRY/EXIT
          SX6    B6          SAVE FWA OF WORKING STORAGE BUFFER
          SX7    B7          SAVE LENGTH OF WORKING STORAGE BUFFER
          SA6    RDWB
          SA7    RDWC
 RDW1     SA1    X2-WRD      GET NUMBER OF WORDS BEFORE CONTROL WORD
          ZR     X1,RDW3     IF LAST WORD OF BLOCK
          PL     X1,RDW2     IF NOT FIRST READ
          SX7    B7          SET WORDS LEFT IN WORKING STORAGE BUFFER
          SA7    RDWA
          EQ     RDW4        CHECK DISK COUNT
 
*         DETERMINE SIZE OF NEXT BML MESSAGE.
 
 RDW2     SB7    B1          SET WORDS TO READ
          RJ     RDW=        READ WORDS
          SA3    B6-B1       LWA  (BML MESSAGE HEADER WORD)
          MX0    12          GET MESSAGE LENGTH
          BX6    X0*X3
          LX6    11-59
          SB7    X6-1
          SA6    RDWD        SAVE FOR ERROR RECOVERY
          BX4    X6
          SA1    X2-WRD
          IX6    X1-X6
          PL     X6,RDW10    IF ENOUGH WORDS LEFT IN BLOCK
          IX6    X4-X1       SET WORDS LEFT TO TRANSFER
          BX7    X7-X7       CLEAR WORDS LEFT IN PRU
          SA6    X2-LWP
          SA7    A1
          SX1    X1-1        REMOVE FIRST WORD READ
 
*         READ FIRST PART OF MESSAGE IN CURRENT BLOCK AND
*         PROCESS *CIO* TRAILING CONTROL WORD.
 
 RDW3     SB7    X1+B1
          RJ     RDW=        READ WORDS
          SB6    B6-1        BACK UP OVER LAST CONTROL WORD
 
*         CHECK SECTOR COUNT TO DETERMINE IF DATA SHOULD BE READ
*         FROM THE DISK FILE OR FROM *CBUF*.
 
 RDW4     SA1    PRUS
          SX6    B1
          IX6    X1-X6
          NZ     X1,RDW5     IF MORE PRUS TO READ
          RJ     ICP         INITIALIZE CM BUFFER PROCESSING
          NG     X1,RDWX     IF EOF/EOI ENCOUNTERED - NO DATA LEFT
 RDW5     SB7    2           READ CONTROL WORDS
          SA6    A1+
          RJ     RDW=
          PL     X1,RDW6     IF NOT EOF/EOI
          SA3    INAM
          NZ     X3,RDWX     IF EOF/EOI ON ALTERNATE INPUT FILE
          SA0    =C* UNEXPECTED EOF/EOI ENCOUNTERED.*
          EQ     ERR         PREMATURE EOF/EOI
 
 RDW6     SB6    B6-2        BACK UP WORKING BUFFER
          SA1    B6          SET BLOCK SIZE FROM *CIO* CONTROL WORD
          BX3    X1
          SX7    5
          SX4    X1+4        ROUND UP
          AX1    36
          SX6    X1
          IX7    X4/X7       SET NUMBER OF WORDS BEFORE CONTROL WORD
          IX6    X7-X6       SET EOR FLAG
          SX7    X7-1        CONTROL WORDS
          SA4    A1+B1
          SA7    X2-WRD      SAVE PRU CONTROL WORD
          SA5    X2-LWP
          SA6    X2-ERF
          BX6    X6-X6       CLEAR WORDS LEFT FROM PREVIOUS PRU
          BX7    X4
          SA6    A5
          NG     X3,RDW9     IF READ ERRORS
          SA7    RDWF
          NG     X7,RDW7     IF RECOVERY SECTOR
          SA1    EFFG
          NZ     X1,RDW8     IF RECOVERING AN ERROR ON PREVIOUS PRU
          SA1    RDWA
          SB7    X1
          ZR     X5,RDW1     IF NO WORDS TO DEBLOCK FROM LAST PRU
          SA1    X2-WRD      WORDS IN BLOCK
          IX6    X1-X5
          SB7    X5          RESET WORDS NEEDED
          EQ     RDW10       COMPLETE MESSAGE
 
*         PROCESS READ ERRORS BY IGNORING THE BEGINNING OF AN
*         INCOMPLETE MESSAGE, THE SECTOR WITH THE READ
*         ERROR AND THE END OF A MESSAGE WHICH STARTS IN THE
*         BAD SECTOR.
 
*         PROCESS A RECOVERY SECTOR.
 
 RDW7     SA1    RDWE
          SB2    RSMC        *RECOVERY SECTOR.*
          BX7    X7-X7
          SA7    A1
          NZ     X1,RDW8     IF BEGINNING SECTOR
          RJ     GEM         GENERATE ERROR MESSAGE
 RDW8     SA1    RDWF        RESET POINTERS TO FIRST MESSAGE
          BX7    X7-X7       CLEAR READ ERROR FLAG
          MX0    12
          BX3    X0*X1       CHECK RECOVERY WORD FORMAT
          LX3    12
          SA0    =C$ MAINLOG - *BML* FORMAT INCORRECT.$
          SX3    X3-4000B
          NZ     X3,ERR      IF FORMAT INCORRECT
          SA7    EFFG
          LX0    12          DECREMENT WORD COUNT
          SA5    X2-WRD
          BX3    X0*X1
          SX7    X3-1
          IX6    X5-X7
          SA6    A5
          RJ     UOP
          SA1    RDWB        RESET START CONDITIONS
          SA5    RDWC
          SB6    X1
          SB7    X5
          EQ     RDW1        START NEW MESSAGE
 
*         PROCESS READ ERROR.
 
 RDW9     SX7    B1          SET READ ERROR FLAG
          SA3    RDWC        RESET WORKING BUFFER
          SA7    EFFG
          SB7    X3
          SA1    X2-WRD
          SX7    X1+B1
          RJ     UOP         UPDATE OUT POINTER
          SB2    REMC        *DATA LOST.*
          RJ     GEM         GENERATE ERROR MESSAGE
          EQ     RDW4        RETRY
 
 
 RDWA     CON    0           NUMBER OF WORDS LEFT TO TRANSFER
 RDWB     CON    0           FWA OF WORKING STORAGE BUFFER
 RDWC     CON    0           LENGTH OF WORKING STORAGE BUFFER
 RDWD     CON    0           MESSAGE WORD LENGTH
 RDWE     CON    1           SKIP FIRST RECOVERY SECTOR
 RDWF     CON    0           PRU LINKAGE WORD
 RIF      SPACE  4,15
**        RIF - READ INPUT FILE FOR NEXT MESSAGE.
*
*         ENTRY  (DFTY) = DAYFILE TYPE.
*
*         EXIT   (X1) = 0, IF MESSAGE READ.
*                (X1) .LT. 0, IF EOF/EOI ENCOUNTERED.
*                (B6) = FWA OF MESSAGE READ.
*                (B7) = LENGTH OF MESSAGE READ.
*
*         USES   X - 2.
*                A - 2.
*                B - 6, 7.
*
*         MACROS INPUTC, INPUTW.
 
 
 RIF      SUBR               ENTRY/EXIT
          SA2    DFTY        CHECK MESSAGE TYPE
          SX2    X2-MLTY
          ZR     X2,RIF1     IF PROCESSING BML
          INPUTC I,WBUF,WBUFL  READ ONE CODED MESSAGE
          EQ     RIF2        SET EXIT CONDITIONS
 
 RIF1     INPUTW I,WBUF,WBUFL  READ ONE BML MESSAGE
 RIF2     SB7    B6-WBUF     SET MESSAGE LENGTH
          SB6    WBUF        SET FWA OF MESSAGE
          EQ     RIFX        EXIT
 SRM      SPACE  4,20
**        SRM - SEARCH FOR MESSAGE.
*         THREE WORDS ARE EXAMINED.
*
*         ENTRY  CURRENT MESSAGE IN WORKING BUFFER.
*                (WBUF) = FWA OF CURRENT MESSAGE.
*                (SEMS - SEMS+2) = CRITERION MESSAGE.
*                (SEMA - SEMA+2) = CRITERION MESSAGE MASK.
*                (SEWI) = STARTING MESSAGE SEARCH WORD INDEX.
*                I = IN FET.
*
*         EXIT   (X4) = 0, IF MESSAGE FOUND.
*                     .NE. 0, IF NOT FOUND.
*
*         USES   X - 1, 2, 3, 4, 6.
*                A - 1, 2, 3.
 
 
 SRM      SUBR               ENTRY/EXIT
          SA1    SEWI        READ STARTING SEARCH INDEX
          SA1    X1+WBUF     COMPARE LINE
          SA2    SEMS
          SA3    SEMA
          BX1    X1-X2
          BX4    X3*X1
          SA1    A1+B1
          SA2    A2+B1
          NZ     X4,SRMX     IF NO COMPARE
          ZR     X2,SRM1     IF END OF MESSAGE
          SA3    A3+B1
          BX1    X1-X2
          BX4    X3*X1
          SA1    A1+B1
          NZ     X4,SRMX     IF NO COMPARE
          SA2    A2+B1
          SA3    A3+B1
          ZR     X2,SRM1     IF END OF MESSAGE
          BX1    X1-X2
          BX4    X3*X1
          NZ     X4,SRMX     IF NO COMPARE
 SRM1     SA1    SEJN        CHECK JOB NAME
          ZR     X1,SRMX     IF NO JOB NAME SET
          SA2    WBUF+1      CHECK JOBNAME FIELD OF DAYFILE
          MX6    24
          LX6    48
          BX3    X1-X2
          BX4    X6*X3
          ZR     X4,SRMX     IF NAMES MATCH
          SX4    B1          INDICATE MESSAGE NOT FOUND
          EQ     SRMX        RETURN
 TSF      SPACE  4,15
**        TSF - TERMINATE SEARCH FILE.
*
*         SET PROPER PAGINATION FLAG, ISSUE MESSAGE IF *FROM NOT
*         FOUND*, DUMP TO OUTPUT FILE FROM *SCR1*.
*
*         USES   X - 1, 2, 5.
*                A - 1.
*                B - 7.
*
*         MACROS READEI, READW, REWIND, WRITEC, WRITER, WRITEW.
 
 
 TSF      SUBR               ENTRY/EXIT
          WRITER S           INITIATE SEARCH FILE READ PROCESSING
          REWIND X2
 TSF1     SA1    DFTY
          SX5    B
          SX1    X1-MLTY
          ZR     X1,TSF2     IF BINARY FILE
          SX5    O
          SA1    JTOP
          NZ     X1,TSF2     IF JOB TERMINATION SPECIFIED
          SA1    SFOP        DETERMINE IF OP=I SPECIFIED
          SA2    =1LI
          BX2    X1-X2
          ZR     X2,TSF2     IF OP=I SPECIFIED
          SA1    FRFO
          NZ     X1,TSF2     IF *FR* FOUND
          SA1    IOUT
          NZ     X1,TSFX     IF NOT TERMINAL OUTPUT
          WRITEC X5,(=C/ *FR* NOT FOUND./)
 TSF2     READEI S
 
 TSF2.1   SA1    INTR
          NZ     X1,DAF5     IF TERMINAL INTERRUPT
          READW  S,WBUF,WBUFL
          NG     X1,TSF3     IF EOF
          WRITEW X5,WBUF,WBUFL
          EQ     TSF2.1      CONTINUE READING
 
 TSF3     SB7    B6-WBUF
          WRITEW X5,WBUF,B7
          EQ     TSFX        RETURN
 UOP      SPACE  4,20
**        UOP - UPDATE OUT POINTER.
*
*         ENTRY  (X7) = NUMBER OF WORDS TO UPDATE OUT POINTER BY.
*                (X2) = FET ADDRESS.
*
*         EXIT   OUT POINTER IN FET UPDATED.
*
*         USES   X - 0, 1, 3, 6.
*                A - 1, 3, 6.
 
 
 UOP      SUBR               ENTRY/EXIT
          MX0    18
          SA1    X2+3        READ OUT POINTER
          LX0    18
          SA3    A1+B1       READ LIMIT
          IX6    X1+X7
          BX3    X0*X3
          IX1    X6-X3
          NG     X1,UOP1     IF NO WRAP AROUND
          SA3    X2+B1       READ FIRST
          BX3    X0*X3
          IX6    X3+X1
 UOP1     SA6    A1
          EQ     UOPX        RETURN
 WBF      SPACE  4,15
**        WBF - WRITE BINARY FILE.
*
*         ENTRY  (X0) = NUMBER OF WORDS IN BINARY MESSAGE.
*                (X5) = FET ADDRESS.
*
*         EXIT   BINARY MESSAGE WRITTEN TO INDICATED FILE.
*                CYBER RECORD MANAGER *W-WORD* PREFIXED TO MESSAGE,
*                IF NOT WRITTEN TO SEARCH FILE.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 6.
*
*         MACROS WRITEW.
 
 
 WBF      SUBR               ENTRY/EXIT
 
*         BUILD *W-WORD*.
 
          SA1    WCWD        SET BACKWARD LINK = OLD FORWARD LINK + 1
          SX2    X1+B1
          LX2    41-17
          SA1    WBUF        SET FORWARD LINK = LENGTH FROM HEADER WORD
          MX3    12
          BX6    X3*X1
          LX6    11-59
          BX6    X2+X6
          CX1    X6          SET PARITY BIT
          MX3    1
          LX1    59-0
          BX1    X3*X1
          BX1    X3-X1
          BX6    X1+X6
          SA6    WCWD        INCLUDE NEW *W-WORD* IN RECORD WRITTEN
 
*         WRITE BINARY MESSAGE.
 
          WRITEW X5,WBUF-1,B7+1
          EQ     WBFX        RETURN
 WCF      SPACE  4,15
**        WCF - WRITE CODED FILE.
*
*         ENTRY  (X5) = FET ADDRESS.
*
*         EXIT   CODED LINE WRITTEN TO INDICATED FILE.
*                PAGINATION SUPPLIED IF NEEDED.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  CDD, SFN.
*
*         MACROS WRITEC, WRITEW.
 
 
 WCF      SUBR               ENTRY/EXIT
 
*         PROCESS DOUBLE SPACE CONTROL.
 
          SA1    JTOP
          NZ     X1,WCF2     IF JOB TERMINATION SPECIFIED
          SA1    LISF
          NZ     X1,WCF2     IF OUTPUT NOT PAGINATED
          SA1    SFOP        CHECK FOR *OP=I*
          SA2    =1LI
          BX2    X1-X2
          ZR     X2,WCF0     IF *OP=I*
          SA1    FRFO
          ZR     X1,WCFX     IF *FR* NOT FOUND
 WCF0     SA1    PLPP
          PL     X1,WCF1     IF SPACE CONTROL NOT REQUIRED
          SA2    WBUF        INSERT DOUBLE SPACE
          SA3    WCFA
          MX0    6
          BX6    -X0*X2
          BX6    X6+X3
          SA6    A2
 
*         PROCESS PAGE EJECT.
 
 WCF1     SA2    LINE        ADVANCE LINE NUMBER
          SX3    X1          LINE LIMIT
          SX6    X2+B1
          IX7    X3-X6
          SA6    A2
          PL     X7,WCF2     IF NOT END OF PAGE
          SX6    3           RESET LINE NUMBER
          SA1    PAGE        ADVANCE PAGE NUMBER
          SA6    A2
          SX6    X1+B1
          SX1    X1+B1
          SA6    PAGE
          RJ     CDD         CONVERT PAGE NUMBER
          SA2    WCFB
          SA1    WBUF        SET PAGE INDEX
          MX0    2*6
          BX6    X2-X6
          SA2    INDX
          LX0    6
          SA6    PGNO
          BX7    -X0*X1
          BX2    X0*X2
          BX1    X7+X2
          RJ     SFN
          SA6    INDX
          SA3    DENC
          BX6    X6-X6
          SA1    PLPP
          LX1    59-35       SET DENSITY CONTROL
          SA6    A3          DISABLE USE OF PRINT DENSITY
          MX0    2*6
          BX7    X0*X1
          SA7    DENF
          WRITEW X5,DENF,X3  CONDITIONALLY WRITE PRINT DENSITY
          WRITEW X5,HEDR,HEDRL  WRITE TITLE
 
*         LIST DAYFILE LINE.
 
 WCF2     WRITEC X5,WBUF     WRITE CODED LINE
          EQ     WCFX        RETURN
 
 WCFA     CON    1L0
 WCFB     CON    6L PAGE &6L
 WOF      SPACE  4,30
**        WOF - WRITE MESSAGE TO OUTPUT FILE.
*
*         ENTRY  (B6) = FWA OF MESSAGE.
*                (B7) = LENGTH OF MESSAGE.
*                (DFTY) = DAYFILE TYPE.
*                (FROM) .EQ. 0 IF FULL DUMP BEING PROCESSED.
*                (FROM) .NE. 0 IF PARTIAL DUMP.  (SEARCH MESSAGE FOR
*                              MESSAGE STRING.)
*
*         EXIT   MESSAGE WRITTEN TO OUTPUT FILE.
*                (FRFO) = 1, IF MESSAGE SEARCH STRING FOUND IN CURRENT
*                            MESSAGE.  OTHERWISE, (FRFO) IS UNCHANGED
*                            FROM ENTRY.
*
*         USES   X - 1, 4, 5, 6, 7.
*                A - 1, 4, 6, 7.
*
*         CALLS  SRM, WBF, WCF.
*
*         MACROS REWIND.
 
 
 WOF      SUBR               ENTRY/EXIT
          SA1    INTR
          NZ     X1,DAF5     IF TERMINAL INTERRUPT
          ZR     B7,WOFX     IF NO MESSAGE
          SA1    DFTY
          SX1    X1-MLTY
          SX5    O           SET FET = CODED OUT-FILE
          NZ     X1,WOF1     IF NOT BINARY FILE
          SX5    B           SET FET = BINARY OUT-FILE
 WOF1     SA1    FROM
          ZR     X1,WOF3     IF SEARCH NOT NEEDED
          RJ     SRM         SEARCH FOR MESSAGE
          SX5    S           SET FET = SEARCH FILE
          NZ     X4,WOF3     IF SEARCH FILE NOT FOUND
          SA1    CMFG
          SA4    I-WRD
          ZR     X1,WOF2     IF NOT PROCESSING CM BUFFER
          ZR     X4,WOF3     IF NO MORE DATA IN BUFFER
 WOF2     REWIND X5,R
          SA1    LISV        RESTORE LIST FLAG
          SX6    B1          SET *FOUND*
          BX7    X1
          SA6    DENC
          SA6    FRFO
          SA1    WCWC        BML LINK RECOVERY
          SA7    LISF
          SX6    PLEN        RESET LINE COUNT
          BX7    X7-X7       RESET PAGE COUNT
          SA6    LINE
          SA7    PAGE
          BX6    X1
          SA6    WCWD
 WOF3     SA1    DFTY
          SX1    X1-MLTY
          NZ     X1,WOF4     IF NOT BINARY FILE
          RJ     WBF         WRITE BINARY FILE
          EQ     WOFX        RETURN
 
 WOF4     RJ     WCF         WRITE CODED FILE
          EQ     WOFX        RETURN
 WUP      SPACE  4,20
**        WUP - WRAP UP PROCESSING.
*
*         ENTRY  (INAM) = 0, IF PROCESSING ACTIVE DAYFILE.
*                       .NE. 0, IF PROCESSING LOCAL FILE.
*                (FRFO) = 0, IF *FR* MESSAGE NOT FOUND.
*                       .NE. 0, IF FOUND.
*                (INAM) = 0, IF PROCESSING ACTIVE DAYFILE.
*                       .NE. 0, IF PROCESSING LOCAL COPY OF DAYFILE.
*
*         EXIT   FILES RETURNED.
*                *NOT FOUND* MESSAGE ISSUED IF NECESSARY.
*
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 7.
*
*         MACROS RETURN.
 
 
 WUP      SUBR               ENTRY/EXIT
          SA1    FRFO
          NZ     X1,WUP1     IF STRING FOUND
          SA1    SFOP        SUPPRESS *NOT FOUND* MESSAGE IF OP=I SET
          LX1    5-59
          SX1    X1-1RI
          ZR     X1,WUP1     IF OP=I SET
          MESSAGE (=C/ *FR* NOT FOUND./)
 WUP1     RETURN S
          SA1    INAM
          NZ     X1,WUPX     IF I=LFN SPECIFIED
          RETURN I
          EQ     WUPX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCRDC
*CALL     COMCRDO
*CALL     COMCRDW
*CALL     COMCSFM
*CALL     COMCSFN
*CALL     COMCSTF
*CALL     COMCSYS
*CALL     COMCWTC
*CALL     COMCWTO
*CALL     COMCWTW
          TITLE  SPECIAL ENTRIES AND BUFFERS.
*         SPECIAL ENTRY POINTS.
 
 
 ARG=     BSS    0           DISABLE ARGUMENT CRACKING
 
*         BUFFERS.
 
          USE    BUFFERS
          SEG
          SPACE  4,15
**        *W* CONTROL WORD.
*
*T W-WORD 1/P,1/F,1/D,13/,2/C,18/ B-LINK,6/,18/ F-LINK
*
*         P = PARITY BIT (MAINTAINS ODD PARITY OF WORD).
*         F = RECORD FLAG (0 = NORMAL RECORD).
*         D = DELETE BIT (0 = ACTIVE RECORD).
*         C = CONTINUATION FLAGS (0 = COMPLETE RECORD).
*         B-LINK = BACKWARD LINK (WORD COUNT OF PREVIOUS RECORD + 1).
*         F-LINK = FORWARD LINK (WORD COUNT NOT INCLUDING *W* WORD).
 
 WCWC     VFD    1/0,1/0,1/0,13/0,2/0,18/0,6/0,18/-1  RECOVERY
 WCWD     VFD    1/0,1/0,1/0,13/0,2/0,18/0,6/0,18/-1
 
 WBUF     EQU    WCWD+1      WORKING BUFFER (MUST FOLLOW W-WORD)
 SBUF     EQU    WBUF+WBUFL  SCRATCH BUFFER
 RBUF     EQU    SBUF+SBUFL  REMAINDER CONCATINATION BUFFER
 BCWD     EQU    RBUF+WBUFL  CIO CONTROL WORD FOR BML PRU-S
 CBUF     EQU    BCWD+1      BUFFER FOR CM PORTION OF DAYFILE
 IBUF     EQU    CBUF+CBUFL  IN BUFFER
 OBUF     EQU    IBUF+IBUFL  OUTPUT BUFFER
 EBUF     EQU    OBUF        EST BUFFER - USED IN PRESET ONLY
 
 
 .RFL     MAX    OBUF+OBUFL,EBUF+EBUFL
 RFL=     EQU    .RFL        REQUIRED FIELD LENGTH
          SPACE  4,10
          ERRNG  JTFL*100B-RFL=  IF OVERFLOW MAXIMUM JOB TERMINATION FL
 PRS      TITLE  PRESET.
**        PRS - PRESET.
*         1. SET TERMINATION MESSAGE, PAGE TITLE.
*         2. VALIDATE ACCESS TO DAYFILE.
*         3. PROCESS THE COMMAND ARGUMENTS.
*         4. DISABLE TERMINAL CONTROL IF NEEDED.
*         5. SET PAGE TITLE INFORMATION IF NEEDED.
*
*         ENTRY  (X4) = ADDRESS OF SEARCH STRING FOR PARTIAL DUMP.
*                (DFTY) = DAYFILE TYPE.
*                (ENPT) = ENTRY POINT NAME.
*
*         EXIT   TO *ERR* IF ARGUMENT OR FORMAT ERROR.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 5, 6, 7.
*                B - 1, 2, 3, 4, 6, 7.
*
*         CALLS  ARM, CPA, CRN, DXB, FNB, IPP, OPN, PDR, SDO,
*                SSM, STF, USB.
*
*         MACROS CLOCK, DATE, DISTC, EVICT, GETJN, MOVE, SYSTEM,
*                WRITEW.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1           SET CONSTANT
          MOVE   3,X4,IBUF
 
*         GET PAGE PARAMETERS.
 
          RJ     IPP
 
*         PROCESS ARGUMENTS.
 
 PRS1     SB2    CCDR        UNPACK COMMAND
          RJ     USB
          SA1    A6+         ASSURE TERMINATION
          SX6    1R.
          SA3    B6          CHECK COMMAND LABEL PRESENT
          SA6    X1+B1
          SA0    =C* ARGUMENT ERROR.*
          SA2    PRSB        SET SEPARATOR MASK
          SB2    60          SET MAXIMUM NON-DELIMITER DISPLAY CODE
          SB7    ERR         SET EXIT FOR TERMINATOR CHARACTER
          RJ     FNB         FIND NON-BLANK CHARACTER
          SX4    X1-1R0
          MI     X4,PRS3     IF NON-NUMERIC CHARACTER
          SX4    X1-1R9-1
          PL     X4,PRS3     IF NON-NUMERIC CHARACTER
 
*         SKIP *KCL* TAG.
 
 PRS2     RJ     FNB         FIND NON-BLANK CHARACTER
          SB4    B5-B2
          LX4    X2,B5
          PL     B4,PRS3     IF SEPARATOR CHARACTER
          PL     X4,PRS2     IF NOT SEPARATOR CHARACTER
 
*         SKIP POSSIBLE INITIAL SPECIAL CHARACTER OR DELIMITER.
 
 PRS3     RJ     FNB         FIND NON-BLANK CHARACTER
 
*         SKIP PROGRAM NAME.
 
          SB7    PRS8        SET EXIT FOR TERMINATOR CHARACTER
 PRS4     RJ     FNB         FIND NON-BLANK CHARACTER
          SB4    B5-B2
          LX4    X2,B5
          PL     B4,PRS5     IF SEPARATOR CHARACTER
          PL     X4,PRS4     IF NOT SEPARATOR CHARACTER
 
*         PROCESS ARGUMENTS.
 
 PRS5     SA1    ENPT        SET ARGUMENT TABLE ADDRESS AND LENGTH
          SA1    PRSD+X1-GLTY
          UX1,B2 X1          UNPACK ARGUMENT TABLE VALUES
          SB3    X1
          SB4    PRSA        CONVERT POSITIONAL ARGUMENTS
          RJ     CPA
          SA0    =C* ARGUMENT ERROR.*
          NG     B5,ERR      IF ERROR
          PL     X1,PRS8     IF NO ARGUMENTS PROCESSED
          SX6    B5          SET LWA OF ARGUMENTS
          SB6    PRSA        SET FWA OF ARGUMENTS
          SA6    USBC
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,ERR      IF ERROR
          MX0    42          CHECK FOR RESERVED FILE
          SA0    =C* RESERVED FILE NAME.*
          SA3    O
          BX4    X3*X0
          RJ     CRN
          ZR     X7,ERR      IF RESERVED FILE NAME
 
*         SET DEFAULT *OP*.
 
 PRS8     SA1    JTOP
          NZ     X1,PRS9     IF JOB TERMINATION OPTION SPECIFIED
          SX2    O           CHECK FOR TERMINAL OUTPUT FILE
          RJ     STF
          SA6    IOUT        SAVE OUTPUT FILE TYPE
          SX7    B1
          NZ     X6,PRS9     IF NOT TERMINAL OUTPUT FILE
          SA7    LISF        SET NON-PAGINATED OUTPUT FLAG
          SA7    PLPP        SET PAGE SIZE
          SA1    SEMS
          NZ     X1,PRS9     IF *FR* OPTION SPECIFIED
          SA1    SFOP
          LX1    59-0
          PL     X1,PRS9     IF *OP* OPTION SPECIFIED
          SX6    1RI         SET *OP=I* AS DEFAULT
          LX6    -6
          SA6    A1
 
*         PROCESS SEARCH OPTION.
 
 PRS9     RJ     SDO         SET DUMP OPTIONS
          ZR     X5,PRS12    IF NOT PARTIAL DUMP
          SX6    B1          SET PARTIAL DUMP
          AX5    1           CHECK FOR INCREMENTAL DUMP
          SA6    FROM
          NZ     X5,PRS11    IF NOT INCREMENTAL DUMP
          SA1    DFTY
          SX1    X1-MLTY
          ZR     X1,PRS10    IF PROCESSING MAINTENANCE LOG
          MOVE   3,IBUF,SEMS SET SEARCH MESSAGE
          EQ     PRS11       SET SEARCH MASK
 
 PRS10    SA1    IBUF+1      SET MAINTENANCE LOG SEARCH MESSAGE
          BX6    X1
          SA6    SEMS
 PRS11    RJ     SSM         SET SEARCH MASK
          SA1    SFOP        DETERMINE IF OP=J SPECIFIED
          SA2    =1LJ
          BX2    X1-X2
          NZ     X2,PRS12    IF NOT SPECIFIED
          SA1    SEMA        ADJUST MASK
          LX1    48
          BX6    X1
          SA6    A1
          SA1    SEMS        ADJUST SEARCH STRING
          LX1    48
          RJ     SFN
          SA6    A1
 
*         DISABLE TERMINAL CONTROL.
 
 PRS12    SA5    JOPR        CHECK JOB ORIGIN
          MX0    -12
          LX5    -24
          BX5    -X0*X5
          SB7    X5-IAOT
          NZ     B7,PRS13    IF NOT TERMINAL ORIGIN
          DISTC  ON,INTR
 PRS13    SA1    IOUT
          ZR     X1,PRS17    IF INTERACTIVE TERMINAL OUTPUT
 
*         PROCESS PAGINATION ARGUMENTS.
 
          SA5    PDEN        CONVERT PRINT DENSITY
          SB7    B1          ASSUME DECIMAL BASE
          SX6    X5          SAVE *ARGUMENT GIVEN* FLAG
          BX5    X5-X6
          SB6    X6
          RJ     DXB
          SA0    =C* INCORRECT PRINT DENSITY FORMAT.*
          NZ     X4,ERR      IF FORMAT ERROR
          SA0    =C* INCORRECT PRINT DENSITY.*
          SB2    X6-3
          SB3    X6-4
          ZR     B2,PRS14    IF 3 LPI
          SB2    X6-6
          ZR     B3,PRS14    IF 4 LPI
          SB3    X6-8
          ZR     B2,PRS14    IF 6 LPI
          NZ     B3,ERR      IF NOT 8 LPI
 PRS14    SA5    PLPP        CONVERT PAGE SIZE
          SA6    PDEN        STORE PRINT DENSITY
          SX7    X5+         UPDATE *ARGUMENT GIVEN* FLAG
          BX5    X5-X7
          SB6    B6+X7
          RJ     DXB
          SA1    PDEN        FIND SPACING CHARACTERISTICS
          SA0    =C* INCORRECT PAGE SIZE FORMAT.*
          SA2    TPAS-1+X1
          NZ     X4,ERR      IF FORMAT ERROR
          BX7    X2
          ZR     X6,PRS15    IF PAGE SIZE NOT SPECIFIED
          MX1    -17
          BX6    -X1*X6      REPLACE PAGE SIZE
          BX7    X1*X7
          PL     X7,PRS14.1  IF NOT DOUBLE SPACE
          AX6    1           DIVIDE PAGE SIZE BY 2 FOR DOUBLE SPACE
 PRS14.1  BX7    X6+X7
 PRS15    SA7    PLPP        SET PAGE SIZE
          SB6    B6-2        CHECK *PD* OR *PL* SPECIFIED
          ZR     B6,PRS16    IF NEITHER *PD* NOR *PL* SPECIFIED
          SX6    0           SET PAGINATION
          SA6    LISF
          EQ     PRS17       SET UP TITLE INFORMATION
 
 PRS16    SA1    O           CHECK IF OUTPUT
          SA2    =0LOUTPUT
          MX0    42
          BX6    X1-X2
          BX7    X0*X6
          SA7    LISF        SET LIST FLAG
 
*         SET PAGE TITLE INFORMATION.
 
 PRS17    SA1    FROM        SET DUMP MODE
          ZR     X1,PRS18    IF FULL DUMP
          SA1    =10H1 PARTIAL
          SA2    LISF        SAVE LIST FLAG
          BX6    X1
          BX7    X2
          SA6    MODE
          SA7    LISV
          BX7    X7-X7       SET *NOT FOUND*
          SA7    FRFO
 PRS18    DATE   DATE        SET DATE
          CLOCK  TIME        SET TIME
          EVICT  S           EVICT SCRATCH FILES
          SA1    INAM
          NZ     X1,PRS19    IF I=LFN SPECIFIED
          EVICT  I,R
 
*         PROCESS JOB TERMINATION OPTION.
 
 PRS19    SA1    JTOP        CHECK JOB TERMINATION FLAG
          ZR     X1,PRS21    IF NOT ENTERED
          FILINFO  PRSE      CHECK FILE TYPE OF *OUTPUT*
          SA1    PRSE+1
          MX0    -6
          BX1    -X0*X1
          ZR     X1,PRS19.3  IF LOCAL FILE TYPE
          SX2    X1-2
          ZR     X2,PRS19.3  IF QUEUED FILE TYPE
          SX2    X1-6
          ZR     X2,PRS19.3  IF PRIMARY FILE TYPE
          RETURN O,R         RETURN *OUTPUT*
 PRS19.3  GETJN  JSNP        SET JSN IN END OF JOB HEADER
          SX2    O
          RJ     STF         CHECK RESIDENCY OF OUTPUT FILE
          NZ     X6,PRS19.5  IF NOT TERMINAL FILE
          RETURN X2,R
          SETFET X2,(DTY==2ROT)
          REQUEST  X2,U,N    MAKE SURE OUTPUT GOES TO DISK
 
 PRS19.5  SYSTEM RSB,R,PRSC  SET TITLE AND VERSION IN END OF JOB HEADER
          SA1    JSNP
          SA2    =2L1
          LX1    60D-12D
          RJ     SFN
          BX6    X6+X2
          SA6    JSNP
          DATE   DAT2        PUT DATE IN END OF JOB HEADER
          CLOCK  TIM2        SET END OF JOB TIME
          SX0    TITL        SPACE FILL TITLE AND VERSION DATA
          SX5    6
 PRS20    SA1    X0          READ NEXT WORD OF TITLE
          RJ     SFN         SPACE FILL WORD
          SX0    X0+B1
          SA6    A1
          SX5    X5-1
          NZ     X5,PRS20    IF NOT ALL WORDS SPACE FILLED YET
          WRITEW O,HDR2,HDR2L  WRITE END OF JOB HEADER
          SA1    JTOP        RESTORE *JT* OPTION TO REGISTER
          RJ     PDR         PROCESS DEFERRED ROUTE
 
*         WRITE *EST* FILE, IF *GETLOG* RUN.
 
 PRS21    SA1    ENPT        CHECK ENTRY POINT
          SX1    X1-GLTY
          NZ     X1,PRS22    IF NOT *GETLOG*
          RJ     WEF         WRITE EST TO FILE
 PRS22    EQ     PRSX        RETURN
 
 PRSA     BSS    200
 
 PRSB     CON    40000000000033127777B  SEPARATOR CHARACTER MASK
 PRSC     VFD    12/0,12/6,18/SYTL,18/TITL  PARAMETERS FOR RSB CALL
 PRSD     BSS    0           ARGUMENT TABLE PARAMETERS
          LOC    GLTY
 GLTY     VFD    12/2000B+TGTLL,48/TGTL  *GETLOG*
 ACTY     VFD    12/2000B+TCODL,48/TCOD  *AFD*
 UDTY     VFD    12/2000B+TCODL,48/TCOD  *DAYFILE*
 SDTY     VFD    12/2000B+TCODL,48/TCOD  *DFD*
 ELTY     VFD    12/2000B+TCODL,48/TCOD  *ELD*
 MLTY     VFD    12/2000B+TMLGL,48/TMLG  *MAINLOG*
          LOC    *O
 PRSE     VFD    42/6LOUTPUT,6/5,11/0,1/1
          BSS    4
 TGTL     SPACE  4,10
**        TGTL - *GETLOG* PARAMETERS.
 
 
 TGTL     BSS    0
 L        ARG    ST,O,0,0     *ERRLOG* FILENAME
 OP       ARG    0,SFOP,0,1   OPTIONS
 I        ARG    ST,INAM,0,0  *BML* INPUT FILENAME
 B        ARG    ST,BNAM,0,0  *BML* FILENAME
 E        ARG    ST,E,0,0     *EST* FILENAME
          ARG                 TERMINATOR
 TGTLL    EQU    *-TGTL-1     LENGTH OF ARGUMENT TABLE
 TMLG     SPACE  4,10
**        TMLG - *MAINLOG* PARAMETERS.
 
 
 TMLG     BSS    0
          VFD    6/1R ,54/   NO ARGUMENT - PLACE HOLDER
 FR       ARG    0,SEMS,400B,3  *FROM* OPTION
 OP       ARG    0,SFOP,0,1     OPTIONS
          VFD    6/1R ,54/0  NO ARGUMENT - PLACE HOLDER
          VFD    6/1R ,54/0  NO ARGUMENT - PLACE HOLDER
 I        ARG    ST,INAM,0,0    *BML* INPUT FILENAME
 B        ARG    ST,BNAM,0,0    *BML* FILENAME
          ARG                   TERMINATOR
 TMLGL    EQU    *-TMLG-1       LENGTH OF ARGUMENT TABLE
 TCOM     SPACE  4,10
**        TCOD - CODED PARAMETERS.
*
*         THIS TABLE IS USED BY THE CODED DAYFILE PROCESSORS.
 
 
 TCOD     BSS    0
 L        ARG    ST,O,0,0       OUTPUT FILENAME
 FR       ARG    0,SEMS,400B,3  *FROM* OPTION
 OP       ARG    0,SFOP,0,1     OPTIONS
 PD       ARG    0,PDEN,0,1     PRINT DENSITY
 PL       ARG    0,PLPP,400B,1  PAGE LENGTH
 I        ARG    ST,INAM,0,0    INPUT FILENAME
 JT       ARG    JTOP,JTOP,0,0  JOB TERMINATION OPTION
          ARG                   TERMINATOR
 TCODL    EQU    *-TCOD-1       LENGTH OF ARGUMENT TABLE
 
 ST       CON    3           DEFAULT FET STATUS
 TPAS     SPACE  4,10
**        TPAS - TABLE OF PAGE SIZE PARAMETERS.
*         INDEXED BY PRINT DENSITY VALUE.
*         ONE WORD ENTRY IN FORM -
*
*T        1/A,23/ ,18/  FMT,18/  DIV       INITIAL FORM
*
*T        1/A,23/ ,18/  FMT,18/  PAGE      FINAL FORM
*
*         WHERE  A = 1 IF DOUBLE SPACING IS NEEDED.
*                FMT = PRINT DENSITY FORMAT CONTROL CHARACTER.
*                PAGE = NUMBER OF LINES PER PAGE FOR THIS DENSITY.
*                DIV = DIVISOR FOR JOB DEFAULT PAGE SIZE.
 
 
 TPAS     BSS    0
          LOC    1
          CON    0
          CON    0
          VFD    1/1,23/0,18/2LS ,18/2
          VFD    1/1,23/0,18/2LT ,18/2
          CON    0
          VFD    1/0,23/0,18/2LS ,18/1
          CON    0
          VFD    1/0,23/0,18/2LT ,18/1
          LOC    *O
          CON    -0          END OF LIST
 CDP      SPACE  4,15
**        CDP - CONVERT DISPLAY TIME TO PACKED TIME.
*
*         ENTRY  (SEMS) = DISPLAY TIME (10H HH.MM.SS.).
*
*         EXIT   (SEMS) = PACKED TIME (VFD  42/0,18/HHMMSS).
*                TO *ERR* IF CONVERSION ERROR.
*
*         USES   X - 1, 2, 3, 5, 6.
*                A - 0, 1, 2, 3, 6.
*                B - 4, 6, 7.
*
*         CALLS  DXB.
 
 
 CDP      SUBR               ENTRY/EXIT
          SB6    3           INITIALIZE TABLE INDEX
          SB7    1           SET DECIMAL CONVERSION FLAG
 CDP1     SB6    B6-1        EXTRACT 2 DISPLAY DIGITS
          SA1    SEMS
          SA2    CDPA+B6
          SA3    CDPB+B6
          BX5    X2*X1
          SB4    X3+
          LX5    B4,X5
          RJ     DXB         CONVERT DISPLAY CODE TO BINARY
          SA0    =C/ *FR* TIME VALUE INCORRECT./
          NZ     X4,ERR      IF CONVERSION ERROR
          SA1    CDPC        MERGE CONVERTED DIGITS
          LX1    6
          BX6    X1+X6
          SA6    A1+
          NZ     B6,CDP1     IF MORE
          SA6    SEMS        SET PACKED TIME
          EQ     CDPX        RETURN
 
 
 CDPA     VFD    42/0,12/7777B,6/0  MASK TABLE
          VFD    24/0,12/7777B,24/0
          VFD    6/0,12/7777B,42/0
 
 CDPB     CON    42D         SHIFT TABLE
          CON    24D
          CON    6D
 
 CDPC     BSSZ   1           CONVERSION AREA
 CRN      SPACE  4,15
**        CRN - CHECK RESERVED NAME.
*
*         ENTRY  (X4) = LEFT JUSTIFIED FILE NAME.
*                (A3) = FET ADDRESS OF FILE BEING CHECKED.
*
*         EXIT   (X7) = 0, IF RESERVED NAME.
*
*         USES   X - 1, 2, 3, 7.
*                A - 1.
*                B - 2, 3, 5.
 
 
 CRN      SUBR
          SB2    I-FETL
          SB5    A3
          SB3    S
          MX3    42
          SX7    B1          INDICATE NOT RESERVED
          BX4    X3*X4
          ZR     X4,CRNX     IF ZERO FILE NAME SPECIFIED
 CRN1     SB2    B2+FETL     INCREMENT FET ADDRESS
          EQ     B2,B5,CRN1  IF FET BEING CHECKED
          GT     B2,B3,CRNX  IF SEARCH COMPLETE
          SA1    B2          SET FET FILENAME
          BX2    X3*X1
          BX7    X2-X4
          NZ     X7,CRN1     IF NOT A MATCH
          EQ     CRNX        RETURN
 FNB      SPACE  4,20
**        FNB - FIND NON-BLANK CHARACTER.
*
*         ENTRY  (B6) = NEXT CHARACTER ADDRESS.
*                (B7) = EXIT ADDRESS, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   (X1) = (B5) = NEXT NON-BLANK CHARACTER.
*                (B6) = NEXT CHARACTER ADDRESS (UPDATED).
*                EXIT IS MADE TO (B7), IF TERMINATOR ENCOUNTERED.
*
*         USES   X - 1, 4.
*                A - 1.
*                B - 5, 6.
 
 
 FNB      SUBR               ENTRY/EXIT
 FNB1     SA1    B6          GET NEXT CHARACTER
          SB6    B6+B1
          SX4    X1-1R
          ZR     X4,FNB1     IF BLANK CHARACTER
          SB5    X1+
          SX4    X1-1R.
          ZR     X4,FNB2     IF TERMINATOR CHARACTER
          SX4    X1-1R)
          NZ     X4,FNBX     IF NOT TERMINATOR CHARACTER, RETURN
 FNB2     JP     B7          TERMINATOR CHARACTER
IPP       SPACE  4,20
**        IPP - INITIALIZE PAGE PARAMETERS.
*
*         ENTRY  NONE.
*
*         EXIT   TABLE *TPAS* SET UP WITH JOB PAGE SIZE.
*                (PDEN) = JOB DEFAULT PRINT DENSITY.
*                (RFMT) = JOB DEFAULT PRINT DENSITY.
*
*         USES   A - 1, 2, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 6, 7.
*
*         MACROS GETPP.
 
 
 IPP      SUBR               ENTRY/EXIT
          GETPP  IPPA,IPPB,PDEN  GET PAGE PARAMETERS
          SA1    PDEN        PRINT DENSITY SYMBOL
          SX6    1R
          LX6    54-6
          BX6    X1+X6
          SA6    RFMT        SET RESTORE DENSITY
          LX1    6
          SX1    X1-1RS+6/2  NUMERIC PRINT DENSITY
          LX1    1
          SX7    X1+1BS6+1R6-6  FORM DISPLAY CODE EQUIVALENT
          LX7    59-5
          SA7    A1
          SA2    IPPB        GET JOB PAGE SIZE
          SA1    TPAS        SET UP PAGE SIZE TABLE
          MX0    42
 IPP1     SB6    X1-1        DIVISOR - 1 = SHIFT COUNT
          NG     B6,IPP2     IF UNUSED WORD
          BX1    X0*X1
          AX6    B6,X2
          BX6    X1+X6
          SA6    A1          STORE ACTUAL LINE COUNT
 IPP2     SA1    A1+B1       GET NEXT WORD IN TABLE
          NZ     X1,IPP1     IF WORD IN USE
          PL     X1,IPP2     IF UNUSED WORD
          EQ     IPPX        RETURN
 
 IPPA     BSSZ   2           GETPAGE RESPONSE BLOCK
 IPPB     CON    0           TEMPORARY STORAGE FOR PAGE SIZE
 PDR      SPACE  4,20
**        PDR - PROCESS DEFERRED ROUTE OF FILE.
*
*         POSITIONS FILE TO *EOI* IF JOB TERMINATION IN
*         PROGRESS.  SETS RANDOM ADDRESS IN *DSP* PARAMETER
*         BLOCK.
*
*         ENTRY  (X1) = *JT* PARAMETER OPTION.
*
*         EXIT   TO ERR IF PARAMETER ERROR.
*
*         USES   X - 1, 2, 6.
*                A - 0, 1, 2, 6.
*
*         MACROS GETEOJS, SKIPEI.
 
 
 PDR      SUBR               ENTRY/EXIT
          SA2    DFTY        GET DAYFILE PROGRAM CALL CODE
          SA0    =C* ARGUMENT ERROR.*  PRESET ERROR MESSAGE
          SX2    X2-UDTY
          NZ     X2,ERR      IF NOT USER DAYFILE CALL
          LX1    6
          SX2    1RD         CHECK OPTION DEFINED
          BX2    X2-X1
          SA0    =C* INCORRECT JOB TERMINATION OPTION.*
          NZ     X2,ERR      IF NOT *D* OPTION
 
*         CHECK IF END OF JOB PROCESSING.
 
          GETEOJS  PDRB      GET END OF JOB STATUS
          SA1    PDRB        READ REPLY WORD
          SA2    PDRA+1
          SX6    X1-100B     CHECK FOR TERMINATION IN PROGRESS
          NG     X6,PDR1     IF TERMINATION NOT IN PROGRESS
          MX6    -12         CLEAR DISPOSITION CODE AND ASSOCIATED BIT
          SX1    21B
          LX6    24
          BX6    X6*X2
          BX6    X6-X1
          SA6    A2          RESET ROUTING INFORMATION
 
*         SET UP *DSP* BLOCK FOR *ROUTE* REQUEST.
 
 PDR1     SA1    O           GET FILE NAME
          MX6    -18         SET NAME IN PARAMETER BLOCK
          BX6    X6*X1
          SA6    PDRA
          SKIPEI O,R         SKIP TO END OF INFORMATION
          SA1    O+6         SET CURRENT RANDOM INDEX IN *DSP* BLOCK
          MX0    30
          BX6    X0*X1
          LX6    -6
          SA6    PDRA+7
 
*         CLEAR PAGINATION AS DEFAULT.
 
          SX6    -1          CLEAR PAGINATION
          SA6    LISF
          EQ     PDRX        RETURN
 
 PDRB     CON    0           *GETEOJS* REPLY WORD
 SDO      SPACE  4,25
**        SDO - SET DUMP OPTIONS.
*
*         ENTRY  (SFOP) = OPTION.
*                (DFTY) = DAYFILE TYPE.
*                (EMSG) = SET WITH DAYFILE CODE.
*                (SEWI) = WORD INDEX OF MESSAGE FIELD FOR THIS DAYFILE.
*                (SEMS) = SEARCH MESSAGE OPTION.
*
*         EXIT   (SEWI) = SEARCH WORD INDEX.
*                (SFOP) = DUMP OPTION.
*                (X5) .EQ. 0, IF FULL DUMP.
*                     .EQ. 1, IF INCREMENTAL DUMP.
*                     .GT. 1, IF PARTIAL DUMP.
*                TO ERR IF DUMP OPTION ERRORS.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 0, 1, 2, 5, 6.
*                B - 7.
*
*         MACROS GETJN.
 
 
 SDO      SUBR               ENTRY/EXIT
          SA1    SFOP        CHECK ENTRERED OPTION
          SA0    =C/ UNKNOWN *OP* FIELD./
          MX0    42
          SA2    ENPT
          SX6    X2-GLTY
          ZR     X6,SDO0.1   IF *GETLOG*
          SX2    X2-MLTY
          NZ     X2,SDO0     IF PROCESSING CODED FILE
          SA5    SDOB-1      SET INDEX FOR BINARY FILE OPTION TABLE
          EQ     SDO1        SEARCH TABLE
 
 SDO0     SA5    SDOA-1      SET INDEX FOR CODED FILE OPTION TABLE
          EQ     SDO1        CONTINUE
 
 SDO0.1   SA5    SDOC-1      SET INDEX FOR *GETLOG* OPTION TABLE
 SDO1     SA5    A5+B1       SEARCH TABLE
          BX6    X5-X1
          ZR     X5,ERR      IF INCORRECT OPTION
          BX6    X0*X6
          NZ     X6,SDO1     IF NO COMPARE
          BX6    -X0*X5      SET PROCESSOR ADDRESS
          SB7    X6+
          SA5    SEMS        SET *FR* OPTION
          JP     B7          JUMP TO PROCESSOR
 
 SDO2     SX6    B0+         PROCESS T OPTION
          SA6    SEWI        SET SEARCH WORD INDEX
          EQ     SDO4
 
 SDO3     SA1    SEWI        PROCESS J OPTION
          SA0    =C* JOB FIELD DISALLOWED ON USER DAYFILE.*
          SX6    X1-1
          ZR     X6,ERR      IF USER DAYFILE
          SA6    A1+
 
 SDO4     SX5    B1+B1       SET PARTIAL DUMP
          EQ     SDOX        PROCESS M OPTION
 
 SDO5     SA0    =C/ *FR* INCORRECT FOR THIS OPTION./  PROCESS I OPTION
          NZ     X5,ERR      IF *FR* SPECIFIED
          SX5    B1          SET INCREMENTAL DUMP
          EQ     SDOX
 
 SDO6     SA1    SEWI        PROCESS P OPTION
          SA0    =C* JOB FIELD DISALLOWED ON USER DAYFILE.*
          SX1    X1-1
          ZR     X1,ERR      IF USER DAYFILE
          GETJN  SEJN        SET JOBNAME
          SA1    SEJN        SET JOBNAME TO CORRECT FORMAT
          LX1    48
          BX6    X1
          SA6    SEJN
 SDO6.1   SX6    1RI         SET INCREMENTAL DUMP
          LX6    -6
          SA6    SFOP
          EQ     SDO5        PROCESS AS INCREMENTAL DUMP
 
 SDO7     ZR     X5,SDOX     IF *FR* NOT SELECTED
          SX6    1RM         SET DEFAULT *OP* OPTION
          LX6    -6
          SA6    SFOP
          EQ     SDO4        SET PARTIAL DUMP OPTION
 
 SDO8     SA0    =C/ *OP* OPTION INCORRECT./
          EQ     ERR         PROCESS ERROR
 
 SDO9     ZR     X5,SDOX     IF *FR* NOT SELECTED
          SA0    =C/ *FR* INCORRECT FOR THIS OPTION./
          EQ     ERR         PROCESS ERROR
 
 
 
*         TABLE OF CODED FILE OPTION PROCESSORS.
 
 
 SDOA     VFD    42/0LT,18/SDO2  T OPTION
          VFD    42/0LJ,18/SDO3  J OPTION
          VFD    42/0LM,18/SDO4  M OPTION
          VFD    42/0LI,18/SDO5  I OPTION
          VFD    42/0LP,18/SDO6  P OPTION
          VFD    42/0LF,18/SDO7  F OPTION
          CON    0
 
*         TABLE OF BINARY FILE OPTION PROCESSORS.
 
 SDOB     VFD    42/0LT,18/SDO2  T OPTION
          VFD    42/0LJ,18/SDO3  J OPTION
          VFD    42/0LM,18/SDO8  M OPTION
          VFD    42/0LI,18/SDO5  I OPTION
          VFD    42/0LP,18/SDO6  P OPTION
          VFD    42/0LF,18/SDO9  F OPTION
          CON    0
 
*         TABLE OF *GETLOG* FILE OPTION PROCESSORS.
 
 SDOC     VFD    42/0LF,18/SDO9    F OPTION
          VFD    42/0LP,18/SDO6.1  P OPTION
          CON    0
 SSM      SPACE  4,20
**        SSM - SET SEARCH MASK.
*
*         ENTRY  (SEMS - SEMS+2) = SEARCH CHARACTERS.
*                (DFTY) = DAYFILE TYPE.
*                (SFOP) = DUMP OPTION (*OP=*).
*
*         EXIT   (SEMA - SEMA+2) = SEARCH MASK.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2.
*
*         CALLS  CDP, SFN.
 
 
 SSM      SUBR               ENTRY/EXIT
          SA1    SEMS
          SA2    SFOP
          SA3    SSMA
          BX2    X2-X3
          ZR     X2,SSM3     IF OP=T OPTION
 SSM1     RJ     SFN         FIND MASK
          SA7    A1+SEMA-SEMS  STORE MASK WORD
          SA1    A1+1        READ NEXT MESSAGE WORD
          NZ     X7,SSM2     IF END OF MESSAGE
          NG     X7,SSM1     IF NOT ZERO WORD
          EQ     SSMX        RETURN
 
 SSM2     BX6    X6-X6       TERMINATE MESSAGE
          SA6    A1
          EQ     SSMX        RETURN
 
 SSM3     SA2    DFTY
          SX2    X2-MLTY
          NZ     X2,SSM1     IF NOT DUMPING MAINTENANCE LOG
          RJ     CDP         CONVERT SEARCH DISPLAY TIME TO PACKED TIME
          SA1    SEMS        BUILD MASK FOR PACKED TIME
          SB2    6
          MX7    3
 SSM4     LX7    3
          BX2    X7*X1
          SB2    B2-1
          ZR     B2,SSMX     IF PACKED TIME FIELD EXHAUSTED
          ZR     X2,SSM4     IF RIGHTMOST DIGIT NOT FOUND
          BX6    X6-X6
 SSM5     BX6    X7+X6
          LX7    3
          SB2    B2-1
          NZ     B2,SSM5     IF PACKED TIME FIELD NOT EXHAUSTED
          SA6    SEMA
          EQ     SSMX        RETURN
 
 SSMA     DATA   1LT         OP=T TEST CHARACTER
 WEF      SPACE  4,10
**        WEF - WRITE EST TO FILE.
*
*         ENTRY  FILENAME INSERTED IN FET.
*
*         EXIT   EST WRITTEN TO FILE.
*
*         CALLS  RSB=.
*
*         MACROS PDATE, SYSTEM, WRITER.
 
 
 WEF      SUBR
          SA1    E
          ZR     X1,WEFX     IF *E=0* SPECIFIED
 
*         READ EST INTO *EBUF*.
 
          SYSTEM RSB,R,WEFA  READ *ESTP*
          SA2    WEFA+1      SET *COMCRSB* ENTRY CONDITIONS
          MX3    -12
          SX1    EBUF+11B    (X1) = ADDRESS TO TRANSFER TO
          AX2    24
          BX3    -X3*X2
          SX7    X3
          AX2    12          (X2) = ADDRESS TO TRANSFER FROM
          SA7    WEFB        SAVE LAST EST ORDINAL + 1
          R=     X6,ESTE
          IX3    X3*X6       (X3) = WORD COUNT
          SX4    B0          (X4) = SUBSYSTEM (= *CMR*)
          MX6    1
          SA6    X1
          RJ     RSB=        READ EST
 
*         SET HEADER INFORMATION.
 
          SA1    WEFB        WORD 0 - EST LENGTH, ENTRY SIZE
          R=     X6,ESTE
          IX5    X1*X6       SAVE EST LENGTH (WORDS)
          MX7    1
          LX1    12
          BX6    X6+X1
          SA6    EBUF
          PDATE  EBUF+2      WORD 2 - PACKED DATE/TIME
          SA7    EBUF+3
          SYSTEM RSB,R,WEFC  READ SYSTEM TITLE/VERSION INTO WORDS 3-10
 
*         WRITE COMPLETED BUFFER TO *EST* FILE.
 
          SX6    X5+11B+EBUF SET EFFECTIVE *IN* VALUE IN FET
          SA6    E+2
          WRITER E,R         WRITE *EST* FILE
          EQ     WEFX        RETURN
 
 WEFA     VFD    12/0,12/1,18/ESTP,18/*+1     *RSB* FOR *ESTP*
          VFD    1/1,59/     ESTP
 WEFB     BSS    1           NUMBER OF EST ENTRIES
 WEFC     VFD    12/0,12/6,18/SYTL,18/EBUF+3  *RSB* FOR TITLE/VERSION
          TITLE  PRESET COMMON DECKS.
**        COMMON DECKS.
 
 
 LIT      CON    1           ALLOW LITERALS ON COMMAND
 QUAL$    EQU    1           DO NOT QUAL COMMON DECKS
*CALL     COMCARM
*CALL     COMCCPA
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCPOP
*CALL     COMCRSB
*CALL     COMCUSB
 
 
          ERRNG  CBUF-*-1    IF *PRESET* OVERLAYS *CM BUFFER*
          END    DAYFILE