*DECK PA
USETEXT CCTTEXT 
PROC PA     ;    BEGIN
#***********************************************************************
  
         PROCEDURE - PICANALYZER
  
------------------------------------------------------------------------
  
PURPOSE:  
         1.  DETERMINE THE ATTRIBUTES OF DATA ITEMS BY ANALYZING THE
             PICTURE STRINGS PLACED IN THE PICTURE-LITERAL-TABLE (PLT). 
             THE ATTRIBUTES GATHERED INCLUDE TYPE/CATEGORY (NUMERIC,
             ALPHANUMERIC, ALPHABETIC OR EDITED), LENGTH, AND POINT 
             LOCATION.
  
         2.  CHECKS THE SYNTACTICAL VALIDITY OF THE WHOLE PICTURE.
  
         3.  GENERATES EDIT PATTERNS FOR NUMERIC, ALPHABETIC, AND 
             ALPHANUMERIC EDITED DATA.
  
         ALL CHECKING AND EXTRACTING IS DONE DURING ONE PASS ON A 
         SYMBOL BY SYMBOL BASIS.
  
------------------------------------------------------------------------
  
USAGE:  
         THIS PROCEDURE IS THE SECOND MODULE OF THE COBOL COMPILER. 
  
------------------------------------------------------------------------
  
TABLES REFERENCED:  
  
         1.  READ THE PICTURE-LITERAL-TABLE (PLT).
  
         2.  APPEND EDIT PATTERNS TO THE END OF THE PLT.
  
         3.  BUILD THE PICTURE-ATTRIBUTE-TABLE (PAT). 
  
         4.  UPDATE THE COMPILER-CONTROL-TABLE (CCT). 
  
------------------------------------------------------------------------
  
************************************************************************
 #
      CONTROL EJECT;
# 
------------------------------------------------------------------------
  
         TABLES 
  
------------------------------------------------------------------------
  
         SYMBOL REFERENCE - THE TABLE IS BUILT BY THE SYMBOL PROCESSORS.
                            EACH SYMBOL HAS A ONE BIT ENTRY.  THE BINARY
                            VALUE OF THE INTERNAL SYMBOL CODE CORRESPOND
                            TO THE INDEX OF THE BIT FROM THE BEGINNING. 
                            THIS SERVES AS A HISTORY PATTERN OF SYMBOLS 
                            THAT WERE PROCESSED.  THIS TABLE IS SET TO
                            ALL ZEROS AT THE BEGINNING OF EACH PICTURE. 
  
                                 FIXED          -FLOATING-
                          *      LLRR      LR   BBAABBAABAEE
                            /B0,.+-+-CDC9AXPPSVEZ*Z*+-+-CC+-1 
                          **         RBS                SS
  
                          * L=LEFT R=RIGHT B=BEFORE A=AFTER E=EXPONENT
                          **CR=CREDIT, DB=DEBIT, CS=CURRENCY SYMBOLS
 #
         ARRAY; 
           BEGIN ITEM 
             SRT  U(0,0,36),
             SRTZERO U(0,0,60); 
             END
#--------------------------------------------------------------------#
# 
         IMPLICIT STATE   - THIS TABLE IS USED BY THE SYNTAX ROUTINE. 
                            EVERY SYMBOL WHICH CAN APPEAR IN A PICTURE
                            HAS A ONE BIT ENTRY.  THE TABLE WILL
                            INDICATE WHETHER OR NOT A CHAR IS ALLOWABLE 
                            CONSIDERING PREVIOUS CHARS ENCOUNTERED. THE 
                            TABLE IS SET TO ALL ONES AT THE START OF
                            EACH PICTURE. THE SEQUENCE IS THE SAME AS 
                            IN THE SYMBOL REFERENCE TABLE.  THE TABLE IS
                            BUILT AS A RESULT OF A LOGICAL AND OPERATION
                            WITH THE SYNTAX TABLE ENTRIES.
 #
         ARRAY; 
           BEGIN ITEM 
             IST  U(0,0,36),
             ISTAND U(0,0,36) ; 
             END
#--------------------------------------------------------------------#
# 
         PICTURE SYMBOL   - THIS TABLE CONTAINS ONE WORD FOR EACH 
                            POSSIBLE PICTURE CHARACTER TO A MAXIMUM OF
                            THIRTY ENTRIES.  EACH ENTRY IS A ONE CHAR 
                            INTERNAL CODE FOR THE PICTURE CHARACTER.  A 
                            SECOND ENTRY OF EIGHT BITS CONTAINS THE 
                            ORIGINAL SOURCE CHAR AND THEN A 48 BIT FIELD
                            TO CONTAIN THE NUMBER OF OCCURRENCES OF THE 
                            CHARACTER.  A SECOND TABLE DESCRIPTION IS 
                            AVAILABLE BASED ON THE FIRST SO THAT THE
                            COUNT FIELD CAN BE DEFINED AS FIXED.
 #
         ARRAY [0:29];
           BEGIN ITEM 
             PSTC  C(0,0,1),
             PSTS  C(0,6,1),
             PSTL  I(0,12,48);
             END
#--------------------------------------------------------------------#
         CONTROL EJECT; 
#---------------------------------------------------------------------- 
         CATEGORY         - THIS TABLE HAS A EIGHT BIT ENTRY FOR EACH 
                            POSSIBLE CHAR IN INTERNAL CODE SEQUENCE.
                            THE ENTRY INDICATES THE CATEGORY OF THAT
                            CHARACTER. A EXCLUSIVE OR OPERATION OF THESE
                            FIELDS AND THE CATEGORY FIELD OF THE CONTROL
                            BIT-BYTE TABLE WILL SHOW THE FINAL CATEGORY 
                            AT THE END OF A PICTURE.
 #
         ARRAY [0:32];
           ITEM CATT  U(0,22,8) = 
             [X"05",X"04",X"05",X"04",X"04",X"04",X"04",X"04",
              X"04",X"04",X"04",X"04",X"01",X"02",X"03",X"01",
              X"01",X"01",X"01",X"08",X"05",X"05",X"05",X"05",
              X"05",X"05",X"05",X"05",X"05",X"05",X"08",X"08",
              X"10" ];
#--------------------------------------------------------------------#
# 
          SYNTAX           -THIS TABLE HAS ONE ENTRY FOR EACH 
                            CHARACTER IN THE INTERNAL CODE SEQUENCE.
                            A LOGICAL AND OPERATION OF THESE
                            ENTRIES AND THE IMPLICIT STATE TABLE
                            ACCUMULATES IN THE IST.  THE BITS SET IN
                            EACH ENTRY INDICATE WHAT SYMBOLS ARE ALLOWED
                            TO FOLLOW THE CURRENT SYMBOL. 
 #
          ARRAY[0:32];
           ITEM  SYN  U(0,0,36) = 
             [X"F9EEAFFC0",X"F9EEAFFC0",X"F9EEAFFC0",X"F9E8AFFC0",
              X"F1E813370",X"F819BF0F0",X"F819BF0F0",X"000000000",
              X"000000000",X"000000000",X"000000000",X"F9E9AFF00",
              X"F9EEB0030",X"E00E00000",X"E00E00000",X"F1E803340",
              X"01E020000",X"0009A0000",X"F1E913370",X"000800030",
              X"F9E8AF000",X"F9E8AF000",X"F1E003000",X"F1E003000",
              X"F808A0F00",X"F808A0F00",X"F00000300",X"F00000300",
              X"F9E8A00C0",X"F1E000040",X"000800000",X"000800000",
              X"000000008" ]; 
#--------------------------------------------------------------------#
         CONTROL EJECT; 
#---------------------------------------------------------------------- 
         TRANSLATION      - THIS TABLE IS USED TO CONVERT THE INPUTTED
                         DISPLAY CHARACTER TO A INTERNAL CODE VALUE.
 #
         ARRAY [0:63];
           ITEM TTS  U(0,52,8) =
             [X"FF",X"0D",X"01",X"09",X"0A",X"FF",X"FF",X"FF",
              X"FF",X"FF",X"FF",X"FF",X"FF",X"FF",X"FF",X"FF",
              X"0F",X"FF",X"FF",X"11",X"FF",X"FF",X"12",X"FF",
              X"0E",X"FF",X"14",X"02",X"20",X"3C",X"3C",X"3C",
              X"3C",X"3C",X"3C",X"3C",X"0C",X"05",X"06",X"15",
              X"00",X"32",X"33",X"0B",X"FF",X"FF",X"03",X"04",
              X"3D",X"FF",X"FF",X"FF",X"FF",X"FF",X"FF",X"FF",
              X"FF",X"FF",X"FF",X"FF",X"FF",X"FF",X"FF",X"FF"]; 
#--------------------------------------------------------------------#
# 
         CONTROL BIT BYTE - THIS TABLE CONTAINS EIGHT ONE BIT SWITCHES
                            AND THREE EIGHT BIT.  ALL POSITIONS ARE 
                            INITIALIZED TO ZERO.  ONE OF THE EIGHT BIT
                            ENTRIES IS REDEFINED INTO FOUR ONE BIT
                            SWITCHES. 
 #
         ARRAY; 
           BEGIN ITEM 
             DECCOM    U(0,0,1),   #DEC PT IS COMMA SWITCH     #
             CSIS      U(0,1,1),   #CURR SIGN IS SWITCH        #
             IGNORE    U(0,2,1),   #IGNORE DIGIT SWITCH        #
             CONST     U(0,3,1),   #CONST CHAR SWITCH          #
             AST       U(0,4,1),   #ASTERISK SWITCH            #
             CR        U(0,5,1),   #CREDIT SYMBOL SWITCH       #
             CSBYT     C(0,6,1),   #CURR SIGN IS CHAR          #
             DB        U(0,12,1),  #DEBIT SYMBOL SWITCH        #
             TESTBIT   U(0,13,1),  #WORKING SWITCH             #
             DECBYT    U(0,14,8),  #DECISION BYTE              #
             FLAGS     U(0,14,8),  #SYNONYM FOR DECBYT         #
             CATBYT    U(0,22,8);  #PIC CATALOG ATTRIBUTES     #
             END
#--------------------------------------------------------------------#
         BASED ARRAY FLT$STR$BASE[0]; 
           BEGIN ITEM 
             FLTINGSTRING C(30);
           END
         CONTROL EJECT; 
#---------------------------------------------------------------------- 
         INDEXES AND LITERALS 
------------------------------------------------------------------------
 #
    ITEM
         EDPLTI         I, #ACCUM. EDIT PATS FOR PLT# 
         LAI            I, #LOOK AHEAD INDEX        # 
         SBI            I, #SCAN BASE INDEX         # 
         PLTPTR         I, #PICTURE LITERAL POINTER # 
         PLTSTOP       I, #ADDR OF FRST PROCED LIT #
         PLSTLENGTHF    I, #LENGTH OF PLT           # 
         PATLENGTHF    I, #ACCUM. LENGTH OF PAT    #
         LOCID         I, #LOCAL ERROR NUMBER      #
         EPLTSTART      I, #BA OF EDIT PATS IN PLT  # 
         CODE U          , #CONTAINS INT CHAR CODE  # 
         CODEX U          , #CONTAINS ACTUAL CHAR    #
         COLUMN U          , #COLUMN NUMBER FOR ERROR # 
         LINE U          , #LINE NUMBER FOR ERRORS  # 
         SAVE U          , #DECIMAL IS COMMA VALUE  # 
         ERR U          , 
# 
------------------------------------------------------------------------
         COUNTERS - RESET TO ZERO FOR EACH PICTURE
------------------------------------------------------------------------
 #
         PICLEN         I, #NUMBER OF CHAR IN PIC   # 
         TOTNUM         I, #TOTAL NUMERIC CHARS     # 
         SUBTOT         I, #SUBTOTAL NUMERIC CHARS  # 
         PLEFT          I, #NO. OF P LEFT CHARS     # 
         PRIGHT         I, #NO. OF P RIGHT CHARS    # 
         DIGITS         I, #NO. OF DIGITS           # 
         EDITCR         I, #TOTAL EDIT CHARS        # 
         PSTCNT         I, #INDEX TO PST ENTRIES    # 
         NOCHR          I, #CNTR OF CHAR LENGTH     # 
         COELEN         I, #CNTR OF COEFF LENGTH    # 
         EXPLEN         I, #CNTR OF EXP LENGTH      # 
         TMPCSBYT  I,      #TEMPORY CURR SIGN      #
         REPFLAG        I, #REPEAT CHR FLAG         # 
         XI             I, #WORKING INDEX           # 
         TEMP           I               #EXTRA WORK              #
         ,TEMPCHAR1A C(1) 
         ,TEMPCHAR1B C(1) 
; 
         ITEM TMPPICSTR C(30);
         ITEM PAT$INDEX I;
          XREF   PROC         INTERCEPT;
# ITEMS USED FOR DEBUGGING PURPOSES # 
          $BEGIN
          COMMON PARAMS;
              ARRAY   [0:7];
                  ITEM PARAMC   C(0,0,10);
          XREF   FUNC         TOBIN  U; 
          XREF   FUNC         OCT    C(40); 
          XREF   FUNC         DEC    C(10); 
          XREF   PROC         OUTPUT; 
          XREF   PROC         DISPLAY;
ITEM DEBUG B; 
ITEM DISPATT B; 
ITEM RESPONSE C(10);
ITEM PAD   C(80); 
ITEM LOWTRACE, HIGHTRACE; 
DEF DSP #2#;
DEF DAR #1#;
          $END
  
#-------------------------------------------------------------------
  
    TEMPORARY USED TO HOLD THE EDIT PATTERN AS IT IS BEING BUILT BY 
    EDIT PATTERN GENERATOR. 
                                                                     #
         ITEM PATTERN    C(240);
  
#--------------------------------------------------------------------#
         CONTROL EJECT; 
#---------------------------------------------------------------------- 
         THE CCT, PLT, AND PAT ARE COPIED IN NEXT.
----------------------------------------------------------------------# 
  
#--------------------------------------------------------------------#
# 
         ENTRIES
 #
         DEF   ON     #1#;
         DEF   OFF    #0#;
         DEF   PDIAGERR    #3#; 
         DEF   JDIAGERR    #6#; 
         DEF   DDIAGERR    #1#; 
  
CONTROL NOLIST; 
CONTROL LIST; 
*CALL PLT1
*CALL PAT1
*CALL TABLNAMES 
*CALL PATVALS 
*CALL PLTVALS 
*CALL GETSET
     CONTROL EJECT; 
#********************************************************************#
# 
         INTERNAL PROCEDURES ARE DIAG, RPT$CONV, SCALE, + EDIT$PAT. 
 #
#********************************************************************#
    PROC DIAG  (LOCID);    BEGIN             #**DIAGNOSTIC ROUTINE    # 
        ITEM  LOCID         I;
# 
         THIS ROUTINE WRITES OUT ALL DIAGNOSTICS
             TESTBIT MUST BE TURNED ON SO THAT LOOK$AHD 
                 WILL KNOW IF RPT$CONV HAD A FATAL DIAGNOSTIC.
 #
         $BEGIN 
         IF DEBUG THEN OUTPUT(1," DIAG"); 
         $END 
  
         TESTBIT[0] = ON  ; 
  
          #IF DIAG 2001-2006, 2008, COMPUTE COL NO. # 
  
          COLUMN = GETFIELD(PL$COLUMN,PLT$,PLTPTR); 
  
          IF LOCID EQ 1 
          THEN
              BEGIN 
              COLUMN = SBI + 2 + GETFIELD(PL$COLUMN,PLT$,PLTPTR) ;
              END 
  
          IF LOCID EQ 2 
          THEN
              BEGIN 
              COLUMN = LAI + GETFIELD(PL$COLUMN,PLT$,PLTPTR) ;
              END 
  
          IF LOCID GQ 3 AND LOCID LQ 6
          THEN
              BEGIN 
              COLUMN = SBI + GETFIELD(PL$COLUMN,PLT$,PLTPTR) ;
              END 
         IF LOCID  EQ  7 THEN 
# 
         TEST FOR SEVERE OR PROPAGATED ERROR
 #
                   ERR = PDIAGERR  ;
         ELSE 
                   ERR = DDIAGERR  ;
  
          IF LOCID EQ 8 
          THEN
              BEGIN 
              IF REPFLAG EQ OFF 
                 THEN 
                 BEGIN
                 COLUMN = LAI - 1 + GETFIELD(PL$COLUMN,PLT$,PLTPTR) ; 
                 END
                 ELSE 
                 BEGIN
                 COLUMN = SBI + GETFIELD(PL$COLUMN,PLT$,PLTPTR) ; 
                 END
              END 
  
  
          LINE = GETFIELD(PL$LINE,PLT$,PLTPTR) ;
  
DIAGC:  
         INTERCEPT(COLUMN,LINE,LOCID,ERR);
# 
         MAKE A PAT ERROR ENTRY 
 #
        CREATE$ENTRY(PAT$,PAT$INDEX); 
         SETFIELD(P$ZERO,PAT$,PAT$INDEX,0); 
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATERROR);
         RETURN;
         END #DIAG# 
         CONTROL EJECT; 
#********************************************************************#
    PROC RPTCONV  ;    BEGIN                      #*REPETITION COUNT
          CONV  # 
# 
         SET COUNTER -XI- TO ZERO FOR ACCUMULATING COUNT. 
 #
         $BEGIN 
         IF DEBUG THEN OUTPUT(1," RPTCONV");
         $END 
  
         XI = 0  ;
RPT:  
         LAI = LAI + 1;                   #INCR LOOK AHEAD INDEX   #
         IF PICLEN  EQ  0 THEN                 #IF AT PIC END ISSUE 
          DIAG# 
                   BEGIN
                    DIAG (2) ;
                   RETURN;
                   END ## 
                                            #IF CHAR NOT A DIGIT-DONE#
         TEMP = C<LAI,1> TMPPICSTR; 
         IF TEMP LS O"33" OR TEMP GR O"44" THEN 
                   GOTO ENDREP  ; 
         TEMP = TEMP - O"33";      #ACCUMULATE EACH DIGIT      #
         XI = XI * 10 + TEMP  ; 
         DIGITS = DIGITS + 1  ;             #NO. OF POSITIONS        #
         IF XI GR 131071 THEN 
                   BEGIN                    #  ISSUE DIAGNOSTIC      #
                    DIAG(1)  ;
                   RETURN;
                   END ## 
         PICLEN = PICLEN - 1  ; 
         GOTO RPT  ;                       #LOOP FOR NEXT CHAR      # 
ENDREP: 
# 
         TEST FOR RIGHT PAREN IF NOT GIVE DIAG ELSE DECREMENT 
         PICTURE LENGTH BY 1
 #
         IF TEMP NQ ")" THEN
                   BEGIN
                    DIAG (2); 
                   RETURN;
                   END ## 
         PICLEN = PICLEN -1  ;
       IF XI EQ 0 THEN
          BEGIN 
             DIAG(23);
             RETURN;
          END 
# 
         STORE REPETITION STRING INTO BINARY COUNTER
 #
         NOCHR = NOCHR + XI  ;
         LAI = LAI + 1  ; 
         PICLEN = PICLEN - 1  ; 
         RETURN;
  
         END #RPTCONV#
         CONTROL EJECT; 
#********************************************************************#
    PROC SCALE  ;    BEGIN
# 
         SCALE ROUTINE USED TO GET P$SCALE VALUE(DECIMAL POINT
          LOCATION) 
         THIS ROUTINE IS CALLED BY NUM$ROUT AND NUM$EDIT. 
         IF SRT (15 + 16) ARE ON P WAS USED FOR DECIMAL POINT.
           ELSE ASSUME . OR V OR NOTHING WAS USED FOR DECIMAL POINT.
 #
         $BEGIN 
         IF DEBUG THEN OUTPUT(1," SCALE");
         $END 
  
         IF B<15,1> SRT[0] EQ ON THEN 
                   BEGIN
                   SETFIELD(P$PTLOC,PAT$,PAT$INDEX,PLEFT + TOTNUM); 
                   RETURN;
                   END ## 
         IF B<16,1> SRT[0] EQ ON THEN 
                   BEGIN
                   SETFIELD(P$PTLOC,PAT$,PAT$INDEX,PRIGHT * (-1));
                   RETURN;
                   END ## 
         TEMP = 0  ;
         IF B<4,1> SRT[0] EQ ON OR B<18,1> SRT[0] EQ ON THEN
                   TEMP = TOTNUM - SUBTOT  ;
         SETFIELD(P$PTLOC,PAT$,PAT$INDEX,TEMP); 
         RETURN;
         END #SCALE#
         CONTROL EJECT; 
#********************************************************************#
    PROC EDIT$PAT  ;    BEGIN 
         $BEGIN 
         IF DEBUG THEN OUTPUT(1," EDIT$PAT"); 
         $END 
         ITEM PACKETLEN;
         ITEM FLOATING B;          #FLAG TO INDICATE WHETHER A FLOATING 
                                    STRING IS CURRENTLY BEING PROCESSED#
         ARRAY A$PACKET[0];        #TEMPLATE FOR COMMAND PACKET#
         BEGIN
         ITEM COMMND       U(0,0,3);   #THE COMMAND#
         ITEM RPTCNT       U(0,3,3);   #THE REPETITION COUNT# 
         ITEM INSCHR1      C(0,6,1);   #THE FIRST INSERT CHAR IF ANY# 
         ITEM INSCHR2      C(0,12,1);  #THE 2ND INSERT CHAR IF ANY# 
         ITEM  PKT         C(0,0,5);   #THE PACKET (MAX SIZE IS 5)# 
         #THE FOLLOWING DEFINITIONS ARE USED WHEN#
         #THE REPETITION COUNT IS > 7#
         ITEM  LONGCOMMND  U(0,3,3);
         ITEM  LONGRPTCNT  U(0,6,12); 
         ITEM  LONGINSCH1  C(0,18,1); 
         ITEM  LONGINSCH2  C(0,24,1); 
         END
  
         DEF  DATA         #0#;        #THE COMMANDS# 
         DEF  SIGN         #1#; 
         DEF  INSERT       #2#; 
         DEF  T$FLOAT      #4#; 
         DEF  T$SIGN       #5#; 
         DEF  T$INSERT     #6#; 
  
         DEF  COMMAND      #COMMND[0]#; #RENAME FIELDS OF PACKET# 
         DEF  RPTCOUNT     #RPTCNT[0]#; #TEMPLATE#
         DEF  INSCHAR1     #INSCHR1[0]#;
         DEF  INSCHAR2     #INSCHR2[0]#;
         DEF  PACKET       #PKT[0]#;
  
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
  
         PROC BUILDPATTERN; 
         BEGIN
         #THIS INTERNAL PROC WITHIN EDIT$PAT DOES MOST OF THE ACTUAL
          CONSTRUCTION OF THE EDIT PATTERN. IT IS CALLED BY MOST OF 
          THE SYMBOL-PROCESSING ROUTINES IN EDIT$PAT. 
          THE CALLER PLACES THE COMMAND INTO THE PACKET TEMPLATE
          AND BUILDPATTERN, USING THE PSTL (LENGTH) FIELD OF THE PST, 
          DECIDES HOW MANY PACKETS TO GENERATE AND WHAT THE REPETITION
          COUNTS ARE TO BE. IT ALSO HAS TO MAKE A DECISION AS TO THE
          LENGTH OF THE PACKET. # 
  
         ITEM I,J,K;       #WORKING ITEMS#
         ITEM  LONGFORM  B; 
         ITEM  MAXCOUNT  I; 
  
         I = 0; J = 0; K = 0; 
  
         #DETERMINE PACKET FORM AND LENGTH# 
         LONGFORM = FALSE;
         IF COMMAND EQ DATA 
         THEN BEGIN 
              IF PSTL[SAVE] GR 21 
              THEN BEGIN
                   LONGFORM = TRUE; 
                   PACKETLEN = 3; 
                   END
              ELSE BEGIN
                   PACKETLEN = 1; 
                   END
              END 
         ELSE BEGIN 
              IF COMMAND EQ INSERT
              THEN BEGIN
                   IF PSTL[SAVE] GR 14
                   THEN BEGIN 
                        LONGFORM = TRUE;
                        PACKETLEN = 4;
                        END 
                   ELSE BEGIN 
                        PACKETLEN = 2;
                        END 
                   END
              ELSE
                  BEGIN 
                  IF COMMAND EQ SIGN
                   OR COMMAND EQ T$SIGN  THEN 
                      PACKETLEN = 3;
                  ELSE
                      PACKETLEN = 2;
                  END 
              END 
         IF LONGFORM
         THEN BEGIN 
              LONGINSCH2 = INSCHR2; 
              LONGINSCH1 = INSCHR1; 
              LONGCOMMND = COMMND;
              COMMND = 3; 
              MAXCOUNT = 4095;
              LONGRPTCNT = 4095;
              END 
         ELSE BEGIN 
              MAXCOUNT = 7; 
              RPTCNT   = 7; 
              END 
         I = PSTL[SAVE] / MAXCOUNT; 
         J = PSTL[SAVE] - (I * MAXCOUNT); 
         FOR K = 1 STEP 1 UNTIL I 
          DO BEGIN #GENERATE THE MAXCOUNT PACKETS#
             C<XI,PACKETLEN>PATTERN = C<0,PACKETLEN>PACKET; 
             XI = XI + PACKETLEN; 
             END
          IF J NQ 0 
          THEN BEGIN  #GENERATE THE TRAILER PACKET# 
               IF LONGFORM THEN LONGRPTCNT = J; 
               ELSE RPTCNT = J; 
               C<XI,PACKETLEN>PATTERN = C<0,PACKETLEN>PACKET; 
               XI = XI + PACKETLEN; 
               END
         END                         #END BUILDPATTERN# 
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# 
  
         #MAINLINE OF EDIT PATTERN GENERATOR - INITIALIZATION.# 
  
         XI = 0; SAVE = 0; TEMP = 0;
         FLOATING = FALSE;
         IF B<21,1> SRT[0] EQ 1     #SET UP FILL CHAR: "*" IF THERE IS# 
           OR B<23,1> SRT[0] EQ 1   #ZERO SUPPR. WITH "*"- ELSE SPACE#
            THEN C<XI,1>PATTERN = "*";
         ELSE C<XI,1>PATTERN = " "; 
         XI = XI + 1; 
         GOTO MAINLOOP; 
  
SWITCH PROCESSCHAR                 #SWITCH LIST TO SELECT CORRECT RTN#
         SLASH, B, ZERO, COMMA, PERIOD, 
         LFPLUS, LFMINUS, RFPLUS, RFMINUS,
         RFCR, RFDB, LFCS, NINE, A, X, BP,
         AP, S, V, E, BZ, BSTAR, AZ, ASTAR, 
         BPLUS, BMINUS, APLUS, AMINUS, BCS, 
         ACS, EPLUS, EMINUS;
  
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# 
MAINLOOP: 
         CODE = PSTC[SAVE]; 
         GOTO PROCESSCHAR[CODE];
  
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# 
  
SLASH:                             #SIMPLE INSERT SLASH#
         INSCHAR1 = "/";
         GOTO SIMPINCOMMN;
  
B:                                 #SIMPLE INSERT BLANK#
         INSCHAR1 = " ";
         GOTO SIMPINCOMMN;
  
ZERO:                              #SIMPLE INSERT ZERO# 
         INSCHAR1 = "0";
         GOTO SIMPINCOMMN;
  
COMMA:                             #SIMPLE INSERT COMMA IF DECCOM OFF,# 
         INSCHAR1 = ",";           #SPECIAL INSERT (AS DECIMAL POINT)#
         IF DECCOM[0] EQ ON            #IF DECCOM ON# 
            THEN GOTO DECPTRTN; 
         ELSE GOTO SIMPINCOMMN; 
  
PERIOD:                            #SPECIAL INSERT (AS DECIMAL POINT)#
         INSCHAR1 = ".";           #IF DECCOM OFF, SIMPLE INSERT PERIOD#
         IF DECCOM[0] EQ ON            #IF DECCOM ON# 
            THEN GOTO SIMPINCOMMN;
                                   #ELSE FALL THROUGH TO DECPTRTN#
  
DECPTRTN: 
         FLOATING = FALSE;         #TURN OFF FLOATING INDICATOR#
         IF B<20,1>SRT[0] EQ 0
            AND B<21,1>SRT[0] EQ 0 THEN 
         BEGIN                     #FLOAT CHAR NOT " " OR *: #
         COMMAND = DATA;           #SET UP A D/0 COMMAND TO FORCE#
         RPTCOUNT = 0;             #THE FLOAT CHARACTER IF ANY TO#
         C<XI,1>PATTERN =          #APPEAR BEFORE THE DECIMAL POINT#
                 C<0,1>PACKET;     #ADD COMMAND PACKET TO PATTERN,# 
         XI = XI + 1;              #INCREMENT OFFSET IN PATTERN#
         END
  
SIMPINCOMMN:                       #SIMPLE INSERTION COMMON ROUTINE#
         IF FLOATING
            THEN COMMAND = T$INSERT;
         ELSE COMMAND = INSERT; 
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
LFPLUS:                            #FIXED INSERTION LEFT PLUS#
         COMMAND = SIGN;
         INSCHAR1 = "+";
         INSCHAR2 = "-";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
LFMINUS:                           #FIXED INSERTION LEFT MINUS# 
         COMMAND = SIGN;
         INSCHAR1 = " ";
         INSCHAR2 = "-";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
RFPLUS:                            #FIXED INSERTION RIGHT PLUS# 
         COMMAND = SIGN;
         INSCHAR1 = "+";
         INSCHAR2 = "-";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
RFMINUS:                           #FIXED INSERTION RIGHT MINUS#
         COMMAND = SIGN;
         INSCHAR1 = " ";
         INSCHAR2 = "-";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
RFCR:                              #FIXED INSERTION RIGHT "CR" #
         COMMAND = SIGN;
         INSCHAR1 = " ";
         INSCHAR2 = "C";
         BUILDPATTERN;
         INSCHAR2 = "R";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
RFDB:                              #FIXED INSERTION RIGHT "DB" #
         COMMAND = SIGN;
         INSCHAR1 = " ";
         INSCHAR2 = "D";
         BUILDPATTERN;
         INSCHAR2 = "B";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
LFCS:                              #FIXED INSERTION LEFT CURR. SIGN#
         COMMAND = INSERT;
         INSCHAR1 = TMPCSBYT; 
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
NINE:                              #SYMBOL "9"# 
A:                                 #SYMBOL "A"# 
X:                                 #SYMBOL "X"# 
         FLOATING = FALSE;
         COMMAND = DATA;
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
BP:                                #P BEFORE POINT# 
                                   #FALL THROUGH# 
AP:                                #P AFTER POINT#
S:                                 #SYMBOL S# 
         GOTO SYMBOLEND;
  
V:                                 #SYMBOL "V" #
                                   #FALL THROUGH# 
  
E:                                 #SYMBOL "E" #
         GOTO SYMBOLEND;
  
BZ:                                #ZERO SUPPRESS BLANKS BEFORE POINT#
         FLOATING = TRUE; 
         COMMAND = T$FLOAT; 
         INSCHAR1 = " ";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
BSTAR:                             #ZERO SUPPRESS ASTERISKS#
         FLOATING = TRUE;                              #BEFORE POINT# 
         COMMAND = T$FLOAT; 
         INSCHAR1 = "*";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
AZ:                                #ZERO SUPPRESS BLANKS AFTER POINT# 
        # THE CODE HERE ORIGINALLY ASSUMED THAT 
          "THE ASSUMED DECIMAL POINT" WAS NOT "THE DECIMAL POINT" 
          IN THE ERS/ANSI MANUAL.  ACCORDINGLY, THE CODE READ:  
  
          IF B<15,1>SRT[0] EQ ON                 = IF LEADING P        =
           OR B<18,1>SRT[0] EQ ON  THEN          =   OR V              =
              GOTO BZ:  
          ELSE                                   = ELSE MUST BE .      =
              GOTO NINE:  
  
          HOWEVER, THEY *ARE* CONSIDERED EQUIVALENT, SO ... 
        # 
          GOTO NINE;
  
ASTAR:                             #ZERO SUPPRESS ASTERISKS 
                                   AFTER POINT POSITION#
          GOTO NINE;                   # SEE NOTE TO *AZ* CODE ABOVE   #
  
BPLUS:                             #FLOATING + BEFORE POINT#
         FLOATING = TRUE; 
         COMMAND = T$SIGN;
         INSCHAR1 = "+";
         INSCHAR2 = "-";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
BMINUS:                            #FLOATING - BEFORE POINT#
         FLOATING = TRUE; 
         COMMAND = T$SIGN;
         INSCHAR1 = " ";
         INSCHAR2 = "-";
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
APLUS:                             #FLOATING + AFTER POINT# 
         IF B<15,1> SRT[0] EQ ON OR B<18,1> SRT[0] EQ ON
            THEN GOTO BPLUS;        #SEE NOTE TO AZ ROUTINE ABOVE.   #
         ELSE GOTO NINE;
  
AMINUS:                            #FLOATING - AFTER POINT# 
         IF B<15,1> SRT[0] EQ ON OR B<18,1> SRT[0] EQ ON
            THEN GOTO BMINUS;       #SEE NOTE TO AZ ROUTINE ABOVE.   #
         ELSE GOTO NINE;
  
BCS:                               #FLOATING CURR. SIGN BEFORE POINT# 
         FLOATING = TRUE; 
         COMMAND = T$FLOAT; 
         INSCHAR1 = TMPCSBYT; 
         BUILDPATTERN;
         GOTO SYMBOLEND;
  
ACS:                               #FLOATING CURR. SIGN AFTER POINT#
         IF B<15,1> SRT[0] EQ ON OR B<18,1> SRT[0] EQ ON
            THEN GOTO BCS;          #SEE NOTE TO AZ ROUTINE ABOVE.   #
         ELSE GOTO NINE;
  
EPLUS:                             #EXPONENT PLUS#
EMINUS:                            #EXPONENT MINUS# 
                                   #FALL THROUGH TO SYMBOLEND#
  
SYMBOLEND:  
         SAVE = SAVE + 1;          #INCREMENT INDEX INTO PST# 
         PSTCNT = PSTCNT - 1; 
         IF PSTCNT GR 0 
            THEN GOTO MAINLOOP; 
         $BEGIN 
         IF DISPATT THEN
         BEGIN
         DISPLAY(DSP,OCT(PATTERN,0,40),0,40); 
         END
         $END 
  
         END #EDIT$PAT# 
         CONTROL EJECT; 
         PROC SEE$IF$FLTNG (FLOATER); 
  
#        PURPOSE:  TO SCAN PICTURES BEGINNING WITH A "+", "-",         #
#                  OR CS TO SEE WHETHER THE LEADING CHARACTER IS       #
#                  THE HEADER OF A FLOATING STRING OR THE LEFT         #
#                  FIXED TYPE. THE ALGORITHM SCANS PAST ALL EMBEDDED   #
#                  /  B  0  ,  . CHARACTERS AS THESE ARE PERMITTED     #
#                  WITHIN A FLOATING STRING.                           #
#        CALLED BY: RECOGNIZER ROUTINES PLMI AND RCG$11 (CS).          #
#                                                                      #
  
  
         BEGIN
         ITEM FLOATER C(1),  CC C(1); 
  
         TEMPCHAR1B = " ";
         FOR TEMP = LAI STEP 1 WHILE TEMPCHAR1B EQ " " DO 
            BEGIN 
            CC = C<TEMP,1> TMPPICSTR; 
            IF CC EQ "/" OR CC EQ "B" OR CC EQ "0" OR CC EQ "," 
                 OR CC EQ "." THEN TEST;
            IF CC EQ FLOATER THEN TEMPCHAR1B = "Y"; 
            ELSE TEMPCHAR1B = "N";
            END 
         RETURN;
         END  #SEE$IF$FLTNG#
         CONTROL EJECT; 
#********************************************************************#
# 
         BEGIN MAIN PROGRAM - (TABLE SET UP)
 #
  
         $BEGIN 
         LOWTRACE = 9999; 
         HIGHTRACE = TOBIN("9999D     ",0); 
          IF CCTCHKOUT[0] NQ 0
             AND
             PARAMC[0] NQ "          "
          THEN
              BEGIN 
              # DEBUG COMMAND IS --                 # 
              #       PICANALYZR,I,J                # 
              # WHERE I IS THE NUMBER OF THE FIRST  # 
              # PICTURE TO BE TRACED AND J THE      # 
              # NUMBER OF THE LAST.                 # 
              LOWTRACE = TOBIN(PARAMC[0],0);
              HIGHTRACE =TOBIN(PARAMC[1],0);
              END 
         $END 
  
         PLSTLENGTHF = CCTPLTLEN + 1; 
         PATLENGTHF = 0  ;
         PLTPTR = 0;
         PLTSTOP = CCTPDLITADDR ; 
# 
         MOVE CURRENCY SYMBOL FROM CCT TO CSBYT[0]
 #
         CSBYT[0] = CCTCURRSIGN[0]; 
         IF CSBYT[0] NQ  "$" THEN 
                   CSIS[0] = ON  ;
         IF CCTDECPTCOMM[0] THEN
                   DECCOM[0] = ON  ;
         EPLTSTART = PLSTLENGTHF; 
         CCTEDITPADDR = EPLTSTART  ;
         EDPLTI = EPLTSTART;                 #SET INDEX FOR EP"S #
         PAT$INDEX = 1; 
         CONTROL EJECT; 
#********************************************************************#
BGNPIC:  #*** BEGIN PICTURE CYCLE # 
# 
         INDEX TO NEXT PLT ENTRY
 #
PLTPTR = PLTPTR + 1;
# 
         TEST FOR END OF PLT OR LOOP ON LITERALS
 #
         $BEGIN 
         IF PAT$INDEX GQ LOWTRACE AND PAT$INDEX LQ HIGHTRACE
            THEN DEBUG = TRUE;   ELSE DEBUG = FALSE;
         $END 
         IF PLTPTR GQ  PLTSTOP THEN 
                        GOTO PRGEND;
         IF GETFIELD(PL$TYPE,PLT$,PLTPTR) NQ  PLTPICTURE THEN 
                        GOTO BGNPIC  ;
# 
         CLEAR SWITCHES AND COUNTERS FOR BEGINNING OF PICTURE 
 #
         DECBYT[0] = 0    ; 
         CATBYT[0] = 0  ; 
         IGNORE[0] = OFF  ; 
         CONST[0]  = OFF  ; 
         AST[0]    = OFF  ; 
         PICLEN  =0;
         TOTNUM  =0;
         SUBTOT  =0;
         PLEFT   =0;
         PRIGHT  =0;
         DIGITS  =0;
         EDITCR  =0;
         PSTCNT  =0;
         NOCHR   =0;
         COELEN  =0;
         EXPLEN  =0;
         XI      =0;
         TEMP    =0;
         REPFLAG = OFF ;
         SRTZERO[0] =0; 
         ISTAND[0] = X"FFFFFFFFF";
         B<4,1> FLAGS[0] = ON;
         LAI = 0  ; 
         TMPCSBYT = CSBYT[0]; 
         PICLEN = GETFIELD(PL$LENGTH,PLT$,PLTPTR)  ;
         IF PICLEN GR 30 THEN 
                   BEGIN
                    DIAG(7)  ;
                   GOTO ENDPIC  ; 
                   END ## 
          TMPPICSTR = "                              "; 
         GETPLST(PLTPTR,LOC(TMPPICSTR));   #MOVE PIC STRING FROM PLST#
                                           #INTO TMPPICSTR.          #
         $BEGIN 
          IF DEBUG
          THEN
              DISPLAY(DSP,TMPPICSTR,0,PICLEN);
         $END 
  
# 
         FALL THROUGH TO BGN$SYM
 #
         CONTROL EJECT; 
#********************************************************************#
BGNSYM:  #** BEGIN SYMBOL CYCLE   # 
# 
         SET COUNTERS AND GET CHARACTER (CODEX) 
         THEN CONVERT CHARACTER TO INTERNAL CODE (CODE) 
 #
  
  
         CR[0] = OFF; 
         DB[0] = OFF; 
         DIGITS = 0  ;
         TESTBIT[0] = 0  ;
         SBI = LAI   ;
         REPFLAG = OFF ;
         CODEX = C<LAI,1> TMPPICSTR;
                   CODE = TTS[CODEX]  ; 
# 
         CURRENCY SUMBOL MAY BE EITHER A   (POUND SIGN), $ (DOLLAR
            SIGN) OR THE CHAR IN THE CURRENCY SYMBOL IS CLAUSE. 
         ONLY ONE MAY BE USED IN A PICTURE BUT ALL MAY APPEAR IN A PRG
         THE TRANSLATED CODE IS CHANGED TO A 11 HEX ( B) AND THE
            CHAR IS STORED IN THE PST AND CNST TABLE TO BE USED FOR 
            EDIT PATTERN GENERATION.
 #
         IF B<11,1> SRT[0] EQ ON   OR 
            B<28,1> SRT[0] EQ ON   OR 
            B<29,1> SRT[0] EQ ON       THEN 
                   TESTBIT[0] = 1  ;
# 
         IF SECOND CURR SYMBOL IS THE SAME OR SYMBOL IS A "$" OR " "
            OR IS THE CURRENCY SYMBOL IS "SYMBOL" 
 #
         IF (CODEX  EQ  TMPCSBYT) THEN
                   BEGIN
                   IF TESTBIT[0] EQ 1 OR CODE EQ 11 OR CODE EQ 61 
                             OR CSIS[0] EQ ON THEN
                             BEGIN
                             CODE = 11  ; 
                             GOTO LOOKAHD  ;
                             END ## 
                   END ## 
         ELSE 
# 
         SECOND CURR SYMBOL DIFFERENT AND IT IS A "$" THEN ERROR
 #
                   BEGIN
                   IF ((TESTBIT[0] EQ  1) AND (CODE EQ 11)) THEN
                             BEGIN
                              DIAG(6)  ;
                             GOTO ENDPIC  ; 
                             END ## 
# 
         FIRST CURR SYMBOL AND ITS A "$" OR " " - SAVE IT 
 #
                   IF ((TESTBIT[0] EQ  0) AND ((CODE EQ 11) OR (CODE EQ 
          61))) THEN
                             BEGIN
                             TMPCSBYT = CODEX  ;
                             CODE = 11  ; 
                             GOTO LOOKAHD  ;
                             END ## 
                   END ## 
# 
         IF CODE GR 21 SPECIAL CASE ERROR 
             THESE CHARACTERS ARE ( ) 1 2 3 4 5 6 7 8 
 #
         IF CODE GR 21 AND CODE NQ 32  THEN 
                   BEGIN
                   IF CODE  EQ  50 THEN 
                             BEGIN
                              DIAG(3)  ; #LEFT PAREN OUT OF PLACE#
                             GOTO ENDPIC  ; 
                             END ## 
                   IF CODE  EQ  51 THEN 
                             BEGIN
                              DIAG(4)  ;#RIGHT PAREN OUT OF PLACE#
                             GOTO ENDPIC  ; 
                             END ## 
                   IF CODE  EQ  60 THEN 
                             BEGIN
                              DIAG(5)  ; #NUMERICS OUT OF PLACE  #
                             GOTO ENDPIC  ; 
                             END ## 
                    DIAG(6)  ;          #INVALID CHARACTER       #
                   GOTO ENDPIC  ; 
                   END ## 
# 
         FALL THROUGH TO LOOK$AHD 
 #
         CONTROL EJECT; 
#********************************************************************#
LOOKAHD:  #LOOK AHEAD ROUTINE      #
         NOCHR =1;
         LAI = LAI + 1 ;                       # INCR LOOK AHEAD CTR #
         IF PICLEN  EQ  0 THEN
                   GOTO RCGNZR ;
# 
         THERE CANNOT BE MORE THAN ONE "E . , S V C D" IN A PICTURE 
 #
         IF CODEX  EQ  "E" OR CODEX EQ "S" OR CODEX EQ "V" THEN 
                   GOTO LAEND ; 
# 
         IF DEC PT IS COMMA MORE THAN ONE PERIOD IS ALLOWED 
 #
         IF CODEX  EQ  "." THEN 
                   BEGIN
                   IF DECCOM[0] EQ  ON THEN 
                             GOTO LACONT  ; 
                   ELSE 
                             GOTO LAEND ; 
                   END ## 
# 
         IF DEC PT IS COMMA ONLY ONE COMMA IS ALLOWED 
 #
         IF CODEX  EQ  "," THEN 
                   BEGIN
                   IF DECCOM[0] EQ  ON THEN 
                             GOTO LAEND  ;
                   ELSE 
                             GOTO LACONT  ; 
                   END ## 
# 
         ENCOUNTERED "C" NEXT MUST BE "R" 
 #
         IF CODEX  EQ  "C" THEN 
                   BEGIN
               TEMPCHAR1A=C<LAI>TMPPICSTR;IF TEMPCHAR1A  EQ  "R" THEN 
                             CR[0] = 1 ;
                   GOTO LAEND  ;
                   END ## 
# 
         ENCOUNTERED "D" NEXT MUST BE "B" 
 #
         IF CODEX  EQ  "D" THEN 
                   BEGIN
               TEMPCHAR1A=C<LAI>TMPPICSTR;IF TEMPCHAR1A  EQ  "B" THEN 
                             DB[0] = 1  ; 
                   GOTO LAEND  ;
                   END ## 
LACONT: 
# 
         IF NEXT CHAR IS THE SAME INCREMENT POINTERS AND CONSTANTS
 #
     TEMPCHAR1B=C<SBI> TMPPICSTR; 
     TEMPCHAR1A=C<LAI>TMPPICSTR;IF TEMPCHAR1A  EQ  TEMPCHAR1B THEN
                   BEGIN
                   REPFLAG = ON ; 
                   NOCHR = NOCHR +1;
                   PICLEN = PICLEN - 1  ; 
                   LAI = LAI + 1  ; 
                   IF PICLEN  EQ  0 THEN
                             GOTO RCGNZR  ; 
                   GOTO LACONT  ; 
                   END ## 
# 
         IF CHAR IS LEFT PAREN REPETITION COUNT IS NEXT 
 #
     TEMPCHAR1A=C<LAI>TMPPICSTR;IF TEMPCHAR1A  EQ  "(" THEN 
                   BEGIN
                   NOCHR = NOCHR - 1  ; 
                   PICLEN = PICLEN - 1 ;
                   TESTBIT[0] = 0  ;
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
                    RPTCONV  ;
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
                   IF TESTBIT[0] EQ  ON THEN
                             GOTO ENDPIC  ; 
                   ELSE 
                             GOTO RCGNZR  ; 
                   END ## 
LAEND:  
# 
         DECREMENT PICTURE LENGTH COUNTER AND GOTO RECOGNIZE CHARACTER
 #
         PICLEN = PICLEN - 1; 
# 
         FALL THROUGH TO RECOGNIZER (RCGNZR). 
 #
         CONTROL EJECT; 
# 
         USING CODE AS THE CASE SELECTOR WILL ALLOW PROPER PROCESSING 
            OF THE INDIVIDUAL CHARACTERS.  THERE ARE 22 POSSIBLE VALUES 
            RANGING FROM ZERO (0) TO 21.
         VALUE  CHAR  ROUTINE 
         -----  ----  ------- 
           0      /   SIMPIN
           1      B   SIMPIN
           2      0   SIMPIN
           3      ,   COMMA 
           4      .   PERIOD
           5      +   PLMI
           6      -   PLMI
           7      +   RCG$ER
           8      -   RCG$ER
           9     CR   CREDIT SYMBOL 
          10     DB   DEBIT SYMBOL
          11     CS   CURRENCY SYMBOL 
          12      9   CHARACTER 
          13      A   CHARACTER 
          14      X   CHARACTER 
          15      P   PLEFT 
          16      P   RCG$ER
          17      S   SIGN
          18      V   IMPLIED DECIMAL 
          19      E   EXPONENT
          20      Z   ZAST
          21      *   ZAST
         ALL ROUTINES WHEN FINISHED WILL GOTO THE STATEMENT FOLLOWING 
            THE DO CASE WHICH IS THE BEGINNING OF THE CAT$SYN ROUTINE.
         THE EXCEPTION TO THIS IS IF THERE IS A DIAGNOSTIC A BRANCH 
            TO THE END$PIC ROUTINE WILL BE MADE IMMEDIATELY AFTER 
            ISSUING THE ERROR MESSAGE.
 #
         CONTROL EJECT; 
#********************************************************************#
RCGNZR:  #RECOGNIZE CHARACTER     # 
# 
         THE VARIABLE -SAVE- IS SET TO ZERO FIRST.
         IF DECCOM IS ON THEN -SAVE- WILL CONTAIN A VALUE 
           TO CHANGE CODE TO EITHER PERIOD OR COMMA.
         AT THE END OF THE DO CASE CAT$SYN WILL 
           ADD -SAVE- TO THE CODE.
 #
         SAVE = 0;
# $X2 # 
         $BEGIN 
         IF DEBUG THEN
         OUTPUT(5,"RCGNZR","CODE=",DEC(CODE),"FLAGS=",DEC(FLAGS));
         $END 
  
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
         SWITCH RCGLABLLIST    SIMPIN,RCG$1,SIMPIN,RCG$3,RCG$4, 
                       PLMI,PLMI,RCGER,RCGER,RCG$9,RCG$10,RCG$11, 
                       RCG$12,CHAR1,CHAR1,RCG$15,RCGER,RCGCASEEND,
                       RCG$18,RCG$19,ZED,ASTERISK,,,,,,,,,,,RCG$32; 
     GOTO RCGLABLLIST[CODE];
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
#---------------------------------------------------------------------- 
   CASE  0 = / SIMPLE INSERT
----------------------------------------------------------------------# 
SIMPIN: 
         BEGIN
         EDITCR = EDITCR + NOCHR;         #TOTAL EDIT CHARACTERS   #
         IGNORE[0] = ON  ;                #SET IGNORE FOR EDIT PAT #
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE  1 = B SIMPLE INSERT
----------------------------------------------------------------------# 
RCG$1:  
# 
         SOURCE CHAR NO LONGER REQUIRED 
         CONVERT SOURCE FROM "B" TO SPACE CHAR IN CASE OF ANE.
 #
         BEGIN
         CODEX = " "  ; 
         GOTO SIMPIN  ; 
         END ## 
#---------------------------------------------------------------------- 
   CASE  2 = 0 SIMPLE INSERT
----------------------------------------------------------------------- 
         GOTO SIMPIN
----------------------------------------------------------------------- 
   CASE  3 = , COMMA
----------------------------------------------------------------------# 
RCG$3:  
         BEGIN
         IF DECCOM[0] EQ  ON THEN                #PROCESS AS PERIOD 
          # 
                   BEGIN
                   SAVE = -1  ;             #CHANGE TO PERIOD VALUE  #
                   CODE = CODE + 1  ;       # FOR CATEGORY ROUTINE   #
                   B<5,1> FLAGS[0] = ON  ;         #SET DECIMAL POINT 
          SW    # 
                   SUBTOT = TOTNUM  ;       #NUMERICS BEFORE DEC PT  #
                   END ## 
         EDITCR = EDITCR + NOCHR  ;         #TOTAL EDIT CHARACTERS   #
         IGNORE[0] = ON  ;                #SET IGNORE FOR EDIT PAT #
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE  4 = . PERIOD 
----------------------------------------------------------------------# 
RCG$4:  
         BEGIN
         IF DECCOM[0] EQ  OFF THEN               #PROCESS AS PERIOD 
          # 
                   BEGIN
                   B<5,1> FLAGS[0] = ON  ;         #SET DECIMAL POINT 
          SW    # 
                   SUBTOT = TOTNUM  ;       #NUMERICS BEFORE DEC PT  #
                   END ## 
         ELSE                               #PROCESS AS COMMA        #
                   BEGIN
                   SAVE = 1  ;              #CHANGE TO PERIOD VALUE  #
                   CODE = CODE - 1  ;       # FOR CATEGORY ROUTINE   #
                   END ## 
         EDITCR = EDITCR + NOCHR  ;         #TOTAL EDIT CHARACTERS   #
         IGNORE[0] = ON  ;                #SET IGNORE FOR EDIT PAT #
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE  5 = + PLMI 
----------------------------------------------------------------------# 
PLMI: 
         BEGIN
         LOCID = 8; 
         IF B<19,1> SRT[0]  EQ  ON THEN               #FLOATING POINT 
          SIGN     #
                   BEGIN                    # NOT MORE THAN ONE CAN  #
                   IF NOCHR GR 1 THEN        # BE USED AFTER "E"      # 
                             BEGIN
                              DIAG(LOCID)  ;
                             GOTO ENDPIC  ; 
                             END ## 
                   ELSE 
                             BEGIN
                             EDITCR = EDITCR + 1 ; #INCR EDIT COUNT  #
                             CODE = CODE + 25  ; #CHANGE CODE TO +/- #
                             GOTO CASEEND  ;   # AFTER E           #
                             END ## 
                   END ## 
         IF B<24,1> SRT[0]  EQ  ON OR B<25,1> SRT[0] EQ ON THEN  #IF
          FLOAT BEFORE SET  # 
                   BEGIN                    #  SWITCH IN DECBYT      #
                   B<7,1> FLAGS[0] = ON  ;
                   TESTBIT[0] = 1  ;
                   END ## 
         ELSE 
                   TESTBIT[0] = 0  ;
          IF NOCHR GR 1 THEN
             TEMPCHAR1B = "Y";
           ELSE 
              BEGIN 
                TEMPCHAR1A = C<SBI,1>TMPPICSTR; 
                 SEE$IF$FLTNG(TEMPCHAR1A);
              END 
          IF TEMPCHAR1B EQ "Y" THEN 
              BEGIN 
                B<6,1>FLAGS[0] = ON;    #INDICATE  #
                GOTO PLMI$0;            #FLOATING  #
              END                       #STRING    #
         IF PICLEN NQ  0 THEN                # FLOATING THEN THIS  #
                   GOTO PLMI$0  ;             # IS A FIXED RIGHT    # 
         IF TESTBIT[0] EQ  0 THEN 
                   DECBYT[0] = 0  ; 
         CONTROL EJECT; 
# 
         THE DECISION BYTE (DECBYT) WILL SERVE AS A CASE SELECTOR 
             FOR EVALUATING THE PLUS OR MINUS AS TO WHETHER ITS 
             FIXED RIGHT OR LEFT OR FLOATING BEFORE OR AFTER. 
             VALUES OF 9, 11, 13 , AND 15 GIVE DIAGNOSTIC NO. 18. 
             VALUES OF 2, AND 6 GIVE SYNTAX DIAGNOSTIC NO. 8. 
 #
PLMI$0: 
# $X2 # 
         $BEGIN 
         IF DEBUG THEN
         OUTPUT(5,"PLMI","CODE=",DEC(CODE),"FLAGS=",DEC(FLAGS));
         $END 
  
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
         SWITCH PLMILABLLIST   PLMI$2,PLMI$1,PLMI$5,PLMI$1,PLMI$2,
                       PLMI$3,PLMI$3,PLMI$3,PLMI$4,PLMI$6,PLMI$1, 
                       PLMI$6,PLMI$4,PLMI$6,PLMI$3,PLMI$6;
         GOTO PLMILABLLIST[DECBYT[0]];
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
#---------------------------------------------------------------------- 
  PCASE  0 = FIXED RIGHT
----------------------------------------------------------------------# 
PLMI$2: 
             BEGIN
             CODE = CODE + 2;             #INCR BY 2 FOR FIXED RGT #
             EDITCR = EDITCR + NOCHR;     #TOTAL EDIT CHARACTERS   #
             END ## 
            GOTO CASEEND; 
#---------------------------------------------------------------------- 
  PCASE  1 = FLOATING BEFORE
----------------------------------------------------------------------# 
PLMI$1: 
             BEGIN
             CODE = CODE + 19;            #INCR BY 19 FOR FLOAT BEF#
             TOTNUM = TOTNUM + NOCHR  ;     #INCR TOTAL NUMERIC COUNT#
             IF B<7,1> FLAGS[0]  EQ  OFF THEN 
                       BEGIN
                       TOTNUM = TOTNUM - 1  ; #DECR FOR SIGN PSN     #
                       EDITCR = EDITCR + 1 ;  #INCR FOR SIGN PSN     #
                       END ## 
             B<4,1> FLAGS[0] = OFF; 
             IGNORE[0] = OFF; 
             END ## 
             GOTO CASEEND;
#---------------------------------------------------------------------- 
  PCASE  2 = SYNTAX ERROR 
----------------------------------------------------------------------# 
PLMI$5: 
             BEGIN
              DIAG(LOCID);
             GOTO ENDPIC  ; 
             END ## 
#---------------------------------------------------------------------- 
  PCASE  3 = FLOATING BEFORE
----------------------------------------------------------------------- 
             GOTO PLMI$1                  -IN PCASE 1              -
----------------------------------------------------------------------- 
  PCASE  4 = FIXED RIGHT
----------------------------------------------------------------------- 
             GOTO PLMI$2                  -IN PCASE 0              -
----------------------------------------------------------------------- 
  PCASE  5 = FLOATING AFTER 
----------------------------------------------------------------------# 
PLMI$3: 
             BEGIN
             CODE = CODE + 21;            #INCR BY 21 FOR FLOAT AFT#
             TOTNUM = TOTNUM + NOCHR  ;     #INCR TOTAL NUMERIC      #
             B<4,1> FLAGS[0] = OFF; 
             IGNORE[0] = OFF; 
             END ## 
             GOTO CASEEND;
#---------------------------------------------------------------------- 
  PCASE  6  = FLOATING AFTER WITH NO FLOATING BEFORE
----------------------------------------------------------------------- 
             GO TO PLMI$3                  -IN PCASE 5
----------------------------------------------------------------------- 
  PCASE  7 = FLOATING AFTER 
----------------------------------------------------------------------- 
             GOTO PLMI$3                  -IN PCASE 5              -
----------------------------------------------------------------------- 
  PCASE  8 = FIXED LEFT 
----------------------------------------------------------------------# 
PLMI$4: 
             BEGIN
             IGNORE[0] = OFF; 
             EDITCR = EDITCR + NOCHR  ;     #TOTAL EDIT CHARACTERS   #
             END ## 
             GOTO CASEEND;
#---------------------------------------------------------------------- 
  PCASE  9 = INVALID DECISION 
----------------------------------------------------------------------# 
PLMI$6: 
             BEGIN
              DIAG(18); 
             GOTO ENDPIC  ; 
             END ## 
#---------------------------------------------------------------------- 
  PCASE 10 = FLOATING BEFORE
----------------------------------------------------------------------- 
             GOTO PLMI$1                  -IN PCASE 1              -
----------------------------------------------------------------------- 
  PCASE 11 = INVALID DECISION 
----------------------------------------------------------------------- 
             GOTO PLMI$6                  -IN PCASE 9              -
----------------------------------------------------------------------- 
  PCASE 12 = FIXED LEFT 
----------------------------------------------------------------------- 
             GOTO PLMI$4                  -IN PCASE 8              -
----------------------------------------------------------------------- 
  PCASE 13 = INVALID DECISION 
----------------------------------------------------------------------- 
             GOTO PLMI$6                  -IN PCASE 9              -
----------------------------------------------------------------------- 
  PCASE 14 = FLOATING AFTER 
----------------------------------------------------------------------- 
             GOTO PLMI$3                  -IN PCASE 5              -
----------------------------------------------------------------------- 
  PCASE 15 = INVALID DECISION 
----------------------------------------------------------------------- 
             GOTO PLMI$6                  -IN PCASE 9              -
-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX-
- 
         END OF PLMI DO CASE ON DECBYT
 #
# 
         END OF PLMI DO CASE 5
 #
CASEEND:  
         END ## 
         GOTO RCGCASEEND; 
         CONTROL EJECT; 
#---------------------------------------------------------------------- 
   CASE  6 = - PLMI 
----------------------------------------------------------------------- 
         GOTO PLMI                      -IN CASE 5               -
----------------------------------------------------------------------- 
   CASE  7 = ERROR (PLUS IS A FIXED RIGHT COMES IN AS A CASE 5 FIRST
                    AND IS PROCESSED THERE) 
----------------------------------------------------------------------# 
RCGER:  
         BEGIN
          DIAG(20); 
         GOTO ENDPIC  ; 
         END ## 
#---------------------------------------------------------------------- 
   CASE  8 = ERROR (MINUS IS A FIXED RIGHT COMES IN AS A CASE 6 FIRST 
                    AND IS PROCESSED THERE) 
----------------------------------------------------------------------- 
         GOTO RCGER 
----------------------------------------------------------------------- 
   CASE  9 = CREDIT SYMBOL (CR) 
----------------------------------------------------------------------# 
RCG$9:  
         BEGIN
         IF CR[0]  EQ  OFF THEN                   #IF SWITCH NOT SET THE
          # 
                   BEGIN                    #  THERE IS NOT AN "R"   #
                    DIAG(8)  ;
                   GOTO ENDPIC  ; 
                   END ## 
CR$DB:  
         EDITCR = EDITCR + 2;             #INCR EDIT CHAR BY 2     #
         PICLEN = PICLEN - 1  ;             #DECR PICLEN FOR "R"/"B" #
         LAI = LAI + 1  ;                   #INCR LAI FOR "R"/"B"    #
         B<4,1> FLAGS[0] = OFF  ;                  #TURN OFF FIRST
          SWITCH   #
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE 10 = DEBIT SYMBOL (DB)
----------------------------------------------------------------------# 
RCG$10: 
         BEGIN
         IF DB[0]  EQ  OFF THEN                   #IF SWITCH NOT SET THE
          # 
                   BEGIN                    #  THERE IS NOT AN "B"   #
                    DIAG(8)  ;
                   GOTO ENDPIC  ; 
                   END ## 
         GOTO CR$DB  ;                     #IN CASE 9               # 
         END ## 
#---------------------------------------------------------------------- 
   CASE 11 = CURRENCY SYMBOL ($ OR   OR CURR SYM IS CLAUSE) 
----------------------------------------------------------------------# 
RCG$11: 
         BEGIN
# 
         SET FLOATING BEFORE SWITCH 
 #
         IF B<28,1> SRT[0]  EQ  ON THEN 
                   B<7,1> FLAGS[0] = ON  ;
# 
         SET LENGTH > 1 SWITCH
 #
          IF NOCHR GR 1 THEN
              TEMPCHAR1B = "Y"; 
           ELSE 
               BEGIN
                 TEMPCHAR1A = C<SBI,1>TMPPICSTR;
                 SEE$IF$FLTNG(TEMPCHAR1A);
               END
           IF TEMPCHAR1B EQ "Y"  THEN 
               BEGIN                       #INDICATE  # 
                 B<6,1>FLAGS[0] = ON;      #FLOATING  # 
               END                         #STRING    # 
         CONTROL EJECT; 
# 
         THE DECISION BYTE (DECBYT) WILL SERVE AS A CASE SELECTOR 
             FOR EVALUATING THE CURRENCY SYMBOL AS TO WHETHER ITS 
             FIXED LEFT OR FLOATING BEFORE OR AFTER.
             VALUES OF 9, 11, 13, AND 15 GIVE DIAGNOSTIC NO. 18.
             VALUES OF 0, 2, 4, AND 6 GIVE SYNTAX DIAGNOSTIC NO. 8. 
 #
# $X2 # 
         $BEGIN 
         IF DEBUG THEN
         OUTPUT(5,"CS","CODE=",DEC(CODE),"FLAGS=",DEC(FLAGS));
         $END 
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
         SWITCH CSLABLLIST     CSERR,CS$1,CSERR,CS$1,CSERR,CS$2,
                               CS$2,CS$2,CS$3,CSER,CS$1,CSER, 
                               CS$3,CSER,CS$2,CSER; 
         GOTO CSLABLLIST[DECBYT[0]];
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
#---------------------------------------------------------------------- 
  CCASE  0 = SYNTAX ERROR 
----------------------------------------------------------------------# 
CSERR:  
           BEGIN
            DIAG(8);
           GOTO ENDPIC  ; 
           END ## 
#---------------------------------------------------------------------- 
  CCASE  1 = FLOATING BEFORE
----------------------------------------------------------------------# 
CS$1: 
           BEGIN
           CODE = CODE + 17;              #INCR CODE BY 17         #
           TOTNUM = TOTNUM + NOCHR  ;       #INCR TOTAL NUMERICS     #
           IF B<7,1> FLAGS[0]  EQ  OFF THEN 
                   BEGIN
                   TOTNUM = TOTNUM - 1  ;   #DECR TOTAL BY 1 FOR $   #
                   EDITCR = EDITCR + 1  ;   #INCR EDIT CHAR FOR $    #
                   END ## 
           B<4,1> FLAGS[0] = OFF; 
           IGNORE[0] = OFF; 
           END ## 
           GOTO CSCASEEND;
#---------------------------------------------------------------------- 
  CCASE  2 = SYNTAX ERROR 
----------------------------------------------------------------------- 
           GOTO CSERR                    -IN CCASE 0              - 
----------------------------------------------------------------------- 
  CCASE  3 = FLOATING BEFORE
----------------------------------------------------------------------- 
           GOTO CS$1                      -IN CCASE 1              -
----------------------------------------------------------------------- 
  CCASE  4 = SYNTAX ERROR 
----------------------------------------------------------------------- 
           GOTO CSERR                    -IN CCASE 0              - 
----------------------------------------------------------------------- 
  CCASE  5 = FLOATING AFTER 
----------------------------------------------------------------------# 
CS$2: 
           BEGIN
           CODE = CODE + 18;              #INCR CODE BY 18         #
           TOTNUM = TOTNUM + NOCHR  ;       #INCR TOTAL NUMERICS     #
           B<4,1> FLAGS[0] = OFF; 
           IGNORE[0] = OFF; 
           END ## 
           GOTO CSCASEEND;
#---------------------------------------------------------------------- 
  CCASE 6 = FLOATING AFTER WITH NO FLOATING BEFORE
----------------------------------------------------------------------- 
           GO TO CS$2                      -IN CCASE 5
----------------------------------------------------------------------- 
  CCASE  7 = FLOATING AFTER 
----------------------------------------------------------------------- 
           GOTO CS$2                      -IN CCASE 5              -
----------------------------------------------------------------------- 
  CCASE  8 = FIXED LEFT 
----------------------------------------------------------------------# 
CS$3: 
           BEGIN
           EDITCR = EDITCR + NOCHR;       #INCR EDIT CHARACTERS    #
           IGNORE[0] = OFF  ; 
           END ## 
           GOTO CSCASEEND;
#---------------------------------------------------------------------- 
  CCASE  9 = INVALID DECISION 
----------------------------------------------------------------------# 
CSER: 
           BEGIN
            DIAG(18); 
           GOTO ENDPIC  ; 
           END ## 
#---------------------------------------------------------------------- 
  CCASE 10 = FLOATING BEFORE
----------------------------------------------------------------------- 
           GOTO CS$1                      -IN CCASE 1              -
----------------------------------------------------------------------- 
  CCASE 11 = INVALID DECISION 
----------------------------------------------------------------------- 
           GOTO CSER                     -IN CCASE 9              - 
----------------------------------------------------------------------- 
  CCASE 12 = FIXED LEFT 
----------------------------------------------------------------------- 
           GOTO CS$3                      -IN CCASE 8              -
----------------------------------------------------------------------- 
  CCASE 13 = INVALID DECISION 
----------------------------------------------------------------------- 
           GOTO CSER                     -IN CCASE 9              - 
----------------------------------------------------------------------- 
  CCASE 14 = FLOATING AFTER 
----------------------------------------------------------------------- 
           GOTO CS$2                      -IN CCASE 5              -
----------------------------------------------------------------------- 
  CCASE 15 = INVALID DECISION 
----------------------------------------------------------------------- 
           GOTO CSER                     -IN CCASE 9              - 
-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX-
- 
         END OF CSROUT DO CASE ON DECBYT
 #
CSCASEEND:     # CANT END THE LINE THERE  # 
# 
         END OF CSROUT DO CASE 11 
 #
         END ## 
         GOTO RCGCASEEND; 
         CONTROL EJECT; 
#---------------------------------------------------------------------- 
   CASE 12 = CHARACTER "9" (NUMERIC)
----------------------------------------------------------------------# 
RCG$12: 
         BEGIN
         IF B<19,1> SRT[0]  EQ  ON THEN               #PUT EXPONENT 
          LENGTH IN  #
                   EXPLEN = NOCHR  ;        #  COUNTER               #
# 
         SOURCE CHAR NO LONGER REQUIRED 
         CONVERT SOURCE CHAR "A" + "9" TO "X" IN CASE OF AE OR ANE. 
 #
CHAR1:  
         CODEX = "X"; 
         TOTNUM = TOTNUM + NOCHR  ;         #INCR TOTAL NUMERICS     #
         B<4,1> FLAGS[0] = OFF; 
         IGNORE[0] = OFF; 
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE 13 = CHARACTER "A" (ALPHABETIC) 
----------------------------------------------------------------------- 
         GOTO CHAR1                      -IN CASE 12              - 
----------------------------------------------------------------------- 
   CASE 14 = CHARACTER "X" (ALPHANUMERIC) 
----------------------------------------------------------------------- 
         GOTO CHAR1                      -IN CASE 12              - 
----------------------------------------------------------------------- 
   CASE 15 = P DENOTING LEFT P"S
----------------------------------------------------------------------# 
RCG$15: 
         BEGIN
         IF B<4,1> FLAGS[0]  EQ  OFF THEN             #IF NOT FIRST 
          PROCESS    #
                   BEGIN                    #  RIGHT P"S             #
                   CODE = CODE + 1  ;       #INCR CODE TO 16         #
                   PRIGHT = PRIGHT + NOCHR; #STORE PRIGHT"S          #
                   END ## 
         ELSE 
                   BEGIN
                   PLEFT = PLEFT + NOCHR  ; #STORE PLEFT"S           #
                   B<5,1> FLAGS[0] = ON  ;         #INDICATE DEC PT 
          ASSUMED # 
                   END ## 
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE 16 = P DENOTING RIGHT P"S - BUT ALL P"S SHOULD COME IN UNDER
                    CODE I5 HENCE THIS WOULD BE AN ERROR
----------------------------------------------------------------------- 
         GOTO RCGER                      -IN CASE 7               - 
----------------------------------------------------------------------- 
   CASE 17 = SIGN ROUTINE FOR S (NOTHING IS DONE) 
----------------------------------------------------------------------- 
  
----------------------------------------------------------------------- 
   CASE 18 = IMPLIED DECIMAL POINT ROUTINE
----------------------------------------------------------------------# 
RCG$18: 
         BEGIN
         SUBTOT = TOTNUM  ;                 #STORE DIGITS BEFORE     #
         B<5,1> FLAGS[0] = ON  ;                   #   DECIMAL POINT
              # 
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE 19 = FLOATING POINT EXPONENT (E)
----------------------------------------------------------------------# 
RCG$19: 
         BEGIN
         #THERE IS NO FLOATING-POINT EDIT PICTURE TYPE IN THE 
          CYBER VERSION OF THE COMPILER AS THERE WAS IN THE 
          STAR VERSION.                                       # 
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE 20 = Z FOR ZERO SUPPRESSION 
----------------------------------------------------------------------# 
ZED:  
         BEGIN
         IF B<5,1> FLAGS[0]  EQ  ON THEN
                   CODE = CODE + 2;       #INCR 2 FOR AFTER DEC PT #
         TOTNUM = TOTNUM + NOCHR  ;         #INCR TOTAL NUMERIC      #
         B<4,1> FLAGS[0] = OFF; 
         IGNORE[0] = OFF; 
         END ## 
         GOTO RCGCASEEND; 
#---------------------------------------------------------------------- 
   CASE 21 = * FOR ZERO SUPPRESSION 
----------------------------------------------------------------------# 
ASTERISK: 
         BEGIN
         AST[0] = 1;
         GOTO ZED;
         END ## 
#-----------------------------------------------------------------------
   CASE 32 = CHARACTER 1 (BOOLEAN)
-----------------------------------------------------------------------#
 RCG$32:  
         TOTNUM = TOTNUM + NOCHR; 
         GOTO RCGCASEEND; 
# 
         END OF DO CASE ON CODE FOR SYMBOL PROCESSING 
         END OF RECOGNIZER
 #
RCGCASEEND: 
         $BEGIN IF DEBUG THEN 
         OUTPUT(5,"RCG END","CODE=",DEC(CODE),"FLAGS=",DEC(FLAGS)); 
         $END 
# 
         FALL THROUGH TO CATEGORY AND SYNTAX PROCESSOR
 #
         CONTROL EJECT; 
#********************************************************************#
# 
         CATEGORY AND SYNTAX PROCESSING 
 #
         B<CODE,1> SRT[0] = ON  ;                  #SET CORR BIT IN SRT 
              # 
         CATBYT[0]=CATBYT[0] LOR CATT[CODE]; #  OR ON CATEGORY# 
         IF B<CODE,1> IST[0]  EQ  OFF THEN
                   BEGIN
                    DIAG(8)  ;          #UNALLOWABLE SYNTAX ENTRY#
                   GOTO ENDPIC  ; 
                   END ## 
         ISTAND[0] = ISTAND[0]  LAN  SYN[CODE]; #LOGICAL AND OF SYNTAX# 
                                            #  AND IMPLICIT TABLE    #
         CODE = CODE + SAVE  ;              #RESET CODE FOR DECIMAL  #
                                            #   IS COMMA             #
# 
         FALL THROUGH TO END OF SYMBOL ROUTINE
         END OF SYMBOL ROUTINE FOLLOWS
         STORE CODE IN PST
         STORE LENGTH IN PST
 #
         PSTL[PSTCNT] = NOCHR  ;            #STORE LENGTH IN PST     #
         PSTS[PSTCNT] = CODEX  ;            #STORE SOURCE CHAR IN PST#
         PSTC[PSTCNT] = CODE  ;             #STORE INT. CODE IN PST  #
         PSTCNT = PSTCNT + 1  ;             #INCR PST INDEX          #
        $BEGIN IF DEBUG THEN
         DISPLAY(DSP," PICLEN TEST",0,12);
         $END 
         IF PICLEN  EQ  0 THEN                 #IF PICTURE END GOTO 
          # 
                   GOTO INITCAT  ;        #  CATEGORY PROCESSORS   #
         GOTO BGNSYM  ; 
# 
         END OF SYMBOL PROCESSING 
 #
         CONTROL EJECT; 
# 
         USING CATBYT AS THE CASE SELECTOR WILL ALLOW PROPER
            PROCESSING OF THE INDIVIDUAL CATEGORIES.  THERE 
            ARE 16 POSSIBLE VALUES. 
         VALUE  CATEGORY
         -----  --------
           0    IMPOSSIBLE UNLESS HARDWARE FAILURE DIAGNOSTIC NO. 22
           1    NUMERIC 
           2    ALPHABETIC
           3    ALPHANUMERIC
           4    EDIT PICTURE IN ERROR DIAGNOSTIC NO. 9
           5    NUMERIC EDIT
           6    ALPHABETIC EDIT 
           7    ALPHANUMERIC EDIT 
           8    DIAGNOSTIC NO. 21 
           9    FLOATING POINT EDIT 
          10    DIAGNOSTIC NO. 21 
          11    DIAGNOSTIC NO. 21 
          12    DIAGNOSTIC NO. 21 
          13    FLOATING POINT EDIT 
          14    DIAGNOSTIC NO. 21 
          15    DIAGNOSTIC NO. 21 
          16    BOOLEAN 
 #
         CONTROL EJECT; 
#********************************************************************#
INITCAT:  # CATEGORY PROCESSORS    #
# $X2 # 
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
         SWITCH CATLABLLIST CAT$0,CAT$1,CAT$2,CAT$3,CAT$4,CAT$5,
                       CAT$6,CAT$7,CATER,FLED,CATER,CATER,CATER,
                       FLED,CATER,CATER,CA$16;
         $BEGIN IF DEBUG THEN BEGIN 
         DISPLAY(DSP," INITCAT",0,8); 
         DISPLAY(DSP,DEC(CATBYT[0]),0,10);
         END  $END
         GOTO CATLABLLIST[CATBYT[0]]; 
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
#---------------------------------------------------------------------- 
   CASE  0 = HARDWARE FAILURE 
----------------------------------------------------------------------# 
CAT$0:  
         BEGIN
          DIAG(22); 
         GOTO ENDPIC  ; 
         END ## 
#---------------------------------------------------------------------- 
   CASE  1 = NUMERIC CATEGORY 
----------------------------------------------------------------------# 
CAT$1:  
#       TEST FOR MAXIMUM (18) AND MINIMUM (1) LENGTHS OF NUMERICS 
              ISSUE DIAGNOSTICS 12 AND 10 RESPECTIVELY.               # 
         BEGIN
         IF TOTNUM GR 18 THEN 
                   BEGIN
                    DIAG(12)  ; 
                   GOTO ENDPIC  ; 
                   END ## 
         IF TOTNUM LS 1 THEN
                   BEGIN
                    DIAG(10)  ; 
                   GOTO ENDPIC  ; 
                   END ## 
# 
         BUILD THE PAT ENTRY
 #
         CREATE$ENTRY(PAT$,PAT$INDEX)  ;                     #CLEAR PAT 
                        # 
         SETFIELD(P$LENGTH,PAT$,PAT$INDEX,TOTNUM);
         SETFIELD(P$NUMLEN,PAT$,PAT$INDEX,TOTNUM);
         IF B<17,1> SRT[0]  EQ  ON THEN               #IF "S" USED IN 
          PICTURE  #
              SETFIELD(P$SGNPIC,PAT$,PAT$INDEX,ON);   #  TURN ON SIGN 
          BIT      #
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATNUMERIC);          #STORE
          NUMERIC TYPE      # 
# 
         CALL THE SCALE ROUTINE 
 #
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
          SCALE  ;
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
# 
         END OF NUMERIC CASE
 #
         END ## 
         GOTO ENDPIC; 
#---------------------------------------------------------------------- 
   CASE  2 = ALPHABETIC CATEGORY
----------------------------------------------------------------------# 
CAT$2:  
# 
         BUILD BASIC ALPHABETIC PAT ENTRY 
         TEST FOR MAXIMUM LENGTH OF 65535 CHARACTERS IF > DIAG NO. 13 
 #
         BEGIN
         CREATE$ENTRY(PAT$,PAT$INDEX)  ;
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATALPHA);
ANED: 
         IF TOTNUM GR 131071 THEN 
                   BEGIN
                    DIAG(13); 
                   GOTO ENDPIC  ; 
                   END ## 
# 
         BUILD THE PAT ENTRY
 #
         SETFIELD(P$LENGTH,PAT$,PAT$INDEX,TOTNUM);
# 
         END OF ALPHABETIC OR ALPHANUMERIC CASES
 #
         END ## 
         GOTO ENDPIC; 
#---------------------------------------------------------------------- 
   CASE  3 = ALPHANUMERIC CATEGORY
----------------------------------------------------------------------# 
CAT$3:  
# 
         BUILD BASIC ALPHANUMERIC PAT ENTRY THEN GOTO ALPHABETIC
 #
         BEGIN
         CREATE$ENTRY(PAT$,PAT$INDEX)  ;
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATALFNUM); 
         GOTO ANED  ;                    #IN CASE 2               # 
         END ## 
#---------------------------------------------------------------------- 
   CASE  4 = EDIT PICTURE IN ERROR ISSUE DIAGNOSTIC NO. 9 
----------------------------------------------------------------------# 
CAT$4:  
         BEGIN
          DIAG(9)  ;
         GOTO ENDPIC  ; 
         END ## 
#---------------------------------------------------------------------- 
   CASE  5 = NUMERIC EDIT CATEGORY
----------------------------------------------------------------------# 
CAT$5:  
# 
         TEST FOR MAXIMUM (18) AND MINIMUM (1) LENGTHS OF NUMERICS
             ISSUE DIAGNOSTICS 12 AND 10 RESPECTIVELY 
 #
         BEGIN
         IF TOTNUM GR 18 THEN 
                   BEGIN
                    DIAG(12)  ; 
                   GOTO ENDPIC  ; 
                   END ## 
         IF TOTNUM LS 1 THEN
                   BEGIN
                    DIAG(9) ; 
                   GOTO ENDPIC  ; 
                   END ## 
# 
         BUILD THE PAT ENTRY
 #
         CREATE$ENTRY(PAT$,PAT$INDEX);
         TEMP = TOTNUM + EDITCR;
         SETFIELD(P$LENGTH,PAT$,PAT$INDEX,TEMP);
      #                           /* THIS CODE MOVED TO 019461 BECAUSE
      /* PAT$NUM$LENGTH = TOTNUM  /* EDIT$PAT CHANGES TO TOTNUM SHOULD
      /*                           /* BE REFLECTED IN PAT$NUM$LENGTH. 
      /*                                                   RMD 25FEB74
      # 
# 
         PUT BEGINNING INDEX OF EDIT PATTERN IN THE PAT.
 #
         SETFIELD(P$PATTOFF,PAT$,PAT$INDEX,EDPLTI); 
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATNEDIT);
# 
         SET SPECIAL CONDITION BITS IN THE PAT BEGINNING AT PSN 40. 
            THEY ARE REFERRED TO AS PAT$FLAGS(I) WITH I FROM 0 TO 7.
            AN EVALUATION OF PICTURE ELEMENTS AND CURRENCY SIGN 
            INDICATES THE FLAGS TO SET.  THE SRT INDICATES WHICH
            ELEMENTS HAVE BEEN ENCOUNTERED. 
    SRT BITS  PAT BIT 
     5 OR 6      0        FIXED SIGN ON LEFT
     12,21,23    1        BLANK WHEN ZERO 
        8        2        RIGHT MINUS 
        7        3        RIGHT PLUS
     9 OR 10    2+3       RIGHT CR OR DB
    28 OR 29     4        FLOATING POUND SIGN ( ) 
    24 OR 26     5        FLOATING PLUS 
    28 OR 29     6        FLOATING DOLLAR SIGN ($)
    28 OR 29    4+6       FLOATING CURRENCY SUMBOL IS 
    25 OR 27    5+6       FLOATING MINUS
       23        7        FLOATING ASTERISK 
 #
         IF B<5,1> SRT[0]  EQ  ON OR B<6,1> SRT[0] EQ ON THEN 
                   SETFIELD(P$FLAG0,PAT$,PAT$INDEX,ON); 
         IF B<7,1> SRT[0]  EQ  ON THEN
                   SETFIELD(P$FLAG3,PAT$,PAT$INDEX,ON); 
         IF B<8,1> SRT[0]  EQ  ON THEN
                   SETFIELD(P$FLAG2,PAT$,PAT$INDEX,ON); 
         IF B<9,1> SRT[0]  EQ  ON OR B<10,1> SRT[0] EQ ON THEN
                   BEGIN
                   SETFIELD(P$FLAG2,PAT$,PAT$INDEX,ON); 
                   SETFIELD(P$FLAG3,PAT$,PAT$INDEX,ON); 
                   END
         IF B<24,1> SRT[0]  EQ  ON OR B<26,1> SRT[0] EQ ON THEN 
                   SETFIELD(P$FLAG5,PAT$,PAT$INDEX,ON); 
         IF B<25,1> SRT[0]  EQ  ON OR B<27,1> SRT[0] EQ ON THEN 
                   BEGIN
                   SETFIELD(P$FLAG5,PAT$,PAT$INDEX,ON); 
                   SETFIELD(P$FLAG6,PAT$,PAT$INDEX,ON); 
                   END
         IF B<23,1> SRT[0]  EQ  ON THEN 
                   SETFIELD(P$FLAG7,PAT$,PAT$INDEX,ON); 
         IF B<12,1>SRT[0] EQ OFF                 # IF NO 9-S           #
                   AND B<21,1>SRT[0] EQ OFF      # AND NO LEADING *-S  #
                   AND B<23,1>SRT[0] EQ OFF THEN # AND NO TRAILING *-S #
                   BEGIN
                   SETFIELD(P$FLAG1,PAT$,PAT$INDEX,ON); 
                   GOTO NUMEDA  ; 
                   END ## 
         IF B<28,1> SRT[0]  EQ  OFF AND B<29,1> SRT[0] EQ OFF THEN
                   GOTO NUMEDA  ; 
         IF TMPCSBYT  EQ  "#" THEN
                   BEGIN
                   SETFIELD(P$FLAG4,PAT$,PAT$INDEX,ON); 
                   GOTO NUMEDA  ; 
                   END ## 
         IF TMPCSBYT  EQ  "$" THEN
                   BEGIN
                   SETFIELD(P$FLAG6,PAT$,PAT$INDEX,ON); 
                   GOTO NUMEDA  ; 
                   END ## 
         IF TMPCSBYT  EQ  CSBYT[0] THEN 
                   BEGIN
                   SETFIELD(P$FLAG4,PAT$,PAT$INDEX,ON); 
                   SETFIELD(P$FLAG6,PAT$,PAT$INDEX,ON); 
                   END
# 
         SAVE THE LINE AND COLUMN NUMBERS THEN RESET BASE TO EDIT AREA
         THEN CALL THE EDIT PATTERN GENERATOR (EDIT$PAT)
 #
NUMEDA: 
         LINE = GETFIELD(PL$LINE,PLT$,PLTPTR);
         COLUMN = GETFIELD(PL$COLUMN,PLT$,PLTPTR)  ;
         CREATE$ENTRY(PLT$,EDPLTI); 
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
          EDIT$PAT ;  # BUILD MOST OF EDIT PATT PLT ENTRY # 
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
# 
/*       ADD NUMERIC LENGTH TO THE PAT
 #
         SETFIELD(P$NUMLEN,PAT$,PAT$INDEX,TOTNUM);
# 
         COMPLETE THE EDIT PATTERN ENTRY IN THE PLT 
         UPDATE THE EDIT PATTERN INDEX (EDPLTI) 
         XI IS THE NUMBER OF EDIT CHARACTERS IN THE PLT$PIC 
 #
         SETFIELD(PL$LENGTH,PLT$,EDPLTI,XI);              #STORE LENGTH 
          OF PLT ENT #
         SETFIELD(PL$TYPE,PLT$,EDPLTI,PLTEDITPATT);  #STORE TYPE
                # 
         SETFIELD(PL$LINE,PLT$,EDPLTI,PLTPTR); #STORE PLTPTR# 
         SETPLST(EDPLTI,LOC(PATTERN));  #MOVE PATTERN INTO PLST.  # 
         EDPLTI = EDPLTI + 1  ;        #ACCUMULATE INDEX OF     # 
                                            # EDIT PATTS FOR PAT     #
# 
         CALL NUMERIC SCALE ROUTINE TO COMPLETE THE PAT 
 #
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
          SCALE  ;
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
         IF AST[0] EQ 1 THEN SETFIELD(P$CKPROTECT,PAT$,PAT$INDEX,ON); 
# 
         NUMERIC EDIT CATEGORY COMPLETED
 #
         END ## 
         GOTO ENDPIC; 
#---------------------------------------------------------------------- 
   CASE  6 = ALPHABETIC EDIT CATEGORY 
----------------------------------------------------------------------# 
CAT$6:  
# 
         THIS CASE WILL PROCESS BOTH ALPHABETIC AND ALPHANUMERIC. 
         THE CASE WILL PUT A ALPHABETIC EDIT CODE INTO THE PAT AND
         IMMEDIATELY AFTER THIS IS WHERE THE ALPHANUMERIC PROCESSING
         WILL START.  THE ALPHANUMERIC CASE 7 WILL DO A LITTLE SPECIAL
         DIAGNOSTIC CASE TESTING BEFORE COMING HERE.
 #
         BEGIN
         CREATE$ENTRY(PAT$,PAT$INDEX)  ;
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATAEDIT);
# 
         ALPHABETIC AND ALPHANUMERIC FROM HERE ON.
 #
ANEDIT: 
# 
         TEST FOR LENGTH > 65535 + PUT IN PAT 
 #
         TEMP = TOTNUM + EDITCR;
         IF TEMP GR 131071 THEN 
                   BEGIN
                    DIAG(13)  ; 
                   GOTO ENDPIC  ; 
                   END ## 
         SETFIELD(P$LENGTH,PAT$,PAT$INDEX,TEMP);
# 
         PUT REPLACEMENT CHARACTER COUNT + EDIT PATTERN INDEX INTO PAT
 #
         SETFIELD(P$REPLCNT,PAT$,PAT$INDEX,TOTNUM); 
         SETFIELD(P$PATTOFF,PAT$,PAT$INDEX,EDPLTI); 
         CREATE$ENTRY(PLT$,EDPLTI); 
         COLUMN = GETFIELD(PL$COLUMN,PLT$,PLTPTR)  ;
         LINE = GETFIELD(PL$LINE,PLT$,PLTPTR)  ;
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
         EDIT$PAT;       # CALL EDIT PATTERN GENERATOR# 
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
  
                   SETFIELD(PL$LENGTH,PLT$,EDPLTI,XI);
                   SETFIELD(PL$TYPE,PLT$,EDPLTI,PLTEDITPATT); 
         SETFIELD(PL$LINE,PLT$,EDPLTI,PLTPTR); #STORE PLTPTR# 
         SETPLST(EDPLTI,LOC(PATTERN));   #MOVE PATTERN INTO PLST.  #
         EDPLTI = EDPLTI + 1  ; 
# 
         ALPHABETIC AND ALPHANUMERIC EDIT CATEGORY COMPLETE 
 #
         END ## 
         GOTO ENDPIC; 
#---------------------------------------------------------------------- 
   CASE  7 = ALPHANUMERIC EDIT CATEGORY 
----------------------------------------------------------------------# 
CAT$7:  
# 
         THIS CASE WILL MAKE A FEW DIAGNOSTIC SYNTAX TESTS, 
         THEN STORE THE TYPE IN THE PAT AND GOTO CASE 6 FOR PROCESSING
 #
         BEGIN
         # PIC AB9 IS LEGAL IN JOD #
          # WE WILL ACCEPT IT AS ALPHANUMERIC EDITED #
         IF B<01,1> SRT [0] EQ ON AND 
            B<12,1> SRT [0] EQ ON AND 
            B<13,1> SRT [0] EQ ON 
         THEN GOTO A$N; 
# 
         FOR ALPHANUMERIC EDIT THERE MUST BE AT LEAST 
           X AND B OR 0 OR /   -OR-  A AND 0 OR / 
 #
         IF B<14,1> SRT[0]  EQ  ON THEN 
                   BEGIN                    #HAVE AN X               #
                   IF B<0,1> SRT[0]  EQ  ON OR B<1,1> SRT[0] EQ ON OR 
          B<2,1> SRT[0] EQ ON THEN
                             GOTO A$N  ;   #GOT A / B OR 0          # 
                   ELSE 
                             GOTO ANER  ; #GOT AN ERROR           # 
                   END ## 
         IF B<13,1> SRT[0]  EQ  ON THEN 
                   BEGIN                    #HAVE AN A               #
                   IF B<0,1> SRT[0]  EQ  ON OR B<2,1> SRT[0] EQ ON THEN 
                             GOTO A$N  ;   #GOT A / OR 0            # 
                   ELSE 
                             GOTO ANER  ; #GOT AN ERROR           # 
                   END ## 
# 
         NOT AN X OR A MUST ISSUE DIAGNOSTIC
 #
ANER: 
          DIAG(11); 
         GOTO ENDPIC  ; 
A$N:  
         CREATE$ENTRY(PAT$,PAT$INDEX);
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATANEDIT); 
         GOTO ANEDIT  ;                  #THIS IS IN CASE 6 ABOVE # 
         END ## 
#---------------------------------------------------------------------- 
   CASE  8 = CATEGORY ERROR 
----------------------------------------------------------------------# 
CATER:  
         BEGIN
          DIAG(21); 
         GOTO ENDPIC  ; 
         END ## 
#---------------------------------------------------------------------- 
   CASE  9 = FLOATING POINT EDIT CATEGORY 
----------------------------------------------------------------------# 
FLED: 
        BEGIN 
          #THERE IS NO FLOATING-POINT EDIT PICTURE TYPE 
           IN THE CYBER VERSION OF THE COMPILER.         #
        END 
#---------------------------------------------------------------------- 
   CASE 10 = CATEGORY ERROR 
----------------------------------------------------------------------# 
         GOTO CATER  ;                    #IN CASE 8               #
#---------------------------------------------------------------------- 
   CASE 11 = CATEGORY ERROR 
----------------------------------------------------------------------# 
         GOTO CATER  ;                    #IN CASE 8               #
#---------------------------------------------------------------------- 
   CASE 12 = CATEGORY ERROR 
----------------------------------------------------------------------# 
         GOTO CATER  ;                    #IN CASE 8               #
#---------------------------------------------------------------------- 
   CASE 13 = FLOATING POINT EDIT CATEGORY 
----------------------------------------------------------------------# 
# 
         THE PROCESS HERE IS THE SAME AS FOR CASE 9 SO GO THERE 
 #
         GOTO FLED  ;                     #IN CASE 9               #
#---------------------------------------------------------------------- 
   CASE 14 = CATEGORY ERROR 
----------------------------------------------------------------------# 
         GOTO CATER  ;                    #IN CASE 8               #
#---------------------------------------------------------------------- 
   CASE 15 = CATEGORY ERROR 
----------------------------------------------------------------------# 
         GOTO CATER  ;                    #IN CASE 8               #
#-----------------------------------------------------------------------
   CASE 16 = BOOLEAN
-----------------------------------------------------------------------#
CA$16:  
         CREATE$ENTRY(PAT$,PAT$INDEX);
         SETFIELD(P$TYPE,PAT$,PAT$INDEX,PATBOOLEAN);
         SETFIELD(P$LENGTH,PAT$,PAT$INDEX,TOTNUM);
         GOTO ENDPIC; 
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
# 
         END OF DO CASE ON CATALOG BYTE (CATBYT)
         END OF INIT$CAT
         FALL THROUGH TO END OF PICTURE PROCESSOR 
 #
         CONTROL EJECT; 
#********************************************************************#
ENDPIC: 
          $BEGIN IF DEBUG THEN
          DISPLAY(DSP," ENDPIC",0,7); 
          $END
# 
         END OF PICTURE PROCESSING
         UPDATE PAT POINTER 
 #
         PAT$INDEX = PAT$INDEX + 1; 
         PATLENGTHF = PATLENGTHF + 1  ; 
# 
         MEASUREMENT POINT
 #
# 
         GOTO BEGINNING OF PICTURE PROCESSING 
 #
         GOTO BGNPIC  ; 
# 
         END OF PROGRAM PROCESSING - UPDATE THE CCT 
 #
PRGEND: 
         CCTPATLEN = PATLENGTHF;
         CCTPLTLEN = EDPLTI - 1;
         CCTEDITPLEN = EDPLTI - EPLTSTART ; 
# 
         RETURN TO COBOL MAIN 
 #
$BEGIN
         IF DEBUG THEN BEGIN DISPLAY(DSP,DEC(PLTSTOP),0,10);
                        DISPLAY(DSP,DEC(PLTPTR),0,10);
                      END 
$END
  
         RETURN;
         END #PICANAL#
TERM
