KTSDMP
          IDENT  KTSDMP,FETS
          ABS 
          SST    LA 
          ENTRY  KTSDMP 
          ENTRY  RFL= 
          SYSCOM B1 
*COMMENT  KTSDMP - *TAF* TASK MEMORY DUMP.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  KTSDMP - KTS MEMORY DUMP.
          SPACE  4
*****     KTSDMP - KTS MEMORY DUMP. 
*         J. C. BOHNHOFF.    72/09/23.
*         W. E. MARTIN.      78/08/30.
          SPACE  4,20 
***       *KTSDMP* IS AUTOMATICALLY CALLED BY THE TRANSACTION FACILITY
*         TO PROCESS A MEMORY DUMP AFTER A TASK ABORT OR AN EXPLICIT
*         *CMDUMP* REQUEST.  IF THE *P* OPTION IS USED, AN
*         INSTALLATION MAY KEEP A RUNNING STACK OF MEMORY DUMPS TO BE 
*         SELECTIVELY LISTED AT SOME LATER TIME.  TO LIST ALL DUMPS 
*         ON THE PERMANENT DUMP FILE, ATTACH THE FILE AND EXECUTE 
*         *KTSDMP*.  ALL DUMP RECORDS ON THE FILE WILL BE PROCESSED.
*         TO LIST ONLY SELECTED DUMPS, ATTACH THE PERMANENT FILE
*         AND EXTRACT THE DESIRED DUMP RECORDS USING *GTR* -
*         THEN EXECUTE *KTSDMP* TO PROCESS THE EXTRACTED RECORDS. 
*         THE INPUT FILE FORMAT IS DESCRIBED IN THE *KTSDMP*
*         DOCUMENTATION.  ITEMS THAT MAY BE LISTED INCLUDE -
* 
*                CENTRAL MEMORY OF A TASK OR PROGRAM. 
*                EXCHANGE PACKAGE OF A TASK.
*                CONTROL POINT AREA OF A TASK.
*                COMMUNICATION BLOCK OF A TASK. 
*                DATA BUFFERS.
          SPACE  4,20 
***       CONTROL CARD CALL.
* 
*         KTSDMP(IF,OF,P,O) 
* 
*                IF - INPUT FILE NAME.
*                     IF ABSENT - *INPUT*.
* 
*                OF - OUTPUT FILE NAME. 
*                     IF ABSENT - *OUTPUT*. 
* 
*                P - IF PRESENT - *APPEND* FILE *IF* ON DIRECT ACCESS 
*                    PERMANENT FILE *OF*.  THE JOB MUST BE RUNNING WITH 
*                    THE PROPER USER NUMBER, AND FILE *OF* MUST BE
*                    DEFINED.  FURTHER, AN END-OF-FILE IS NOT COPIED TO 
*                    *OF*.
* 
*                O - *OCTAL* FORMAT IF SPECIFIED - OTHERWISE DEFAULT
*                    IS *DISPLAY*.
          SPACE  4,25 
***       DAYFILE MESSAGES ISSUED.
* 
*         * DISPLAY DUMP NOT ALLOWED TO TERMINAL.*
*                A DISPLAY DUMP (DEFAULT) IS NOT ALLOWED TO AN
*                INTER-ACTIVE TERMINAL.  OCTAL DUMPS, OBTAINED WITH 
*                THE *O* CONTROL CARD PARAMETER, ARE ALLOWED. 
* 
*         * FILE NAME CONFLICT.*
*                THE INPUT FILE NAME IS THE SAME AS THE OUTPUT FILE 
*                NAME.
* 
*         * FWA .GE. LWA+1.*
*                DUMP FIRST WORD ADDRESS IS GIVEN AS .GE. THE LAST WORD 
*                ADDRESS + 1. 
* 
*         * KTSDMP COMPLETE.* 
*                DUMP COMPLETED NORMALLY. 
* 
*         * UNKNOWN FILE FORMAT.* 
*                FILE DOES NOT CONFORM TO THE FORMAT RULES ESTABLISHED. 
* 
*         * XXXXXXX NOT FOUND.* 
*                THE FILE SPECIFIED ON THE P-PARAMETER WAS NOT FOUND
*                IN THE USER-S PERMANENT FILE CATALOG.
          SPACE  4,80 
**        DUMP INPUT FILE FORMAT -
* 
*         THE DUMP INPUT FILE IS COMPOSED OF AT LEAST ONE RECORD
*         COMPRISED OF SEVERAL TABLES, EACH CONTAINING DATA PERTAINING
*         TO A TYPE OF DUMP AS DESCRIBED ABOVE.  SEVERAL RECORDS MAY
*         APPEAR IN THE FILE, EACH STARTING A NEW DUMP SEQUENCE.
*         ALL TABLES EXCEPT TABLE-0 MAY APPEAR IN ANY ORDER AND MAY 
*         BE REPEATED INDEFINITELY OR MAY BE SUPPRESSED.
* 
*         RECORD FORMAT - 
* 
*         WORD 1 - RECORD NAME. 
*T WD1    42/  NAME,18/ 0 
* 
*         WHERE - NAME MAY BE USED BY OTHER UTILITIES TO IDENTIFY 
*                 THE RECORD. 
* 
*         TABLE 0 - GENERAL INFORMATION.
*T GIN    12/ 2000B,30/  0,18/  0 
*T,       60/  LABEL
*T,       60/  DUMP DATE
*T,       60/  DUMP TIME
*T,       60/  RESERVED 
* 
*         WHERE -  LABEL IS USED FOR IDENTIFICATION IN TITLE LINES. 
*                  DUMP DATE IS THE DATE UPON WHICH THE INPUT FILE WAS
*                  CREATED. 
*                  DUMP TIME IS THE TIME AT WHICH THE INPUT FILE WAS
*                  CREATED. 
* 
*         TABLE 1 - MEMORY DUMP.
*T MED    12/ 2001B,30/  0,18/  N 
*T,       42/  0,18/  FWA 
*T,       42/  0,18/  LWA 
*T,       60/  RESERVED 
*T,       60/  RESERVED 
*T,       60/  ... FIRST OF N WORDS OF MEMORY TO DUMP ... 
* 
*         WHERE -  FWA IS THE FIRST WORD ADDRESS OF THE DUMP AREA.
*                  FWA IS ROUNDED UP TO A MULTIPLE OF FOUR, AND LWA IS
*                  THE LAST WORD ADDRESS OF THE DUMP AREA.  LWA IS
*                  IS ROUNDED DOWN TO A MULTIPLE OF FOUR. 
* 
*         TABLE 2 - EXCHANGE PACKAGE. 
*T EXP    12/ 2002B,30/  0,18/  N 
*T,       60/  RESERVED 
*T,       60/  RESERVED 
*T,       60/  RESERVED 
*T,       60/  RESERVED 
*T,       60/  ... FIRST OF 20B WORDS OF EXCHANGE PACKAGE ... 
*T,       60/  ... FIRST OF *M* WORDS OF TASK CONTROL POINT AREA ...
* 
*         WHERE -  *N* IS THE TOTAL OF 20B EXCHANGE PACKAGE WORDS 
*                   PLUS *M* TASK CONTROL POINT WORDS.
* 
*         TABLE 3 - COMMUNICATION BLOCK.
*T CMB    12/ 2003B,30/  0,18/  N 
*T,       42/  TASK NAME,18/  0 
*T,       36/  0 ,24/  SEQUENCE NUMBER
*T,       42/  0 ,18/  ADDRESS
*T,       60/  RESERVED 
*T,       60/  ... FIRST OF *N* WORDS OF COMMUNICATION BLOCK ...
* 
*         WHERE -  SEQUENCE NUMBER IS THE TRANSACTION SEQUENCE NUMBER.
*                  ADDRESS IS THE ADDRESS FROM WHICH THE DUMP WAS 
*                  CALLED.
* 
*         TABLE 4 - DATA BUFFERS. 
*T DAB    12/ 2004B,30/  0,18/N 
*T,       6/ DB,36/  FILE NAME,18/  0 
*T,       60/  .. FIRST OF 2 WORDS OF CURRENT KEY VALUE ... 
*T,       60/  ...                                       ...
*T,       30/  CURRENT PRU ADDRESS,30/  CURRENT FILE STATUS 
*T,       60/  .. FIRST OF N WORDS OF DATA BUFFER TO DUMP ... 
* 
*         WHERE -  DB IS THE DATA BASE NAME.
          TITLE  MACRO DEFINITIONS. 
*         COMMON TEXT.
  
  
*CALL     COMSPFM 
*CALL     COMCMAC 
*CALL     COMKMAC 
          TRXCOM
          SPACE  4
*         ASSEMBLY CONSTANTS. 
  
  
 CMBM     OCTMIC COMC        FWA OF COMMUNICATION BLOCK 
 IBUFL    EQU    1001B       INPUT BUFFER SIZE
 OBUFL    EQU    4001B       OUTPUT BUFFER SIZE 
          SPACE  4
*         FET DEFINITIONS.
  
  
          ORG    115B 
  
 FETS     BSS    0
  
 I        BSS    0           INPUT FILE 
 INPUT    FILEB  IBUF,IBUFL 
  
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEC  OBUF,OBUFL,FET=CFLM
          TITLE  GLOBAL STORAGE.
*         GLOBAL STORAGE. 
  
  
 CW       BSSZ   5           TABLE CONTROL WORDS
 FW       CON    0           FWA OF DUMP
 LW       CON    0           LWA OF DUMP
 LA       CON    0           LINE ADDRESS 
 DB       CON    0           DUMP BLOCK INDEX 
 DC       VFD    6/36B,18/,18/2,18/4  DUMP CONTROL
 EP       CON    0           EXCHANGE PACKAGE DUMP INDICATOR
 IND      CON    BUF2 
 DF       CON    0           DISPLAY/OCTAL DUMP FLAG
 TERM     CON    0           TERMINAL OUTPUT FLAG (IF SET)
 ZR       CON    0           ZERO WORD
 MBUF     BSSZ   3           *PFM* ERROR MESSAGE BUFFER 
          TITLE  MAIN PROGRAM.
**        MAIN PROGRAM. 
  
  
 KTSDMP   SB1    1
          RJ     PRS         PRESET PROGRAM 
          NZ     X5,KTS5     IF *APPEND* TO PERMAMENT FILE OPERATION
  
*         PROCESS DUMP LIST.
  
 KTS1     SX7    0           CLEAR EXCHANGE PACKAGE DUMPED INDICATOR
          SA7    EP 
          RJ     COF         CHECK OUTPUT FILE
          READ   I           START READ OF DUMP RECORD
          READW  I,CW,B1     SKIP RECORD NAME 
          NZ     X1,KTS2     IF EOR/EOF/EOI 
  
*         RETURN FROM DUMP PROCESSORS.
  
 KTSX     READW  I,CW,5      READ TABLE CONTROL WORDS 
          NZ     X1,KTS2     IF EOR/EOF/EOI 
          SA1    CW          PROCESS TABLE
          UX6,B7 X1 
          NG     B7,ERR1     IF UNKNOWN TABLE 
          SB7    B7-TCTPL 
          PL     B7,ERR1     IF UNKNOWN TABLE 
          JP     TCTP+TCTPL+B7  EXECUTE DUMP PROCESSOR
  
 KTS2     NG     X1,KTS3     IF EOF/EOI 
          WRITER O,R         END OUTPUT RECORD
          RJ     CFA         CLEAR FILE ARGUMENTS 
          EQ     KTS1        LOOP TO END OF FILE
  
 KTS3     WRITER O,R         END OUTPUT RECORD
 KTS4     MESSAGE (=C* KTSDMP COMPLETE.*) 
          ENDRUN
  
*         APPEND *IF* TO PERMENANT FILE *OF*. 
  
 KTS5     SA1    O+B1        SET *EP* BIT 
          SX2    B1 
          LX2    44 
          BX6    X1+X2
          SX7    MBUF        SET ERROR MESSAGE RETURN ADDRESS 
          SA6    A1 
          SA7    O+CFPW 
 KTS6     ATTACH O,,,,M 
          SA1    X2          CHECK ERROR FLAG 
          MX0    -8 
          LX1    -10
          BX2    -X0*X1 
          ZR     X2,KTS7     IF NO ERROR ON ATTACH
          SX2    X2-1 
          NZ     X2,ERR4     IF NOT *FILE BUSY* 
          BX6    X0*X1       CLEAR STATUS FIELD 
          LX6    10 
          SA6    A1+
          ROLLOUT  ZR        WAIT FOR FILE NOT BUSY 
          EQ     KTS6        RETRY OPERATION
  
 KTS7     SA1    A1+B1       CLEAR *EP* BIT 
          MX2    -1 
          SX7    B0          CLEAR ERROR ADDRESS
          LX2    44 
          BX6    X1*X2
          SA7    O+CFPW 
          SA6    A1 
          SKIPEI O           POSITION TO WRITE AT EOI 
 KTS8     READ   I           COPY RECORD
          RECALL O
 KTS9     READW  I,BUF,100B 
          NZ     X1,KTS10    IF EOR/EOF/EOI 
          WRITEW O,BUF,100B 
          EQ     KTS9        LOOP TO EOR
  
 KTS10    NG     X1,KTS4     IF EOF/EOI 
          WRITEW O,BUF,X1-BUF  TERMINATE RECORD 
          WRITER O
          EQ     KTS8        LOOP TO EOF
          SPACE  4
*         TABLE OF FUNCTION PROCESSORS. 
  
 TCTP     BSS    0
          LOC    0
          EQ     GIN         GENERAL INFORMATION
          EQ     MED         MEMORY DUMP
          EQ     XPD         EXCHANGE PACKAGE DUMP
          EQ     CBD         COMMUNICATION BLOCK DUMP 
          EQ     DBD         DATA BUFFER DUMP 
 TCTPL    BSS    0           LENGTH OF TABLE
          LOC    *O 
 GIN      TITLE  PROCESS TABLE 0 - GENERAL INFORMATION. 
 GIN      SPACE  4,10 
**        GIN - PROCESS GENERAL INFORMATION TABLE.
* 
*         ENTRY  (CW - CW+3) = TABLE CONTROL WORDS. 
* 
*         EXIT   TO *KTSX*. 
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                X - 0, 1, 2, 3, 6, 7.
* 
*         CALLS  SKW. 
  
  
 GIN      BSS    0           ENTRY
          SA1    CW+1        READ LABEL 
          SA2    A1+B1       READ DUMP DATE 
          SA3    A2+B1       READ DUMP TIME 
          BX6    X1 
          LX7    X2 
          SA6    LB          STORE LABEL
          SA7    DD          STORE DUMP DATE
          SA1    A1-B1       READ TABLE LENGTH
          BX6    X3 
          SX0    X1+
          SA6    DT          STORE DUMP TIME
          RJ     SKW         SKIP EXCESS WORDS IN TABLE 
          EQ     KTSX        RETURN 
 MED      TITLE  PROCESS TABLE 1 - MEMORY DUMP. 
 MED      SPACE  4,15 
**        MED - PROCESS MEMORY DUMP TABLE.
* 
*         ENTRY  (CW  - CW+3) = TABLE CONTROL WORDS.
* 
*         EXIT   TO *KTSX*. 
*                TO *ERR1* - IF UNKNOWN FILE FORMAT.
*                TO *ERR2* - IF FWA .GE. LWA+1. 
* 
*         USES   A - 0, 1, 2, 3, 6, 7.
*                X - ALL. 
*                B - 2. 
* 
*         CALLS   COD, DCM, SKW, WTL. 
  
  
 MED      BSS    0           ENTRY
          SA1    CW          READ TABLE LENGTH
          SA2    A1+B1       READ FWA 
          SA3    A2+B1       READ LWA 
          SX1    X1          N
          SX2    X2          FWA
          SX3    X3          LWA
          IX4    X2+X1       FWA+N
          NG     X2,ERR1     IF FWA .LT. 0
          NZ     X3,MED1     IF LWA .NE. 0
          SX3    X4-1        LWA = FWA+N-1
 MED1     SX3    X3+B1       LIMIT = LWA+1
          IX5    X3-X4
          NG     X5,MED2     IF TOO MANY WORDS ON FILE - LIMIT = LWA+1
          SX3    X4+         LIMIT = FWA+N
 MED2     IX7    X2-X3       FWA - LIMIT
          PL     X7,ERR2     IF FWA .GE. LIMIT
          SB2    B1+B1       ROUND UP FWA 
          SX0    X2+3 
          AX6    X3,B2       ROUND DOWN LWA 
          AX0    X0,B2
          LX6    X6,B2
          LX7    X0,B2
          SA6    LW          STORE LIMIT
          IX0    X7-X2       FIND NUMBER OF WORDS FWA ROUNDED UP
          IX6    X6-X4
          SA7    FW          STORE FWA
          IX6    X6+X0       DECREMENT EXCESS WORD COUNT
          SA6    MEDA 
          RJ     SKW         SKIP WORDS TO FWA
          SA1    FW          SET SECOND TITLE LINE
          RJ     COD         CONVERT FWA
          SA1    MEDC 
          LX6    3*6
          BX7    X1-X6
          SA1    LW          CONVERT LIMIT
          SA7    MEDB+2 
          RJ     COD         CONVERT CONSTANT TO DISPLAY
          LX6    3*6
          SA0    MEDB        SET TITLE ADDRESS
          SA6    MEDB+3 
          RJ     WTL         WRITE TITLE LINES
          RJ     DCM         DUMP CENTRAL MEMORY
          SA1    MEDA        SKIP EXCESS WORDS
          PL     X1,KTSX     IF NO EXCESS WORDS - RETURN
          BX0    -X1
          SX0    X0-1 
          ZR     X0,KTSX     IF NO EXCESS WORDS - RETURN
          RJ     SKW         SKIP EXCESS WORDS
          EQ     KTSX        RETURN 
  
 MEDA     CON    0           STORAGE FOR EXCESS WORD COUNT
 MEDB     DATA   1H0         SET DOUBLE SPACE 
          DATA   10HDUMP FROM 
          CON    0           STORAGE FOR FWA OF DUMP
          CON    0           STORAGE FOR LWA OF DUMP
          CON    0           LINE TERMINATOR
 MEDC     CON    2ATO&2A
 XPD      TITLE  PROCESS TABLE 2 - EXCHANGE PACKAGE DUMP. 
 XPD      SPACE  4,15 
**        XPD - PROCESS EXCHANGE PACKAGE DUMP.
* 
*         ENTRY  (CW - CW+3) = TABLE CONTROL WORDS. 
* 
*         EXIT   TO *KTSX*. 
*                TO *ERR1* - UNKNOWN FILE FORMAT. 
* 
*         USES   A - 0, 1, 6, 7.
*                X - 0, 1, 6, 7.
*                B - 7. 
* 
*         CALLS  DCM, DXP, SKW, WTL.
* 
*         MACROS READW, WRITEC. 
  
  
 XPD      BSS    0           ENTRY
          SA1    CW          READ TABLE LENGTH
          SB7    X1-20B 
          NG     B7,ERR1     IF .LT. 20B WORDS
          READW  I,BUF,20B   READ EXCHANGE PACKAGE
          SA0    XPDA        SET TITLE ADDRESS
          RJ     WTL         WRITE TITLE LINES
          RJ     DXP         DUMP EXCHANGE PACKAGE
          SX7    B1+         SET EXCHANGE PACKAGE DUMPED INDICATOR
          SA1    CW          CHECK TASK CONTROL POINT AREA PRESENT
          SX0    X1-20B 
          SA7    EP 
          ZR     X0,KTSX     IF NO CONTROL POINT - RETURN 
          WRITEC O,XPDB      LIST CONTROL POINT AREA HEADER 
          WRITEC O,XPDC 
          SX7    X0+20B      SET DUMP FROM 20 TO 20+M (MOD 4) 
          IX6    X7-X0
          AX7    2           ROUND LWA DOWN 
          SA6    FW 
          LX7    2
          IX6    X0-X7
          SA7    LW 
          SX6    X6+20B 
          SA6    XPDD        SAVE EXCESS WORD COUNT 
          RJ     DCM         DUMP IN CM FORMAT
          SA1    XPDD        READ EXCESS WORD COUNT 
          SX0    X1+
          RJ     SKW         SKIP EXCESS WORDS
          EQ     KTSX        RETURN 
  
 XPDA     DATA   1H0         DOUBLE SPACE CARRIAGE CONTROL
          DATA   C*EXCHANGE PACKAGE.* 
 XPDB     DATA   1H-         TRIPLE SPACE CARRIAGE CONTROL
          DATA   C*TASK CONTROL POINT AREA.*
 XPDC     DATA   1L          BLANK LINE 
 XPDD     CON    0
 CBD      TITLE  PROCESS TABLE 3 - COMMUNICATION BLOCK DUMP.
 CBD      SPACE  4,15 
**        CBD - PROCESS COMMUNICATION BLOCK DUMP. 
* 
*         ENTRY  (CW - CW+3) = TABLE CONTROL WORDS. 
* 
*         EXIT   TO *KTSX*. 
* 
*         USES   A - 0, 1, 6, 7.
*                X - 0, 1, 6, 7.
*                B - 2. 
* 
*         CALLS  CDD, COD, DCM, SFN, SKW, WTL.
* 
*         MACROS WRITEC.
  
  
 CBD      BSS    0           ENTRY
          SX6    COMC        SET FWA OF TASK LOAD 
          SA1    CW          CALCULATE LWA+1
          SA6    FW          STORE FWA
          SX1    X1          NUMBER OF WORDS
          SB2    B1+B1       ROUND DOWN NUMBER OF WORDS 
          AX0    X1,B2
          LX0    X0,B2
          IX7    X1-X0       NUMBER OF EXCESS WORDS IN TABLE
          IX6    X6+X0       SET LWA+1
          SX1    COMC+COMCL-1  SET LWA OF COMMUNICATION BLOCK 
          SA7    CBDC 
          SA6    LW          STORE LIMIT
          RJ     COD         CONVERT LWA
          BX6    X4 
          SA1    CW+B1       SET TITLE LINE 
          MX0    42 
          SA6    CBDB 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    CBDB+2 
          SA1    CW+2        CONVERT *TRF* NUMBER 
          MX0    -24
          BX1    -X0*X1 
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          LX6    6
          MX0    54 
          SX1    1RB
          BX6    X0*X6
          BX6    X6+X1
          SA6    CBDB+4 
          SA1    CW+3        CONVERT CALL ADDRESS 
          SX1    X1+
          RJ     COD         CONVERT TO DECIMAL 
          BX6    X4 
          SA0    CBDA        SET TITLE ADDRESS
          SA6    CBDB+6 
          SA1    EP 
          NZ     X1,CBD1     IF EXCHANGE PACKAGE DUMPED FOR THIS RECORD 
          RJ     WTL         WRITE TITLE LINES
          EQ     CBD2        WRITE BLANK LINE 
  
 CBD1     WRITEC O,CBDA      WRITE COMMUNICATION BLOCK HEADER 
 CBD2     WRITEC O,CBDD 
          RJ     DCM         DUMP CENTRAL MEMORY
          SA1    CBDC        READ EXCESS WORD COUNT 
          BX0    X1 
          RJ     SKW         SKIP EXCESS WORDS
          EQ     KTSX        RETURN 
  
 CBDA     DATA   1H-         SET TRIPLE SPACE 
          DATA   H*COMMUNICATION BLOCK DUMP FROM    "CMBM" TO * 
 CBDB     CON    0           LWA
          DATA   10H  PROGRAM 
          CON    0           TASK/PROGRAM NAME
          DATA   10H SEQUENCE 
          CON    0           SEQUENCE NUMBER
          DATA   10H  ADDRESS 
          CON    0           CALL ADDRESS 
          CON    0           LINE TERMINATOR
 CBDC     CON    0
 CBDD     DATA   1L          BLANK LINE 
 DBD      TITLE  PROCESS TABLE 4 - DATA BUFFER DUMP.
 DBD      SPACE  4,15 
**        DBD - PROCESS DATA BUFFER DUMP. 
* 
*         ENTRY  (CW - CW+4) = TABLE CONTROL WORDS. 
* 
*         EXIT   TO *KTSX*. 
*                TO *ERR1* - IF UNKNOWN FILE FORMAT.
* 
*         USES   A - 0, 1, 2, 6, 7. 
*                X - 0, 1, 2, 6, 7. 
* 
*         CALLS  DCM, OCB, SFN, SKW, WOD, WTL.
* 
*         MACROS WRITEW.
  
  
 DBD      BSS    0           ENTRY
          SX6    0           SET FWA OF DUMP
          SA1    CW          FIND LWA+1 
          SA6    FW 
          SX7    X1+         LWA+1
          SX1    X1 
          AX7    2           ROUND DOWN LWA+1 
          ZR     X1,KTSX     IF TABLE EMPTY - RETURN
          LX7    2
          IX6    X1-X7       EXCESS WORDS 
          NG     X1,ERR1     IF N .LT. ZERO 
          SA7    LW          STORE LWA
          SA6    DBDF        SAVE EXCESS
          SA1    CW+1        SET DATA BASE, FILE NAME IN TITLE
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA6    DBDA+3 
          SA0    DBDA        SET FWA OF LINE TO BE WRITTEN
          RJ     WTL         WRITE TITLE LINES
          SA1    DBDB        SET KEY VALUE
          SA2    DBDC 
          BX6    X1 
          LX7    X2 
          SA6    BUFO 
          SA7    BUFO+1 
          SA6    BUFO+3 
          SX7    0
          SA1    CW+2        CONVERT KEY VALUE
          SA7    BUFO+2 
          RJ     OCB         OCTAL CONVERSION TO BUFO+4, +5 
          SA1    CW+2        SET DISPLAY INTERPRETATION 
          RJ     SFN         SPACE FILL NAME
          SA2    TERM        GET TERMINAL OUTPUT FLAG 
          SX7    B0+         TERMINATE LINE 
          NZ     X2,DBD1     IF OUTPUT TO TERMINAL
          SA6    A6+1 
 DBD1     SA7    A6+1 
          SA2    DBDB        STORE SECOND KEY VALUE WORD
          SA1    CW+3 
          BX6    X2 
          SA6    A7+B1
          RJ     OCB         CONVERT WORD 2 
          SA1    CW+3 
          RJ     SFN         SPACE FILL NAME
          SA2    TERM        GET TERMINAL OUTPUT FLAG 
          SX7    B0+
          NZ     X2,DBD2     IF OUTPUT TO TERMINAL
          SA6    A6+1 
 DBD2     SA7    A6+1 
          WRITEW O,BUFO,A7-BUFO+1  LIST KEY VALUE 
          SA1    CW+4        CONVERT PRU NUMBER 
          RJ     WOD         CONVERT WORD TO OCTAL DISPLAY
          SA1    CW+4        CONVERT STATUS 
          SA6    DBDD+3 
          RJ     WOD         CONVERT WORD TO OCTAL DISPLAY
          SA7    DBDE+2 
          WRITEW O,DBDD,DBDDL  LIST PRU, STATUS 
          RJ     DCM         DUMP CENTRAL MEMORY BUFFER 
          SA1    DBDF        READ EXCESS WORD COUNT 
          BX0    X1 
          RJ     SKW         SKIP EXCESS WORDS
          EQ     KTSX        RETURN 
  
 DBDA     DATA   1H0         DOUBLE SPACE PAGE HEADER 
          DATA   H*DATA BUFFER DUMP OF *
          CON    0           DB,FN
          CON    0           LINE TERMINATOR
 DBDB     DATA   10H
 DBDC     DATA   10HKEY VALUE 
 DBDD     DATA   2L 
          DATA   10H
          DATA   10HPRU 
          CON    0           PRU NUMBER 
          CON    0
 DBDE     DATA   10H
          DATA   10HSTATUS
          CON    0           STATUS 
          CON    0
          DATA   2L 
 DBDDL    EQU    *-DBDD 
 DBDF     CON    0
 CFA      TITLE  SUBROUTINES. 
 CFA      SPACE  4,10 
**        CFA - CLEAR FILE ARGUMENTS. 
* 
*         EXIT   (LB), (DD), AND (DT) RESET TO (CFAA).
* 
*         USES   A - 1, 6, 7. 
*                X - 1, 6, 7. 
  
  
 CFA      SUBR               ENTRY/EXIT 
          SA1    CFAA        RESET LABEL, DUMP DATE, DUMP TIME
          BX6    X1 
          LX7    X1 
          SA6    LB 
          SA7    DD 
          SA6    DT 
          EQ     CFAX        RETURN 
  
 CFAA     CON    1H          BLANKS 
 COF      SPACE  4,10 
**        COF - CHECK OUTPUT FILE NAME AND ASSIGNMENT.
* 
*         EXIT   (X2) = FWA OF ERROR MESSAGE - IF ERROR.
*                TO *ERR3* - IF OUTPUT FILE IS TERMINAL FILE AND *DMD*
*                TYPE DUMP REQUESTED. 
* 
*         USES   A - 1, 2, 4, 6, 7. 
*                X - 1, 2, 4, 6, 7. 
* 
*         CALLS  STF. 
  
  
 COF      SUBR               ENTRY/EXIT 
          SX2    O
          RJ     STF         CHECK FILE ASSIGNMENT
          NZ     X6,COFX     IF OUTPUT NOT ASSIGNED TO TERMINAL 
          SA1    DF 
          ZR     X1,ERR3     IF DISPLAY DUMP REQUESTED
          SA4    COFB        TERMINAL DUMP CONTROL WORD 
          BX6    X4 
          SA2    COFA        CLEAR AUTO EJECT 
          LX7    X2 
          SA6    DC          NEW DUMP CONTROL WORD
          SA7    WTLB 
          SX6    B1+         SET TERMINAL OUTPUT FLAG 
          SX7    BUF1+2 
          SA6    TERM 
          SA7    IND
          SA1    COFC        CLEAR OTHER CARRIAGE CONTROL CHARACTERS
          BX6    X1 
          LX7    X1 
          SA6    MEDB 
          SA7    XPDA 
          SA6    XPDB 
          SA7    CBDA 
          SA6    DBDA 
          SA7    WTLA 
          EQ     COFX        RETURN 
  
 COFA     CON    1L 
 COFB     VFD    6/30B,18/0,18/1,18/2 TERMINAL DUMP CONTROL WORD
 COFC     DATA   10H            BLANK FILLER
 DCK      SPACE  4,15 
**        DCK - STRING OUT DATA.
* 
*         ENTRY  (X6) = FIRST CONVERTED WORD OF DUMP. 
*                (X7) = SECOND CONVERTED WORD OF DUMP.
*                (B3) = INDEX OF SPACE. 
*                (A7) = LOCATION IN DESTINATION LINE. 
* 
*         EXIT   WORDS PACKED AND INTERPRETED INTO BUFFER.
* 
*         USES   A - 3, 4, 6, 7.
*                X - 2, 3, 4, 6, 7. 
*                B - 2, 3, 4, 5.
  
  
 DCK      SUBR               ENTRY/EXIT 
          SB4    B3 
          SB5    1
          BX3    X6          SAVE (X6)
 DCK1     SA4    B4+SBUF+19 
          SB4    B4-B1
          BX6    X4 
          SA6    B4+SBUF
          PL     B4,DCK1     IF TRANSFER RESIDUE
          NG     B7,DCK2     IF NO SPACE PRESENT
          SX6    1R 
          SA6    B3+SBUF
          SB3    B3+1 
 DCK2     SB2    10 
          MX2    6
 DCK3     BX6    X2*X3
          LX6    6
          SA6    B3+SBUF
          SB2    B2-B1       SHIFT COUNT
          LX3    6
          SB3    B3+1 
          NZ     B2,DCK3     IF COMPLETE STRING 
          BX3    X7 
          SB5    B5-B1
          ZR     B5,DCK2     IF ZERO - PROCESS SECOND WORD
          SB5    B1 
          SB3    B0 
 DCK4     SB2    10 
          SX7    0
 DCK5     SA3    B3+SBUF
          NZ     X3,DCK6     IF NOT A 0-CHARACTER 
          SX3    1R 
 DCK6     LX7    6
          BX7    X7+X3
          SB3    B3+B1
          SB2    B2-B1
          NZ     B2,DCK5     IF COMPLETE STRING 
          SA7    A7+B1
          SB5    B5-B1
          ZR     B5,DCK4     IF ZERO - DO SECOND WORD 
          EQ     DCKX        RETURN 
 DCM      SPACE  4,15 
**        DCM - DUMP CENTRAL MEMORY.
* 
*         ENTRY  (FW) = FWA OF DUMP.
*                (LW) = LIMIT ADDRESS OF DUMP.
* 
*         EXIT   TO *ERR1* - IF PREMATURE EOR/EOF/EOI.
* 
*         USES   A - 0, 1, 2, 3, 5, 6, 7. 
*                X - ALL. 
*                B - 2, 6, 7. 
* 
*         CALLS  COD, OCT, RDW=.
* 
*         MACROS READW, WRITEW. 
  
  
 DCM4     SA1    LA          READ ADDRESS 
          RJ     COD         CONVERT OCTAL TO DISPLAY 
          SA1    DB          SET BLOCK INDEX
          LX6    2*6
          SA0    BUF1+X1
          SA6    BUF
          SB7    X5 
          RJ     OCT         LIST MEMORY IN OCTAL 
  
 DCM      SUBR               ENTRY/EXIT 
          SA1    FW          SET LINE ADDRESS 
          SA5    DC          SET DUMP CONTROL 
          SX6    X1 
          BX7    X7-X7       CLEAR BUFFER INDEX 
          SA6    LA 
          SA7    DB 
          READW  I,BUF1,X5   READ FIRST BLOCK 
 DCM1     SA1    LA          CONVERT LINE ADDRESS 
          RJ     COD         CONVERT OCTAL TO DISPLAY 
          SA1    DB          SET BLOCK INDEX
          LX6    2*6
          SA0    BUF1+X1     FWA OF MEMORY TO CONVERT 
          SA6    BUF         DESTINATION ADDRESS - 1
          SB7    X5          WORD COUNT 
          RJ     OCT         LIST MEMORY IN OCTAL 
          SA5    DC          SET DUMP CONTROL 
          SA1    DB          TOGGLE DUMP BLOCK
          SX2    X5 
          BX6    X1-X2
          SA6    A1 
          BX0    X1-X2
*         READW  I,BUF1+X0,X5  READ NEXT BLOCK
 DCM2     SB6    BUF1+X0
          SB7    X5+
          SX2    I
          RJ     RDW=        READ SPECIFIED NUMBER OF WORDS 
          SA3    LA          ADVANCE LINE ADDRESS 
          NZ     X1,ERR1     IF EOR/EOF/EOI 
          SA1    BUF1        LOAD FIRST WORD PAIR 
          SA2    IND
          SA2    X2 
          LX4    X5,B1       SET WORD COUNT 
          SB2    X5 
          BX7    X7-X7       CLEAR DIFFERENCE 
          SX6    X3+B2
 DCM3     BX3    X1-X2       COMPARE WORDS
          LX4    1           COUNT WORD 
          SA1    A1+B1
          BX7    X7+X3       ACCUMULATE DIFFERENCES 
          SA2    A2+B1
          NG     X4,DCM3     IF .LT. ZERO - LOOP FOR ALL WRODS
          SA1    A3-B1       CHECK LIMIT REACHED
          IX2    X6-X1
          SA6    A3+         STORE ADDRESS
          SB6    X2+B2
          PL     B6,DCM4     IF LIMIT REACHED 
          NZ     X7,DCM1     IF DIFFERENT WORD DETECTED 
          NG     X7,DCM1     IF DIFFERENT WORD DETECTED 
          NG     X5,DCM2     IF DUPLICATE LINE SET
          WRITEW O,DCMA,DCMAL 
          MX1    1           SET DUPLICATE LINE 
          BX5    X1+X5
          EQ     DCM2        CONTINUE DUMPING MEMORY
  
 DCMA     DATA   1H          BLANKS 
          DATA   C*DUPLICATED LINES.* 
 DCMAL    EQU    *-DCMA 
 DXP      SPACE  4,15 
**        DXP - DUMP EXCHANGE PACKAGE.
* 
*         ENTRY  (BUF - BUF+17B) = EXCHANGE PACKAGE.
* 
*         EXIT   CONVERTED EXCHANGE PACKAGE WRITTEN TO OUTPUT BUFFER. 
* 
*         USES   A - 0, 1, 2, 5, 6. 
*                X - 0, 1, 2, 3, 5, 6.
*                B - 2. 
* 
*         CALLS  COD, OCB.
* 
*         MACROS WRITEW.
  
  
 DXP      SUBR               ENTRY/EXIT 
          SA0    0           INITIALIZE REGISTER INDEX
          SA5    BUF
 DXP1     SA1    DXPA+A0     SET REGISTER NAME
          SA2    DXPB 
          MX0    4*6
          SB2    X1          SET SHIFT
          BX3    X0*X1
          LX3    4*6
          IX6    X2+X3
          MX0    -18
          SA6    BUFO 
          NG     X1,DXP2     IF BLANK FIELD 
          LX2    X5,B2       EXTRACT REGISTER 
          BX1    -X0*X2 
          RJ     COD         CONVERT OCTAL TO DISPLAY 
 DXP2     LX6    4*6         CONVERT A-REGISTER 
          SX3    2RA0-2R  +A0 
          IX6    X6+X3
          SA6    A6+B1
          LX5    -18
          SX0    1RB-1R 
          MX2    -18
          BX1    -X2*X5 
          RJ     COD         CONVERT OCTAL TO DISPLAY 
          LX6    3*6
          IX6    X6+X0
          SA6    A6+B1
          LX5    18          CONVERT B-REGISTER 
          SX0    1R0-1R +A0 
          MX2    -18
          BX1    -X2*X5 
          LX0    54 
          RJ     COD         CONVERT OCTAL TO DISPLAY 
          LX6    2*6
          IX6    X6+X0
          SA6    A6+1 
          BX6    X6-X6       CLEAR LAST WORD
          SA6    A6+B1
          WRITEW O,BUFO,A6-BUFO+1 
          SA0    A0+1        ADVANCE REGISTER 
          SB2    A0-10B 
          SA5    BUF+A0      READ REGISTER
          NZ     B2,DXP1     IF MORE A-REGISTERS TO PROCESS 
          WRITEW O,(=C*  *),B1  SPACE 
 DXP3     SA2    DXPC        CONVERT X-REGISTERS
          SX3    A0-10B 
          LX3    2*6
          IX6    X2+X3
          SA1    BUF+A0 
          SA6    BUFO 
          RJ     OCB         CONVERT OCTAL BY BYTES 
          BX6    X6-X6
          SA6    A6+B1
          WRITEW O,BUFO,A6-BUFO+1 
          SA0    A0+1        ADVANCE REGISTER 
          SB2    A0-20B 
          NZ     B2,DXP3     IF NOT ZERO - PROCESS END OF REGISTERS 
          EQ     DXPX        RETURN 
  
 DXPA     VFD    24/0HP,36/24 
          VFD    24/0HRA,36/24
          VFD    24/0HFL,36/24
          VFD    24/0HEM,36/12
          VFD    24/0HRAE,36/18 
          VFD    24/0HFLE,36/18 
          VFD    24/0HMA,36/24
          VFD    60/1H
 DXPB     DATA   6L 
 DXPC     DATA   4AX0 
 DXPAL    EQU    *-DXPA      LENGTH OF EXCHANGE PACKAGE 
 ERR      SPACE  4,10 
**        ERR - PROCESS ERROR.
* 
*         MACROS ABORT, MESSAGE.
  
  
 ERR      MESSAGE X2,0,R     ISSUE DAYFILE MESSAGE
          ABORT 
  
 ERR1     SX2    ERRA        * UNKNOWN FILE FORMAT.*
          EQ     ERR         PROCESS ERROR
  
 ERR2     SX2    ERRB        * FWA .GE. LWA+1.* 
          EQ     ERR         PROCESS ERROR
  
 ERR3     SX2    ERRC        * DISPLAY DUMP NOT ALLOWED TO TERMINAL.* 
          EQ     ERR         PROCESS ERROR
  
 ERR4     SX2    MBUF        * XXXXXXX NOT FOUND.*
          EQ     ERR         PROCESS ERROR
  
 ERRA     DATA   C* UNKNOWN FILE FORMAT.* 
 ERRB     DATA   C* FWA .GE. LWA+1.*
 ERRC     DATA   C* DISPLAY DUMP NOT ALLOWED TO TERMINAL.*
 OCB      SPACE  4,15 
**        OCB - CONVERT OCTAL BY BYTES. 
* 
*         ENTRY  (X1) = WORD TO CONVERT.
*                (A6) = BUFFER ADDRESS. 
* 
*         EXIT   (A6) = BUFFER ADDRESS ADVANCED.
* 
*         USES   A - 1, 6, 7. 
*                X - ALL. 
* 
*         CALLS  WOD. 
  
  
 OCB      SUBR               ENTRY/EXIT 
          RJ     WOD         CONVERT WORD (ABCDEFGHIJ KLMNOPQRST) 
          SA1    OCBA 
          MX2    -2*6 
          BX5    -X2*X6      ........IJ 
          MX0    4*6
          BX3    X0*X6       ABCD...... 
          LX0    -4*6 
          IX4    X1+X3       ABCD*....* 
          BX2    X0*X6
          LX2    -6          .....EFGH. 
          BX6    X4+X2       ABCD*EFGH* 
          LX7    -4*6        QRSTKLMNOP 
          SA6    A6+B1
          MX0    4*6
          BX6    X0*X7       QRST...... 
          LX5    8*6         IJ........ 
          BX7    -X0*X7      ....KLMNOP 
          LX7    2*6         ..KLMONP.. 
          IX2    X5+X7       IJKLMNOP.. 
          BX3    X0*X2       IJKL...... 
          LX0    -4*6 
          IX4    X1+X3       IJKL*....* 
          BX5    X0*X2       ....MNOP.. 
          SA1    A1+B1       ....****** 
          LX5    -6          .....MNOP. 
          IX7    X4+X5       IJKL*MNOP* 
          BX6    X1+X6       QRST****** 
          SA7    A6+B1
          SA6    A7+B1
          EQ     OCBX        RETURN 
  
 OCBA     VFD    24/0,6/1R ,24/0,6/1R 
          VFD    24/0,36/6H 
 OCT      SPACE  4,15 
**        OCT - LIST OCTAL OR OCTAL WITH DISPLAY. 
* 
*         ENTRY  (B7) = WORD COUNT. 
*                (A0) = WORD ADDRESS. 
*                (A6) = DESTINATION ADDRESS - 1.
* 
*         EXIT   NONE.
* 
*         USES   A - 1, 2, 6, 7.
*                X - ALL. 
*                B - 6, 7.
* 
*         CALLS  WOD, SFN.
* 
*         MACROS WRITEW.
  
  
 OCT      SUBR               ENTRY/EXIT 
          SA1    A0          READ FIRST WORD
          SB6    B7 
          SA2    DF          READ CONVERSION TYPE FLAG
          ZR     X2,OCT2     IF DISPLAY DUMP REQUESTED
 OCT1     RJ     WOD         CONVERT WORD TO DISPLAY
          MX5    5*6
          BX3    X5*X6       ABCDE..... 
          SA2    OCTA 
          LX3    -4*6        ....ABCDE. 
          BX1    -X5*X6      .....FGHIJ 
          IX6    X2+X3       ****ABCDE* 
          SA2    A2+B1
          LX1    5*6         FGHIJ..... 
          BX4    -X5*X7      .....PQRST 
          MX3    -4*6 
          IX2    X2+X1       FGHIJ*.... 
          SA6    A6+B1
          LX7    -6*6        OPQRSTKLMN 
          BX0    -X3*X7      ......KLMN 
          SA3    A2+B1
          IX6    X2+X0       FGHIJ*KLMN 
          MX5    1*6
          SA6    A6+B1
          IX4    X3+X4       ***.*PQRST 
          SB7    B7-B1
          BX3    X5*X7       O......... 
          SA1    A1+B1       NEXT DUMP BLOCK WORD 
          LX4    3*6         .*PQRST*** 
          IX6    X3+X4       O*PQRST*** 
          SA6    A6+B1
          NZ     B7,OCT1     IF NOT ZERO - CONTINUE CONVERTING
          MX6    0
          SA6    A6+B1
          WRITEW O,BUF,A6-BUF+1 
          EQ     OCTX        RETURN 
  
*         LIST MEMORY WITH DISPLAY CODE INTERPRETATION. 
  
 OCT2     RJ     WOD         CONVERT WORD TO OCTAL
          SA6    A6+1 
          SA7    A6+1 
 OCT3     SA1    A1+1        NEXT DUMP BLOCK
          RJ     WOD         CONVERT WORD TO OCTAL
          SB7    B7-1 
          ZR     B7,OCT4     IF END OF NUMBER FORMATTING
          SB2    3
          SB3    B2-B7
          RJ     DCK         STRING OUT DATA
          EQ     OCT3        PROCESS NEXT WORD
  
 OCT4     SB6    B1 
          SA1    A0-B1
          SB3    3
 OCT5     SA1    A1+B1
          BX6    X1 
          SA1    A1+B1
          BX7    X1 
          RJ     DCK         STRING OUT DATA
          SB6    B6-B1
          SB7    B7-B1
          SB3    4
          PL     B6,OCT5     IF POSITIVE - CONTINUE COMMENTS
          MX6    0
          SX7    B0 
          RJ     DCK         FLUSH BUFFER AND ADD TERMINATING BYTE
          MX2    24 
          SA1    BUF+13 
          BX6    X2*X1       SET TERMINATION BYTE 
          SA6    A1 
          WRITEW O,BUF,A7-BUF 
          EQ     OCTX        RETURN 
  
 OCTA     BSS    0
          VFD    24/1H ,30/0,6/1H 
          VFD    30/0,6/1H ,24/0
          VFD    18/1H ,6/0,6/1H ,30/0
 OCTB     CON    1H 
 SKW      SPACE  4,10 
**        SKW - SKIP WORDS. 
* 
*         ENTRY  (X0) = WORD COUNT. 
* 
*         USES   X - 0. 
* 
*         MACROS READW. 
  
  
 SKW      SUBR               ENTRY/EXIT 
 SKW1     ZR     X0,SKWX     IF NO WORDS TO SKIP - RETURN 
          SX0    X0-100B
          PL     X0,SKW2     IF .GE. 100B WORDS TO SKIP 
          READW  I,BUF,X0+100B  SKIP
          EQ     SKWX        RETURN 
  
 SKW2     READW  I,BUF,100B  SKIP 
          EQ     SKW1        LOOP 
 WTL      SPACE  4,10 
**        WTL - WRITE TITLE LINES.
* 
*         ENTRY  (A0) = ADDRESS OF SECOND TITLE LINE. 
* 
*         MACROS CLOCK, WRITEC, WRITEW. 
  
  
 WTL      SUBR               ENTRY/EXIT 
          CLOCK  TM          GET TIME 
          WRITEW O,WTLA,WTLAL  WRITE LINE ONE 
          WRITEC O,A0        WRITE LINE TWO 
          WRITEW O,(=C*  *),B1  SPACE 
          WRITEW O,WTLB,B1   SET AUTO EJECT 
          EQ     WTLX        RETURN 
  
 WTLA     BSS    0           TITLE LINES
          DATA   10H1          EJECT PAGE 
          DATA   10HKTSDMP -
 LB       CON    0           LABEL
 DD       CON    0           DUMP DATE
 DT       CON    0           DUMP TIME
          DATA   10H            BLANKS
 DA       CON    0           CURRENT DATE 
 TM       CON    0           CURRENT TIME 
          CON    0           LINE TERMINATOR
 WTLAL    EQU    *-WTLA 
 WTLB     DATA   1LR         SET AUTO EJECT 
          SPACE  4
*         COMMON DECKS. 
  
  
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCOD 
*CALL     COMCCPM 
*CALL     COMCPFM 
*CALL     COMCRDW 
*CALL     COMCSFN 
*CALL     COMCSTF 
*CALL     COMCSYS 
*CALL     COMCWOD 
*CALL     COMCWTC 
*CALL     COMCWTW 
 BUFFERS  TITLE  BUFFERS. 
*         BUFFERS.
  
  
          USE    BUFFERS. 
  
 BUFFERS  BSS    0
 IBUF     EQU    BUFFERS     INPUT FILE BUFFER
 OBUF     EQU    IBUF+IBUFL  OUTPUT FILE BUFFER 
 BUF      EQU    OBUF+OBUFL  WORKING BUFFER 
 BUFO     EQU    BUF+20B     EXCHANGE PACKAGE OUTPUT BUFFER 
 BUF1     EQU    BUF+400B    DUMP BUFFERS 
 BUF2     EQU    BUF1+4      DUMP BUFFER
 SBUF     EQU    BUF1-24     STRING BUFER FOR DISPLAY CODE
 RFL=     EQU    BUF2+10B 
  
          USE    *
 PRS      TITLE  PRESET.
**        PRS - PRESET KTSDMP.
* 
*         EXIT   (X5) = .GT. 0 - APPEND *IF* TO *P*.
*                (X5) = 0 - LIST *IF* TO *OF*.
*                (DA) = CURRENT DATE. 
*                (DF) = 0 - LIST WITH DISPLAY CODE. 
*                (DF) = 1 - LIST WITH OCTAL ONLY. 
* 
*         USES   B - 7. 
*                A - 1, 2, 3, 6, 7. 
*                X - 0, 1, 2, 3, 5, 6, 7. 
* 
*         MACROS ABORT, DATE, MESSAGE.
  
  
          ORG    BUFFERS
  
 PRS      SUBR               ENTRY/EXIT 
          SA1    ACTR        READ ARGUMENT COUNT
          SA2    ARGR        READ FIRST ARGUMENT
          SB7    X1 
          MX0    42 
          ZR     B7,PRS2     IF NO ARGUMENTS - COMPLETE PRESETTING
          SX3    3
          ZR     X2,PRS1     IF DEFAULT INPUT FILE
          BX6    X0*X2       SET INPUT FILE NAME
          IX7    X6+X3
          SA7    I
 PRS1     SB7    B7-B1       DECREMENT NUMBER OF REMAINING ARGUMENTS
          ZR     B7,PRS2     IF END OF ARGUMENTS
          SA2    A2+B1       READ SECOND ARGUMENT 
          ZR     X2,PRS2     IF DEFAULT OUTPUT FILE NAME
          BX6    X0*X2       STORE OUTPUT FILE NAME 
          IX7    X6+X3
          SB7    B7-1        DECREMENT ARGUMENT COUNT 
          SA7    O
 PRS2     SA1    I           CHECK FILE NAME CONFLICT 
          SA3    O
          BX6    X1-X3
          BX7    X0*X6
          ZR     X7,PRS5     IF I = O 
          ZR     B7,PRS4     IF ARGUMENT COUNT EXHAUSTED
          SA2    A2+B1       READ *APPEND* PARAMETER
          SB7    B7-B1
          BX2    X0*X2
          ZR     X2,PRS3     IF NULL ARGUMENT 
          SX5    1           SET *APPEND* FLAG
          ZR     B7,PRS4     IF ARGUMENT COUNT EXHAUSTED
 PRS3     SA2    A2+B1       READ *OCTAL* PARAMETER 
          BX2    X0*X2
          ZR     X2,PRS4     IF NO PARAMETER SPECIFIED
          SX6    B1 
          SA6    DF 
 PRS4     DATE   DA 
          EQ     PRSX        RETURN 
  
 PRS5     MESSAGE PRSA,R
          ABORT 
  
 PRSA     DATA C* FILE NAME CONFLICT.*
          SPACE  4
          END 
