DMPCCC
          IDENT  DMPCCC,ORG 
          ABS 
          SST 
          ENTRY  DMPCCC 
          ENTRY  RFL= 
          ENTRY  SSJ= 
          SYSCOM B1 
*COMMENT 84/04/01. DMPCCC - DUMP CCC MEMORY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  DMPCCC - DUMP *CCC* MEMORY.
          SPACE  4
***       DMPCCC - DUMP CCC MEMORY. 
*         L. E. LOVETT       84/04/01.
          SPACE  4,10 
***       DMPCCC - DUMP CCC MEMORY. 
* 
*         *DMPCCC* PROVIDES THE CAPABILITY TO DYNAMICALLY AUTODUMP
*         THE *CCC* MEMORY.  THE CALLING JOB MUST BE SYSTEM ORIGIN
*         OR THE USER MUST BE VALIDATED FOR SYSTEM ORIGIN PRIVILEGES, 
*         AND THE SYSTEM MUST BE IN ENGINEERING MODE. 
* 
*         *DMPCCC* READS THE *CCC* MEMORY VIA THE *PP* PROGRAM *DCC*
*         AND FORMATS THE DATA INTO AN OUTPUT FILE.  *DMPCCC* WILL ISSUE
*         APPROPRIATE MESSAGES TO INDICATE THE SUCCESS OR FAILURE OF
*         THE AUTODUMP ATTEMPT. 
          SPACE  4,10 
***       COMMAND FORMAT. 
* 
*         DMPCCC(C=CH,L=LFN)
* 
*         CH     CHANNEL NUMBER TO DUMP *CCC* FROM. THE SPECIFIED 
*                CHANNEL MUST BE IN THE RANGE 0 - 13B OR 20B - 33B OR 
*                C0 - C11B FOR CONCURRENT CHANNELS. 
*                CHANNEL 0 WILL BE ASSUMED IF NO CHANNEL IS SPECIFIED 
*                ON THE CALL. 
* 
*         LFN    OUTPUT FILE NAME.  DEFAULT IS *OUTPUT*.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * DUMP COMPLETE.* 
*                INFORMATIVE MESSAGE INDICATING THE COMPLETION OF THE 
*                DUMP UTILITY.
* 
*         * EQUIVALENCE MISSING.* 
*                A SYNTAX ERROR WAS ENCOUNTERED WITH THE COMMAND.  THE
*                COMMAND PARAMETER WAS NOT SEPARATED FROM ITS EQUIVALENC
*                VALUE BY AN *=*. 
* 
*         * INCORRECT CHANNEL NUMBER.*
*                THE SPECIFIED CHANNEL NUBER WAS NOT IN THE RANGE 
*                0 - 13B OR 20B - 33B OR C0 - C11B. 
* 
*         * 8/9 NOT ALLOWED IN OCTAL FIELD.*
*                THE CHANNEL NUMBER WAS SPECIFIED WITH A POST SUFFIX
*                OF *B* WHILE AN *8* OR *9* WAS SPECIFIED.
* 
*         * NUMERIC FIELD MUST NOT BE BLANK.* 
*                NO CHANNEL VALUE WAS SPECIFIED WITH THE *C* PARAMETER. 
* 
*         * INCORRECT DIRECTIVE NAME.*
*                AN UNRECOGNIZED PARAMETER HAS BEEN SPECIFIED ON THE
*                COMMAND. 
  
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCMAC 
          SPACE  4
**        ASSEMBLY CONSTANTS. 
  
  
 LNP      EQU    84          LINES/PRINTER PAGE 
 CCSZ     EQU    40000B      *CCC* MEMORY SIZE
 CCSZA    SET    CCSZ*2+4 
 NMBL     SET    CCSZA/5+100B   DUMP BUFFER SIZE
 LFBL     EQU    2001B       LIST FILE BUFFER LENGTH
 WBFL     EQU    64          WORKING BUFFER LENGTH
  
  
 SSJ=     EQU    400000B
          TITLE  DATA ASSIGNMENTS.
 DATA     SPACE  4
**        DATA ASSIGNMENTS. 
  
  
  
          ORG    110B 
 ORG      BSS    0
  
 L        BSS    0           LIST FILE
 OUTPUT   FILEC  LFB,LFBL,FET=8 
          ORG    L
          CON    0LOUTPUT+15B 
          ORG    L+8
  
 N        FILEB  NMB,NMBL,FET=9 
          ORG    N
          VFD    12/0,18/0,18/0,12/0
          ORG    N+9
  
 BA       CON    LB1         BUFFER ADDRESS 
 NA       CON    0           CCC ADDRESS
 NL       CON    0#4000      LIMIT ADDRESS
 CCHF     CON    0           CONCURRENT CHANNEL FLAG
          SPACE  4
**        LIST FILE CONTROLS. 
  
  
 LN       CON    10000       LINE NUMBER
 LP       CON    LNP         LINES/PAGE 
 PN       CON    0           PAGE NUMBER
  
 TTL      DATA   H*1 DUMP OF *  PAGE TITLE LINE 
          DATA   10H  CCC,  CH
          DATA   40H00. 
 DTE      BSS    1           DATE FOR OUTPUT
 TME      BSS    1           TIME FOR OUTPUT
 PGE      BSS    1           PAGE FOR OUTPUT
          CON    0
  
 STL      DATA   10H0 
          DATA   C* 0     1     2     3     4     5     6     7     8 
,  9     A     B     C     D     E     F* 
          TITLE  MAIN PROGRAM.
 DMP      SPACE  4,20 
**        DMPCCC - MAIN PROGRAM.
  
  
 DMPCCC   RJ     PRS         PRESET PROGRAM 
 DMP1     SA1    NA          ADVANCE *CCC* ADDRESS
          SX6    X1+16
          SA6    A1 
          SA4    NL 
          IX4    X1-X4
          PL     X4,DMP5     IF END OF DUMP 
          RJ     CHD         CONVERT ADDRESS TO DISPLAY 
          SA1    BA          SET BUFFER ADDRESS 
          LX6    30 
          MX0    48 
          SB3    6
          BX0    X0*X6
          SB2    X1 
          RJ     RDL         READ DUMP LINE 
          NZ     X1,DMP4     IF END OF DATA 
          SA1    BA          SET BUFFER ADDRESS 
          SX2    LB1&LB2     TOGGLE BUFFER
          BX6    X1-X2       COMPARE BUFFERS
          SA3    X1+B1
          MX7    1
          SA4    X6+B1
          BX7    X7+X1
          SX6    X6 
 DMP2     BX2    X3-X4
          SA3    A3+B1
          SA4    A4+B1
          NZ     X2,DMP3     IF LINE NOT DUPLICATE
          NG     X2,DMP3     IF LINE NOT DUPLICATE
          NZ     X3,DMP2     IF NOT END OF NEW LINE 
          NG     X1,DMP1     IF DUPLICATE LINES WRITTEN 
          SA7    A1          SET DUPLICATE LINES WRITTEN
          SB2    =C*         DUPLICATED LINES.* 
          RJ     LSL         LIST LINE
          EQ     DMP1        GET NEXT LINE TO PRINT 
  
 DMP3     SA6    A1 
          SB2    X1 
          RJ     LSL         LIST LINE
          EQ     DMP1        GET NEXT LINE TO PRINT 
  
 DMP4     SA1    BA          BUFFER ADDRESS 
          SB2    X1 
          RJ     LSL         LIST LINE
 DMP5     WRITER L
          MESSAGE  (=C* DUMP COMPLETE.*)
          ENDRUN
          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) = DISPLAY CODE CONVERSION RIGHT JUSTIFIED.
*                (X4) = DISPLAY CODE CONVERSION LEFT JUSTIFIED. 
*                (B2) = 6*COUNT OF DIGITS CONVERTED.
* 
*         USES   A - 4. 
*                B - 2, 3.
*                X - 1, 2, 3, 4, 6. 
  
  
 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 LESS THAN 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     CHD         RETURN 
 LSL      SPACE  4
**        LSL - LIST LINE.
* 
*         ENTRY  (B2) = ADDRESS OF LINE IN C-FORMAT.
* 
*         EXIT   LINE WRITTEN TO OUTPUT FILE. 
* 
*         USES   A - 1, 2, 6, 7.
*                B - 2. 
*                X - 1, 2, 6, 7.
* 
*         CALLS  CDD. 
* 
*         MACROS WRITEC.
  
  
 LSL1     SX6    X1+B1       ADVANCE LINE POINTER 
          SA6    A1 
          BX1    X6          CONVERT PAGE NUMBER
          RJ     CDD         CONVERT DECIMAL TO DISPLAY 
          SA1    LSLB        SET PAGE NUMBER ON OUTPUT
          BX6    X1-X6
          SA6    PGE
          WRITEC L,TTL       WRITE LIST TITLE 
          WRITEC L,STL       WRITE LIST SUBTITLE
          WRITEC L,(=C* *)   SKIP A LINE
          WRITEC L,(=C* *)   SKIP A LINE
          SA1    LSLA        RESTORE ADDRESS OF LINE
          SB2    X1 
 LSL2     WRITEC L,B2        WRITE DATA LINE
  
 LSL      SUBR               ENTRY/EXIT 
          SA1    LN          SET LINE NUMBER
          SA2    LP          SET LINES PER PAGE 
          SX6    X1+B1       ADVANCE LINE NUMBER
          SA6    A1 
          IX1    X6-X2
          NG     X1,LSL2     IF NO PAGE OVERFLOW
          SA1    PN          SET PAGE NUMBER
          SX6    6           RESET LINE COUNT 
          SX7    B2          SAVE ADDRESS OF LINE 
          SA6    A6 
          SA7    LSLA 
          NZ     X1,LSL1     IF NOT FIRST PAGE
          SB2    X2-80
          NG     B2,LSL1     IF NOT 8 LINES/INCH
          WRITEC L,(=1LT)    SET 8 LINES PER INCH 
          SA1    PN          SET PAGE NUMBER
          EQ     LSL1        WRITE PAGE HEADER
  
 LSLA     BSS    1           ADDRESS OF DATA LINE 
 LSLB     CON    5L PAGE&5L      PAGE NUMBER IDENTIFIER 
 RDL      SPACE  4
**        RDL - READ DUMP LINE. 
* 
*         ENTRY  (B2) = OUTPUT WORD ADDRESS.
*                (B3) = OUTPUT WORD CHARACTER POSITION. 
*                (X0) = PARTIAL ASSEMBLY. 
* 
*         EXIT   (X1) = EOR STATUS. 
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                X - ALL. 
* 
*         MACROS READO. 
  
  
*         ADD CHARACTER TRANSLATION OF MEMORY DUMP TO THE END 
*         OF THE DUMP LINE. 
  
 RDL9     SA2    RDLB 
          SA6    RDLA+1      SAVE INPUT STATUS
          SX6    B4 
          MX3    -36
          SA6    A6-B1
          LX2    48 
          BX6    -X3*X2 
          BX4    X3*X2
          SA2    A2+B1
          BX7    X0+X6
          BX6    X4+X2
          SA2    A2+B1
          MX4    -12
          SA3    A2+B1
          SA7    B2 
          SA6    B2+B1
          LX2    12 
          LX3    24 
          BX7    -X4*X3 
          BX6    X4*X3
          BX7    X2+X7
          SA7    A6+B1
          SA6    A7+B1
          MX7    0           SET LINE TERMINATOR
          SA7    A7+2 
  
 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 
 RDL1     ZR     B4,RDL8     IF END OF INPUT WORD 
          LX6    8           EXTRACT NEXT 4 BITS
          SB4    B4-B1
 RDL2     BX1    -X2*X6 
          SB6    B6-B1
          LX6    4           NEXT 4 BITS
          SX7    X1-10       CONVERT HEX DIGIT
          SX4    1R0+X1 
          NG     X7,RDL3     IF DIGIT LESS THAN 10
          SX4    1RA+X7 
 RDL3     BX1    -X2*X6 
          LX4    X4,B3
          SB3    B3-6 
          SX7    X1-10
          SX1    1R0+X1 
          NG     X7,RDL4     IF DIGIT LESS THAN 10
          SX1    1RA+X7 
 RDL4     BX0    X0+X4
          BX4    -X3*X6      CONVERT CHARACTER
          SX4    1R 
          LX1    X1,B3
          LX5    6
          BX0    X0+X1
          BX5    X5+X4
          NZ     B3,RDL5     IF OUTPUT WORD NOT FULL
          SB3    60 
          BX7    X0 
          MX0    0
          SA7    B2 
          SB2    B2+B1
 RDL5     SB3    B3-6 
          NZ     B6,RDL1     IF 4 DIGITS NOT DONE 
          SB3    B3-6        ADD SPACES 
          SX1    2R 
          LX1    X1,B3
          BX0    X0+X1
          SB5    B5-B1
          SB6    B1+B1
          NZ     B3,RDL6     IF OUTPUT WORD NOT FULL
          SB3    60 
          BX7    X0 
          MX0    0
          SA7    B2 
          SB2    B2+B1
 RDL6     SX7    B5          CHECK WORD 
          MX1    -2 
          SB3    B3-6 
          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     IF NOT 8 WORDS 
          EQ     RDL9        ADD CHARACTER TRANSLATION
  
*         READ NEXT WORD. 
  
 RDL8     READO  N
          MX2    -4 
          SB4    4
          MX3    -7 
          LX6    8
          ZR     X1,RDL2     IF NOT EOR 
          BX7    X0 
          SA7    B2 
          EQ     RDL9        ADD CHARACTER TRANSLATION
  
 RDLA     CON    0,0         INPUT WORD STATUS
 RDLB     BSS    4           CHARACTER TRANSLATION STORAGE
          SPACE  4
**        COMMON DECKS. 
  
  
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCMVE 
*CALL     COMCRDO 
*CALL     COMCRDW 
*CALL     COMCSYS 
*CALL     COMCWTC 
*CALL     COMCWTW 
          SPACE  4
**        BUFFERS.
  
  
          USE    // 
          SEG 
  
 LB1      BSS    15          LINE BUFFER 1
 LB2      BSS    15          LINE BUFFER 2
 LFB      EQU    *           LIST FILE BUFFER 
 NMB      EQU    LFB+LFBL    MEMORY BUFFER
 RFL=     EQU    NMB+NMBL+100B
 PRS      SPACE  4
**        PRS - PRESET PROGRAM. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          SB1    1
          SA1    N           SET E=0 IN THE FET 
          MX0    3
          BX6    -X0*X1 
          SA6    A1+
          SX7    LINP        SET LINES/PAGE 
          SA7    LP 
          SX6    A0+         SET FIELD LENGTH 
          SA6    N+4
          MOVE   PRSB,PRSA,2 COPY FILE ACCESS LIST
          SA1    CCDR        UNPACK CONTROL STATEMENT 
          SB2    ISB         INPUT STRING BUFFER
          RJ     UCS         UNPACK C-FORMAT TO S-FORMAT
          RJ     ARG         PROCESS ARGUMENTS
          DATE   DTE         GET CURRENT DATE 
          CLOCK  TME         GET CURRENT TIME 
  
*         FORM PAGE TITLE LINE USING CHANNEL. 
  
          SA1    TTL+2       SET CHANNEL IN TITLE 
          SA2    N
          MX3    -5 
          LX3    -12
          BX2    -X3*X2 
          MX3    -3 
          LX3    -12
          BX4    -X3*X2 
          LX2    3
          LX3    6
          BX7    -X3*X2 
          IX6    X1+X4
          IX6    X6+X7
          SA6    A1 
          SA2    A2 
          SA1    NA          SET CCC ADDRESSES
          SA3    NL 
          LX1    12 
          LX3    30 
          BX6    X2+X1
          BX6    X6+X3
          SA6    A2 
          SA1    CCHF        CHECK FOR CONCURRENT CHANNEL 
          NZ     X1,PRS1     IF A CONCURRENT CHANNEL
          SYSTEM DCC,R,N     CALL *DCC* 
          EQ     PRSX        RETURN 
  
 PRS1     SYSTEM CPM,R,PRSC,140B*100B 
          RECALL N           WAIT FOR DUMP COMPLETE 
          EQ     PRSX        RETURN 
  
 PRSA     BSS    0           FILE ACCESS LIST 
          CON    0LOUTPUT+L 
          CON    0
 PRSB     EQU    *-PRSA 
 PRSC     VFD    36/0,12/0,12/0 
          VFD    18/3RDCC,6/40B,36/N
  
*         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/PRSA,18/AFN 
          CON    0LCH        CH = CHANNEL NUMBER
          CON    ACH
          CON    0LC         C = CHANNEL NUMBER 
          CON    ACH
          CON    0
 ABT      SPACE  4
**        ABT - ABORT JOB.
* 
*         ENTRY  (X7) = DAYFILE MESSAGE ADDRESS.
* 
*         EXIT   JOB ABORTED. 
* 
* 
*         MACROS ABORT, MESSAGE.
  
  
 ABT      MESSAGE X7
          ABORT 
 ACH      SPACE  4
**        ACH - ASSEMBLE CHANNEL. 
* 
*         ENTRY  (X5) = PARAMETER SEPARATOR.
*                (A5) = ADDRESS OF PARAMETER SEPARATOR IN LIST. 
* 
*         EXIT   (N) = CONVERTED CHANNEL NUMBER.
*                (A5) = ADDRESS OF PARAMETER LIST.
* 
*         ERROR  *ERM* CALLED IF PARAMETER ERROR. 
*                (X7) = ERROR MESSAGE ADDRESS.
* 
*         USES   A - 1, 6, 5. 
*                B - 2, 3.
*                X - 1, 5, 6, 7.
* 
*         CALLS  ASD, ERM.
  
  
 ACH      SB2    X5-1R=      CHECK SEPARATOR
          SX7    =C* EQUIVALENCE MISSING.*
          NZ     B2,ERM      IF NOT *=* 
          SA5    A5+1        ASSEMBLE CHANNEL 
          SX6    X5-1RC 
          ZR     X6,ACH2     IF CONCURRENT CHANNEL
          RJ     ASD         ASSEMBLE OCTAL DIGITS
          SB2    X6-34B      CHECK CHANNEL
          SB3    X6-20B 
          SX7    =C* INCORRECT CHANNEL NUMBER.* 
          PL     B2,ERM      IF CHANNEL NUMBER OUT OF RANGE 
          PL     B3,ACH1     IF CHANNEL IN RANGE
          SB2    X6-14B 
          PL     B2,ERM      IF CHANNEL OUT OF RANGE
 ACH1     SA1    N           SET CHANNEL IN REQUEST 
          MX7    -6 
          LX1    -48
          BX1    X7*X1
          BX6    X1+X6
          LX6    48 
          SA6    A1 
          EQ     TCSX        RETURN 
  
 ACH2     SA5    A5+1 
          RJ     ASD
          SX7    =C* INCORRECT CHANNEL NUMBER.* 
          SB2    X6-12B 
          PL     B2,ERM      IF CHANNEL OUT OF RANGE
          SX6    X6+40B      SET CONCURRENT BIAS
          BX7    X6 
          LX7    12          SET CHANNEL IN *CPM* CALL
          SA7    PRSC 
          SA7    CCHF        FLAG CONCURRENT CHANNEL
          SA1    =10H  CCC, CHH 
          BX7    X1 
          SA7    TTL+1       SET NEW TITLE LINE 
          EQ     ACH1        SET CHANNEL IN *DCC* CALL
 AFN      SPACE  4
**        AFN - ASSEMBLE FILE NAME. 
* 
*         ENTRY  (X5) = PARAMETER SEPARATOR.
*                (A5) = ADDRESS OF PARAMETER SEPARATOR IN LIST. 
*                (X2) = TRANSLATION TABLE ENTRY.
* 
*         EXIT   FILENAME SET IN *FET* (*0* = NO FILE). 
* 
*         USES   A - 1, 5, 7. 
*                B - 2, 3.
*                X - 0, 1, 2, 5, 6, 7.
* 
*         CALLS  ASN. 
  
  
 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
          NZ     X7,AFN3     IF ERROR IN FILE 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 
  
 AFN3     SX7    =C* UNRECOGNIZED FILE NAME.* 
          EQ     ERM
 ARG      SPACE  4
**        ARG - PROCESS ARGUMENTS.
* 
*         ENTRY  (ISB) = STRING BUFFER CONTAINING CONTROL CARD IMAGE. 
* 
*         EXIT   (X1) = ZERO. 
*                ALL PARAMETERS PROCESSED.
* 
*         ERROR  *ABT* CALLED IF PARAMETER ERROR. 
*                (X7) = ERROR MESSAGE ADDRESS.
* 
*         USES   A - 1, 2, 3, 4, 5. 
*                B - 2, 3.
*                X - ALL. 
* 
*         CALLS  ABT, ASN, TCS. 
* 
*         MACROS MESSAGE. 
  
  
 ARG      SUBR               ENTRY/EXIT 
          SA5    ISB         FIRST CHARACTER
          RJ     ASN         ASSEMBLE NAME
 ARG1     SB2    X5-1R) 
          SB3    X5-1R. 
          ZR     B2,ARGX     IF END OF COMMAND
          ZR     B3,ARGX     IF END OF COMMAND
          SA5    A5+1        SKIP SEPARATOR 
          SX0    CST
          RJ     TCS         TRANSLATE CONTROL STATEMENT
          SA1    EM 
          ZR     X1,ARG1     LOOP IF NO ERROR MESSAGE 
          MESSAGE X1
          SX7    ARGA 
          EQ     ABT         ABORT JOB
  
 ARGA     DATA   C* CONTROL STATEMENT ERROR.* 
 ASD      SPACE  4
**        ASD - ASSEMBLE DIGITS.
* 
*         ENTRY  (X5) = FIRST CHARACTER TO ASSEMBLE.
*                (A5) = ADDRESS OF CHARACTER STRING.
*                (B2) = ZERO IF OCTAL BASE ASSUMED. 
*                     = NON-ZERO IF DECIMAL BASE ASSUMED. 
* 
*         EXIT   (X6) = ASSEMBLED DIGITS. 
*                (X5) = NEXT CHARACTER TO BE PROCESSED. 
*                (A5) = ADDRESS OF NEXT CHARACTER.
* 
*         ERROR  *ERM* CALLED IF VALUE ERROR. 
*                (X7) = ERROR MESSAGE ADDRESS.
* 
*         USES   A - 5, 6.
*                B - 2, 3, 4, 5, 6. 
*                X - 1, 2, 3, 5, 6, 7.
* 
*         CALLS  ERM. 
  
  
 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     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        RETURN 
  
 ASD2     NZ     X2,ASD3     IF NOT *B* 
          SA5    A5+1        SKIP CHARACTER 
          ZR     B5,ASDX     IF *8*/*9* NOT PRESENT 
          SX7    =C* 8/9 NOT ALLOWED IN OCTAL FIELD.* 
          EQ     ERM         PROCESS ERROR
  
 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* NUMERIC FIELD MUST NOT BE BLANK.*
          EQ     ERM         PROCESS ERROR
 ASN      SPACE  4
**        ASN - ASSEMBLE NAME.
* 
*         ENTRY  (X5) = FIRST CHARACTER IN NAME.
*                (A5) = ADDRESS OF FIRST CHARACTER. 
* 
*         EXIT   (X6) = ASSEMBLED NAME. 
*                (X5) = NEXT CHARACTER TO BE PROCESSED. 
*                (A5) = ADDRESS OF NEXT CHARACTER.
*                (X7) = 0, IF NO ERROR. 
*                (X7) = 1, IF ERROR ENCOUNTERED.
* 
*         USES   A - 5, 7.
*                B - 2, 4.
*                X - 1, 2, 5, 6, 7. 
  
  
 ASN1     LX5    X5,B2       MERGE
          NG     B2,ASNX     IF ASSEMBLY FULL 
          BX6    X6+X5
          SA5    A5+B1       NEXT CHARACTER 
          SB2    B2-6 
          SB4    X5 
 ASN2     AX2    X1,B4
          LX2    59 
          NG     X2,ASN1     IF LETTER OR DIGIT 
          SX7    B0+         SET NO ERROR 
  
 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    B1+         PRESET ERROR 
          EQ     ASN2        ASSEMBLE NAME
 TCS      SPACE  4
**        TCS - TRANSLATE CONTROL STATEMENT.
* 
*         ENTRY  (X0) = ADDRESS OF STATEMENT TRANSLATION TABLE. 
* 
*         EXIT   PROCESSOR DEFINED FOR PARAMETER ENTERED. 
* 
*         ERROR  *ERM* CALLED PROCESSOR NOT DEFINED FOR PARAMETER.
*                (X7) = ERROR MESSAGE ADDRESS.
* 
*         USES   A - 1, 2, 6, 7.
*                B - 2. 
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  ERM. 
  
  
 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
          NZ     X7,TCS1.1   IF ERROR 
          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 
 TCS1.1   SX7    TCSA 
          EQ     ERM
  
 TCS2     SB2    X2          PROCESS STATMENT 
          JP     B2 
  
 TCSA     DATA   C* INCORRECT 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) = FIRST WORD ADDRESS OF C-FORMAT BUFFER.
*                (X1) = FIRST WORD OF C-FORMAT BUFFER.
*                (B2) = FIRST WORD ADDRESS OF S-FORMAT BUFFER.
* 
*         EXIT   (A1) = ADDRESS OF LAST WORD OF C-FORMAT BUFFER.
*                (A6) = ADDRESS+1 OF LAST CHARACTER OF S-FORMAT BUFFER. 
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                B - 3, 4.
*                X - 0, 1, 2, 3, 5, 6, 7. 
  
  
 UCS      SUBR               ENTRY/EXIT 
          SA2    B2-B1       PRESET A6
          MX3    1
          SB3    -1R
          SX6    B0 
          BX7    X2 
          MX2    -6 
          SA6    A2 
          SX0    1R 
 UCS1     LX1    6           NEXT CHARACTER 
          BX6    -X2*X1 
          LX3    6
          BX1    X2*X1
          IX5    X6-X0
          ZR     X5,UCS1.5   IF LEADING SPACE 
          SA6    A6+B1
          SX0    3R 
 UCS1.5   PL     X3,UCS2     IF NOT END OF WORD 
          SA1    A1+1        NEXT WORD
 UCS2     NZ     X6,UCS1     IF NOT ZERO CHARACTER
          NZ     X1,UCS1     IF NOT END OF LINE 
          NG     X1,UCS1     GET NEXT CHARACTER 
          SA3    A6-B1       DELETE TRAILING SPACES 
          MX6    1
 UCS3     SB4    X3+B3
          SA3    A3-B1
          ZR     B4,UCS3     IF NEXT CHARACTER ZERO 
          SX3    -B3
          SA7    A2+         RESTORE WORD BEFORE LINE 
          BX6    X6+X3
          SA6    A3+2        SET END OF LINE
          EQ     UCSX        RETURN 
          CON    0
 ISB      EQU    *           STRING BUFFER
          SPACE  4
          END 
