TDUMP 
          IDENT  TDUMP,ASEM 
          ABS 
          ENTRY  TDUMP
          ENTRY  RFL= 
          SST    LREC 
          TITLE  TDUMP - FILE DUMP. 
          SYSCOM B1 
          SPACE  4
*COMMENT  TDUMP - FILE DUMP.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       TDUMP - FILE DUMP.
*         R. N. LAGERSTROM.  70/03/05.
*         D. A. HIVELEY.     72/05/16.
          SPACE  4
***       TDUMP WILL LIST A FILE IN OCTAL, ALPHANUMERIC OR HEXADECIMAL
*         FORM.  ANY OR ALL OF THE THREE FORMS MAY BE SELECTED IN ANY 
*         COMBINATION.  EACH LINE OF THE DUMP IS LISTED IN EACH OF THE
*         SELECTED FORMS - OCTAL, ALPHANUMERIC, AND/OR HEXADECIMAL, IN
*         THAT ORDER.  BY DEFAULT, AN OCTAL/ALPHANUMERIC DUMP IS DONE 
*         ON THE ENTIRE DATA FILE.
          SPACE  4
***       CONTROL CARD CALL.
* 
*         TDUMP(P1,P2,...,PN) 
* 
*         WHERE PN CAN BE - 
*         I=FN   INPUT FILE NAME (DEFAULT = TAPE1). 
*         L=FN   OUTPUT FILE NAME (DEFAULT = OUTPUT). 
*         O      OCTAL DUMP (DEFAULT = O AND A).
*         A      ALPHANUMERIC DUMP (DEFAULT = O AND A). 
*         H      HEXADECIMAL DUMP (DEFAULT = O AND A).
*         R=NN   RECORD COUNT(DECIMAL) (DEFAULT = TO EOI).
*         F=NN   FILE COUNT(DECIMAL) (DEFAULT = TO EOI).
*         F=0    DUMP TO DOUBLE EOF (EMPTY FILE)
*         N=NN   LINE LIMIT OF DUMP(DECIMAL) (DEFAULT = INFINITE).
*         C      READ FILE I IN CODED MODE (DEFAULT = BINARY MODE). 
*         NR     DO NOT REWIND FILE I BEFORE DUMP (DEFAULT = REWIND). 
*         CW     PRINT CONTROL WORDS IF DEFINED ON DEVICE TYPE. 
          SPACE  4
*CALL     COMCMAC 
*CALL     COMCCMD 
 READO    SPACE  4
**        READO - REDEFINE READ WORD MACRO TO USE CONTROL WORD READS. 
  
          PURGMAC  READO
  
 READO    MACRO  F
          SA1    F+2
          RJ     RDA
          ENDM
          TITLE  EQUIVALENCES AND CONSTANTS.
 OLWSL    EQU    136         LINE LENGTH (CHARACTERS) 
 BUFOL    EQU    512*2+1     LENGTH OF OUTPUT BUFFER
 BUFFL    EQU    20011B      LENGTH OF *TAPE1* BUFFER 
 ODFEL    EQU    16          OPTICAL DISK FET EXTENSION LENGTH
 OPBO     EQU    0           BIT FOR OPTION O (OCTAL DUMP)
 OPVO     EQU    1S0         VALUE FOR OPTION O 
 OPBA     EQU    1           BIT FOR OPTION A (ALPHANUMERIC DUMP) 
 OPVA     EQU    1S1         VALUE FOR OPTION A 
 OPBH     EQU    2           BIT FOR OPTION H (HEXADECIMAL DUMP)
 OPVH     EQU    1S2         VALUE FOR OPTION H 
          SPACE  4
          ORG    110B 
 ASEM     EQU    *
 RECT     CON    1           RECORD COUNT 
 FLCT     CON    1           FILE COUNT 
 PGCT     CON    1           PAGE COUNT 
 WDCT     CON    0           WORD COUNT 
 RPCT     CON    0           REPEAT COUNT - SKIPPED LINES 
 TLCT     CON    0           TOTAL LINE COUNT 
 LILM     DATA   1C0         LINE LIMIT 
 LREC     DATA   1C0         RECORD LIMIT 
 LFLC     DATA   0L999999    FILE LIMIT (EOI) 
 REWD     CON    0           REWIND FILE
 LSCT     CON    99999,0     LINE COUNT ON PAGE 
 LL       EQU    LSCT+1      LINE LIMIT 
 SCPC     CON    0           BYTE POSITION
 OPWD     CON    OPVO+OPVA   OPTION CONTROL WORD (PRESET OCTAL/ALPHA) 
 EQTW     CON    0           EQUIVALENCE TEST WORD
 EOFL     CON    0           END OF FILE FLAG 
 DTOL     BSSZ   4           DATA FOR ONE LINE
 WCBL     CON    0           BEGINNING OF LINE WORD COUNT 
 TCCS     CON    0           TERMINAL-S CURRENT CHARACTER SET 
 TSRW     BSSZ   2           TERMINAL STATUS REPLY WORDS
 TF       CON    1           ZERO IF TERMINAL FILE
 CODD     CON    0           INPUT FILE MODE (0=BINARY, 2=CODED)
 CW       CON    0           CONTROL WORD FLAG (1=LEGAL)
 CWDS     CON    0           CONTROL WORD DUMP SELECTED (1=SELECTED)
  
*         WORDS/LINE TABLE INDEXED BY *TF*. 
  
 WPLT     BSS    0
          CON    2           TERMINAL 
          CON    4           NON-TERMINAL 
          TITLE  MAIN PROGRAM.
*         MAIN ROUTINE. 
  
 TDM      SA1    CW          CHECK CONTROL WORDS LEGAL
          ZR     X1,TDM0     IF CONTROL WORDS NOT LEGAL 
          MX6    1           SET FIRST READ FLAG
          SA6    F-2
          READCW F,17B       INITIAL FILE READ
          JP     TDM1 
  
 TDM0     READ   F           NORMAL FILE READ 
  
 TDM1     SA0    B0          CLEAR ENTRY POSITION 
          BX6    X6-X6
          SA6    WDCT        CLEAR WORD COUNT 
          SA6    WCBL        CLEAR BEGINNING OF LINE COUNT
 TDM1.1   READO  F           READ WORD FROM FILE
          NZ     X1,TDM5     IF EOR OR EOF
          BX7    X7-X7
          SX2    B1 
          SA7    EOFL        CLEAR EOF FLAG 
          SA6    DTOL+A0     STORE IN LINE WORD BUFFER
          SA1    WDCT 
          IX6    X1+X2       ADVANCE WORD COUNT 
          SA6    A1 
          SA0    A0+B1       ADVANCE POSITION COUNT 
          SA1    TF 
          SA2    X1+WPLT
          SB2    X2 
          SX1    A0-B2
          NZ     X1,TDM1.1   IF NOT FULL LINE 
          SA4    WPLT        TERMINAL WORD COUNT
          SB3    X4 
          SA1    DTOL        WORD 1 
          SA2    A1+B1
          SA3    A2+B1
          SA4    A3+B1       WORD 4 
          BX6    X1-X2       X6 = DIFF(1-2) 
          EQ     B2,B3,TDM1.2  IF TERMINAL
          BX7    X1-X3
          BX6    X6+X7       X6 = DIFF(1-2-3) 
          BX7    X1-X4
          BX6    X6+X7       X6 = DIFF(1-2-3-4) 
 TDM1.2   NZ     X6,TDM1.3   IF NOT ALL SAME ON LINE
          PL     X6,TDM4     IF ALL SAME ON LINE
 TDM1.3   BSS    0
          SA1    RPCT 
          NZ     X1,TDM3     IF LINES BEING SKIPPED 
 TDM2     RJ     FML         FORMAT LIST LINE(S)
          SA0    B0          CLEAR POSITION COUNT 
          ZR     X1,TDM1.1   IF NO LIMIT REACHED
          EQ     TDM10       PROCESS LIMIT
  
 TDM2.5   BX7    X3          USE OLD REPEAT COUNT 
          SA7    A3 
 TDM3     BX7    X7-X7
          SA2    RPCT 
          SA7    A2          ZERO SUPPRESSING COUNT 
          AX2    1
          ZR     X2,TDM2     IF ONE LINE ONLY 
          WRITEC O,MALR      WRITE LINES REPEATED 
          RJ     CPL
          EQ     TDM2 
  
 TDM4     SA4    EQTW        PREVIOUS IDENTITY LINE 
          SA3    RPCT        SKIP COUNT 
          BX6    X1 
          BX1    X1-X4
          SA6    A4          STORE NEW IDENTITY 
          SX7    X3+B1       ADVANCE SKIP COUNT 
          SA7    A3 
          ZR     X3,TDM2     IF NO SUPPRESSION RUNNING
          NZ     X1,TDM2.5   IF PREVIOUS SUPPRESSION NOT CONTINUED
          NG     X1,TDM2.5   IF PREVIOUS SUPPRESSION NOT CONTINUED
          SA2    WDCT 
          BX7    X2 
          SA0    B0          RESET WORD COUNT 
          SA7    WCBL 
          JP     TDM1.1      GET NEXT WORD
  
 TDM5     NG     X1,TDM6     IF EOF 
          RJ     TDS
          WRITEC O,MEOR      WRITE EOR MESSAGE
          RJ     WBL
          RJ     CPL
          SA1    RECT 
          SX7    X1+B1
          SA7    A1          ADVANCE RECORD COUNT 
          RJ     CKL
          NZ     X1,TDM10    IF LIMIT REACHED 
          SA1    CW          CHECK TYPE OF READ FOR NEXT RECORD 
          ZR     X1,TDM0     IF NO CONTROL WORDS, ISSUE STANDARD READ 
          JP     TDM1        ELSE, FETCH FROM BUFFER
  
 TDM6     SA1    EOFL 
          SA2    LFLC 
          SX6    X1+B1       ADVANCE EOF FLAG 
          NZ     X2,TDM7     IF FILE LIMIT REQUESTED
          SA6    A1 
          AX6    1
          NZ     X6,TDM9     IF DOUBLE EOF TERMINATION
 TDM7     SA1    F
          LX1    59-0 
          NG     X1,TDM8     IF FILE NOT BUSY 
          RECALL F
          EQ     TDM7 
  
 TDM8     LX1    60-9 
          NG     X1,TDM9     IF END OF INFORMATION
          RJ     TDS
          WRITEC O,MEOF      WRITE EOF MESSAGE
          RJ     WBL
          RJ     CPL
          SX6    B1 
          SA6    RECT        RESET RECORD COUNT 
          SA2    FLCT 
          SX7    X2+B1
          SA7    A2          ADVANCE FILE COUNT 
          RJ     CKL
          ZR     X1,TDM      IF NO LIMIT, GET NEXT FILE 
          EQ     TDM10       LIMIT TERMINATION
  
 TDM9     RJ     TDS
          SX1    MEOI 
 TDM10    WRITEC O,X1        WRITE TERMINATION MESSAGE
          RJ     WBL
          RJ     CPL
          WRITEC O,MEOD      WRITE END OF DUMP
          WRITEF O
          MESSAGE TDMA
          ENDRUN
  
  
 TDMA     DATA   C* TDUMP COMPLETE.*
          TITLE  SUBROUTINES. 
 BSB      SPACE  4
**        BSB - BLANK FILL STRING BUFFER. 
* 
*         ENTRY  NONE.
* 
*         EXIT   (OWLS)      BLANK FILLED.
* 
*         USES   A - 7. 
*                X - 7. 
*                B - 6, 7.
  
  
 BSB      SUBR               ENTRY/EXIT 
          SX7    1R 
          SB7    OLWS+OLWSL 
          SB6    OLWS 
 BSB1     SA7    B6 
          SB6    B6+B1
          NE     B6,B7,BSB1  IF NOT BLANK FILLED
          EQ     BSBX        RETURN 
 CKL      SPACE  4
**        CKL - CHECK LIMITS ON ALL COUNTERS. 
* 
*         ENTRY  (TLCT), (RECT), (FLCT) CHECKED FOR LIMITS AGAINST
*                (LILM), (LREC), (LFLC).
* 
*         EXIT   (X1) = 0    IF NO LIMIT REACHED. 
*                            ELSE, ADDRESS OF LIMIT MESSAGE.
* 
*         USES   A - 1, 2.
*                X - 1, 2.
  
  
 CKL      SUBR               ENTRY/EXIT 
          SA1    LILM 
          ZR     X1,CKL1     IF NO LINE LIMIT 
          SA2    TLCT 
          IX2    X1-X2       (LIMIT)-(TOTAL LINE COUNT) 
          SX1    MLLN        SET LINE LIMIT 
          NG     X2,CKLX     IF LINE LIMIT
 CKL1     SA1    LREC 
          ZR     X1,CKL2     IF NO RECORD LIMIT 
          SA2    RECT 
          IX2    X1-X2       (LIMIT)-(RECORD COUNT) 
          SX1    MLRN        SET RECORD LIMIT 
          NG     X2,CKLX     IF RECORD LIMIT
 CKL2     SA1    LFLC 
          ZR     X1,CKL3     IF DUMPING TO DOUBLE EOF 
          SA2    FLCT 
          IX2    X1-X2       (LIMIT)-(FILE COUNT) 
          SX1    MLFN        SET FILE LIMIT 
          NG     X2,CKLX     IF FILE LIMIT
 CKL3     BX1    X1-X1
          EQ     CKLX        RETURN IF NO LIMITS REACHED
 CPL      SPACE  4
**        CPL - CHECK PAGE LIMIT. 
* 
*         ENTRY  (LSCT)      LINE COUNT ON PAGE.
*                (TLCT)      TOTAL LINE COUNT.
* 
*         EXIT   (LSCT)      ADVANCED BY 1 AND PAGE HEADER WRITTEN
*                            AND RESET IF NECESSARY.
*                (TLCT)      ALWAYS ADVANCED. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
* 
*         CALLS  CDD. 
* 
*         MACROS CLOCK, WRITEC. 
  
  
 CPL      SUBR               ENTRY/EXIT 
          SA1    LSCT 
          SA2    TLCT 
          SX6    X2+B1       ADVANCE TOTAL LINE COUNT 
          SA6    A2 
          SA3    TF 
          ZR     X3,CPLX     IF TERMINAL FILE 
          SX7    X1+B1       ADVANCE LINES ON PAGE
          SA7    A1 
          SA3    A1+B1
          IX7    X7-X3
          NG     X7,CPLX     IF NOT END OF PAGE 
          SX7    B1+B1
          IX6    X6+X7       ADVANCE TOTAL LINE COUNT 
          SA6    A2 
          SA7    A1          CLEAR LINES ON PAGE
          SA1    PGCT 
          SX7    X1+B1       ADVANCE PAGE COUNT 
          SA7    A1 
          RJ     CDD         CONVERT PAGE NUMBER
          SA1    HDRMD
          MX2    30 
          BX7    X2*X1
          BX6    -X2*X6 
          BX7    X6+X7
          SA7    A1          STORE PAGE NUMBER IN HEADER
          CLOCK  HDRMC
          WRITEC O,HDRM      WRITE HEADER 
          WRITEC O,WBLA      WRITE BLANK LINE 
          EQ     CPLX        RETURN 
 ELH      SPACE  4
**        ELH - ENTER DUMP LINE HEADER. 
* 
*         ENTRY  (FLCT)      FILE COUNT.
*                (RECT)      RECORD COUNT.
*                (WDCT)      WORD COUNT.
* 
*         EXIT   LINE BUFFER CLEARED AND HEADER DATA INSERTED.
* 
*         CALLS  BSB, COD, ESB. 
* 
*         USES   A - 1, 2, 7. 
*                X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 6, 7. 
  
  
 ELH      SUBR               ENTRY/EXIT 
          RJ     BSB         BLANK STRING BUFFER
  
*         SET FILE COUNT. 
  
          SA1    FLCT 
          RJ     COD         CONVERT FILE COUNT 
          SX7    1RF
          SA7    OLWS+1      STORE FILE IDENTIFIER
          SB7    A7+B1
          MX1    3
          LX6    48          POSITION CONVERTED DIGITS
          RJ     ESB         ENTER FILE COUNT 
  
*         SET RECORD COUNT. 
  
          SA1    RECT 
          RJ     COD         CONVERT RECORD COUNT 
          SX7    1RR
          SA7    B7+B1       STORE RECORD IDENTIFIER
          SB7    A7+B1
          MX1    4
          LX6    42 
          RJ     ESB         ENTER RECORD COUNT 
  
*         SET WORD COUNT. 
  
          SA1    WCBL 
          RJ     COD         CONVERT WORD COUNT 
          SX7    1RW
          SA7    B7+B1       STORE WORD IDENTIFIER
          SB7    A7+B1
          MX1    6
          LX6    30 
          RJ     ESB         ENTER WORD COUNT 
          SX7    1R-
          SA7    B7          ENTER SEPARATOR
          EQ     ELHX        RETURN 
 ESB      SPACE  4
**        ESB - ENTER STRING BUFFER.
* 
*         ENTRY (X6)         POSITIONED CHARACTER DATA
*               (X1)         NUMBER OF CHARS TO STORE (ONE BIT PER CHAR)
*               (B7)         ENTRY ADDRESS IN STRING BUFFER 
* 
*         EXIT   (B7)        NEXT ENTRY ADDRESS 
* 
*         USES   A - 7. 
*                X - 1, 2, 6, 7.
*                B - 7. 
  
  
 ESB      SUBR               ENTRY/EXIT 
 ESB1     PL     X1,ESBX     RETURN 
          MX2    -6 
          LX1    1
          BX7    -X2*X6 
          SA7    B7          STORE CHARACTER
          SB7    B7+B1       ADVANCE STORE
          LX6    6
          EQ     ESB1        LOOP FOR NEXT CHARACTER
 FAW      SPACE  4
**        FAW - FORMAT ALPHA WORD.
* 
*         ENTRY  (B2) = ADDRESS OF WORD TO FORMAT TO STRING BUFFER. 
*                (SCPC) = BYTE POSITION.
* 
*         EXIT   (B2) = UNCHANGED.
*                CHARACTERS PLACED IN STRING BUFFER AND (SCPC)
*                ADVANCED.
* 
*         CALLS  BSB. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 3, 4, 5, 6, 7.
*                B - 4, 5, 6, 7.
  
  
 FAW      SUBR               ENTRY/EXIT 
          SA4    SCPC 
          NZ     X4,FAW2     IF NOT FIRST WORD
          SA3    OPWD 
          LX3    59-OPBO
          BX6    X6-X6       CLEAR POSITION INCREMENT 
          SA6    FAWB 
          PL     X3,FAW2     IF NOT OCTAL/ALPHA MODE
          RJ     BSB         BLANK BUFFER 
 FAW2     SA5    FAWA        GET ASCII ESCAPE CHARACTER 
          SA1    B2          GET DATA WORD
          MX2    10 
          SA3    OPWD 
          MX6    54 
          LX3    59-OPBO
          SB7    1R          SET BLANK REPLACE
          NG     X3,FAW7     IF OCTAL/ALPHA MODE
          SA3    TAAP+X4     GET STARTING POSITION
          SB5    X3 
          SB4    B1 
 FAW2.1   SA3    FAWB        INCREMENT STARTING POSITION
          SB5    X3+B5
 FAW3     SB6    B1+B1       SET BYTE WIDTH 
 FAW4     LX1    6
          BX7    -X6*X1 
          LX2    1
          SB6    B6-B1
          SA3    TCCS 
          ZR     X3,FAW4.1   IF TERMINAL CHARACTER SET NOT ASCII
          NZ     X5,FAW9     IF PREVIOUS CHARACTER IS ESCAPE
          SX3    X7-76B 
          ZR     X3,FAW8     IF ESCAPE 76 
          SX3    X7-74B 
          ZR     X3,FAW8     IF ESCAPE 74 
 FAW4.1   NZ     X7,FAW5     IF NOT 00 CHARACTER
          SX7    B7          FORCE BLANK
 FAW5     SA7    B5 
          SB5    B5+B4       ADVANCE STORE
          NZ     B6,FAW4     IF NOT END OF BYTE 
          SB5    B5+B1       SKIP ONE POSITION
          NG     X2,FAW3     IF NOT END OF WORD 
          BX7    X5          SAVE ESCAPE CHARACTER
          SA7    FAWA 
          SA4    SCPC        ADVANCE POSITION 
          SA3    OPWD 
          SX7    X4+B1
          LX3    59-OPBO
          SX6    X7-TBOPL 
          NG     X3,FAW6     IF OCTAL ALPHA MODE
          SX6    X7-TAAPL 
 FAW6     SA7    A4 
          NZ     X6,FAW      IF NOT END OF LINE 
          SA6    A4          SET BEGINNING OF NEXT LINE 
          EQ     FAWX        RETURN 
  
 FAW7     SA3    TBOP+X4     SET STARTING POSITION
          SB5    X3+B1
          SB4    B1+B1       SET INCREMENT
          EQ     FAW2.1      LOOP FOR NEXT BYTE 
  
 FAW8     BX5    X7 
          SX7    B7          FORCE BLANK
          EQ     FAW5        STORE CHARACTER
  
 FAW9     BX6    X5          STORE ESCAPE CHARACTER 
          SA6    B5 
          SB5    B5+1 
          SA3    FAWB        ADVANCE POSITION INCREMENT 
          SX6    X3+B1
          SA6    A3 
          BX5    X5-X5       CLEAR ESCAPE CHARACTER 
          MX6    54          RESET MASK 
          EQ     FAW5        STORE CHARACTER
  
 FAWA     CON    0           ASCII ESCAPE CHARACTER 
 FAWB     CON    0           WORD POSITION INCREMENT
  
*         TABLE OF BYTE FORMAT POSITIONS
  
 TAAP     BSS    0
          LOC    0
          CON    OLWS+21
          CON    OLWS+38
          CON    OLWS+55
          CON    OLWS+72
 TAAPL    EQU    *
          LOC    *O 
 FHW      SPACE  4,15 
**        FHW - FORMAT HEXADECIMAL WORD.
* 
*         ENTRY  (B2) = ADDRESS OF WORD TO FORMAT TO STRING BUFFER. 
*                (SCPC) = BYTE POSITION.
* 
*         EXIT   (B2) = UNCHANGED.
*                (X6) = 0 IF LINE IS FILLED.
*                CHARACTERS PLACED IN STRING BUFFER AND (SCPC)
*                ADVANCED.
* 
*         USES   X - 2, 3, 4, 6, 7. 
*                A - 3, 4, 6, 7.
*                B - 5, 6, 7. 
* 
*         CALLS  BSB. 
  
  
 FHW      SUBR               ENTRY/EXIT 
          SA4    SCPC 
          NZ     X4,FHW0     IF NOT FIRST WORD
          SA3    OPWD 
          SX3    X3-OPVH
          ZR     X3,FHW0     IF ONLY H OPTION SELECTED
          RJ     BSB         BLANK BUFFER 
 FHW0     SA4    TBOP+X4
          MX3    15          DIGIT COUNT
          SB7    X4          STORE ADDRESS
          MX2    -4 
          SA4    B2 
 FHW1     SB5    3
 FHW2     LX4    4
          BX7    -X2*X4      EXTRACT DIGIT
          SB6    X7-10
          LX3    1
          NG     B6,FHW3     IF PURE DECIMAL DIGIT PRESENT
          SX7    X7-9-1R0    BIAS TO ALPHA
 FHW3     SX7    X7+1R0      CONVERT DIGIT
          SA7    B7          STORE RESULT 
          SB5    B5-B1
          SB7    B7+1 
          NZ     B5,FHW2     IF NOT END OF BYTE 
          SB7    B7+2        SKIP COLUMNS 
          NG     X3,FHW1     IF NOT END OF WORD 
          SA4    SCPC 
          SX7    X4+B1
          SA7    A4 
          SX6    X7-TBOPL 
          NZ     X6,FHWX     IF LINE NOT FILLED 
          SA6    A4+         RESET BYTE POSITION
          EQ     FHWX        RETURN 
 FML      SPACE  4
**        FML - FORMAT PRINT LINE(S). 
* 
*         ENTRY  (A0)        INDEX TO LAST ENTRY+1 IN WORD BUFFER.
* 
*         EXIT   (X1) = 0    IF NO LIMIT REACHED. 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 2, 6, 7. 
*                B - 2. 
* 
*         CALLS  ELH, FAW, FHW, FOW, WSB. 
  
  
 FML      SUBR               ENTRY/EXIT 
          BX1    X1-X1
          SX1    A0-B1
          NG     X1,FMLX     IF EMPTY LINE
          SA2    OPWD 
          LX2    59-OPBO
          PL     X2,FML2     IF NOT OCTAL MODE
          BX6    X6-X6       CLEAR BYTE POSITION
          SA6    SCPC 
          RJ     ELH         ENTER LINE HEADER
          SB2    DTOL 
          RJ     FOW         WORD 1 
          SB2    B2+B1
          SX1    A0-2 
          NG     X1,FML1     IF END OF LINE 
          RJ     FOW         WORD 2 
          SB2    B2+B1
          SX1    A0-3 
          NG     X1,FML1     IF END OF LINE 
          RJ     FOW         WORD 3 
          SB2    B2+B1
          SX1    A0-4 
          NG     X1,FML1     IF END OF LINE 
          RJ     FOW         WORD 4 
 FML1     RJ     WSB         WRITE BUFFER 
 FML2     SA2    OPWD 
          LX2    59-OPBA
          BX6    X6-X6
          PL     X2,FML4     IF NOT ALPHA MODE
          SA6    SCPC 
          RJ     ELH
          SB2    DTOL 
          RJ     FAW         WORD 1 
          SB2    B2+B1
          SX1    A0-2 
          NG     X1,FML3     IF END OF LINE 
          RJ     FAW         WORD 2 
          SB2    B2+B1
          SX1    A0-3 
          NG     X1,FML3     IF END OF LINE 
          RJ     FAW         WORD 3 
          SB2    B2+B1
          SX1    A0-4 
          NG     X1,FML3     IF END OF LINE 
          RJ     FAW         WORD 4 
 FML3     RJ     WSB         WRITE BUFFER 
 FML4     SA2    OPWD 
          LX2    59-OPBH
          BX6    X6-X6
          PL     X2,FML6     IF NOT A HEXADECIMAL DUMP
          SA6    SCPC        CLEAR BYTE COUNT 
          RJ     ELH         SET UP LINE HEADERS
          SB2    DTOL 
          RJ     FHW         FORMAT HEXADECIMAL WORD
          SB2    B2+1 
          SX1    A0-2 
          NG     X1,FML5     IF END OF LINE 
          RJ     FHW         FORMAT HEXADECIMAL WORD
          SB2    B2+1 
          SX1    A0-3 
          NG     X1,FML5     IF END OF LINE 
          RJ     FHW         FORMAT HEXADECIMAL WORD
          SB2    B2+1 
          SX1    A0-4 
          NG     X1,FML5     IF END OF LINE 
          RJ     FHW         FORMAT HEXADECIMAL WORD
 FML5     RJ     WSB         WRITE BUFFER 
 FML6     SA2    WDCT 
          BX7    X2 
          SA7    WCBL        SET BEGINNING OF NEXT LINE 
          EQ     FMLX        RETURN 
 FOW      SPACE  4
**        FOW - FORMAT OCTAL WORD.
* 
*         ENTRY  (B2)        ADDRESS OF WORD TO FORMAT. 
*                (SCPC)      BYTE POSITION. 
* 
*         EXIT   WORD PLACED IN BUFFER. 
*                (SCPC)      UPDATED. 
*                (X6) = 0    IF LINE IS FILLED. 
*                (B2)        UNCHANGED. 
* 
*         USES   A - 4, 6, 7. 
*                X - 2, 3, 4, 6, 7. 
*                B - 1, 2, 5, 6, 7. 
  
  
 FOW      SUBR               ENTRY/EXIT 
          SA4    SCPC 
          SA4    TBOP+X4     GET BEGINNING CHARACTER POSITION 
          MX3    20          DIGIT COUNT
          SB7    X4          STORE ADDRESS
          SB6    1R0
          MX2    -3 
          SA4    B2          GET INPUT WORD 
 FOW2     SB5    4
 FOW3     LX4    3
          BX7    -X2*X4      GET DIGIT
          SX7    X7+B6
          LX3    1
          SA7    B7          STORE CONVERTED DIGIT
          SB7    B7+B1
          SB5    B5-B1
          NZ     B5,FOW3     IF NOT END OF BYTE 
          SB7    B7+B1       SKIP COLUMN
          NG     X3,FOW2     IF NOT END OF WORD 
          SA4    SCPC 
          SX7    X4+B1
          SX6    X7-TBOPL 
          SA7    A4          ADVANCE POSITION 
          NZ     X6,FOWX     IF NOT END OF LINE 
          SA6    A4          RESET BYTE POSITION
          EQ     FOWX        RETURN 
  
*         TABLE OF FORMATTING VALUES
  
 TBOP     BSS    0
          LOC    0
          CON    OLWS+21
          CON    OLWS+48
          CON    OLWS+75
          CON    OLWS+102 
 TBOPL    EQU    *
          LOC    *O 
 RDA      SPACE  4
**        RDA - READ DATA (READO MACRO).
*         PROCESS READ ONE WORD REQUESTS (RDO=).
*         DEBLOCK DATA IF CONTROL WORD READS USED.
* 
*         ENTRY  (X1) = (FET+2).
*                (A1) = FET+2.
* 
*         EXIT   (X1) = 1 IF EOR DETECTED.
*                (X1) = -1 IF EOF DETECTED. 
*                (X1) = -2 IF EOI DETECTED. 
*                (X1) = 0 IF TRANSFER COMPLETE. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 4, 5, 6. 
* 
*         CALLS  RDO=.
  
  
 RDA5     SX7    B6          STORE WORDS REMAINING IN THIS BLOCK
          SA7    A2 
 RDA6     RJ     RDO=        PROCESS WORD REQUEST 
  
 RDA      SUBR               ENTRY/EXIT 
          SA2    CWDS        CHECK CONTROL WORD DUMP FLAG 
          PL     X2,RDA6     IF CONTROL WORDS NOT LEGAL NOW 
 RDA1     SB4    A1          SAVE FET POINTER 
          SA2    A1-4        GET NUMBER OF WORDS BEFORE CONTROL WORD
          SB5    X2 
          NG     X2,RDA4     IF FIRST READ OF FILE
 RDA2     SB6    B5-B1       DECREMENT WORDS REMAINING IN BLOCK 
          PL     B6,RDA5     IF ENOUGH WORDS LEFT FOR REQUEST 
          SA3    A2+B1       CHECK EOR FLAG 
          PL     X3,RDA3     IF NOT EOR 
          MX6    1           SET NEW READ FLAG ON 
          SA6    A2 
          SA6    A3          RESET EOR FLAG 
          RJ     RDO=        CLEAR LEVEL WORD 
          SX1    B1          SET EOR INDICATOR FOR RETURN 
          JP     RDAX        RETURN 
  
 RDA3     RJ     RDO=        CLEAR LEVEL WORD 
 RDA4     SA1    B4          RESET A1, X1 VALUES
          RJ     RDO=        READ CONTROL WORD
          NG     X1,RDAX     IF EOF/EOI, RETURN 
          SA1    B4          RESET A1, X1 VALUES
          BX3    X6          CONTROL WORD 
          SX7    5           BYTES/WORD 
          SX4    X3+4        ROUND UP 
          AX3    36 
          SX3    X3 
          IX7    X4/X7       WORDS IN BLOCK 
          IX6    X7-X3       SAVE EOR FLAG
          SA7    A1-4        STORE WORD COUNT 
          SA6    A1-3        STORE EOF FLAG 
          JP     RDA1        CONTINUE IN LOOP 
 TDS      SPACE  4
**        TDS - TERMINATE DUMP SEGMENT. 
* 
*         ENTRY  (A0)        NUMBER OF WORDS IN BUFFER. 
* 
*         EXIT   (X1) = 0    IF NO LIMITS EXCEEDED. 
* 
*         CALLS  FML, CPL, WBL. 
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5 AND X5.
  
  
 TDS      SUBR               ENTRY/EXIT 
          SA1    RPCT 
          SX2    X1-3 
          AX1    1
          BX6    X6-X6
          SA6    A1          CLEAR REPEAT 
          ZR     X1,TDS3     IF NOT REPEAT (SUPPRESSING)
          PL     X2,TDS1     IF MORE THAN TWO LINES 
          SX6    A0 
          ZR     X6,TDS2     IF NO WORDS
 TDS1     WRITEC O,MALR      WRITE REPEAT MESSAGE 
          RJ     WBL
          RJ     CPL
          SX6    A0 
          NZ     X6,TDS3     IF WORDS IN BUFFER 
 TDS2     SA4    TF          SET WORDS/LINE FOR FILE TYPE 
          SA2    X4+WPLT
          SA1    WCBL 
          IX6    X1-X2
          SA6    A1 
          SA0    X2 
 TDS3     RJ     FML
          BX6    X6-X6
          SA6    WCBL        ZERO BEGIN LINE WORD COUNT 
          EQ     TDSX        RETURN 
 WBL      SPACE  4
**        WBL - WRITE BLANK LINE. 
* 
*         ENTRY  NONE.
* 
*         EXIT   BLANK LINE WRITTEN.
* 
*         CALLS  CPL, WTC.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5 AND X5.
  
  
 WBL      SUBR               ENTRY/EXIT 
          RJ     CPL         CHECK PAGE LIMIT 
          WRITEC O,WBLA      WRITE BLANK LINE 
          EQ     WBLX        RETURN 
  
 WBLA     DATA   2C 
 WSB      SPACE  4
**        WSB - WRITE STRING BUFFER.
* 
*         ENTRY  NONE.
* 
*         EXIT   (X1) = 0    IF NO LIMITS REACHED.
*                STRING BUFFER WRITTEN TO OUTPUT FILE.
* 
*         CALLS  CPL, CKL, WTS. 
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5 AND X5.
  
  
 WSB      SUBR               ENTRY/EXIT 
          WRITES O,OLWS,OLWSL 
          RJ     CPL
          BX6    X6-X6
          SA6    SCPC        SET LINE EMPTY 
          RJ     CKL
          EQ     WSBX        RETURN 
  
*         MESSAGES. 
  
 HDRM     DATA   30H1        - FILE DUMP -
 HDRMA    DATA   30H
          DATA   30H
 HDRMB    DATA   10H
 HDRMC    DATA   10H
 HDRMD    DATA   10H PAGE 0000
          DATA   1C.
 MLLN     DATA   C* -- LINE LIMIT --* 
 MLRN     DATA   C* -- RECORD LIMIT --* 
 MLFN     DATA   C* -- FILE LIMIT --* 
 MEOR     DATA   C* -- END OF RECORD --*
 MEOF     DATA   C* -- END OF FILE --*
 MEOI     DATA   C* -- END OF INFORMATION --* 
 MEOD     DATA   C* -- END OF DUMP --*
 MALR     DATA   C* -- ABOVE LINE REPEATED --*
  
*         COMMON DECKS. 
  
*CALL,COMCCDD 
*CALL,COMCCOD 
*CALL,COMCCIO 
*CALL,COMCRDO 
*CALL,COMCSYS 
*CALL,COMCWTC 
*CALL,COMCWTS 
*CALL,COMCWTW 
  
*         FETS. 
  
 O        BSS    0
 OUTPUT   FILEB  BUFO,BUFOL,EPR,(FET=8) 
  
          CON    0           REMAINING WORD COUNT 
          CON    0           EOR FLAG 
  
 F        BSS    0
 TAPE1    FILEB  BUFF,BUFFL,(FET=10)
 ODFE     BSSZ   ODFEL       OPTICAL DISK FET EXTENSION 
          TITLE  PRESET PROGRAM 
 PRE      SPACE  4
**        PRE - PRESET PROGRAM. 
* 
*         ENTRY  CONTROL CARD ARGUMENTS STORED BY SYSTEM. 
* 
*         EXIT   (B1) = 1.
* 
*         CALLS  ARG, CDT, CPL, DXB, SFN, STF.
* 
*         MACROS ABORT, DATE, GETPP, MESSAGE, OPEN, REWIND, 
*                TSTATUS, WRITEW. 
  
  
 TDUMP    BSS    0
 PRE      EQU    TDUMP
  
          SB1    1
          SA1    ACTR 
          R=     A4,ARGR     SET FIRST ARGUMENT 
          SB4    X1          SET ARGUMENT COUNT 
          SB5    TARG        SET EQUIVALENCE TABLE
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,PRE1.1   IF NO ARGUMENT ERROR 
 PRE1     SX2    =C* ARGUMENT ERROR.* 
          MESSAGE X2
          ABORT 
  
 PRE1.1   SA1    OPWA        GET ALPHA DUMP OPTION
          SA2    OPWH        GET HEX DUMP OPTION
          BX6    X1+X2
          SA1    OPWO        GET OCTAL DUMP OPTION
          BX6    X1+X6
          ZR     X6,PRE2     IF NO DUMP OPTION USE DEFAULT
          SA6    OPWD        SET COMPOSITE DUMP OPTION
 PRE2     SA1    O
          MX6    42 
          BX7    X7-X7
          BX1    X6*X1
          SX6    A1 
          BX6    X1+X6       FORM POINTER TO *OUTPUT* FILE
          SA6    B1+B1
          SA7    A6+B1
          SX2    A1          OUTPUT FET ADDRESS 
          RJ     STF         CHECK IF TERMINAL FILE 
          SA6    TF 
          NZ     X6,PRE3     IF NON-TERMINAL
          TSTATUS  TSRW      GET CURRENT CHARACTER SET
          SA2    TSRW+1 
          MX0    59 
          LX2    0-2
          BX6    -X0*X2 
          SA6    TCCS 
 PRE3     SB7    B1          DECIMAL BASE 
          SA5    LREC 
          RJ     DXB
          NZ     X4,PRE1     IF RECORD COUNT NON NUMERIC
          SA6    A5          STORE CONVERTED VALUE
          SA5    LFLC 
          ZR     X5,PRE3.1   IF NO CONVERSION 
          RJ     DXB
          NZ     X4,PRE1     IF FILE COUNT NON NUMERIC
          SA6    A5          STORE CONVERTED VALUE
 PRE3.1   SA5    LILM 
          RJ     DXB
          NZ     X4,PRE1     IF LINE LIMIT NON NUMERIC
          SA6    A5          STORE CONVERTED VALUE
          SB6    8
          SA1    CCDR-1 
          SB7    HDRMA
          MX3    54 
 PRE4     SA1    A1+B1       GET WORD OF CONTROL CARD 
          BX7    X1 
          BX6    -X3*X1 
          ZR     X6,PRE6     IF LAST WORD 
          SA7    B7          STORE IN HEADER LINE 
          SB6    B6-B1
          SB7    B7+B1
          NZ     B6,PRE4     IF MORE WORDS TO CONTROL CARD
 PRE5     DATE   HDRMB
          SA1    CODD        SET FET FOR CODED READ IF REQUESTED
          SA2    F
          BX6    -X1*X2 
          SA6    A2 
          GETPP  BUFF,LL,BUFF  GET PAGE SIZE PARAMETERS 
          SA1    TF 
          WRITEW O,A6,X1     CONDITIONALLY WRITE FORMAT EFFECTOR
          RJ     CPL         ISSUE FIRST LINE 
          SX2    F
          SA3    PREA 
          RJ     SOE         SET OPTICAL FET EXTENSION
          OPEN   F,READNR,R  CHECK IF CONTROL WORDS LEGAL 
          SA1    F+1
          RJ     CDT         CHECK DEVICE TYPE
          ZR     X7,PRE5.1   IF CONTROL WORDS NOT LEGAL 
          SX7    B0+
          SA1    LREC        CHECK RECORD COUNT 
          NZ     X1,PRE5.1   IF *R=* USED, FORCE NO CONTROL WORD READS
          SX7    1           SET CONTROL LEGAL FLAG 
          SA7    CW 
 PRE5.1   SA1    CWDS        SET CONTROL WORD DUMP FLAG 
          IX7    X1-X7
          SA7    A1 
          SA1    REWD        CHECK REWIND INDICATOR 
          NZ     X1,TDM      IF NO REWIND 
          REWIND F,R
          EQ     TDM         BEGIN PROGRAM
  
 PRE6     RJ     SFN         SPACE FILL WORD
          SA6    B7 
          EQ     PRE5 
  
 PREA     VFD    36/0,6/ODFEL,18/ODFE  OPTICAL FET EXTENSION POINTER
  
*         TABLE OF ARGUMENT CONTROL WORDS 
  
 TARG     BSS    0
 CW       ARG    -DFCW,CWDS 
 I        ARG    F,F,400B 
 L        ARG    O,O,400B 
 A        ARG    -DFVA,OPWA 
 H        ARG    -DFVH,OPWH 
 O        ARG    -DFVO,OPWO 
 NR       ARG    -DFVO,REWD 
 C        ARG    -DFVA,CODD 
 R        ARG    LREC,LREC
 F        ARG    LFLC,LFLC
 N        ARG    LILM,LILM
          ARG 
  
*         TABLE OF DEFAULT VALUES.
  
 DFCW     CON    1
 DFVO     CON    OPVO 
 DFVA     CON    OPVA 
 DFVH     CON    OPVH 
  
*         TEMPORARY OPTION CONTROL WORDS. 
  
 OPWO     CON    0           OPTION O CONTROL WORD (PRESET OMITTED) 
 OPWA     CON    0           OPTION A CONTROL WORD (PRESET OMITTED) 
 OPWH     CON    0           OPTION H CONTROL WORD (PRESET OMITTED) 
 CDT      SPACE  4
**        CDT - CHECK DEVICE TYPE.
* 
*         ENTRY  (X1) = (FET+1).
* 
*         EXIT   (X7) = 0 IF CONTROL WORD READ/WRITE NOT SUPPORTED ON 
*                THIS DEVICE. 
* 
*         USES   A - 2. 
*                X - 0, 1, 2, 6, 7. 
  
  
 CDT2     LX1    12          CHECK *TT* 
          BX6    -X0*X1 
          SX7    X6-2RTT
  
 CDT      SUBR               ENTRY/EXIT 
          MX0    -12
          PL     X1,CDT2     IF ALLOCATABLE 
          LX1    12 
          SA2    CDTA        SEARCH DEVICE TABLE
          SX7    0           ASSUME NO FIND 
 CDT1     ZR     X2,CDTX     IF NOT FOUND, RETURN 
          BX6    X1-X2
          AX2    12 
          BX6    X2*X6
          SA2    A2+B1
          NZ     X6,CDT1     IF NOT MATCH 
          SX7    1           INDICATE CONTROL WORD POSSIBLE 
          JP     CDTX        RETURN 
  
 CDTA     VFD    36/,12/7703B,12/4002B
          VFD    36/,12/7703B,12/4102B
          VFD    36/,12/7777B,12/2RMT+4000B 
          VFD    36/,12/7777B,12/2RNT+4000B 
          VFD    36/,12/7777B,12/2RCT+4000B 
          VFD    36/,12/7777B,12/2RAT+4000B 
          VFD    36/,12/7777B,12/2ROD+4000B 
          CON    0
          SPACE  4
*CALL,COMCARG 
*CALL     COMCCPM 
*CALL,COMCDXB 
*CALL,COMCLFM 
*CALL,COMCSFN 
*CALL,COMCSOE 
*CALL,COMCSTF 
  
*         BUFFERS.
  
 OLWS     EQU    PRE
 BUFO     EQU    OLWS+OLWSL 
 BUFF     EQU    BUFO+BUFOL 
 RFL=     EQU    BUFF+BUFFL+4 
  
          END 
