Retro1.org codex

          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