Retro1.org codex

          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