*DECK,DMPNAD
          IDENT  DMPNAD 
          ENTRY  DMPNAD 
          TITLE  DMPNAD - DUMP NAD MEMORY.
          COMMENT DUMP NAD MEMORY.
          COMMENT COPYRIGHT (C) CONTROL DATA CORP. 1981.
*CALL COMCMAC 
 NOS      IFEQ   OS$NOS 
          LDSET  EPT=DMPNAD/SSJ=
          ENTRY  SSJ= 
 SSJ=     EQU    400000B
 NOS      ENDIF 
          SYSCOM B1 
          LCC    OVERLAY(SCP,0,0) 
          BASE   D
          SPACE  4
*****     DMPNAD - DUMP NAD MEMORY. 
* 
*         G. R. MANSFIELD.   01/28/80.
*         R. L. DELANEY      09/13/80.
*         N. A. DEILY        06/18/81.
* 
*         COPYRIGHT (C) CONTROL DATA CORPORATION, 1980, 1981. 
*         ALL RIGHTS RESERVED.
          SPACE  4
***       DMPNAD IS A CP UTILITY PROGRAM TO READ AND FORMAT A MEMORY
*         DUMP OF A NETWORK ACCESS DEVICE (NAD).  THE DUMP IS 
*         FORMATTED AS SIXTEEN SIXTEEN-BIT WORDS PER LINE, WITH 
*         EACH WORD PRINTED AS FOUR HEX DIGITS AND THE ASCII
*         TRANSLATION OF EACH PAIR OF HEX DIGITS GIVEN TO THE 
*         RIGHT OF EACH LINE.  DMPNAD IS NORMALLY CALLED WITH 
*         A CHANNEL NUMBER TO SPECIFY WHICH ON-LINE NAD IS TO 
*         BE DUMPED BY PP PROGRAM NLD.  THE DUMP CAN ALSO BE
*         SAVED AS A BINARY FILE, WHICH CAN THEN LATER BE 
*         FORMATTED FOR PRINTING BY USE OF THE DMPNAD *I* 
*         PARAMETER.
          SPACE  4,10 
***       CONTROL STATEMENT CALL. 
* 
*         DMPNAD(CH=NN,ND=NN,AC=NN,LT=NNNN,L=LFN,B=LFN,I=LFN) 
* 
*         WHERE:  
* 
*                CH = CHANNEL NUMBER OF LOCAL NAD (OCTAL) 
* 
*                ND = REMOTE NAD ADDRESS (HEX)
* 
*                AC = REMOTE NAD ACCESS CODE (HEX)
* 
*                LT = LOCAL TRUNK ENABLES (4 BINARY DIGITS, 0 OR 1).
*                     (E.G., LT=1000 FOR LOCAL TRUNK ENABLE 0,
*                            LT=0001 FOR LOCAL TRUNK ENABLE 3.) 
* 
*                L  = LISTING FILE (DEFAULT=OUTPUT) 
* 
*                B  = BINARY OUTPUT FILE (DEFAULT=NONE, ASSUMED=BINOUT) 
*                     (THE BINARY OUTPUT RECORD HAS NO PREFIX TABLE.) 
* 
*                I  = BINARY INPUT FILE (DEFAULT=NONE, ASSUMED=BININ) 
*                     (DMPNAD WILL DETECT A PREFIX (77) TABLE HEADING 
*                      THE BINARY INPUT RECORD, AND LIST DATE, TIME,
*                      AND COMMENTS.) 
* 
*         NOTES.
* 
*         IF *I* IS SPECIFIED, ONLY *L* AND *B* FILES ARE MEANINGFUL. 
* 
*         REMOTE NAD PARAMETERS (*ND* AND *AC*) ARE MEANINGFUL ONLY 
*         IF *LT* IS NON-ZERO.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
* 
*         DMPNAD  DUMPING REMOTE NAD XX - GO/DROP.  (OPERATOR MESSAGE)
* 
*         DMPNAD ABORTED - NLD ERROR CODE = NNB.
*         DMPNAD ABORTED - EQUIVALENCE MISSING. 
*         DMPNAD ABORTED - INVALID ACCESS CODE. 
*         DMPNAD ABORTED - CHANNEL NUMBER INVALID OR MISSING. 
*         DMPNAD ABORTED - NAD ADDRESS INVALID OR MISSING.
*         DMPNAD ABORTED - FILE NAME CONFLICT.
*         DMPNAD ABORTED - 8/9 NOT ALLOWED IN OCTAL FIELD.
*         DMPNAD ABORTED - BAD CHARACTER IN NUMERIC FIELD.
*         DMPNAD ABORTED - MORE THAN 7 CHARACTERS IN NAME.
*         DMPNAD ABORTED - TRUNK ENABLES INVALID OR MISSING.
*         DMPNAD ABORTED - ILLEGAL DIRECTIVE NAME.
*         DMPNAD ABORTED - CVL ERROR CODE = NNB.
*         DMPNAD ABORTED - VALIDATION DENIED, DEVICE IN USE OR NOT OFF. 
*         DMPNAD ABORTED - DEVICE NOT FOUND.
*         DMPNAD COMPLETE.
          SPACE  4
**        ASSEMBLY CONSTANTS. 
  
  
 NMBL     EQU    2001B             NAD MEMORY BUFFER LENGTH 
 LFBL     EQU    2001B             LIST FILE BUFFER LENGTH
          TITLE  DATA ASSIGNMENTS.
 DATA     SPACE  4
**        DATA ASSIGNMENTS. 
  
  
 L        FILEC  LFB,LFBL,FET=8    LIST FILE
          ORG    L
          CON    0LOUTPUT+15B 
          ORG    L+8
  
 N        FILEB  NMB,NMBL,FET=9    NLD PARAMETER BLOCK
          ORG    N
          VFD    12/0B,18/0,18/0,12/2 
          ORG    N+9
  
 I        FILEB  NMB,NMBL,FET=9    BINARY INPUT FILE
          ORG    I
          CON    0+3B              DEFAULT = NO BINARY INPUT
          ORG    I+9
*                                  (OVERLAYS *N*) 
  
 B        FILEB  BFB,NMBL,FET=8    BINARY OUTPUT FILE 
          ORG    B
          CON    0+3B              DEFAULT = NO BINARY OUTPUT 
          ORG    B+8
  
 BA       CON    LB1               BUFFER ADDRESS 
 NA       CON    0                 NAD ADDRESS
          SPACE  4
**        LIST FILE CONTROLS. 
  
  
 LN       CON    10000             LINE NUMBER
 LP       CON    60                JOB LINES PER PAGE 
 PD       CON    6                 JOB PRINT DENSITY
 PN       CON    0                 PAGE NUMBER
  
 TTL      DATA   90H1 
 DTE      BSS    1                 DATE 
 TME      BSS    1                 TIME 
 PGE      BSS    1                 PAGE 
          CON    0
  
 STL      DATA   10H               SUBTITLE (COLUMN HEADERS)
          DATA   C*   0    1    2    3    4    5    6    7    8    9
,A    B    C    D    E    F*
  
 STL1     DATA   10H               SUBTITLE (PREFIX TABLE COMMENTS) 
          BSSZ   21B
          TITLE  MAIN PROGRAM.
 DMP      SPACE  4,20 
**        DMPNAD - MAIN PROGRAM.
  
  
 DMPNAD   SB1    1                 PRESET PROGRAM 
          RJ     PRS
  
 DMP1     SA1    NA                ADVANCE NAD ADDRESS
          SX6    X1+16
          SA6    A1 
          RJ     CHD               CONVERT ADDRESS
          SA1    BA                SET BUFFER ADDRESS 
          LX6    12                ALIGN ADDRESS
          SB2    X1+B1             ADDR OF NEXT LINE BUFFER WORD
          SA6    X1                STORE NAD ADDR 
          RJ     RDL               READ DUMP LINE 
          NZ     X1,DMP4           IF END OF DATA 
          SA1    BA                CHECK LINE 
          SA2    DMPA              TOGGLE BUFFER (LB1&LB2)
          BX6    X1-X2             COMPARE BUFFERS
          SA3    X1+B1
          MX7    1
          SA4    X6+B1
          BX7    X7+X1
          SX6    X6 
          SB2    7                 COUNT OF WORDS TO COMPARE
  
 DMP2     BX2    X3-X4
          SA3    A3+B1
          SB2    B2-B1             DECR WORD COUNT
          SA4    A4+B1
          NZ     X2,DMP3
          PL     B2,DMP2           IF MORE WORDS TO COMPARE 
          NG     X1,DMP1           IF DUPLICATE LINES WRITTEN 
          SA7    A1                SET DUPLICATE LINES WRITTEN
          SB2    =C*               DUPLICATED LINES.* 
          RJ     LSL
          EQ     DMP1 
  
 DMP3     SA6    A1 
          SB2    X1 
          RJ     LSL
          EQ     DMP1              LOOP 
  
 DMP4     SA1    BA                LIST LINE
          SB2    X1 
          RJ     LSL
          WRITEC L,(=1L1) 
          WRITER L
          SA1    B
          AX1    18 
          ZR     X1,DMP8           IF NO BINARY OUTPUT FILE 
          WRITER B
  
 DMP8     SA1    I
          AX1    18 
          NZ     X1,DMP9           IF BINARY INPUT FILE 
          SA1    PRSD+CVLES 
          MX6    1
          LX6    48+1 
          BX6    X6+X1             EST ORDINAL + DATA-IN-WORD FLAG
          SA6    A1 
          SX6    10B               RELEASE-EST FUNCTION 
          SA6    PRSD+CVLFC 
          MX6    0
          SA6    PRSD+CVLRC        CLEAR REPLY WORD 
  
          CEVAL  PRSD              RELEASE NAD EST ENTRY
  
          SA2    N                 FETCH NLD RESPONSE CODE
          MX0    -6 
          LX2    -6 
          BX1    -X0*X2            MASK NLD RESPONSE CODE 
          ZR     X1,DMP9           IF NO ERROR
          RJ     =XCOD=            CONVERT BINARY TO OCTAL DPC
          SA1    DMPC              INSERT INTO ERROR MESSAGE
          MX0    -2*6 
          LX6    3*6
          LX0    3*6
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X1+X6
          SA6    A1 
          MESSAGE DMPB
          ABORT 
  
 DMP9     MESSAGE (=C* DMPNAD COMPLETE.*) 
          ENDRUN
  
 DMPA     CON    0
  
 DMPB     DATA   C* DMPNAD ABORTED - NLD ERROR CODE = XXB*
 DMPC     EQU    *-1
          TITLE  SUBROUTINES. 
 CHD      SPACE  4
**        CHD - CONVERT HEXADECIMAL DIGITS. 
* 
*         CHD CONVERTS UP TO 10 DIGITS TO DISPLAY CODE WITH LEADING 
*         ZERO SUPPRESSION.  CONVERSION CONTAINS SPACE FILL AND IS
*         RIGHT AND LEFT JUSTIFIED. 
* 
*         ENTRY  X1 = NUMBER TO BE CONVERTED. 
* 
*         EXIT   X6 = DPC CONVERSION RIGHT JUSTIFIED. 
*                X4 = DPC CONVERSION LEFT JUSTIFIED.
*                B2 = 6*COUNT OF DIGITS CONVERTED.
  
  
 CHD      SUBR                     ENTRY/EXIT 
          SA4    =1H
          MX2    -4 
          SB2    B0                CLEAR JUSTIFY COUNT
  
 CHD1     BX3    -X2*X1            EXTRACT DIGIT
          LX4    -6                SHIFT ASSEMBLY 
          SB2    B2+6 
          SB3    X3-10
          SX3    1R0+X3-1R
          NG     B3,CHD2           IF DIGIT < 10
          SX3    1RA+B3-1R
  
 CHD2     AX1    4                 SHIFT OFF DIGIT
          IX4    X4+X3             ADD DIGIT TO ASSEMBLY
          NZ     X1,CHD1           LOOP TO ZERO DIGIT 
          LX4    -6                LEFT JUSTIFY ASSEMBLY
          LX6    X4,B2             RIGHT JUSTIFY ASSEMBLY 
          EQ     CHDX              RETURN 
 LSL      SPACE  4
**        LSL - LIST LINE.
* 
*         ENTRY  B2 = ADDRESS OF LINE IN C-FORMAT.
  
  
 LSL1     SX6    X1+B1
          SA6    A1 
          BX1    X6                CONVERT PAGE NUMBER
          RJ     =XCDD= 
          SA1    LSLB 
          BX6    X1-X6
          SA6    PGE
          WRITEC L,TTL             LIST TITLE 
          WRITEC L,STL1            LIST SUBTITLE (COMMENTS) 
          WRITEC L,(=C* *)
          WRITEC L,STL             LIST COLUMN HEADERS
          WRITEC L,(=C* *)
          SA1    LSLA              RESTORE ADDRESS OF LINE
          SB2    X1 
  
 LSL2     WRITEC L,B2 
  
 LSL      SUBR                     ENTRY/EXIT 
          SA1    LN                ADVANCE LINE NUMBER
          SA2    LP 
          SX6    X1+B1
          SA6    A1 
          IX1    X6-X2
          NG     X1,LSL2           IF NO PAGE OVERFLOW
          SA1    PN                ADVANCE PAGE NUMBER
          SX6    6                 RESET LINE COUNT 
          SX7    B2                SAVE ADDRESS OF LINE 
          SA6    A6 
          SA7    LSLA 
          NZ     X1,LSL1           IF NOT FIRST PAGE
          SA1    PD                JOB PRINT DENSITY
          SB2    X1-8 
          NZ     B2,LSL0           IF NOT 8 LINES/INCH
          WRITEC L,(=1LT  8LPI) 
          SA1    PN 
          EQ     LSL1 
  
 LSL0     WRITEC L,(=1LS  6LPI) 
          SA1    PN 
          EQ     LSL1 
  
 LSLA     BSS    1
 LSLB     CON    5L PAGE&5L 
 RDL      SPACE  4
**        RDL - READ DUMP LINE. 
* 
*         ENTRY  B2 = (BA)+1 = ADDR OF NEXT LINE BUFFER WORD. 
* 
*         EXIT   X1 = EOR STATUS. 
  
  
 RDL10    SA2    RDLB              ADD CHARACTER TRANSLATION
          SA6    RDLA+1            SAVE INPUT STATUS
          SX6    B4 
          SA6    A6-B1
  
*         MOVE CHARACTER TRANSLATION TO LINE BUFFER 
  
          SX6    2R 
          SA3    A2+B1             GET 2D CONVERSION WORD 
          LX6    48 
          LX3    12                ALIGN 2D WORD
          BX6    X6+X2             ADD BLANKS TO 1ST WORD 
          MX4    -12               MASK 
          SA6    B2                STORE 1ST WORD IN LINE 
          SA2    A3+B1             GET 3D CONVERSION WORD 
          LX2    24                ALIGN 3D WORD
          BX7    -X4*X2            SAVE LOWER 2 CHAR - 3D WORD
          BX7    X7+X3             MERGE WITH UPPER 8 - 2D WORD 
          SA7    A6+B1             STORE 2D WORD IN LINE
          MX4    -24               MASK 
          SA3    A2+B1             GET 4TH CONVERSION WORD
          BX2    X4*X2             SAVE UPPER 6 CHAR
          LX3    36                ALIGN 4TH WORD 
          BX6    -X4*X3            SAVE LOWER 4 CHAR
          BX6    X6+X2             MERGE WITH 3D WORD 
          SA6    A7+B1             STORE 3D WORD IN LINE
          BX7    X4*X3             SAVE UPPER 4 CHAR
          SA7    A6+B1             STORE 4TH WORD IN LINE 
          NZ     X1,RDLX           IF EOR 
          SA1    RDLD              END OF DATA FLAG 
  
 RDL      SUBR                     ENTRY/EXIT 
          SA1    RDLA              SET INPUT WORD STATUS
          MX2    -4 
          MX3    -7 
          SB5    16 
          SA4    A1+B1
          SB4    X1 
          BX5    X5-X5
          BX6    X4 
          SB6    B1+B1
          SB7    RDLB 
          SB3    54                SET ASSEMBLY POSITION
          MX0    0                 CLEAR ASSEMBLY WORD
  
 RDL1     ZR     B4,RDL8           IF END OF INPUT WORD 
          SB4    B4-B1
  
 RDL2     PL     X6,RDL2.1         IF NOT END-OF-DATA 
          SA6    RDLD              SET END-OF-DATA FLAG 
          MX7    12 
          BX6    X7*X6             CLEAR REMAINDER OF WORD
          MX7    0
          SA7    B7+B1             CLEAR NEXT CHARACTER WORD
  
 RDL2.1   LX6    8                 ALIGN NEXT 4 BITS
          BX1    -X2*X6 
          SB6    B6-B1
          LX6    4                 NEXT 4 BITS
          SX7    X1-10             CONVERT HEX DIGIT
          SX4    1R0+X1 
          NG     X7,RDL3
          SX4    1RA+X7 
  
 RDL3     BX1    -X2*X6 
          LX4    X4,B3
          SB3    B3-6 
          SX7    X1-10
          SX1    1R0+X1 
          NG     X7,RDL4
          SX1    1RA+X7 
  
 RDL4     BX0    X0+X4
          BX4    -X3*X6            CONVERT CHARACTER
          SA4    ADT+X4 
          LX1    X1,B3
          LX5    6
          BX0    X0+X1
          BX5    X5+X4
          SB3    B3-6 
          NZ     B6,RDL1           LOOP FOR 4 HEX DIGITS
          SX1    1R                ADD SPACE
          LX1    X1,B3
          BX0    X0+X1
          SB3    B3-6 
          SB5    B5-B1
          SB6    B1+B1
          PL     B3,RDL6           IF OUTPUT WORD NOT FULL
          SB3    54 
          BX7    X0 
          MX0    0
          SA7    B2 
          SB2    B2+B1
  
 RDL6     SX7    B5                CHECK WORD 
          MX1    -2 
          BX1    -X1*X7 
          NZ     X1,RDL7           IF NOT 4TH WORD
          BX7    X5                STORE CONVERSION 
          SA7    B7 
          MX5    0
          SB7    B7+B1
  
 RDL7     NZ     B5,RDL1           LOOP FOR 8 WORDS 
          EQ     RDL10
  
*         READ NEXT WORD. 
  
  
 RDL8     READO  N
          NZ     X1,RDL9.0         IF END OF RECORD 
          SA2    B
          AX2    18 
          ZR     X2,RDL9           IF NOT WRITING BINARY OUTPUT 
          SA6    RDLC              SAVE DATA WORD READ
          WRITEO B                 WRITE WORD READ
          SA2    RDLC 
          MX1    0                 SIGNAL NO EOR ENCOUNTERED
          BX6    X2                RESTORE DATA WORD
  
 RDL9     SA2    RDLD 
          NG     X2,RDL8           IF END OF DATA 
          MX2    -4 
          SB4    4
          MX3    -7 
          ZR     X1,RDL2           IF NOT EOR 
  
*         STORE ASSEMBLED WORD
  
 RDL9.0   BX7    X0                CURRENT WORD 
          SX2    1R*
          MX3    -6                MASK 
 RDL9.1   BX0    -X3*X7 
          NZ     X0,RDL9.2         IF CURRENT WORD FULL 
          LX3    6
          BX7    X7+X2             ADD *
          LX2    6
          EQ     RDL9.1 
  
 RDL9.2   SA4    BA                X4 = FWA OF LINE 
          SB5    X4+9              B5 = FWA OF TRANSLATION
          SA7    B2                STORE CURRENT WORD IN LINE 
          SA4    =10H**** ****
          BX7    X4 
 RDL9.3   GE     B2,B5,RDL9.4      IF LAST WORD FILLED
          SB2    B2+B1
          SA7    B2                FILL REMAINING WORDS 
          SA4    =10H 
          EQ     RDL9.3 
  
*         ADJUST CONVERSION WORDS (RDLB - RDLB+3) 
  
 RDL9.4   MX2    12 
          BX7    X5                CURRENT CONVERSION WORD
          ZR     X5,RDL9.6         IF NO CHARACTERS 
 RDL9.5   LX7    6                 POSITION 1ST CHARACTER 
          BX5    X2*X7
          ZR     X5,RDL9.5         IF NOT DONE
 RDL9.6   LX7    54                (12/0, 42/CHARACTERS)
          SB6    RDLB+4 
          SA7    B7                STORE LAST CONVERSION WORD 
          SB7    B7+B1
          MX7    0
          LT     B7,B6,RDL9.6      CLEAR REMAINING CONVERSION 
          EQ     RDL10             RETURN 
  
 RDLA     CON    0,0
 RDLB     BSSZ   4                 CONVERSION WORDS 
  
 RDLC     CON    0
 RDLD     CON    0                 END OF DATA FLAG 
          SPACE  4,10 
**        COMMON DECKS. 
  
 NOS      IFEQ   OS$NOS 
          XTEXT  COMCCVL
 NOS      ENDIF 
 ADT      SPACE  4
**        ADT - ASCII TO DISPLAY CODE TRANSLATION TABLE.
  
  
 ADT      BSS    0
          LOC    0
  
          CON    1R                NULL 
          CON    1R                START OF HEADING 
          CON    1R                START OF TEXT
          CON    1R                END OF TEXT
          CON    1R                END OF TRANSMISSION
          CON    1R                ENQUIRY
          CON    1R                ACKNOWLEDGE
          CON    1R                BELL 
          CON    1R                BACKSPACE
          CON    1R                HORIZONTAL TAB 
          CON    1R                LINE FEED
          CON    1R                VERTICAL TAB 
          CON    1R                FORM FEED
          CON    1R                CARRIAGE RETURN
          CON    1R                SHIFT OUT
          CON    1R                SHIFT IN 
  
          CON    1R                DATA LINK ESCAPE 
          CON    1R                DEVICE CONTROL 1 
          CON    1R                DEVICE CONTROL 2 
          CON    1R                DEVICE CONTROL 3 
          CON    1R                DEVICE CONTROL 4 
          CON    1R                NEGATIVE ACKNOWLEDGE 
          CON    1R                SYNCHRONOUS IDLE 
          CON    1R                END OF TRANSMISSION BLOCK
          CON    1R                CANCEL 
          CON    1R                END OF MEDIUM
          CON    1R                SUBSTITUTE 
          CON    1R                ESCAPE 
          CON    1R                FILE SEPARATOR 
          CON    1R                GROUP SEPARATOR
          CON    1R                RECORD SEPARATOR 
          CON    1R                UNIT SEPARATOR 
  
          CON    1R                SPACE
          CON    1R!               EXCLAMATION
          CON    1R"               DIARESIS 
          CON    1R#               NUMBER 
          CON    1R$               $
          CON    1R%               PERCENT
          CON    1R&               AMPERSAND
          CON    1R'               QUOTE
          CON    1R(               (
          CON    1R)               )
          CON    1R*               *
          CON    1R+               +
          CON    1R,               ,
          CON    1R-               -
          CON    1R.               .
          CON    1R/               /
  
          CON    1R0               0
          CON    1R1               1
          CON    1R2               2
          CON    1R3               3
          CON    1R4               4
          CON    1R5               5
          CON    1R6               6
          CON    1R7               7
          CON    1R8               8
          CON    1R9               9
          CON    1R:               COLON
          CON    1R;               ;
          CON    1R<               <
          CON    1R=               =
          CON    1R>               >
          CON    1R?               QUESTION MARK
  
          CON    1R@               COMMERCIAL AT
          CON    1RA               A
          CON    1RB               B
          CON    1RC               C
          CON    1RD               D
          CON    1RE               E
          CON    1RF               F
          CON    1RG               G
          CON    1RH               H
          CON    1RI               I
          CON    1RJ               J
          CON    1RK               K
          CON    1RL               L
          CON    1RM               M
          CON    1RN               N
          CON    1RO               O
  
          CON    1RP               P
          CON    1RQ               Q
          CON    1RR               R
          CON    1RS               S
          CON    1RT               T
          CON    1RU               U
          CON    1RV               V
          CON    1RW               W
          CON    1RX               X
          CON    1RY               Y
          CON    1RZ               Z
          CON    1R[               [
          CON    1R\               REVERSE SLANT
          CON    1R]               ]
          CON    1R^               CIRCUMFLEX 
          CON    65B               UNDERLINE (COMPASS CONCAT MARK)
  
          CON    1R                GRAVE ACCENT 
          CON    1RA               A    LC
          CON    1RB               B    LC
          CON    1RC               C    LC
          CON    1RD               D    LC
          CON    1RE               E    LC
          CON    1RF               F    LC
          CON    1RG               G    LC
          CON    1RH               H    LC
          CON    1RI               I    LC
          CON    1RJ               J    LC
          CON    1RK               K    LC
          CON    1RL               L    LC
          CON    1RM               M    LC
          CON    1RN               N    LC
          CON    1RO               O    LC
  
          CON    1RP               P    LC
          CON    1RQ               Q    LC
          CON    1RR               R    LC
          CON    1RS               S    LC
          CON    1RT               T    LC
          CON    1RU               U    LC
          CON    1RV               V    LC
          CON    1RW               W    LC
          CON    1RX               X    LC
          CON    1RY               Y    LC
          CON    1RZ               Z    LC
          CON    1R                LEFT BRACE 
          CON    1R                VERTICAL LINE
          CON    1R                RIGHT BRACE
          CON    1R                TILDE
          CON    1R                DELETE 
  
          LOC    *O 
          SPACE  4
**        BUFFERS.
  
  
          USE    // 
  
          BSS    1
 ISB      BSS    0                 INPUT STRING BUFFER FOR CONTROL STATE
 LB1      BSS    15                LINE BUFFER 1
 LB2      BSS    15                LINE BUFFER 2
 LFB      BSS    LFBL              LIST FILE BUFFER 
 BFB      BSS    NMBL              BINARY OUTPUT FILE BUFFER
          BSS    1
 NMB      BSS    NMBL              MEMORY BUFFER
 RFL=     EQU    *+100B 
  
          USE    *
 PRS      SPACE  4
**        PRS - PRESET PROGRAM. 
  
  
 PRS      SUBR                     ENTRY/EXIT 
          MEMORY CM,PRSC,RCL,RFL= 
          MOVE   PRSB,PRSA,RA.ARG  COPY FILE ACCESS LIST
          SA1    RA.CCD            UNPACK CONTROL STATEMENT 
          SB2    ISB
          RJ     UCS
          RJ     ARG               PROCESS ARGUMENTS
          DATE   DTE
          CLOCK  TME
          MX6    0
          SA6    PRSC              CLEAR GETPAGE REPLY WORD 
          GETPAGE PRSC             RETURN PAGE SIZE PARAMETERS
          SA1    PRSC 
          MX0    -8 
          LX1    0-20 
          BX6    -X0*X1            JOB PAGE LENGTH
          SA6    LP                LINES PER PAGE 
          LX1    -8 
          MX0    -4 
          BX6    -X0*X1            JOB PRINT DENSITY
          SA6    PD                LINES PER INCH 
          SX1    LB1
          SX2    LB2
          BX6    X1-X2             FORM EXCLUSIVE-OR OF BUFFERS 
          SA6    DMPA              (LOADER CANNOT HANDLE AT LOAD TIME)
          SB6    7
  
 PRS1     SA1    RA.CCD+B6         FETCH NEXT WORD OF CC IMAGE
          RJ     =XSFN=            SPACE-FILL NAME
          SA6    TTL+1+B6          STORE IN TITLE 
          SB6    B6-B1
          PL     B6,PRS1           IF MORE WORDS TO MOVE
          SA1    B
          AX1    18 
          ZR     X1,PRS2           IF NO BINARY OUTPUT FILE 
          OPEN   B,WRITENR,RCL
  
 PRS2     SA1    I
          AX1    18 
          ZR     X1,PRS3           IF NOT READING FILE
          MOVE   9,I,N             MOVE INPUT FET TO NLD FET
          OPEN   N,READNR,RCL 
          READ   N,RCL             PRIME BUFFER 
          SA1    NMB               FETCH FIRST WORD OF BUFFER 
          MX0    -12
          BX6    X1 
          LX6    12 
          BX2    -X0*X6 
          SX2    X2-7700B 
          NZ     X2,PRS9           IF NO PREFIX (77) TABLE
          LX6    12 
          BX6    -X0*X6 
          ZR     X6,PRS9           IF ZERO-LENGTH TABLE 
          SX2    X6-21B 
          PL     X2,PRS9           IF PREFIX TABLE TOO LONG 
          SA2    N+3               FETCH FET *OUT* POINTER
          IX6    X2+X6             SKIP OVER PREFIX TABLE 
          SX6    X6+B1             INCLUDE 77 TABLE HEADER
          SA6    A2 
          SA1    NMB+1             GET RECORD NAME FROM PREFIX TABLE
          RJ     =XSFN=            SPACE-FILL NAME
          SA6    STL1+1            (A6) = ADDR-1 TO STORE COMMENTS
          SA1    NMB               PREFIX TABLE 
          RJ     =XCPT=            EXTRACT COMMENTS FROM PREFIX TABLE 
          SA1    NMB+2             GET DATE FROM PREFIX TABLE 
          RJ     =XSFN=            SPACE-FILL NAME
          SA6    DTE               STORE IN TITLE 
          SA1    NMB+3             GET TIME FROM PREFIX TABLE 
          RJ     =XSFN=            SPACE-FILL NAME
          SA6    TME               STORE IN TITLE 
          SA1    STL1+12           ENSURE COMMENT LINE .LE. 136 CHARS 
          MX6    -24
          BX6    X6*X1
          SA6    A1 
          EQ     PRS9 
  
 PRS3     SA1    N                 NLD PARAMETER BLOCK
          SA2    PRSD+CVLCH        CVL PARAMETER BLOCK
          MX0    -12
          LX1    12                POSITION CHANNEL NUMBER
          BX2    X0*X2
          BX1    -X0*X1 
          BX6    X1+X2             ADD CHANNEL TO CVL BLOCK 
          SA6    A2 
          RJ     SCVLPB            SET CVL PARAMETER BLOCK
          CEVAL  PRSD              CALL CVL TO VALIDATE ACCESS TO NAD 
          SA1    PRSD+CVLRC        GET CVL RETURN CODE
          MX0    -6 
          LX1    -6 
          BX1    -X0*X1 
          ZR     X1,PRS7           IF NO ERROR
          SX6    X1-4 
          SB6    =C* DMPNAD ABORTED - DEVICE NOT FOUND.*
          ZR     X6,PRS4           IF RC = 4
          SX6    X1-6 
          SB6    =C* DMPNAD ABORTED - VALIDATION DENIED, DEVICE IN USE O
,R NOT OFF.*
          ZR     X6,PRS4           IF RC = 6
          SX6    X1-34B            CHECK SITUATION INDETERMINATE
          ZR     X6,PRS5           IF DUMPING REMOTE NAD
          RJ     =XCOD=            CONVERT BINARY TO OCTAL DPC
          SA1    PRSF              INSERT INTO ERROR MESSAGE
          MX0    -2*6 
          LX1    -3*6              POSITION MESSAGE WORD
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X1+X6
          LX6    3*6               RESTORE MESSAGE WORD 
          SA6    A1 
          SB6    PRSE              FWA OF ERROR MESSAGE 
  
 PRS4     MESSAGE B6               ISSUE ERROR MESSAGE
          ABORT 
  
 PRS5     MESSAGE PRSG,2,RCL       DISPLAY OPERATOR MESSAGE 
          SA1    B0                SET THE PAUSE FLAG 
          SX6    10000B 
          BX6    X6+X1
          SA6    A1 
 PRS6     RECALL                   WAIT FOR OPERATOR RESPONSE 
          SA1    B0 
          LX1    59-12
          NG     X1,PRS6           IF NO RESPONSE 
  
 PRS7     SYSTEM NLD,,N,2*100B     REQUEST DUMP 
  
 PRS9     EQ     PRSX              RETURN 
  
 PRSA     BSS    0                 FILE ACCESS LIST 
          CON    0LOUTPUT+L 
          CON    0LBININ+I
          CON    0LBINOUT+B 
          CON    0
 PRSB     EQU    *-PRSA 
  
 PRSC     CON    0
          CON    0
  
 PRSD     BSS    0                 CVL PARAMETER BLOCK
          LOC    0
 CVLRC    CON    0                 RETURN CODE
 CVLES    CON    0                 EST ORDINAL
 CVLCH    CON    1S48              CHANNEL
 CVLEQ    CON    1S52+1S48+300B*10000B  DEDICATED ACCESS
 CVLUN    CON    0                 UNIT 
 CVLDC    CON    1S48+300B         NAD DEVICE CODE
 CVLFC    CON    201B              LOAD MEMORY
 CVLAC    CON    0                 REMOTE NAD ACCESS CODE 
 CVLLT    CON    0                 REMOTE NAD LOCAL TRUNK ENABLES 
 CVLND    CON    0                 REMOTE NAD ADDRESS 
          LOC    *O 
  
*         REPLACEMENT CVL PARAMETER WORDS FOR REMOTE NAD VALIDATION.
  
 CVLEQR   CON    1S48+300B*10000B  SHARED ACCESS TO LOCAL NAD 
 CVLFCR   CON    0                 REMOTE NAD FUNCTION
 CVLDCR   CON    1S48+301B         REMOTE NAD DEVICE CODE 
 CVLACR   CON    1S48              REMOTE NAD ACCESS CODE 
 CVLLTR   CON    1S48+20B          LOCAL TRUNK ENABLES
 CVLNDR   CON    1S52+1S48+301B*10000B  REMOTE NAD ADDRESS
  
  
 PRSE     DATA   C* DMPNAD ABORTED - CVL ERROR CODE = XXB.* 
 PRSF     EQU    PRSE+3            MESSAGE WORD WITH ERROR CODE 
 NOS      IFEQ   OS$NOS 
 PRSG     DIS    ,*$ DUMP REMOTE NAD XX - GO/DROP*
 PRSH     EQU    PRSG+1 
 NOS      ELSE
 PRSG     DIS    ,*$DMPNAD  DUMPING REMOTE NAD XX - GO/DROP*
 PRSH     EQU    PRSG+2            POSITION OF NAD ADDRESS
 NOS      ENDIF 
  
*         USED BY ARG.
* 
*         NAD PARAMETER FLAGS - BIT 59 = 0, CH= SPECIFIED 
*                               BIT 58 = 0, LT= SPECIFIED 
*                               BIT 57 = 0, ND= SPECIFIED 
  
 NPF      VFD    3/7,57/0          NAD PARAMETER FLAGS
  
*         USED BY TCS.
  
 EC       CON    0                 ERROR COUNTER
 EM       CON    0                 ERROR MESSAGE
 EP       CON    0                 ERROR POINTER
 CST      SPACE  4
**        CONTROL STATMENT TABLE
  
  
 CST      BSS    0
          CON    0LL               L = LIST FILE
          VFD    6/,18/L,18/=0LOUTPUT,18/AFN
          CON    0LCH              CH = CHANNEL NUMBER
          CON    ACH
          CON    0LND              ND = NAD ADDRESS 
          CON    AND
          CON    0LAC              AC = NAD ACCESS CODE 
          CON    AAC
          CON    0LLT              LT = NAD TRUNK ENABLES 
          CON    ATE
          CON    0LI               I  = BINARY INPUT FILE 
          VFD    6/,18/I,18/=0LBININ,18/AFN 
          CON    0LB               B  = BINARY OUTPUT FILE
          VFD    6/,18/B,18/=0LBINOUT,18/AFN
          CON    0
 ABT      SPACE  4
**        ABT - ABORT JOB.
* 
*         ENTRY  X7 = MESSAGE ADDRESS.
  
  
 ABT      MESSAGE X7
          ABORT 
 AAC      SPACE  4,10 
**        AAC - ASSEMBLE NAD ACCESS CODE. 
  
  
 AAC      SB2    X5-1R=            CHECK SEPERATOR
          SX7    =C* DMPNAD ABORTED - EQUIVALENCE MISSING.* 
          NZ     B2,ERM            IF NOT *=* 
          SA5    A5+B1             ASSEMBLE ADDRESS 
          RJ     AHD
          MX1    -16
          BX1    X1*X6
          SX7    =C* DMPNAD ABORTED - INVALID ACCESS CODE.* 
          NZ     X1,ERM            IF INVALID ACCESS CODE 
          SA1    N+5               SAVE NAD ACCESS CODE (BITS 31-16)
          LX6    16 
          BX6    X1+X6
          SA6    A1 
          EQ     TCSX              RETURN 
 ACH      SPACE  4
**        ACH - ASSEMBLE CHANNEL. 
  
  
 ACH      SB2    X5-1R=            CHECK SEPARATOR
          SX7    =C* DMPNAD ABORTED - EQUIVALENCE MISSING.* 
          NZ     B2,ERM            IF NOT *=* 
          SA5    A5+B1             ASSEMBLE CHANNEL 
          RJ     ASD
          SB2    X6-34B            CHECK CHANNEL
          SB3    X6-20B 
          SX7   =C* DMPNAD ABORTED - CHANNEL NUMBER INVALID OR MISSING.*
          NZ     B5,ERM            IF NOT OCTAL NUMBER
          PL     B2,ERM 
          PL     B3,ACH1
          SB2    X6-14B 
          PL     B2,ERM 
  
 ACH1     SA1    N                 SET CHANNEL IN REQUEST 
          MX7    -6 
          LX1    -48
          BX1    X7*X1
          BX6    X1+X6
          LX6    48 
          SA6    A1 
          MX6    1                 CLEAR CH= FLAG (BIT 59)
          SA1    NPF
          BX6    -X6*X1 
          SA6    A1 
          EQ     TCSX              RETURN 
 AFN      SPACE  4
**        AFN - ASSEMBLE FILE NAME. 
* 
*         ENTRY  X2 = TRANSLATION TABLE ENTRY.
*                A5, X5 = NEXT CHARACTER. 
  
  
 AFN      SB2    X5-1R=            CHECK SEPARATOR
          AX2    18                GET ASSUMED FILE NAME
          SA1    X2 
          AX2    18                SET FET ADDRESS
          MX6    42 
          SB3    X2 
          BX6    X6*X1
          NZ     B2,AFN1           IF NOT *=* 
          SA5    A5+B1             SKIP SEPARATOR 
          BX0    X2 
          RJ     ASN               ASSEMBLE NAME
          SX7    1R0               CHECK NAME 
          LX7    54 
          BX2    X0 
          BX7    X7-X6
          ZR     X7,AFN2           IF *0* 
  
 AFN1     SA1    X2                REPLACE FILE NAME
          MX7    42 
          BX1    -X7*X1 
          BX7    X1+X6
          NZ     X1,AFN2           IF STATUS IS SET 
          SX1    B1 
          BX7    X1+X6
  
 AFN2     SA7    X2 
          EQ     TCSX              RETURN 
 AHD      SPACE  4
**        AHD - ASSEMBLE HEX DIGITS.
* 
*         ENTRY  A5, X5 = CHARACTER.
* 
*         EXIT   X6 = ASSEMBLY. 
  
  
 AHD1     GT     B3,AHDX           IF BEYOND DIGIT
          LX6    4                 MERGE NEW DIGIT
          SA5    A5+B1             NEXT CHARACTER 
  
 AHD2     BX6    X6+X1
          SX1    X5-1R0 
          SB2    X5 
          SB3    X5-1R9 
          PL     X1,AHD1           IF NOT LETTER
          SX1    X5-1RA+10
          SB3    X5-1RF 
          GE     B2,B1,AHD1        IF NOT 00
  
 AHD      SUBR                     ENTRY/EXIT 
          SX7    A5                SET ERROR POINTER
          SX6    B0                CLEAR ASSEMBLY 
          SA7    EP 
          BX1    X1-X1
          EQ     AHD2 
 AND      SPACE  4,10 
**        AND - ASSEMBLE NAD ADDRESS. 
  
  
 AND      SB2    X5-1R=            CHECK SEPARATOR
          SX7    =C* DMPNAD ABORTED - EQUIVALENCE MISSING.* 
          NZ     B2,ERM            IF NOT *=* 
          SA5    A5+B1             ASSEMBLE ADDRESS 
          RJ     AHD
          MX1    -8 
          BX1    X1*X6
          SX7    =C* DMPNAD ABORTED - NAD ADDRESS INVALID OR MISSING.*
          ZR     X6,ERM            IF INVALID NAD ADDRESS 
          NZ     X1,ERM            IF INVALID NAD ADDRESS 
          SA1    N+5               SAVE NAD ADDRESS (BITS 15-8) 
          LX6    8
          BX6    X1+X6
          SA6    A1 
          LX6    -8                SET NAD ADDR IN MESSAGE
          MX1    -8 
          BX1    -X1*X6 
          RJ     CHD               CONVERT TO HEX 
          SA1    PRSH              MESSAGE WORD 
          MX2    -12
          BX6    -X2*X6 
          BX2    X2*X1
          IX6    X6+X2
          SA6    A1 
          MX6    2                 CLEAR ND= FLAG (BIT 57)
          SA1    NPF
          BX6    X6*X1
          SA6    A1 
          EQ     TCSX              RETURN 
 ARG      SPACE  4
**        ARG - PROCESS ARGUMENTS.
  
  
 ARG      SUBR                     ENTRY/EXIT 
          SA5    ISB               FIRST CHARACTER
          RJ     ASN               ASSEMBLE NAME
  
 ARG1     SB2    X5-1R) 
          SB3    X5-1R. 
          ZR     B2,ARG2           IF END OF STATEMENT
          ZR     B3,ARG2
          SA5    A5+B1             SKIP SEPARATOR 
          SX0    CST               TRANSLATE CONTROL STATEMENT
          RJ     TCS
          SA1    EM 
          ZR     X1,ARG1           LOOP IF NO ERROR MESSAGE 
          BX7    X1 
          EQ     ABT
  
 ARG2     SA1    I                 CHECK FOR INPUT FILE 
          AX1    18 
          MX3    2
          NZ     X1,ARG2.1         IF READING FILE (NOT DUMPING NAD)
  
          SA1    NPF               CHECK NAD PARAMETER FLAGS
          SX7   =C* DMPNAD ABORTED - CHANNEL NUMBER INVALID OR MISSING.*
          NG     X1,ABT            IF CHANNEL NOT SPECIFIED 
          LX1    1
          ZR     X1,ARG2.1         IF NEITHER LT= NOR ND= SPECIFIED 
          BX3    X1-X3
          SX7    =C* DMPNAD ABORTED - TRUNK ENABLES INVALID OR MISSING.*
          ZR     X3,ARG2.1         IF BOTH LT AND ND SPECIFIED
          NG     X1,ABT            IF LT UNSPECIFIED
          SX7    =C* DMPNAD ABORTED - NAD ADDRESS INVALID OR MISSING.*
          EQ     ABT               ABORT JOB
  
 ARG2.1   SA1    RA.ARG-1          CHECK FILE NAMES 
          MX7    42 
  
 ARG3     SA1    A1+B1             NEXT FILE ADDRESS
          SA3    X1 
          ZR     X1,ARGX           RETURN IF END OF LIST
          AX3    18 
          ZR     X3,ARG3           IF FILE NOT USED 
          SA2    A1+B1
  
 ARG4     SA4    X2 
          ZR     X2,ARG3           IF END OF LIST 
          BX6    X4-X3             COMPARE NAMES
          SA2    A2+B1
          BX6    X7*X6
          NZ     X6,ARG4           LOOP IF NO MATCH 
          SX7    =C* DMPNAD ABORTED - FILE NAME CONFLICT.*
          EQ     ABT
 ASD      SPACE  4
**        ASD - ASSEMBLE DIGITS.
* 
*         ENTRY  A5, X5 = CHARACTER.
*                B2 = ASSUMED BASE. 
*                     0 = OCTAL.
*                     NONZERO = DECIMAL.
* 
*         EXIT   X6 = ASSEMBLY. 
*                A5, X5 ADVANCED. 
  
  
 ASD1     LX3    X7,B4             DECIMAL*10 
          SX5    X5+B3             CONVERT CHARACTER
          IX7    X3+X7
          LX6    3                 OCTAL*8
          LX7    1
          BX6    X6+X5             OCTAL+NEW DIGIT
          IX7    X7+X5             DECIMAL+NEW DIGIT
          AX5    3                 NOTE *8*/*9* 
          SB5    B5+X5
          SA5    A5+B1             NEXT CHARACTER 
          SB6    X5                CHECK CHARACTER
          LX3    X1,B6
          NG     X3,ASD1           LOOP IF DIGIT
          SX1    X5-1RD            CHECK NEXT CHARACTER 
          SX2    X5-1RB 
          NZ     X1,ASD2           IF NOT *D* 
          SA5    A5+B1             SKIP CHARACTER 
          BX6    X7                RETURN DECIMAL 
          EQ     ASDX 
  
 ASD2     NZ     X2,ASD3           IF NOT *B* 
          SA5    A5+B1             SKIP CHARACTER 
          ZR     B5,ASDX           IF *8*/*9* NOT PRESENT 
          SX7    =C* DMPNAD ABORTED - 8/9 NOT ALLOWED IN OCTAL FIELD.*
          EQ     ERM
  
 ASD3     SB2    B2+B5             SET BASE 
          ZR     B2,ASDX           IF OCTAL 
          BX6    X7                RETURN DECIMAL 
  
 ASD      SUBR                     ENTRY/EXIT 
          MX1    10                MASK FOR *0* - *9* 
          SB3    -1R0 
          SB4    B1+B1
          LX1    -1R0 
          SX6    A5                SET ERROR POINTER
          SB5    B0                CLEAR *8*/*9* PRESENCE 
          SB6    X5                CHECK CHARACTER
          MX7    0                 CLEAR DECIMAL ASSEMBLY 
          SA6    EP 
          BX6    X6-X6             CLEAR OCTAL ASSEMBLY 
          LX3    X1,B6
          NG     X3,ASD1           IF DIGIT 
  
          SX7    =C* DMPNAD ABORTED - BAD CHARACTER IN NUMERIC FIELD.*
          EQ     ERM
 ASN      SPACE  4
**        ASN - ASSEMBLE NAME.
* 
*         ENTRY  A5, X5 = CHARACTER.
* 
*         EXIT   X6 = ASSEMBLY. 
*                A5, X5 ADVANCED. 
  
  
 ASN1     LX5    X5,B2             MERGE
          SB4    B2-18
          BX6    X6+X5
          NG     B4,ERM            IF MORE THAN 7 CHARACTERS
          SA5    A5+B1             NEXT CHARACTER 
          SB2    B2-6 
          SB4    X5 
  
 ASN2     AX2    X1,B4
          LX2    59 
          NG     X2,ASN1           LOOP IF LETTER OR DIGIT
  
 ASN      SUBR                     ENTRY/EXIT 
          MX1    36                MASK FOR LETTERS AND DIGITS
          SB2    54 
          BX6    X6-X6             CLEAR ASSEMBLY 
          SX7    A5                SET ERROR POINTER
          LX1    37 
          SB4    X5 
          SA7    EP 
          SX7    =C* DMPNAD ABORTED - MORE THAN 7 CHARACTERS IN NAME.*
          EQ     ASN2 
 ATE      SPACE  4,10 
**        ATE - ASSEMBLE TRUNK ENABLES. 
  
  
 ATE      SB2    X5-1R=            CHECK SEPARATOR
          SX7    =C* DMPNAD ABORTED - EQUIVALENCE MISSING.* 
          NZ     B2,ERM            IF NOT *=* 
          SA5    A5+B1             ASSEMBLE TRUNK ENABLES 
          RJ     ASD
          SX1    -1111B            CHECK NUMBER 
          MX2    4                 CONVERSION MASK
          BX1    X1*X6
          SX7    =C* DMPNAD ABORTED - TRUNK ENABLES INVALID OR MISSING.*
          NZ     X1,ERM            IF INVALID ENABLES 
          ZR     X6,ERM            IF INVALID ENABLES 
          LX2    1                 POSITION MASK
          BX1    X2*X6             COLLECT 1ST DIGIT
 ATE1     LX2    1                 POSITION MASK
          AX6    2                 POSITION NEXT DIGIT
          BX1    X1+X6             COLLECT NEXT DIGIT 
          BX6    -X2*X6            CLEAR DIGIT
          NG     X2,ATE1           IF NOT DONE
          BX6    X2*X1             MASK 4 DIGITS
          SA1    N+5               SAVE LOCAL TRUNK ENABLES (BITS 3-0)
          BX6    X1+X6
          SA6    A1 
          MX6    1                 CLEAR LT= FLAG (BIT 58)
          SA1    NPF
          LX6    -1 
          BX6    -X6*X1 
          SA6    A1 
          EQ     TCSX              RETURN 
 SCVLPB   SPACE  4,10 
**        SCVLPB - SET CVL PARAMETER BLOCK. 
* 
*         ENTRY  N+5 = REMOTE NAD PARAMETERS. 
* 
*         EXIT   PRSD (CVL PARAMETER BLOCK) RESET IF REMOTE NAD DUMP. 
* 
*         USES   A1/X1, A2/X2, A6/X6. 
  
  
 SCVLPB   SUBR
          SA1    N+5               FETCH REMOTE NAD PARAMETERS
          MX6    -4                MASK FOR LT
          BX6    -X6*X1 
          ZR     X6,SCVLPB         IF NOT REMOTE NAD DUMP 
  
          SA2    CVLLTR 
          IX6    X6+X2
          SA6    PRSD+CVLLT        RESET LT WORD
  
          SA2    A2+B1             (CVLNDR) 
          LX1    -8                POSITION ND
          MX6    -8                MASK FOR ND
          BX6    -X6*X1 
          IX6    X6+X2
          SA6    A6+B1             RESET ND WORD
  
          SA2    CVLEQR 
          BX6    X2 
          SA6    PRSD+CVLEQ        RESET EQ WORD
  
          SA2    A2+B1             (CVLFCR) 
          BX6    X2 
          SA6    PRSD+CVLFC        RESET FC WORD
  
          SA2    A2+B1             (CVLDCR) 
          BX6    X2 
          SA6    PRSD+CVLDC        RESET DC WORD
  
          SA2    A2+B1             (CVLACR) 
          LX1    -8                POSITION AC
          MX6    -16               MASK FOR AC
          BX6    -X6*X1 
          IX6    X6+X2
          SA6    PRSD+CVLAC        RESET AC WORD
  
          EQ     SCVLPB            RETURN 
 TCS      SPACE  4
**        TCS - TRANSLATE CONTROL STATEMENT.
* 
*         ENTRY  A5, X5 = FIRST CHARACTER.
*                X0 = ADDRESS OF STATMENT TRANSLATION TABLE.
  
  
 ERM      SA2    EC                ADVANCE ERROR COUNTER
          SA7    EM                SET ERROR MESSAGE ADDRESS
          SX6    X2+B1
          SA6    A2 
  
 TCS      SUBR                     ENTRY/EXIT 
          RJ     ASN               ASSEMBLE NAME
          SA1    X0                START NAME SEARCH
  
 TCS1     BX3    X1-X6
          SA2    A1+B1
          ZR     X3,TCS2           IF MATCH FOUND 
          SA1    A2+B1             NEXT ENTRY 
          NZ     X1,TCS1           LOOP TO END OF TABLE 
          SX7    TCSA 
          EQ     ERM
  
 TCS2     SB2    X2                PROCESS STATMENT 
          JP     B2 
  
 TCSA     DATA   C* DMPNAD ABORTED - ILLEGAL DIRECTIVE NAME.* 
 UCS      SPACE  4
**        UCS - UNPACK C-FORMAT TO S-FORMAT.
* 
*         UCS UNPACKS A C-FORMAT LINE TO AN S-FORMAT LINE (1 CHARACTER/ 
*         WORD).  TRAILING SPACES ARE DELETED, AND THE END OF LINE IS 
*         MARKED BY A NEGATIVE WORD (BITS 0-58 = 0, BIT 59 = 1).
* 
*         ENTRY  A1, X1 = FIRST WORD OF C-FORMAT. 
*                B2 = FIRST WORD OF S-FORMAT BUFFER.
* 
*         EXIT   A1 = ADDRESS OF LAST WORD OF C-FORMAT. 
*                A6 = ADDRESS+1 OF LAST CHARACTER OF S-FORMAT.
  
  
 UCS      SUBR                     ENTRY/EXIT 
          SA2    B2-B1             PRESET A6
          MX3    1
          SB3    -1R
          SX6    B0 
          BX7    X2 
          MX2    -6 
          SA6    A2 
  
 UCS1     LX1    6                 NEXT CHARACTER 
          BX6    -X2*X1 
          LX3    6
          BX1    X2*X1
          SA6    A6+B1
          PL     X3,UCS2           IF NOT END OF WORD 
          SA1    A1+B1             NEXT WORD
  
 UCS2     NZ     X6,UCS1           IF NOT ZERO CHARACTER
          NZ     X1,UCS1           IF NOT END OF LINE 
          NG     X1,UCS1
          SA3    A6-B1             DELETE TRAILING SPACES 
          MX6    1
  
 UCS3     SB4    X3+B3
          SA3    A3-B1
          ZR     B4,UCS3
          SX3    -B3
          SA7    A2                RESTORE WORD BEFORE LINE 
          BX6    X6+X3
          SA6    A3+2              SET END OF LINE
          EQ     UCSX              RETURN 
          SPACE  4
          END    DMPNAD 
