*DECK LP
USETEXT CCTTEXT 
USETEXT DNTEXT
PROC     LP;
         BEGIN
 #
         HE HAD BOUGHT A LARGE MAP REPRESENTING THE SEA,
         WITHOUT THE LEAST VESTIGE OF LAND: 
         AND THE CREW WERE MUCH PLEASED WHEN THEY FOUND IT TO BE
         A MAP THEY COULD ALL UNDERSTAND. 
  
                              "THE HUNTING OF THE SNARK"
                                   LEWIS CARROLL
  
         THE LPOOLER PHASE OF THE COBOL 5.0 COMPILER IS RESPONSIBLE 
         FOR SOURCE PROGRAM ALPHANUMERIC LITERAL MANAGEMENT. ITS
         PRIMARY DUTIES ARE THE CONVERSION OF SUCH SOURCE PROGRAM 
         LITERALS TO OPTIMUM OBJECT TIME FORMAT AND THE BUILDING OF 
         THE OBJECT TIME LITERAL POOL CONTAINING THESE CONVERTED
         LITERALS. IT IS WRITTEN IN SYMPL.
  
         THE PRINCIPAL SOURCES OF DOCUMENTATION ARE 
  
         1) CHAPTER 14 OF THE IMS WHICH DESCRIBES THE INTERNAL
            DESIGN AND WORKINGS OF THE PHASE
  
         2) LPTEST,A COBOL PROGRAM WRITTEN ESPECIALLY TO TEST 
            THE PHASE AND ITS SUBORDINATE MODULES 
  
         3) COMMENTS IN THE SOURCE CODE WHICH FURTHER EXTEND THE
            IMS DESCRIPTION BUT ON A MORE PRIMITIVE LEVEL 
  
                                             KENNETH G. KINLIN
                                             CDC MEADOWVALE 
                                             DECEMBER 1974
  
         * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
         *                                                           *
         *  COPYRIGHT CONTROL DATA CORPORATION 1975                  *
         *                                                           *
         * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  
         C A L L E D   B Y
  
         COBLP
  
         R O U T I N E S   C A L L E D
  
         ALIT 
         PLIT 
 #
 #
         DECLARATION OF LISTING CONTROL MACROS
 #
         DEF  NEWPAGE             #CONTROL EJECT#;
         DEF  LISTOFF             #CONTROL NOLIST#; 
         DEF  LISTON              #CONTROL LIST#; 
         NEWPAGE; 
 #
         T R A C E   A N D   D E B U G   D E C L A R A T I O N S
  
         IN ORDER TO AID IN THE TASK OF PROGRAM TRACING AND 
         AND DEBUGGING THE FOLLOWING FEATURES ARE INCLUDED. 
  
         A) COMPILE TIME SWITCHES PERMITTING THE INCLUSION
            OR EXCLUSION OF DEBUG CODE. THIS FEATURE TAKES
            ADVANTAGE OF THE SYMPL CONDITIONAL COMPILATION
            FACILITY VIA $BEGIN AND $END. HOWEVER WHEN
            EXCLUSION IS SELECTED VIA THE CONTROL CARD
            E OPTION THE DEBUG CODE IS NOT LISTED.
  
         B) AN EXECUTION TIME SWITCH CONTROLLING THE OUTPUT 
            OF TRACE INFORMATION. IF DEBUG$SW IS TRUE THEN
            TRACE OUTPUT IS GENERATED. THE VALUE OF DEBUG$SW
            IS DETERMINED FROM THE CONTENTS OF THE COMPILER 
            COMMON DEBUG PARAMETERS AREA. 
  
         C) A ROUTINE FOR THE DUMPING OF PROGRAM VARIABLES AND
            DATA AREAS INSERTED IN THE CODE AS
  
               TRACE(TYPE,"PARAMETER         = ",PARAMETER,LENGTH)
  
            WHICH OUTPUTS THE PARAMETER IN THE FORMAT SPECIFIED 
            BY TYPE WITH THE APPROPRIATE LENGTH. FOR CERTAIN
            TYPES OF TRACE IT IS UNNECESSARY TO SPECIFY A LENGTH
            SINCE ONE WORD IS ASSUMED. CURRENTLY IMPLEMENTED ARE: 
  
            0) VAR$TRACE:  PRINTING OF DECIMAL CONTENTS OF
                           VARIABLE SPECIFIED BY PARAMETER
            1) POS$TRACE:  PRINTING OF THE CHARACTER STRING 
                           "PARAMETER"
            2) REG$TRACE:  PRINTING OF OCTAL CONTENTS OF VARIABLE 
                           SPECIFIED BY PARAMETER 
            3) CHA$TRACE:  PRINTING OF CHARACTER CONTENTS OF
                           DATA AREA IDENTIFIED BY PARAMETER
            4) INT$TRACE:  SIMILAR TO CHA$TRACE EXCEPT THAT 
                           THE PRINTING IS OF THE OCTAL 
                           CONTENTS DESCRIBED BY PARAMETER
            5) DIV$TRACE:  VAR$TRACE WITH DISPLAY OF THE
                           VARIABLE ON THE TERMINAL AS
                           WELL AS PRINTING 
            6) DIP$TRACE:  POS$TRACE WITH DISPLAY OF THE
                           PARAMETER CHARACTER STRING ON
                           TERMINAL SCREEN
  
         THE FOLLOWING COMPILER COMMON DEBUG ROUTINES ARE USED: 
  
         1) CBLIST  - WRITES OUTPUT TO LISTING FILE 
         2) DISPLAY - READS AND WRITES TO TERMINAL SCREEN 
         3) DEC     - CONVERT VARIABLES TO DECIMAL CHARACTER STRINGS
         4) OCT     - CONVERT VARIABLES TO OCTAL CHARACTER STRINGS
 #
         NEWPAGE; 
 #
         DECLARATION OF DEBUG VARIABLES,PROCEDURES AND MACROS 
  
         THE IO$AREA MUST BE DECLARED TWICE THE SIZE OF THE LITERAL 
         SAVE AREAS TO ALLOW A FULL OCTAL TRACE AND MUST HAVE TWO 
         ADDITIONAL WORDS RESERVED FOR TRACE IDENTIFICATION PURPOSES
 #
         LISTOFF; $BEGIN LISTON;
         ITEM DEBUG$SW            B;
         ARRAY IO$AREA[1:58]; 
         ITEM IO$WORD             C(0,0,10);
         XREF PROC                DISPLAY;
         XREF PROC                CBLIST; 
         XREF FUNC                DEC              C(10); 
         XREF FUNC                OCT              C(40); 
         COMMON PARAMS; 
         BEGIN
         ARRAY PARAMT[0:7]; 
         ITEM PARAMC              C(0,0,10);
         END
         DEF  VAR$TRACE           #0#;
         DEF  POS$TRACE           #1#;
         DEF  REG$TRACE           #2#;
         DEF  CHA$TRACE           #3#;
         DEF  INT$TRACE           #4#;
         DEF  DIV$TRACE           #5#;
         DEF  DIP$TRACE           #6#;
         DEF  DEBUGBEGIN          #LISTON; IF DEBUG$SW THEN BEGIN#; 
         DEF  DEBUGEND            #END#;
         $END LISTON; 
         NEWPAGE; 
 #
         D I A G N O S T I C   G E N E R A T I O N
  
         ALL PHASE DIAGNOSTICS ARE GENERATED VIA A CALL TO THE EXTERNAL 
         INTERCEPTOR ROUTINE WHICH PERFORMS THE REQUIRED ERROR TEXT 
         MANIPULATIONS. A SUMMARY OF THESE ERROR MESSAGES FOLLOWS:  
  
          NO.                     ROUTINE(S)
          ---                     ----------
  
          1                       ALIT
          2                       ALIT
          3                       ALIT
          11                      ALPHACHECK
          12                      CON2AN
          13                      CON2AN
          994                     CHECKCONV 
          995                     CHECKCONV 
          996                     ALIT
          997                     LP
          998                     SRCHAUXTAB
          999                     CHECKCONV 
 #
 #
         DECLARATION OF ERROR MESSAGE DEFS ENABLING THE MESSAGES
         TO BE FOUND IN THE COMPILATION CROSS REFERENCE 
 #
         DEF  MSG001              #1#;
         DEF  MSG002              #2#;
         DEF  MSG003              #3#;
          DEF    MSG004   #4#;
          DEF  MSG010  #10#;
         DEF  MSG011              #11#; 
         DEF  MSG012              #12#; 
         DEF  MSG013              #13#; 
          DEF    MSG994      #020#;    #OLD 8994# 
          DEF    MSG995      #021#;    #OLD 8995# 
          DEF    MSG996      #022#;    #OLD 8996# 
          DEF    MSG997      #023#;    #OLD 8997# 
          DEF    MSG998      #024#;    #OLD 8998# 
          DEF    MSG999      #025#;    #OLD 8999# 
 #
         DECLARATION OF ERROR MESSAGE SEVERITY LEVELS 
 #
         DEF  ADVISORY            #4#;
         DEF  SEVERE              #2#;
 #
         DECLARATION OF THE EXTERNAL DIAGNOSTIC INTERCEPTOR ROUTINE 
         WHICH INTERCEPTS GENERATED DIAGNOSTIC INFORMATION AND
         CREATES ETEXT ELEMENTS TO BE PROCESSED BY DFORMATTER.
 #
         XREF PROC                INTERCEPTOR;
         NEWPAGE; 
 #
         DESCRIPTIONS OF PARAMETERS,SWITCHS,MACROS AND VARIABLES
  
  
         ADVISORY       ETEXT CODE VALUE FOR AN ADVISORY ERROR
         ALL$FLAG       SWITCH INDICATING IF CONVERTED LITERAL
                        CONSISTS OF ONE REPEATED CHARACTER
                              FALSE INDICATES NO REPETITION 
                              TRUE  INDICATES REPLICATED CHARACTER
         ALNAME$END     INDEX OF LAST ALPHABET NAME DNAT ENTRY
                        IN ENVIRONMENT DIVISION 
         ALNAME$START   INDEX OF FIRST ALPHABET NAME DNAT ENTRY 
                        IN ENVIRONMENT DIVISION 
         ASCII$CSEQ     STRING INITIALIZED TO ASCII COLLATING SEQUENCE
         ASCII$WD       SUBDIVISION OF ASCII$CSEQ BY WORDS
         ASLONGAS       MACRO TO SIMULATE WHILE LOOPS IN SYMPL
         AUX$INDEX      ENTRY INDEX FOR CURRENT AUX TABLE ENTRY 
         AUX$NEXT       INDEX OF THE NEXT ENTRY IN A CHAIN OF 
                        AUX TABLE ENTRIES 
         AUX$OLD        SAVE AREA FOR INITIAL AUX TABLE INDICIES
         AUX$PREV       INDEX OF THE PREVIOUS ENTRY IN A CHAIN OF 
                        AUX TABLE ENTRIES 
         AUX$TYPE       TYPE OF CURRENT AUX TABLE ENTRY 
         BITSIN1WORD    NUMBER OF BITS IN ONE WORD
         CASE$NUMBER    INDEX INTO CHECKCONV SWITCH LIST, OBTAINED
                        FROM THE CONVERSION TABLE CONV$TABLE
         CDC$CSEQ       STRING INITIALIZED TO CDC COLLATING SEQUENCE
         CDC$WD         SUBDIVISION OF CDC$CSEQ BY WORDS
         CHARSIN1WORD   NUMBER OF CHARACTERS IN ONE WORD
         CHARSIN2WORD   NUMBER OF CHARACTERS IN TWO WORDS 
         CHARSIN3WORD   NUMBER OF CHARACTERS IN THREE WORDS 
         CHAR$INDEX     CHARACTER INDEX INTO STRING ARRAY WORDS 
         CHAR$VAL       VARIABLE USED TO CONTAIN SINGLE CHARACTERS
                        PRIOR TO TESTING OR REPLICATION 
         CHA$TRACE      TRACE TYPE SPECIFYING CHARACTER CONTENTS
         CMU$FLAG       SWITCH INDICATING IF LITERALS ARE TO BE 
                        CONVERTED FOR A COMPARE MOVE UNIT MACHINE 
                              FALSE INDICATES CMU OPTION
                              TRUE  INDICATES NO CMU
         COMPARE$LIM    BOUNDARY VALUE FOR LENGTH OF "IF" LITERALS
         CONVCASE       SWITCH USED IN THE CHECKCONV ROUTINE
         CONV$TABLE     TABLE USED TO LOOK UP THE PROPER CASE 
                        NUMBERS IN THE CHECKCONV ROUTINE
         CSEQ$DNAT      DNAT INDEX OF THE PROGRAM COLLATING SEQUENCE
         DEBUGBEGIN     STARTING MACRO BRACKET FOR DEBUG CODE 
         DEBUGEND       TERMINATION MACRO BRACKET FOR DEBUG CODE
         DEBUG$SW       FLAG INDICATING WHETHER TRACE INFORMATION 
                        IS DESIRED WHILE IN DEBUG MODE
                              FALSE INDICATES NO OUTPUT 
                              TRUE  INDICATES TRACE OUTPUT
 #
         NEWPAGE; 
 #
         DIAG$NO        GENERATED ERROR NUMBER : 0 INDICATES NONE 
         DIP$TRACE      TRACE TYPE SPECIFYING POSITIONAL DISPLAY
         DIV$TRACE      TRACE TYPE SPECIFYING VARIABLE CONTENTS DISPLAY 
         DNAT$INDEX     ENTRY INDEX FOR CURRENT DNAT ENTRY
         DUMMY          DUMMY VARIABLE USED IN THE ASLONGAS MACRO 
         EFF$RES$LEN    AMOUNT OF OBJECT AREA TO BE FILLED DURING EACH
                        REPLICATION IN THE CONVERSION OF AN ALL QUOTED
                        LITERAL TO ALPHANUMERIC FORM
         HIGH$VALUE     FOR A LITERAL ALPHABET NAME THE INDEX OF
                        THE HIGHEST COLLATING CHARACTER. IN THE PROC
                        DIVISION THE PROGRAM HIGH VALUE CHARACTER 
         HI$LO$FLAG     SWITCH INDICATING IF THE CURRENT LITERAL
                        IS EITHER HIGH VALUES OR LOW VALUES 
                              FALSE INDICATES NORMAL CASE 
                              TRUE  INDICATES HIGH OR LOW VALUE 
         IDX            FORMAL PARAMETER FOR THE CHARUSED ROUTINE 
                        SPECIFYING A CHARACTER INDEX VALUE
         INCR           INCREMENT VARIABLE FOR TWO WAY WHILE LOOP IN
                        THE TRANSTAB ROUTINE
         INDEX          CHARACTER INDEX USED IN SUBSTR AND FILLC
         INT$TRACE      TRACE TYPE SPECIFYING INTERNAL FORMAT 
         IO$AREA        AREA USED FOR TRACE AND DEBUG INPUT-OUTPUT
         IO$WORD        SUBDIVISION OF IO$AREA BY WORDS 
         JUST$FLAG      SWITCH INDICATED IF THE ITEM ASSOCIATED WITH
                        A LITERAL HAS BEEN SPECIFIED AS JUSTIFIED 
                              FALSE INDICATES NO JUSTIFIED
                              TRUE  INDICATES JUSTIFIED 
         LAT$ALL$FLAG   SWITCH INDICATING IF THE FIGURATIVE 
                        CONSTANT "ALL" EXPLICITLY OR IMPLICITLY 
                        WAS USED WITH THE CURRENT LITERAL 
                              FALSE INDICATES NON-REPLICATION 
                              TRUE  INDICATES ALL 
         LAT$INDEX      ENTRY INDEX FOR CURRENT LAT ENTRY 
         LAT$PD$END     INDEX OF LAST PROCEDURE DIVISION LAT ENTRY
         LAT$PD$START   INDEX OF FIRST PROCEDURE DIVISION LAT ENTRY 
         LENGTH$DIFF    DIFFERENCE IN SOURCE AND OBJECT LITERAL 
                        LENGTHS DURING CONVERSION TO ALPHANUMERIC 
         LENGTH$LEFT    AMOUNT OF OBJECT AREA LEFT TO FILL DURING 
                        CONVERSION OF AN ALL LITERAL TO ALPHANUMERIC
         LISTOFF        MACRO TO TURN OFF SOURCE LISTING
         LISTON         MACRO TO TURN ON SOURCE LISTING 
         LOW$VALUE      FOR A LITERAL ALPHABET NAME THE INDEX OF
                        THE LOWEST COLLATING CHARACTER. IN THE PROC 
                        DIVISION THE PROGRAM LOW VALUE CHARACTER
 #
         NEWPAGE; 
 #
         LPOOL$INDEX    INDEX INTO THE LITERAL POOL 
         LPOOL$LEN      CHARACTER LENGTH OF THE LITERAL POOL
         LPOOL$SR$LEN   EFFECTIVE WORD LENGTH OF THE LITERAL POOL,THAT
                        IS THE PORTION OF THE POOL TO BE SEARCHED FOR 
                        AN INSTANCE OF A PARTICULAR CONVERTED LITERAL 
         LPOOL$WD$LEN   WORD LENGTH OF THE LITERAL POOL 
         MOD            MACRO, GIVEN A DIVIDEND AND A DIVISOR, WHICH
                        CALCULATES A REMAINDER
         MSG$NO         ERROR MESSAGE PARAMETER FOR DIAGNOSTIC ROUTINE
         MSG$SEVERITY   SEVERITY PARAMETER FOR THE DIAGNOSTIC ROUTINE 
         NATIVECASE     SWITCH USED TO DETERMINE THE NATIVE CHARACTER 
                        SET HIGH AND LOW VALUES 
         NATIVE$HIGH    INDEX OF THE NATIVE HIGH VALUE CHARACTER
         NATIVE$LOW     INDEX OF THE NATIVE LOW VALUE CHARACTER 
         NATIVE$SIZE    NUMBER OF CHARACTERS IN THE NATIVE SET
         NATIVE$SW      SWITCH SPECIFYING THE NATIVE CHARACTER SET
                              1 INDICATES CDC 63
                              2 INDICATES CDC 64
                              3 INDICATES ASCII 63
                              4 INDICATES ASCII 64
                              5 INDICATES DISPLAY 
         NEWPAGE        LISTING EJECT MACRO 
         NO$LEAD$BLK    NUMBER OF LEADING BLANKS TO BE APPENDED TO
                        THE START OF A SEMI CONVERTED LITERAL 
         NO$POOL$FLAG   SWITCH INDICATING IF THERE IS ANY CONVERTED 
                        RESULT TO BE ADDED TO THE LITERAL POOL
                              FALSE INDICATES POOLABLE RESULT 
                              TRUE  INDICATES NO CONVERSION 
         NO$TRAIL$BLK   NUMBER OF TRAILING BLANKS TO BE APPENDED TO 
                        THE END OF A SEMI CONVERTED LITERAL 
         OBJ$ALIGN      STARTING POINT WITHIN WORD OF RESULT FIELD
         OBJ$CHAR       SUBDIVISION OF OBJ$LIT BY CHARACTERS
         OBJ$INDEX      INDEX FOR THE CONVERTED LITERAL AREA AND
                        THE POOLABLE LITERAL AREA 
         OBJ$LIT        SAVE AREA FOR CONVERTED LITERAL FORM
         OBJ$LIT$LEN    CHARACTER LENGTH OF CONVERTED LITERAL RESULT
         OBJ$LIT$TYPE   LOCAL TYPE OF OBJECT ITEM 
         OBJ$MSEC       MEMORY SECTION FOR CONVERTED LITERAL FORM 
         OBJ$OCC$LEN    OCCURRENCE LENGTH ASSOCIATED WITH RESULT
         OBJ$OFFSET     CHARACTER STORAGE OFFSET OF RESULT FIELD
         OBJ$ORG$LEN    SAVE AREA FOR CHARACTER LENGTH OF RESULT
         OBJ$REP$CNT    NUMBER OF REPLACEMENT CHARACTERS IN 
                        AN ALPHANUMERIC EDIT PATTERN
         OBJ$SUB$DPTH   DEPTH OF SUBSCRIPTING OF AN OBJECT ITEM 
         OCT$A          CONSTANT VALUE OF DISPLAY CODE FOR A
         OCT$BLANK      CONSTANT VALUE OF DISPLAY CODE FOR SPACE
         OCT$MINUS      CONSTANT VALUE OF DISPLAY CODE FOR -
         OCT$PLUS       CONSTANT VALUE OF DISPLAY CODE FOR +
         OCT$WORD       CONSTANT VALUE OF A WORD OF ZEROS 
 #
         NEWPAGE; 
 #
         OCT$Y          CONSTANT VALUE OF DISPLAY CODE FOR Y,USED 
                        ONLY WHEN THE PHASE DEBUG CODE IS ACTIVATED 
         OCT$Z          CONSTANT VALUE OF DISPLAY CODE FOR Z
         OCT$ZERO       CONSTANT VALUE OF DISPLAY CODE FOR ZERO 
         OCT$00         CONSTANT VALUE OF DISPLAY CODE 00 
         OCT$40         CONSTANT VALUE OF DISPLAY CODE 40 
         OCT$44         CONSTANT VALUE OF DISPLAY CODE 44 
         OCT$55         CONSTANT VALUE OF DISPLAY CODE 55 
         OCT$57         CONSTANT VALUE OF DISPLAY CODE 57 
         OCT$65         CONSTANT VALUE OF DISPLAY CODE 65 
         OCT$77         CONSTANT VALUE OF DISPLAY CODE 77 
         OFFSET         CHARACTER INDEX INTO THE SOURCE LITERAL AREA
         OVERHANG       CHARACTER COUNT OF AN ITEMS EXTENSION BEYOND
                        ITS LAST WORD BOUNDARY
         PARAMS         COMPILER COMMON AREA USED TO PASS DEBUG 
                        PARAMETERS TO THE INDIVIDUAL PHASES 
         PLT$INDEX      ENTRY INDEX FOR CURRENT PLT ENTRY 
         POS$TRACE      TRACE TYPE SPECIFYING POSITIONAL INFORMATION
         QLIT$LIMIT     BOUNDARY VALUE FOR LENGTH OF QUOTED LITERALS
         REG$TRACE      TRACE TYPE SPECIFYING OCTAL CONTENTS
         RETURN$FLAG    INTERNAL VALUE RETURNED BY THE CHARUSED ROUTINE 
         R$ARRAY        FORMAL PARAMETER FOR THE CHARACTER HANDLING 
                        ROUTINES SPECIFYING A RESULT CHARACTER STRING 
         R$LENGTH       FORMAL PARAMETER FOR THE CHARACTER HANDLING 
                        ROUTINES SPECIFYING A RESULT STRING LENGTH
         R$OFFSET       FORMAL PARAMETER FOR THE CHARACTER HANDLING 
                        ROUTINES,BEING AN OFFSET INTO A RESULT STRING 
         R$WORD         SUBDIVISION OF R$ARRAY BY WORDS 
         SET$COL$FLAG   SWITCH INDICATING IF SOURCE PROGRAM CONTAINS
                        ALPHABET NAMES OR SET COLLATING STATEMENTS
                              FALSE INDICATES NONE
                              TRUE  INDICATES HIGH-VALUES SPECIAL CASES 
         SEVERE         ETEXT CODE VALUE FOR A SEVERE ERROR 
         SHORT$FLAG     SWITCH INDICATING WHETHER A CONVERTED LITERAL 
                        OF THE SHORT FORMAT IS TO BE POOLED OR NOT
                              FALSE INDICATES SHORT LITS INTO POOL
                              TRUE  INDICATES SHORT LITS INTO DNAT
         SPACES$FLAG    SWITCH INDICATING IF SOURCE OR CONVERTED
                        LITERAL CONSISTS OF ALL BLANKS
                              FALSE INDICATES NOT ALL SPACES
                              TRUE  INDICATES ALL BLANKS
         SRCCASE        SWITCH USED IN THE CHECKCONV ROUTINE TO SELECT
                        CODE TO ACCESS SOURCE LITERAL CHARACTER STRING
         SRC$COL$NO     COLUMN NUMBER OF THE CURRENT LITERAL
                        OBTAINED FROM THE PLT 
         SRC$LINE$NO    LINE NUMBER OF THE CURRENT LITERAL OBTAINED 
                        FROM THE PLT
         SRC$LIT        SAVE AREA FOR SOURCE LITERAL STRING AND 
                        ALSO THE AREA WHEREIN THE POOLABLE LITERAL
                        IS CONSTRUCTED
 #
         NEWPAGE; 
 #
         SRC$LIT$LEN    CHARACTER LENGTH OF SOURCE CHARACTER STRING AND 
                        ALSO THE LENGTH OF THE POOLABLE LITERAL 
         SRC$LIT$TYPE   LOCAL TYPE OF SOURCE LITERAL
         SRC$OLD$VAL    PREVIOUS CHARACTER ENCOUNTERED WHILE PROCESSING 
                        LITERALS IN THE ALPHABET NAME CLAUSE
         SRC$ORIGIN     SWITCH INDICATING SOURCE LITERAL ORIGIN 
                              0 INDICATES PLT 
                              1 INDICATES IMMEDIATE SPACES
                              2 INDICATES IMMEDIATE INTEGER 
         SRC$PAD$LEN    LENGTH OF AREA TO BE PADDED ON THE RIGHT BEFORE 
                        THE LITERAL CAN BE POOLED 
         SRC$VAL        CURRENT CHARACTER INDEX WHILE PROCESSING
                        LITERALS IN THE ALPHABET NAME CLAUSE
         SRC$VERBCODE   TYPE OF VERB WITH WHICH THE CURRENT LITERAL 
                        IS ASSOCIATED 
         SRC$WD$LEN     WORD LENGTH OF POOLABLE LITERAL 
         SRC$WORD       SUBDIVISION OF SRC$LIT BY WORDS 
         SUBS$FLAG      SWITCH INDICATING IF ITEM IS SUBSCRIPTED
                              FALSE INDICATES NO SUBSCRIPTING OR
                                    SUBSCRIPTING WITH AN OCCURRENCE 
                                    LENGTH EVENLY DIVISIBLE BY WORDS
                              TRUE  INDICATES ALL OTHER SUBSCRIPTING
         S$ARRAY        FORMAL PARAMETER FOR THE CHARACTER HANDLING 
                        ROUTINES SPECIFYING A SOURCE CHARACTER STRING 
         S$CHAR         FORMAL PARAMETER FOR THE CHARACTER HANDLING 
                        ROUTINES SPECIFYING A SINGLE SOURCE CHARACTER 
         S$OFFSET       FORMAL PARAMETER FOR THE CHARACTER HANDLING 
                        ROUTINES, BEING AN OFFSET INTO A SOURCE STRING
         S$WORD         SUBDIVISION OF S$ARRAY BY WORDS 
         TRACEFORMAT    SWITCH USED IN THE TRACE ROUTINE
         TRACE$COUNT    NUMBER OF WORDS TO BE CONVERTED DURING
                        TRACING AND ALSO NUMBER OF CHARACTERS TO
                        BE OUTPUT PER LINE OF TRACE OUTPUT
         TRACE$CTR      INDEX FOR LOOPS DURING TRACING AND ALSO FINAL 
                        CHARACTER LENGTH OF INFORMATION TO BE OUTPUT
         TRACE$IDENT    FORMAL CHARACTER STRING PARAMETER FOR OUTPUT
                        IDENTIFICATION IN TRACE ROUTINE CALLS 
         TRACE$LENGTH   FORMAL PARAMETER SPECIFYING OUTPUT CHARACTER
                        LENGTH IN TRACE ROUTINE CALLS 
         TRACE$MTYPE    ACTUAL OUTPUT FORMAT DURING TRACING AND ALSO
                        NUMBER OF TRACE WORDS LEFT TO BE OUTPUT 
         TRACE$OUTLEN   OUTPUT LENGTH CALCULATED IN TRACE ROUTINE CALLS 
         TRACE$SOURCE   FORMAL PARAMETER SPECIFYING WHAT IS TO BE 
                        OUTPUT IN TRACE ROUTINE CALLS 
         TRACE$TYPE     FORMAL PARAMETER SPECIFYING OUTPUT FORMAT 
                        IN TRACE ROUTINE CALLS
         USED$ARRAY     FORMAL ARRAY NAME FOR USED$PREV ARRAY 
         USED$CHAR      MACRO USED TO TEST INDICATOR BITS IN USED$PREV
         USED$PREV      ARRAY USED IN ALPHABET NAME LITERAL PROCESSING
                        TO INDICATE PREVIOUS USAGE OF CHARACTERS
         VAR$TRACE      TRACE TYPE SPECIFYING DECIMAL CONTENTS
         WORD$INDEX     WORD INDEX INTO STRING ARRAYS 
 #
         NEWPAGE; 
 #
         DECLARATION OF LITERAL SAVE AREAS
  
         THE LITERAL SOURCE AREAS ARE DECLARED AS ARRAYS
         BECAUSE OF SYMPLS RESTRICTION OF CHARACTER STRINGS 
         TO 240 CHARACTERS. THESE ARRAYS ARE DECLARED 28
         WORDS IN LENGTH TO ALLOW FOR THE MAXIMUM SOURCE
         LITERAL LENGTH OF 255 CHARACTERS PLUS A MAXIMUM
         OF 9 CHARACTERS PADDING FORE AND AFT.
 #
         ARRAY SRC$LIT [0:27];
         ITEM SRC$WORD            I(0,0,60);
  
         ARRAY OBJ$LIT [0:27];
         ITEM OBJ$CHAR            C(0,0,10);
 #
         DECLARATION OF LENGTH,TYPE AND INDEX VARIABLES 
 #
         ITEM SRC$LIT$LEN         I,
              SRC$LINE$NO         I,
              SRC$COL$NO          I,
              SRC$VERBCODE        I,
              SRC$LIT$TYPE        I,
              OBJ$LIT$TYPE        I,
              OBJ$LIT$LEN         I,
              OBJ$SUB$DPTH        I,
              OBJ$OCC$LEN         I,
              OBJ$MSEC            I,
              OBJ$OFFSET          I,
              OBJ$ALIGN           I,
              OBJ$ORG$LEN         I,
              OBJ$INDEX           I,
              AUX$INDEX           I,
              LAT$INDEX           I,
              LIT$NEG,
              DNAT$INDEX          I,
              PLT$INDEX           I,
              LPOOL$INDEX         I,
              WORD$INDEX          I,
              CHAR$INDEX          I,
              DIAG$NO             I;
 #
         DECLARATION OF CHARACTER VARIABLES 
 #
         ITEM NATIVE$LOW          C(1), 
              NATIVE$HIGH         C(1), 
              LOW$VALUE           C(1), 
              HIGH$VALUE          C(1), 
              CHAR$VAL            C(1); 
         NEWPAGE; 
 #
         DECLARATION OF FLAGS 
 #
         ITEM NO$POOL$FLAG        B,
              SUBS$FLAG           B,
              SPACES$FLAG         B,
              ZEROS$FLAG          B,
              HI$LO$FLAG          B,
              SHORT$FLAG          B,
              LAT$ALL$FLAG        B;
 #
         DECLARATION OF CCT INFORMATION VARIABLES 
 #
         ITEM ALNAME$START        I,
              ALNAME$END          I,
              LAT$PD$START        I,
              LAT$PD$END          I,
              CSEQ$DNAT           I,
              CMU$FLAG            B,
              SET$COL$FLAG        B,
              NATIVE$SW           I,
              LPOOL$LEN           I;
 #
         DECLARATION OF NUMERIC CONSTANTS 
 #
         DEF  CHARSIN1WORD        #10#; 
         DEF  CHARSIN2WORD        #20#; 
         DEF  CHARSIN3WORD        #30#; 
         DEF  BITSIN1WORD         #60#; 
         DEF  NATIVE$SIZE         #64#; 
         DEF  QLIT$LIMIT          #30#; 
         DEF  COMPARE$LIM         #20#; 
 #
         DECLARATION AND INITIALIZATION OF THE CONVERSION TABLE.
         CURRENTLY THE ELEMENTS OF THIS ARRAY ARE NOT PACKED
         MORE THAN ONE PER WORD. ALSO RECALL THAT SYMPL DOES
         ITS INITIALIZATION COLUMN WISE. MORE INFORMATION ON
         THIS TABLE MAY BE FOUND IN THE CHECKCONV ROUTINE 
         INTRODUCTORY DOCUMENTATION.
 #
         ARRAY [1:20,2:9];
         ITEM  CONV$TABLE   I(0,0,60) = [ 
           [ 3, 2, 3, 4, 2, 2, 8, 1, 2, 2, 1, 2, 1, 2, 2, 5, 5, 1, 9, 9]
           [ 2, 2, 2, 2, 2, 2, 8, 1, 2, 2, 1, 2, 1, 2, 2, 5, 5, 1, 1, 1]
           [ 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 1, 2, 1, 2, 2, 5, 5, 1, 1, 1]
           [ 2, 2, 3, 4, 2, 2, 8, 1, 2, 2, 1, 2, 1, 2, 2, 3, 3, 1, 9, 9]
           [ 6, 7, 3, 4, 2,10,10, 1, 2, 2, 1, 2, 1, 2, 2, 3, 3, 3, 9, 9]
           [ ]
           [ ]
           [ 1, 1, 3, 4, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 1, 9, 9]
           ]; 
         NEWPAGE; 
 #
         DEFINITION OF CHARACTER USAGE CHECKING MACRO AND PSEUDO ARRAY
 #
         DEF  USED$CHAR(I)
              #B<MOD(I,BITSIN1WORD),1>USED$PREV[I/BITSIN1WORD]#;
         ARRAY USED$ARRAY [0:1];
         ITEM USED$PREV           I(0,0,60);
 #
         DEFINITION OF WHILE LOOP CONTROL MACRO 
 #
         ITEM DUMMY               I;
         DEF  ASLONGAS            #FOR DUMMY = 0 WHILE#;
 #
         DEFINITION OF REMAINDER FUNCTION MACRO 
 #
         DEF  MOD(DIVIDEND,DIVISOR) 
              #((DIVIDEND)-((DIVIDEND)/(DIVISOR))*(DIVISOR))#;
 #
         DECLARATION OF DISPLAY CODE CHARACTER VALUES 
 #
         DEF  OCT$00              #O"00"#;         # COLON           #
         DEF  OCT$40              #O"40"#;         # FIVE            #
         DEF  OCT$44              #O"44"#;         # NINE            #
         DEF  OCT$55              #O"55"#;         # BLANK           #
         DEF  OCT$57              #O"57"#;         # PERIOD          #
         DEF  OCT$65              #O"65"#;         # UNDERLINE       #
         DEF  OCT$77              #O"77"#;         # SEMICOLON       #
         DEF  OCT$A               #"A"#;
         DEF  OCT$Y               #"Y"#;
         DEF  OCT$Z               #"Z"#;
         DEF  OCT$PLUS            #"+"#;
         DEF  OCT$ZERO            #"0"#;
         DEF  OCT$MINUS           #"-"#;
         DEF  OCT$BLANK           #" "#;
         DEF  OCT$WORD            #O"00000000000000000000"#;
         NEWPAGE; 
 #
         DECLARATION AND INITIALIZATION OF THE COLLATING SEQUENCES
         FOR THE CDC AND ASCII CHARACTER SETS. THEY ARE DECLARED AS 
         ARRAYS BECAUSE OF PROBLEMS IN INITIALIZING LONG CHARACTER
         STRINGS WITH OCTAL OR CHARACTER CONSTANTS. THEY ARE SEVEN
         WORDS IN LENGTH TO ACCOMODATE 64 CHARACTERS AND WILL BE
         ACCESSED USING THE GETCHAR FUNCTION. 
 #
         ARRAY CDC$CSEQ [0:6];
         ITEM CDC$WD              C(0,0,10)        =[ 
              O"55 74 63 61 65 60 67 70 71 73", 
              O"75 76 57 52 77 45 53 47 46 50", 
              O"56 51 54 64 72 01 02 03 04 05", 
              O"06 07 10 11 66 12 13 14 15 16", 
              O"17 20 21 22 62 23 24 25 26 27", 
              O"30 31 32 00 33 34 35 36 37 40", 
              O"41 42 43 44 00 00 00 00 00 00"];
         ARRAY ASCII$CSEQ [0:6];
         ITEM ASCII$WD            C(0,0,10)        =[ 
              O"55 66 64 60 53 63 67 70 51 52", 
              O"47 45 56 46 57 50 33 34 35 36", 
              O"37 40 41 42 43 44 00 77 72 54", 
              O"73 71 74 01 02 03 04 05 06 07", 
              O"10 11 12 13 14 15 16 17 20 21", 
              O"22 23 24 25 26 27 30 31 32 61", 
              O"75 62 76 65 00 00 00 00 00 00"];
         NEWPAGE; 
 #
         INCLUSION OF REFERENCED COMPILER TABLES
 #
*CALL TABLNAMES 
*CALL TABLEDF 
*CALL GETSET
*CALL AUXT1 
*CALL AUXTVALS
*CALL DNATVALS
*CALL PLT1
*CALL PLTVALS 
*CALL LAT1
*CALL LPOOL1
# 
          XREFS 
# 
          XREF  PROC FILLC; 
          XREF PROC  LIT2RN;
          XREF  PROC  LSEARCH;
          XREF  PROC  SUBSTR; 
         NEWPAGE; 
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
 #                                                                   #
 #                                                                   #
 #       D E B U G   O U T P U T   R O U T I N E                     #
 #                                                                   #
 #                                                                   #
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
         LISTOFF; $BEGIN
PROC     TRACE((TRACE$TYPE),(TRACE$IDENT),
               TRACE$SOURCE,(TRACE$LENGTH));
         BEGIN
 #
         T R A C E
  
         THIS ROUTINE USED IN PHASE DEBUG MODE FORMATS TRACE
         INFORMATION AND OUTPUTS IT TO THE LISTING OR THE USER
         TERMINAL SCREEN. THE COMPILER COMMON ROUTINES OCT AND
         DEC ARE USED TO CONVERT VARIABLES TO HUMAN READABLE FORM 
         WHILE THE ROUTINES DISPLAY AND CBLIST ARE USED TO OUTPUT 
         THE FORMATTED TRACE INFORMATION. THE ITEM TO BE TRACED,
         TRACE$SOURCE,IS PASSED BY REFERENCE TO ENABLE TRACING OF 
         THE FULL CONTENTS OF CHARACTER AREAS RATHER THAN JUST ONE
         WORD OF SUCH AREAS. IT IS DECLARED AS CHARACTER TO AVOID 
         PROBLEMS WITH THE BEAD FUNCTION USED IN THE CHARACTER
         TRACE SECTION. 
 #
         ITEM TRACE$TYPE          I,
              TRACE$IDENT         C(20),
              TRACE$SOURCE        C(240), 
              TRACE$LENGTH        I,
              TRACE$MTYPE         I,
              TRACE$CTR           I,
              TRACE$OUTLEN        I,
              TRACE$COUNT         I;
         SWITCH TRACEFORMAT       VAR0,POS0,REG0,CHA0,INT0; 
                                  # 0    1    2    3    4 # 
  
         # PRELIMINARY CONSTRUCTION OF MESSAGE #
         IO$WORD[1] = C<0,10>TRACE$IDENT;          # FIRST WORD 
                                                     OF MESSAGE      #
         IO$WORD[2] = C<10,10>TRACE$IDENT;         # SECOND WORD
                                                     OF MESSAGE      #
         TRACE$MTYPE = MOD(TRACE$TYPE,5);          # CALC ACTUAL
                                                     TYPE OF TRACE   #
         GOTO TRACEFORMAT[TRACE$MTYPE];            # SELECT 
                                                     TRACE CODE      #
         NEWPAGE; 
VAR0:    # DECIMAL CONTENTS OF VARIABLE TRACE # 
         TRACE$OUTLEN = 10;                        # ONE WORD        #
         IO$WORD[3] = DEC(TRACE$SOURCE);           # CONVERT INTEGER
                                                     TO CHARACTER    #
         GOTO TRACEWRITE; 
  
POS0:    # POSITIONAL TRACE # 
         TRACE$OUTLEN = 0;                         # NO MORE OUTPUT  #
         GOTO TRACEWRITE; 
  
REG0:    # OCTAL CONTENTS OF VARIABLE TRACE # 
         TRACE$OUTLEN = 20;                        # ONE WORD        #
         TRACE$COUNT = 1; 
         GOTO INT1; 
  
CHA0:    # CHARACTER CONTENTS OF AREA TRACE # 
         TRACE$OUTLEN = TRACE$LENGTH;              # SPECIFIED LENGTH#
         TRACE$COUNT = (TRACE$LENGTH + 9)/10;      # CALCULATE
                                                     WORD LENGTH     #
         FOR TRACE$CTR = 1 STEP 1 
                           UNTIL TRACE$COUNT DO 
         IO$WORD[TRACE$CTR+2] 
         = C<(TRACE$CTR-1)*10,10>TRACE$SOURCE;     # MOVE CONTENTS
                                                     TO OUTPUT AREA  #
         GOTO TRACEWRITE; 
  
INT0:    # OCTAL CONTENTS OF AREA TRACE # 
         TRACE$OUTLEN = TRACE$LENGTH * 2;          # TWO CHARACTERS 
                                                     FOR 1 SPECIFIED #
         TRACE$COUNT = (TRACE$LENGTH + 9)/10;      # CALCULATE
                                                     WORD LENGTH     #
INT1: 
         TRACE$COUNT = TRACE$COUNT * 2;            # 2 WORDS FOR 1   #
         FOR TRACE$CTR = 1 STEP 1 
                           UNTIL TRACE$COUNT DO 
         IO$WORD[TRACE$CTR+2] 
         = OCT(TRACE$SOURCE,(TRACE$CTR-1)*10,10);  # MOVE CONVERTED 
                                                     TO OUTPUT AREA  #
         NEWPAGE; 
         # FINAL OUTPUT OF TRACE MESSAGE #
TRACEWRITE: 
         # LOOP THROUGH TRACE OUTPUT LINE BY LINE # 
  
         # CALCULATE NUMBER OF CHARACTERS ON THIS LINE #
         IF TRACE$OUTLEN LQ 80
            THEN
            TRACE$COUNT = TRACE$OUTLEN;            # LAST LINE       #
            ELSE
            TRACE$COUNT = 80;                      # MAX LINE LENGTH #
         TRACE$CTR = TRACE$COUNT + 20;             # MESSAGE LENGTH 
                                                     WITH HEADER     #
         IF TRACE$TYPE LS 5                        # TRACE DESTINY   #
            THEN
            CBLIST(1,IO$AREA,TRACE$CTR);           # LISTING         #
            ELSE
            DISPLAY(2,IO$AREA,0,TRACE$CTR);        # SCREEN AND 
                                                     LISTING         #
         TRACE$OUTLEN = TRACE$OUTLEN - TRACE$COUNT;# CALCULATE
                                                     LENGTH LEFT     #
         IF TRACE$OUTLEN GR 0                      # MORE TO COME\   #
            THEN
            BEGIN 
            IO$WORD[1] = "          ";
            IO$WORD[2] = "          ";             # BLANK OUT
                                                     HEADER PART      # 
            TRACE$MTYPE = TRACE$OUTLEN/10;         # NO. OF WORDS 
                                                     LEFT(BASE ZERO) #
            FOR TRACE$CTR = 0 STEP 1
                            UNTIL TRACE$MTYPE DO   # LOOP THROUGH 
                                                     REMAINING STUFF #
            IO$WORD[3 + TRACE$CTR]
            = IO$WORD[11 + TRACE$CTR];             # SHIFT DOWNWARD 
                                                     TO BE ADJACENT 
                                                     TO HEADER AREA  #
            GOTO TRACEWRITE;                       # JUMP TO OUTPUT 
                                                     AND REPEAT      #
            END 
         END #TRACE#
         $END LISTON; 
         NEWPAGE; 
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
 #                                                                   #
 #                                                                   #
 #       C H A R A C T E R   H A N D L I N G   R O U T I N E S       #
 #                                                                   #
 #                                                                   #
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
FUNC     GETCHAR(S$ARRAY,(S$OFFSET))               C(1);
         BEGIN
 #
         G E T C H A R
  
         THIS FUNCTION RETURNS THE CHARACTER SPECIFIED BY 
         THE OFFSET (S$OFFSET) FROM THE STRING (S$ARRAY). 
 #
 #
         DECLARATION OF FORMAL PARAMETERS 
 #
         ARRAY S$ARRAY; 
         ITEM S$WORD              C(0,0,10);
         ITEM S$OFFSET            I;
         WORD$INDEX = S$OFFSET/CHARSIN1WORD;       # CALC WHICH 
                                                     WORD OF ARRAY   #
         CHAR$INDEX 
         = S$OFFSET - WORD$INDEX*CHARSIN1WORD;     # CALC INDEX 
                                                     WITHIN WORD     #
         GETCHAR
         = C<CHAR$INDEX,1>S$WORD[WORD$INDEX];      # RETURN THE 
                                                     APPROPRIATE
                                                     CHARACTER       #
         END #GETCHAR#
         NEWPAGE; 
PROC     PUTCHAR((S$CHAR),R$ARRAY,(R$OFFSET));
         BEGIN
 #
         P U T C H A R
  
         THIS ROUTINE GIVEN AN INSERTION CHARACTER (S$CHAR) 
         INSERTS IT INTO THE POSITION OF THE STRING (R$ARRAY) 
         SPECIFIED BY THE CHARACTER OFFSET (R$OFFSET).
 #
 #
         DECLARATION OF FORMAL PARAMETERS 
 #
         ITEM S$CHAR              C(1); 
         ARRAY R$ARRAY; 
         ITEM R$WORD              C(0,0,10);
         ITEM R$OFFSET            I;
         WORD$INDEX = R$OFFSET/CHARSIN1WORD;       # CALC WHICH 
                                                     WORD OF ARRAY   #
         CHAR$INDEX 
         = R$OFFSET - WORD$INDEX*CHARSIN1WORD;     # CALC INDEX 
                                                     WITHIN WORD     #
         C<CHAR$INDEX,1>R$WORD[WORD$INDEX]
         = S$CHAR;                                 # INSERT 
                                                     SPECIFIED CHAR  #
         END #PUTCHAR#
         NEWPAGE; 
  
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
 #                                                                   #
 #                                                                   #
 #       A U X I L I A R Y   R O U T I N E S                         #
 #                                                                   #
 #                                                                   #
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
PROC     DIAGNOSTIC((MSG$NO),(MSG$SEVERITY)); 
         BEGIN
 #
         D I A G N O S T I C
  
         THIS ROUTINE GENERATES THE ERROR MESSAGE IDENTIFIED BY 
         MSG$NO WITH THE SEVERITY CODE MSG$SEVERITY BY CALLING
         THE EXTERNAL COMPILER COMMON INTERCEPTOR ROUTINE.
  
         I N P U T S
  
         MSG$NO 
         MSG$SEVERITY 
         PLT$INDEX
         PLT INFORMATION - VIA PLT$INDEX
              PL$LINE 
              PL$COLUMN 
  
         C A L L E D   B Y
  
         ALPHACHECK 
         CHECKCONV
         CON2AN 
         SRCHAUXTAB 
  
         R O U T I N E S   C A L L E D
  
         INTERCEPTOR
 #
 #
         DECLARATION OF FORMAL PARAMETERS 
 #
         ITEM MSG$NO              I,
              MSG$SEVERITY        I;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"DIAGNOSTIC-ENTRY    "); 
         TRACE(VAR$TRACE,"MSG$NO            = ",MSG$NO);
         TRACE(VAR$TRACE,"MSG$SEVERITY      = ",MSG$SEVERITY);
         TRACE(VAR$TRACE,"PLT$INDEX         = ",PLT$INDEX); 
         DEBUGEND $END LISTON;
 #
         ACCESS LINE AND COLUMN INFORMATION FROM CURRENT PLT ENTRY
 #
         SRC$COL$NO 
         = GETQUICK(PL$COLUMN,PLT$,PLT$INDEX);     # LITERAL
                                                     COLUMN NUMBER   #
         SRC$LINE$NO
         = GETQUICK(PL$LINE,PLT$,PLT$INDEX);       # LITERAL
                                                     LINE NUMBER     #
 #
         GENERATE THE ERROR MESSAGE 
 #
         INTERCEPTOR(SRC$COL$NO,SRC$LINE$NO,
                     MSG$NO,MSG$SEVERITY);
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"DIAGNOSTIC-EXIT     "); 
         TRACE(VAR$TRACE,"SRC$LINE$NO       = ",SRC$LINE$NO); 
         TRACE(VAR$TRACE,"SRC$COL$NO        = ",SRC$COL$NO);
         DEBUGEND $END LISTON;
         END #DIAGNOSTIC# 
         NEWPAGE; 
PROC     SRCHAUXTAB;
         BEGIN
 #
         S R C H A U X T A B
  
         THIS HOUSEKEEPING ROUTINE SEARCHES THE AUX TABLE 
         ENTRIES ASSOCIATED WITH A GIVEN DNAT ENTRY FOR THE 
         ENTRY CONTAINING SUBSCRIPTING INFORMATION. 
  
         I N P U T S
  
         OBJ$SUB$DPTH 
         DNAT$INDEX 
         DNAT INFORMATION - VIA DNAT$INDEX
              DN$AUXREF 
         AUX TABLE INFORMATION - VIA DN$AUXREF
              AX$TTYPE
              AX$TNEXTPTR 
              AX$SUBSLVL
  
         O U T P U T S
  
         AUX$INDEX
  
         C A L L E D   B Y
  
         CHECKCONV
  
         R O U T I N E S   C A L L E D
  
         DIAGNOSTIC 
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM AUX$TYPE            I;
 #
         THE LOGICAL STEPS NEEDED TO FIND THE APPROPRIATE 
         ENTRY ARE
  
           1) OBTAIN THE AUX POINTER FROM THE DNAT ENTRY
           2) CHECK THE AUX ENTRY TO SEE IF IT IS THE 
              DESIRED ONE. IF SO, QUIT
           3) OTHERWISE CHAIN TO THE NEXT AUX ENTRY AND 
              REPEAT STEP 2 
 #
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"SRCHAUXTAB-ENTRY    "); 
         TRACE(VAR$TRACE,"OBJ$SUB$DPTH      = ",OBJ$SUB$DPTH);
         TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
         TRACE(VAR$TRACE,"DN$AUXREF         = ",
               GETQUICK(DN$AUXREF,DNAT$,DNAT$INDEX)); 
         DEBUGEND $END LISTON;
 #
         AN INFINITE LOOP IS POSSIBLE IF THE EXISTENCE OF 
         AN APPROPRIATE AUX TABLE ENTRY IS ASSUMED. THE 
         FOLLOWING CODE PREVENTS THIS BY TESTING FOR A
         ZERO INDEX.
 #
         AUX$INDEX
         = GETQUICK(DN$AUXREF,DNAT$,DNAT$INDEX);   # SET INDEX TO 
                                                     1ST AUX ENTRY   #
SRCHAUXTAB1:  
         IF AUX$INDEX EQ 0                         # CHECK FOR BAD   #
            THEN
            BEGIN 
            DIAGNOSTIC(MSG998,SEVERE);             # COMPILER ERROR  #
            GOTO SRCHAUXTAB30;                     # QUIT            #
            END 
 #
         SEARCH FOR AN ENTRY OF THE RIGHT TYPE WITH THE 
         CORRECT SUBSCRIPT LEVEL FOR THE TYPE MAXOCCUR. 
 #
         AUX$TYPE 
         = GETQUICK(AX$TTYPE,AUX$,AUX$INDEX);      # ACCESS 
                                                     ENTRY TYPE      #
         IF AUX$TYPE NQ MAXOCCUR
         OR GETQUICK(AX$SUBSLVL,AUX$,AUX$INDEX) NQ OBJ$SUB$DPTH 
            THEN
            BEGIN 
            AUX$INDEX 
            = GETQUICK(AX$TNEXTPTR,AUX$,AUX$INDEX);# CHAIN TO 
                                                     NEXT ENTRY      #
            GOTO SRCHAUXTAB1;                      # REPEAT PROCESS  #
            END 
SRCHAUXTAB30: 
 #
         UPON EXIT FROM THE LOOP AUX$INDEX POINTS TO THE
         APPROPRIATE AUX TABLE ENTRY
 #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"SRCHAUXTAB-EXIT     "); 
         TRACE(VAR$TRACE,"AUX$INDEX         = ",AUX$INDEX); 
         DEBUGEND $END LISTON;
         END #SRCHAUXTAB# 
         NEWPAGE; 
FUNC     CHARUSED((IDX))            B;
         BEGIN
 #
         C H A R U S E D
  
         THIS ROUTINE,CALLED DURING CONSTRUCTION OF THE TRANSLATION 
         TABLES FOR LITERAL ALPHABET NAMES,AND GIVEN A CHARACTER
         INDEX,DETERMINES IF SAID CHARACTER HAS BEEN SPECIFIED
         PREVIOUSLY. IF SO THE DIAGNOSTIC NUMBER IS SET UP AND
         THE ROUTINE RETURNS TRUE. OTHERWISE THE CHARACTER IS 
         MARKED AS HAVING OCCURRED AND THE ROUTINE RETURNS FALSE. 
  
         O U T P U T S
  
         DIAG$NO
  
         C A L L E D   B Y
  
         TRANSTAB 
 #
 #
         DECLARATION OF FORMAL PARAMETER AND LOCAL STORAGE
 #
         ITEM IDX                 I,
              RETURN$FLAG         B;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"CHARUSED-ENTRY      "); 
         TRACE(REG$TRACE,"IDX OCTAL         = ",IDX); 
         TRACE(INT$TRACE,"USED$ARRAY        = ",USED$ARRAY,11); 
         DEBUGEND $END LISTON;
 #
         USE THE USED ARRAY TO DETERMINE IF WE HAVE 
         ENCOUNTERED THIS CHARACTER PREVIOUSLY
 #
         IF USED$CHAR(IDX) NQ 0                    # HAD CHAR BEFORE\#
            THEN
            BEGIN 
            DIAG$NO = MSG003;                      # ERROR MESSAGE   #
            RETURN$FLAG = TRUE;                    # RETURN TRUE     #
            END 
            ELSE
            BEGIN                                  # NOT HAD BEFORE  #
            USED$CHAR(IDX) = 1;                    # MARK CHARACTER 
                                                     AS USED         #
            RETURN$FLAG = FALSE;                   # RETURN FALSE    #
            END 
         CHARUSED = RETURN$FLAG;                   # ACTUAL RETURN
                                                     OF VALUE        #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"CHARUSED-EXIT       "); 
         TRACE(VAR$TRACE,"RETURN$FLAG       = ",RETURN$FLAG); 
         IF RETURN$FLAG 
            THEN
            TRACE(VAR$TRACE,"DIAG$NO           = ",DIAG$NO);
         TRACE(INT$TRACE,"USED$ARRAY        = ",USED$ARRAY,11); 
         DEBUGEND $END LISTON;
         END #CHARUSED# 
         NEWPAGE; 
FUNC     PADTOWORD; 
         BEGIN
 #
         P A D T O W O R D
  
         THIS ROUTINE CALCULATES THE DISTANCE IN CHARACTERS 
         TO THE NEXT WORD BOUNDARY FOR A PARTIALLY CONVERTED
         ALPHANUMERIC LITERAL. THE DISTANCE CALCULATED IS 
         SUBSEQUENTLY BLANK OR BINARY ZERO FILLED.
  
         I N P U T S
  
         SRC$LIT$LEN
         OBJ$ALIGN
  
         C A L L E D   B Y
  
         CON2AN 
         DIVER
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM OVERHANG            I;
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"PADTOWORD-ENTRY     "); 
         TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN); 
         TRACE(VAR$TRACE,"OBJ$ALIGN         = ",OBJ$ALIGN); 
         DEBUGEND $END LISTON;
         OVERHANG 
         = MOD(OBJ$ALIGN+SRC$LIT$LEN,CHARSIN1WORD);# CALC OVERHANG
                                                     BEYOND LAST
                                                     WORD BOUNDARY   #
         IF OVERHANG NQ 0                          # ANY OVERHANG\   #
            THEN
            OVERHANG = CHARSIN1WORD - OVERHANG;    # GET DISTANCE 
                                                     TO NEXT WORD    #
         PADTOWORD = OVERHANG;                     # RETURN THE 
                                                     CALCULATED VALUE#
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"PADTOWORD-EXIT      "); 
         TRACE(VAR$TRACE,"OVERHANG          = ",OVERHANG);
         DEBUGEND $END LISTON;
         END #PADTOWORD#
         NEWPAGE; 
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
 #                                                                   #
 #                                                                   #
 #       N O N N U M E R I C   C O N V E R S I O N   R O U T I N E S #
 #                                                                   #
 #                                                                   #
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
PROC     TRANSTAB;
         BEGIN
 #
         T R A N S T A B
  
         THIS ROUTINE,GIVEN A LITERAL ALPHABET NAME INITIAL AUX 
         TABLE ENTRY GENERATES THE APPROPRIATE CHARACTER TRANSLATION
         TABLE BY MAKING A PASS OVER THE ASSOCIATED AUX TABLE 
         ENTRIES PROCESSING THE SPECIFIED LITERALS. THE HIGH AND
         LOW VALUES OF THE ALPHABET ARE ALSO DETERMINED.
  
         I N P U T S
  
         AUX$INDEX
  
         O U T P U T S
  
         OBJ$LIT$LEN
         TRANSLATE TABLE - VIA OBJ$LIT
         NO$POOL$FLAG 
         DIAG$NO
         LOW$VALUE
         HIGH$VALUE 
  
         C A L L E D   B Y
  
         ALIT 
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM OFFSET              I,
              SRC$OLD$VAL         I,
              SRC$VAL             I,
              AUX$PREV            I,
              AUX$NEXT            I,
              INCR                I;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"TRANSTAB-ENTRY      "); 
         TRACE(VAR$TRACE,"AUX$INDEX         = ",AUX$INDEX); 
         DEBUGEND $END LISTON;
 #
         THE VARIABLE OBJ$LIT$LEN WILL SERVE AS THE CURRENT 
         ENTRY POSITION WITHIN THE TRANSLATION TABLE. IT WILL 
         THUS HAVE A RANGE OF 0 THROUGH NATIVE$SIZE-1. EACH 
         TIME A CHARACTER IS ASSIGNED A NEW POSITION WITHIN 
         THE TRANSLATION TABLE,THE COUNTER (OBJ$LIT$LEN) WILL 
         BE UPDATED BY 1. THIS DOES NOT OCCUR FOR ANY ALSO
         PHRASES ENCOUNTERED WHERE THE SAME VALUE OF THE
         INDEX IS USED. 
 #
         NO$POOL$FLAG = TRUE;                      # ASSUME ERRORS
                                                     WILL OCCUR      #
         OBJ$LIT$LEN = -1;                         # INITIALIZE 
                                                     COLLATING INDEX #
 #
         ZERO OUT THE INDICATORS SPECIFYING WHICH 
         CHARACTERS HAVE BEEN ASSIGNED VALUES 
 #
         B<0,60>USED$PREV[0] = OCT$WORD;           # FIRST WORD      #
         B<0,60>USED$PREV[1] = OCT$WORD;           # SECOND WORD     #
 #
         THE AUX ENTRIES ARE IN REVERSE ORDER OF ENCOUNTER
         TO SIMPLIFY FURTHER PROCESSING WE WILL REORDER TO
         THE ORDER AS IN THE SOURCE WHICH IS CRUCIAL TO THE 
         TRANSLATION TABLE TO BE BUILT. ON ENTRY TO THIS
         ROUTINE AUX$INDEX WILL HAVE BEEN SET BY ALIT TO
         POINT TO THE FIRST ENTRY IN THE CHAIN. 
 #
         AUX$PREV = 0;                             # SET PREVIOUS 
                                                     INDEX AS 0      #
         ASLONGAS AUX$INDEX NQ 0 DO                # LOOP THROUGH 
                                                     ALL ENTRIES     #
            BEGIN 
            AUX$NEXT
            = GETQUICK(AX$TNEXTPTR,AUX$,AUX$INDEX);# SAVE INDEX 
                                                     OF NEXT ENTRY   #
            SETFIELD(AX$TNEXTPTR,AUX$,AUX$INDEX,
                     AUX$PREV);                    # POINT TO 
                                                     PREV ENTRY      #
            AUX$PREV = AUX$INDEX;                  # UPDATE LAST
                                                     ENTRY INDEX     #
            AUX$INDEX = AUX$NEXT;                  # GO ON TO 
                                                     NEXT ENTRY      #
            END                                    # END OF 
                                                     REORDER LOOP    #
 #
         NOW SET AUX$INDEX TO POINT TO THE LAST ENTRY IN
         THE CHAIN OR THE FIRST SOURCE LITERAL ENTRY. 
 #
         AUX$INDEX = AUX$PREV;
         NEWPAGE; 
 #
         NOW LOOP THROUGH THE AUX ENTRIES ATTACHED TO THE 
         ALPHA NAME DNAT WHICH SPECIFY THE LITERALS WHICH 
         WILL COMPOSE THE TRANSLATION TABLE. THE CODE ASSUMES 
         BOTH EXISTENCE AND EXCLUSIVITY OF THE APPROPRIATE
         AUX TABLE ENTRIES. 
 #
         ASLONGAS AUX$INDEX NQ 0 DO                # PROCESS ALL
                                                     LITERALS        #
         BEGIN
         OBJ$LIT$TYPE 
         = GETQUICK(AX$TTYPE,AUX$,AUX$INDEX);      # WHAT KIND OF 
                                                     ALPHA LITERAL   #
         PLT$INDEX
         = GETQUICK(AX$ANPLTPTR,AUX$,AUX$INDEX);   # INDEX OF PLT 
                                                     LITERAL ENTRY   #
         SRC$LIT$TYPE 
         = GETQUICK(PL$CODE,PLT$,PLT$INDEX);       # TYPE OF
                                                     SOURCE LITERAL  #
         SRC$LIT$LEN
         = GETQUICK(PL$LENGTH,PLT$,PLT$INDEX);     # CHARACTER LENGTH 
                                                     OF LITERAL      #
         GETPLST(PLT$INDEX,LOC(SRC$LIT));          # MOVE LITERAL 
                                                     TO SAVE AREA    #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"TRANSTAB-LOOP       "); 
         TRACE(VAR$TRACE,"AUX$INDEX         = ",AUX$INDEX); 
         TRACE(VAR$TRACE,"OBJ$LIT$TYPE      = ",OBJ$LIT$TYPE);
         TRACE(VAR$TRACE,"PLT$INDEX         = ",PLT$INDEX); 
         TRACE(VAR$TRACE,"SRC$LIT$TYPE      = ",SRC$LIT$TYPE);
         TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN); 
         TRACE(CHA$TRACE,"SRC$LIT           = ",SRC$LIT,SRC$LIT$LEN); 
         DEBUGEND $END LISTON;
         NEWPAGE; 
 #
         CHECK FOR A NUMERIC LITERAL,PERFORM A RANGE
         VALIDITY TEST AND MODIFY THE SOURCE AREA AS
         IF THE LITERAL HAD BEEN NON-NUMERIC. 
 #
         IF SRC$LIT$TYPE NQ PLTQUOTEDLIT           # NUMERIC LITERAL #
            THEN
            BEGIN 
            LISTOFF; $BEGIN DEBUGBEGIN
            TRACE(POS$TRACE,"TRANSTAB-NUMERIC    ");
            DEBUGEND $END LISTON; 
            SRC$VAL = 0;                           # INITIALIZE 
                                                     LITERAL VALUE   #
            FOR OFFSET = 0 STEP 1 
                         UNTIL SRC$LIT$LEN - 1 DO  # LOOP THROUGH 
                                                     SOURCE LITERAL  #
            SRC$VAL = SRC$VAL * 10
            + GETCHAR(SRC$LIT,OFFSET) - OCT$ZERO;  # CALCULATE AND
                                                     SUM DIGITS      #
            LISTOFF; $BEGIN DEBUGBEGIN
            TRACE(VAR$TRACE,"SRC$VAL           = ",SRC$VAL);
            DEBUGEND $END LISTON; 
            IF SRC$VAL LS 1 
            OR SRC$VAL GR NATIVE$SIZE              # WITHIN RANGE\   #
               THEN 
               BEGIN
               DIAG$NO = MSG001;                   # ERROR MESSAGE   #
               GOTO TRANSTAB30;                    # RECOVERY ACTION #
               END
 #
            SUBTRACT ONE FROM THE SOURCE LITERAL VALUE TO 
            MAP IT ON TO THE RANGE OF THE NATIVE CHARACTERS.
 #
            CHAR$VAL = SRC$VAL - 1;                # CONVERT TO 
                                                     CHARACTER FORM  #
            PUTCHAR(CHAR$VAL,SRC$LIT,0);           # STORE RESULT 
                                                     BACK IN SOURCE  #
            SRC$LIT$LEN = 1;                       # SOURCE LENGTH
                                                     IS 1 CHARACTER  #
            LISTOFF; $BEGIN DEBUGBEGIN
            TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN);
            TRACE(INT$TRACE,"SRC$LIT OCTAL     = ",SRC$LIT,SRC$LIT$LEN);
            DEBUGEND $END LISTON; 
            END                                    # END OF NUMERIC 
                                                     LITERAL CODE    #
         NEWPAGE; 
 #
         PROCESS THE LITERAL DEPENDING ON THE SPECIFIED TYPE
 #
         IF OBJ$LIT$TYPE EQ AUXANLITERAL           # PLAIN LITERAL   #
            THEN
            BEGIN 
            LISTOFF; $BEGIN DEBUGBEGIN
            TRACE(POS$TRACE,"TRANSTAB-LITERAL    ");
            DEBUGEND $END LISTON; 
            FOR OFFSET = 0 STEP 1 
                         UNTIL SRC$LIT$LEN - 1 DO  # LOOP THROUGH 
                                                     SPECIFIED CHARS #
                BEGIN 
                SRC$VAL = GETCHAR(SRC$LIT,OFFSET); # ACCESS NEXT
                                                     CHARACTER       #
                IF CHARUSED(SRC$VAL)               # USED BEFORE\    #
                   THEN 
                   GOTO TRANSTAB30;                # RECOVERY ACTION #
                IF OBJ$LIT$LEN LS 0                # FIRST LITERAL\  #
                   THEN 
                   LOW$VALUE = SRC$VAL;            # SAVE LOW 
                                                     VALUE INDEX     #
                OBJ$LIT$LEN = OBJ$LIT$LEN + 1;     # BUMP COLLATING 
                                                     CHAR INDEX      #
                CHAR$VAL = OBJ$LIT$LEN;            # CONVERT TO 
                                                     CHARACTER FORM  #
                PUTCHAR(CHAR$VAL, 
                        OBJ$LIT,SRC$VAL);          # PLACE INDEX
                                                     IN OUTPUT AREA  #
                LISTOFF; $BEGIN DEBUGBEGIN
                TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN);
                TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ", 
                      OBJ$LIT,NATIVE$SIZE); 
                DEBUGEND $END LISTON; 
                END                                # END OF LOOP     #
            END                                    # END OF NORMAL
                                                     LITERAL SECTION #
            NEWPAGE;
            ELSE
            BEGIN                                  # ALSO OR THROUGH #
 #
            CHECK THE SYNTAX RULE SPECIFYING THAT SINGLE
            CHARACTER LITERALS ARE REQUIRED FOR ALSO AND
            THROUGH CLAUSES 
 #
            IF SRC$LIT$LEN NQ 1                    # 1 CHAR ONLY     #
               THEN 
               BEGIN
               DIAG$NO = MSG002;                   # ERROR MESSAGE   #
               GOTO TRANSTAB30;                    # RECOVERY ACTION #
               END
            SRC$VAL = GETCHAR(SRC$LIT,0);          # ACCESS THE 
                                                     CHARACTER       #
            IF OBJ$LIT$TYPE EQ AUXANALSO           # ALSO SPECIFIED  #
               THEN 
               BEGIN
               LISTOFF; $BEGIN DEBUGBEGIN 
               TRACE(POS$TRACE,"TRANSTAB-ALSO       "); 
               DEBUGEND $END LISTON;
               IF CHARUSED(SRC$VAL)                # SAME CHARACTER\ #
                  THEN
                  GOTO TRANSTAB30;                 # RECOVERY ACTION #
               CHAR$VAL = OBJ$LIT$LEN;             # CONVERT TO 
                                                     CHARACTER       #
               PUTCHAR(CHAR$VAL,
                       OBJ$LIT,SRC$VAL);           # USE SAME INDEX 
                                                     AS BEFORE       #
               LISTOFF; $BEGIN DEBUGBEGIN 
               TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
               TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",
                     OBJ$LIT,NATIVE$SIZE);
               DEBUGEND $END LISTON;
               END                                 # END OF ALSO     #
               NEWPAGE; 
               ELSE 
               BEGIN                               # THROUGH CLAUSE  #
               LISTOFF; $BEGIN DEBUGBEGIN 
               TRACE(POS$TRACE,"TRANSTAB-THROUGH    "); 
               DEBUGEND $END LISTON;
               IF SRC$VAL LS SRC$OLD$VAL           # WHICH WAY\      #
                       THEN 
                       INCR = -1;                  # DESCENDING      #
               ELSE IF SRC$VAL GR SRC$OLD$VAL 
                       THEN 
                       INCR = 1;                   # ASCENDING       #
                       ELSE 
                       BEGIN                       # SAME CHARACTER  #
                       DIAG$NO = MSG003;           # ERROR MESSAGE   #
                       GOTO TRANSTAB30;            # RECOVERY ACTION #
                       END
               OFFSET = SRC$OLD$VAL;               # START WITH 
                                                     PREVIOUS VALUE  #
               ASLONGAS OFFSET NQ SRC$VAL DO       # LOOP THROUGH 
                                                     SPECIFIED RANGE #
               BEGIN
               OFFSET = OFFSET + INCR;             # BUMP FOR 
                                                     NEXT CHARACTER  #
               IF CHARUSED(OFFSET)                 # SAME CHARACTER\ #
                  THEN
                  GOTO TRANSTAB30;                 # RECOVERY ACTION #
               OBJ$LIT$LEN = OBJ$LIT$LEN + 1;      # BUMP COLLATING 
                                                     CHARACTER INDEX #
               CHAR$VAL = OBJ$LIT$LEN;             # CONVERT TO 
                                                     CHARACTER       #
               PUTCHAR(CHAR$VAL,
                       OBJ$LIT,OFFSET);            # PUT INDEX IN 
                                                     OUTPUT AREA     #
               LISTOFF; $BEGIN DEBUGBEGIN 
               TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
               TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",
                     OBJ$LIT,NATIVE$SIZE);
               DEBUGEND $END LISTON;
               END                                 # END OF LOOP     #
               END                                 # END OF THROUGH  #
            END                                    # END OF ALSO
                                                     AND THRU CODE   #
         SRC$OLD$VAL = SRC$VAL;                    # SAVE LAST SOURCE 
                                                     VALUE FOR NEXT  #
         AUX$INDEX
         = GETQUICK(AX$TNEXTPTR,AUX$,AUX$INDEX);   # NEXT ENTRY 
                                                     IN CHAIN        #
         END                                       # END OF 
                                                     AUX LOOP        #
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"TRANSTAB-CLEANUP    "); 
         DEBUGEND $END LISTON;
 #
         THE HIGH VALUE FOR THIS COLLATING SEQUENCE IS THE LAST 
         CHARACTER SPECIFIED IF ALL CHARACTERS WERE MENTIONED 
         IN THE LITERAL PHRASES PROCESSED ABOVE OR IS THE LAST
         CHARACTER ASSIGNED IN THE CLEANUP OPERATION TO FOLLOW. 
 #
         HIGH$VALUE = SRC$OLD$VAL;                 # LAST CHAR ABOVE #
 #
         MAKE A PASS OVER THE NATIVE SET ASSIGNING ALL UNSPECIFIED
         CHARACTERS MONOTONICALLY INCREASING INDICIES WITHIN THE
         TRANSLATION TABLE. EACH TIME THAT AN UNASSIGNED CHARACTER
         IS FOUND WE UPDATE THE HIGH VALUE TO THAT CHARACTER. 
 #
         FOR OFFSET = 0 STEP 1
                      UNTIL NATIVE$SIZE - 1 DO     # CHECK ALL CHARS #
             BEGIN
 #
             OBTAIN NEXT CHARACTER IN COLLATING SEQUENCE DEPENDING
             ON THE NATIVE CHARACTER SET SWITCH. IF DISPLAY CODE IS 
             THE NATIVE SET,THE LOOP INDEX VALUE ITSELF IS USED.
 #
             IF NATIVE$SW LQ 2                     # CDC 63 OR CDC 64#
                THEN
                SRC$VAL = GETCHAR(CDC$CSEQ,OFFSET);# NEXT CHAR
                                                     IN CDC SEQUENCE #
             ELSE IF NATIVE$SW LQ 4                # ASCII 63 OR 64  #
                THEN
                SRC$VAL 
                = GETCHAR(ASCII$CSEQ,OFFSET);      # NEXT CHAR IN 
                                                     ASCII SEQUENCE  #
                ELSE
                SRC$VAL = OFFSET;                  # DISPLAY CODE    #
             IF USED$CHAR(SRC$VAL) EQ 1            # CHAR SPECIFIED\ #
                THEN
                TEST OFFSET;                       # NO ACTION
                                                     NECESSARY       #
             HIGH$VALUE = SRC$VAL;                 # SET HIGH AS
                                                     LAST UNASSIGNED #
             OBJ$LIT$LEN = OBJ$LIT$LEN + 1;        # BUMP COLLATING 
                                                     CHARACTER INDEX #
             CHAR$VAL = OBJ$LIT$LEN;               # CONVERT TO 
                                                     CHARACTER FORM  #
             PUTCHAR(CHAR$VAL,
                     OBJ$LIT,SRC$VAL);             # STORE INDEX
                                                     IN OUTPUT AREA  #
             LISTOFF; $BEGIN DEBUGBEGIN 
             TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
             TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",
                   OBJ$LIT,NATIVE$SIZE);
             DEBUGEND $END LISTON;
             END                                   # END OF LOOP     #
         NEWPAGE; 
 #
         AT THIS POINT ALL CHARACTERS WILL HAVE BEEN ASSIGNED 
         POSITIONS IN THE COLLATING SEQUENCE. NOW OBJ$LIT$LEN 
         WILL BE UPDATED TO NATIVE$SIZE,THE TRUE CHARACTER
         LENGTH OF THE TRANSLATION TABLE. 
 #
         OBJ$LIT$LEN = NATIVE$SIZE;                # SET FOR USE
                                                     BY DIVER        #
 #
         IF AN ERROR HAS BEEN DETECTED DURING CONSTRUCTION OF 
         THE TRANSLATION TABLE THE NO$POOL$FLAG WILL REMAIN 
         TRUE SINCE EXIT WILL BE MADE TO THE FOLLOWING LABEL
 #
         NO$POOL$FLAG = FALSE;                     # DIDNT HAVE 
                                                     ANY ERRORS      #
TRANSTAB30: 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"TRANSTAB-EXIT     "); 
         TRACE(VAR$TRACE,"NO$POOL$FLAG      = ",NO$POOL$FLAG);
         IF NO$POOL$FLAG
            THEN
            TRACE(VAR$TRACE,"DIAG$NO           = ",DIAG$NO);
            ELSE
            BEGIN 
            TRACE(INT$TRACE,"LOW$VALUE OCTAL   = ",LOW$VALUE,1);
            TRACE(INT$TRACE,"HIGH$VALUE OCTAL  = ",HIGH$VALUE,1); 
            TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN);
            TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",OBJ$LIT,OBJ$LIT$LEN);
            END 
         DEBUGEND $END LISTON;
         END #TRANSTAB# 
          CONTROL EJECT;
          PROC  ALL2NUM;     #MOVE ALL LITERAL TO NUMERIC#
          ITEM OFFSET;
          BEGIN 
          SHORT$FLAG = FALSE; 
          OBJ$LIT$LEN = GETQUICK(DN$NUMLEN,DNAT$,DNAT$INDEX); 
          IF SRC$LIT$LEN GQ OBJ$LIT$LEN 
          THEN
              BEGIN 
              LAT$ALL$FLAG = FALSE; 
              OFFSET = SRC$LIT$LEN - OBJ$LIT$LEN; 
              SUBSTR(SRC$LIT,OFFSET,OBJ$LIT,0,OBJ$LIT$LEN); 
              END 
          ELSE
              BEGIN 
              XPANDER;
              SUBSTR(SRC$LIT,0,OBJ$LIT,0,SRC$LIT$LEN);
              END 
          SETFIELD(DN$SIGNGRP,DNAT$,DNAT$INDEX,0);
          SETFIELD(DN$POINT,DNAT$,DNAT$INDEX,0);
          SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM); 
          OBJ$ALIGN = 0;
          RETURN; 
          END 
         NEWPAGE; 
PROC     ALPHACHECK;
         BEGIN
 #
         A L P H A C H E C K
  
         THIS ROUTINE VERIFIES IF AN ALPHANUMERIC ITEM CONSISTS 
         ONLY OF ALPHABETIC CHARACTERS AND GENERATES AN ERROR 
         MESSAGE IF NOT.
  
         I N P U T S
  
         CONVERTED LITERAL - VIA OBJ$LIT
         OBJ$LIT$LEN
  
         C A L L E D   B Y
  
         CHECKCONV
  
         R O U T I N E S   C A L L E D
  
         DIAGNOSTIC 
 #
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"ALPHACHECK-ENTRY    "); 
         TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
         TRACE(CHA$TRACE,"OBJ$LIT           = ",OBJ$LIT,OBJ$LIT$LEN); 
         TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",OBJ$LIT,OBJ$LIT$LEN); 
         DEBUGEND $END LISTON;
 #
         CHECK FOR ALPHABETIC CHARACTERS ONLY. THAT IS ALLOW
         CHARACTERS IN THE RANGE A THROUGH Z AND ALSO SPACE.
 #
         FOR OBJ$INDEX = 0 STEP 1 
                         UNTIL OBJ$LIT$LEN - 1 DO  # SCAN THROUGH 
                                                     CONVERTED LIT   #
         BEGIN
         CHAR$VAL = GETCHAR(OBJ$LIT,OBJ$INDEX);    # ACCESS NEXT
                                                     CHARACTER       #
         IF (CHAR$VAL LS OCT$A OR CHAR$VAL GR OCT$Z)
         AND CHAR$VAL NQ OCT$BLANK                 # TEST FOR ALPHA  #
            THEN
            BEGIN 
            DIAGNOSTIC(MSG011,ADVISORY);           # ERROR
                                                     MESSAGE         #
            GOTO ALPHACHECK30;                     # SKIP TO EXIT    #
            END 
         END
ALPHACHECK30: 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"ALPHACHECK-EXIT     "); 
         DEBUGEND $END LISTON;
         END #ALPHACHECK# 
          CONTROL EJECT;
          PROC  BOOLEXPANDER; 
#     EXPAND ALL BOOLEAN LITERAL WHICH IS ASSOCIATED WITH A BIT ITEM   #
#     IF  LITERAL IS NOT FULLY EXPANDED IT MUST BE A MULTIPLE OF       #
#     SIX CHARACTERS.                                                  #
          ITEM  OFFSET; 
          ITEM  LENGTH$LEFT;
          ITEM  EFF$RES$LEN;
          BEGIN 
          LAT$ALL$FLAG = FALSE; 
          IF  SRC$LIT$LEN GQ OBJ$LIT$LEN
          THEN
              BEGIN 
              IF  SRC$VERBCODE NQ 2   #NOT MOVE#
              THEN SRC$LIT$LEN = OBJ$LIT$LEN; 
              RETURN; 
              END 
          IF  OBJ$LIT$LEN GR 120 AND  6*SRC$LIT$LEN LS OBJ$LIT$LEN
          AND  SRC$VERBCODE NQ 0       # NOT EXPRESSION#
          THEN
              BEGIN 
              LAT$ALL$FLAG = TRUE;
              OBJ$LIT$LEN = 6 * SRC$LIT$LEN;
              END 
          OFFSET = 0; 
          EFF$RES$LEN = SRC$LIT$LEN;
          ASLONGAS OFFSET LS OBJ$LIT$LEN DO 
              BEGIN 
              LENGTH$LEFT = OBJ$LIT$LEN - OFFSET; 
              IF LENGTH$LEFT LS SRC$LIT$LEN 
              THEN  EFF$RES$LEN = LENGTH$LEFT;
              SUBSTR(SRC$LIT,0,OBJ$LIT,OFFSET,EFF$RES$LEN); 
              OFFSET = OFFSET + EFF$RES$LEN;
              END 
          IF  NOT LAT$ALL$FLAG
          THEN
              BEGIN 
              SRC$LIT$LEN = OBJ$LIT$LEN;
              SUBSTR(OBJ$LIT,0,SRC$LIT,0,SRC$LIT$LEN);
              END 
          RETURN; 
          END 
         NEWPAGE; 
PROC     XPANDER; 
         BEGIN
 #
         X P A N D E R
  
         THIS ROUTINE GIVEN AN "ALL" ALPHANUMERIC LITERAL REPEATS 
         THE SOURCE LITERAL UNTIL THE OBJECT AREA IS FILLED OR
         UNTIL A PREDETERMINED LIMIT IS REACHED. THIS LIMIT DEPENDS 
         UPON THE LENGTH OF THE SOURCE LITERAL AND THE ASSOCIATED 
         RECEIVING FIELD. THE REPEATED SOURCE STRING IS RETURNED IN 
         THE SOURCE AREA IF FURTHER PROCESSING CAN BE DONE. OTHERWISE 
         THE REPEATED STRING IS RETURNED IN THE OBJECT AREA.
  
         I N P U T S
  
         SOURCE LITERAL - VIA SRC$LIT 
         SRC$LIT$LEN
         OBJ$LIT$LEN
         CMU$FLAG 
         SRC$VERBCODE 
  
         O U T P U T S
  
         LAT$ALL$FLAG 
         REPEATED LITERAL - VIA SRC$LIT OR OBJ$LIT
         SRC$LIT$LEN
         OBJ$LIT$LEN
  
         C A L L E D   B Y
  
         CON2AN 
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM LENGTH$LEFT         I,
              EFF$RES$LEN         I,
              OFFSET              I;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"XPANDER-ENTRY       "); 
         TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN); 
         TRACE(CHA$TRACE,"SRC$LIT           = ",SRC$LIT,SRC$LIT$LEN); 
         TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
         DEBUGEND $END LISTON;
 #
         IF THE SOURCE STRING LENGTH IS THE SAME AS THE 
         DESIRED OBJECT LENGTH THIS ROUTINE SIMPLY RETURNS
         SINCE THE "ALL" IS ESSENTIALLY A NULL OPERATION. 
         IF THE SOURCE IS LONGER THAN THE OBJECT AND THE
         LITERAL APPEARS IN AN IF RELATION, WE CHANGE THE 
         SOURCE LENGTH TO BE THE SAME AS THE OBJECT LENGTH. 
         THIS WILL ALLOW PROPER RELATION EVALUATION AS IN 
         IF ALL "123" = PIC-X (WHERE WE MUST COMPARE "1"
         AGAINST PIC-X) AND ALSO WILL CAUSE AN ADVISORY 
         DIAGNOSTIC TO BE GENERATED FOR CASES LIKE MOVE 
         ALL "123" TO PIC-X.
 #
         LAT$ALL$FLAG = FALSE;                     # TURN OFF LAT 
                                                     REPLICATION     #
         IF SRC$LIT$LEN GQ OBJ$LIT$LEN             # SOURCE >= OBJECT#
              AND GETQUICK(L$REFMOD,LAT$,LAT$INDEX) EQ 0
            THEN
            BEGIN 
            IF SRC$VERBCODE EQ 1                   # IF STATEMENT    #
               THEN 
               SRC$LIT$LEN = OBJ$LIT$LEN;          # MAKE STRING
                                                     LENGTHS SAME    #
            GOTO XPANDER30;                        # SKIP TO EXIT    #
            END 
         NEWPAGE; 
 #
         SINCE THE SOURCE STRING IS SHORTER THAN THE DESIRED
         OBJECT ITEM LENGTH WE MUST REPEAT IT. ONLY IF THE
         OBJECT LENGTH IS SHORTER THAN THE QUOTED LITERAL 
         LIMIT DO WE FULLY REPEAT THE SOURCE. OTHERWISE THE 
         REPETITION LENGTH IS A FUNCTION OF THE SOURCE
         STRING LENGTH. 
 #
         IF OBJ$LIT$LEN GR QLIT$LIMIT              # LENGTH > LIMIT\ #
              OR  GETQUICK(L$REFMOD,LAT$,LAT$INDEX) NQ 0
            THEN
            BEGIN                                  # LIMIT EXCEEDED  #
            LAT$ALL$FLAG = TRUE;                   # RESET LAT
                                                     REPLICATION     #
 #
            DETERMINE HOW MANY TIMES TO REPEAT THE SOURCE 
            STRING BASED ON ITS LENGTH
 #
            IF MOD(CHARSIN1WORD,SRC$LIT$LEN) EQ 0 
               THEN 
               BEGIN                               # DIVIDES INTO 10 #
               IF CMU$FLAG                         # CMU OPTION      #
                  THEN
                  OBJ$LIT$LEN = CHARSIN3WORD;      # EXPAND TO 30    #
                  ELSE
                  OBJ$LIT$LEN = CHARSIN1WORD;      # EXPAND TO 10    #
               END
            ELSE IF MOD(CHARSIN2WORD,SRC$LIT$LEN) EQ 0
               THEN 
               OBJ$LIT$LEN = CHARSIN2WORD;         # DIVIDES INTO 20 #
            ELSE IF MOD(CHARSIN3WORD,SRC$LIT$LEN) EQ 0
               THEN 
               OBJ$LIT$LEN = CHARSIN3WORD;         # DIVIDES INTO 30 #
            ELSE IF SRC$LIT$LEN LS CHARSIN1WORD    # LESS THAN 1 WORD#
               THEN 
               OBJ$LIT$LEN = SRC$LIT$LEN * 2; 
               ELSE 
               OBJ$LIT$LEN = SRC$LIT$LEN;          # USE SOURCE LENGTH# 
            END 
         NEWPAGE; 
 #
         THE FOLLOWING CODE MOVES THE SOURCE LITERAL STRING 
         REPEATEDLY TO THE OBJECT AREA UNTIL THE OBJECT 
         AREA IS FILLED UP TO OBJ$LIT$LEN. OFFSET IS THE
         LENGTH OF THE ALREADY FILLED OBJECT AREA. ONLY 
         A PORTION OF THE STRING MAY BE MOVED ON THE LAST 
         ITERATION. 
 #
         OFFSET = 0;                               # INITIALIZE 
                                                     RESULT INDEX    #
         EFF$RES$LEN = SRC$LIT$LEN;                # SET SOURCE 
                                                     MOVE LENGTH     #
         ASLONGAS OFFSET LS OBJ$LIT$LEN DO         # LOOP THROUGH 
                                                     OBJECT AREA     #
            BEGIN 
            LENGTH$LEFT = OBJ$LIT$LEN - OFFSET;    # CALCULATE SPACE
                                                     LEFT IN
                                                     OBJECT AREA     #
            IF LENGTH$LEFT LS SRC$LIT$LEN 
               THEN 
               EFF$RES$LEN = LENGTH$LEFT;          # IS THERE ROOM
                                                     FOR ANOTHER
                                                     SOURCE STRING   #
            SUBSTR(SRC$LIT,0, 
                   OBJ$LIT,OFFSET,EFF$RES$LEN);    # MOVE SOURCE
                                                     TO RESULT       #
            OFFSET = OFFSET + EFF$RES$LEN;         # INCREMENT
                                                     RESULT INDEX    #
            END                                    # END OF 
                                                     MOVE CYCLE      #
 #
         IF THE STRING HAS BEEN COMPLETELY REPLICATED WE
         MOVE IT BACK INTO THE SOURCE AREA TO SIMULATE ITS
         BEING A NORMAL SOURCE LITERAL. ALL DIAGNOSTICS WILL
         BE GENERATED AND FURTHER PROCESSING DONE BY CON2AN.
 #
         IF NOT LAT$ALL$FLAG                       # FULL REPEAT\    #
            THEN
            BEGIN 
            SRC$LIT$LEN = OBJ$LIT$LEN;             # USE NEW
                                                     STRING LENGTH   #
            SUBSTR(OBJ$LIT,0, 
                   SRC$LIT,0,SRC$LIT$LEN);         # COPY BACK       #
            END 
         NEWPAGE; 
 #
         TERMINATION OF ROUTINE WITH THE RESULT EITHER IN THE 
         OBJECT AREA OR IN THE SOURCE AREA DEPENDING ON WHETHER 
         LAT$ALL$FLAG IS TRUE OR FALSE. 
 #
XPANDER30:  
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"XPANDER-EXIT        "); 
         TRACE(VAR$TRACE,"LAT$ALL$FLAG      = ",LAT$ALL$FLAG);
         IF LAT$ALL$FLAG
            THEN
            BEGIN 
            TRACE(CHA$TRACE,"OBJ$LIT           = ",OBJ$LIT,OBJ$LIT$LEN);
            TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN);
            END 
            ELSE
            BEGIN 
            TRACE(CHA$TRACE,"SRC$LIT           = ",SRC$LIT,SRC$LIT$LEN);
            TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN);
            END 
         DEBUGEND $END LISTON;
         END #XPANDER#
         NEWPAGE; 
PROC     CON2AN;
         BEGIN
 #
         C O N 2 A N
  
         THIS ROUTINE CONVERTS A QUOTED LITERAL TO AN ALPHANUMERIC
         ITEM. THUS THE PROCESS IS ESSENTIALLY CHARACTER TO 
         CHARACTER. SPECIAL CONSIDERATION NEEDS TO BE GIVEN TO
  
         1) ALL LITERALS
         2) JUSTIFIED ITEMS 
  
         WITH THE INTERPRETATION,IF BOTH 1) AND 2) APPLY, BEING 
         THAT JUSTIFICATION IS IGNORED. RECALL THAT THE NATURAL 
         ALIGNMENT OF THE ITEM, OBJ$ALIGN, HAS ALREADY BEEN 
         CALCULATED IN THE CHECKCONV ROUTINE. 
  
         I N P U T S
  
         SOURCE LITERAL - VIA SRC$LIT 
         SRC$LIT$LEN
         SRC$VERBCODE 
         DNAT INFORMATION - VIA DNAT$INDEX
              DN$JUST 
         LAT$ALL$FLAG 
         SUBS$FLAG
         OBJ$ALIGN
         CMU$FLAG 
  
         O U T P U T S
  
         CONVERTED LITERAL - VIA OBJ$LIT
         OBJ$LIT$LEN
  
         C A L L E D   B Y
  
         CHECKCONV
         CON2ANEDIT 
  
         R O U T I N E S   C A L L E D
  
         DIAGNOSTIC 
         PADTOWORD
         XPANDER
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM JUST$FLAG           B,
              LENGTH$DIFF         I,
              OFFSET              I,
              NO$LEAD$BLK         I,
              NO$TRAIL$BLK        I;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"CON2AN-ENTRY        "); 
         TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN); 
         TRACE(CHA$TRACE,"SRC$LIT           = ",SRC$LIT,SRC$LIT$LEN); 
         TRACE(VAR$TRACE,"SRC$VERBCODE      = ",SRC$VERBCODE);
         TRACE(VAR$TRACE,"OBJ$ALIGN         = ",OBJ$ALIGN); 
         TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
         TRACE(VAR$TRACE,"DN$JUST           = ",
               GETQUICK(DN$JUST,DNAT$,DNAT$INDEX)); 
         TRACE(VAR$TRACE,"LAT$ALL$FLAG      = ",LAT$ALL$FLAG);
         DEBUGEND $END LISTON;
 #
         CHECK TO SEE IF WE HAVE AN ALL LITERAL. IF SO CALL 
         THE XPANDER ROUTINE TO REPEAT THE SOURCE CHARACTER 
         STRING. THE STATUS OF LAT$ALL$FLAG ON XPANDER"S
         RETURN WILL INDICATE WHETHER THE REPEATED STRING 
         MAY BE TREATED AS A NORMAL SOURCE STRING.
 #
         IF LAT$ALL$FLAG                           # ALL LITERAL\    #
            THEN
            BEGIN 
            XPANDER;                               # REPEAT TO
                                                     SOME LIMIT      #
            IF LAT$ALL$FLAG                        # NEEDS REPEATING\#
               THEN 
               BEGIN
               OBJ$ALIGN = 0;                      # SET FOR WORD 
                                                     ALIGNMENT       #
               GOTO CON2AN30;                      # SKIP TO EXIT    #
               END
            END 
 #
         CALCULATE DIFFERENCE BETWEEN OBJECT AND SOURCE LENGTH
 #
         LENGTH$DIFF = OBJ$LIT$LEN - SRC$LIT$LEN; 
  
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(VAR$TRACE,"LENGTH$DIFF       = ",LENGTH$DIFF); 
         DEBUGEND $END LISTON;
 #
         INITIALIZE THE DIAGNOSTIC NUMBER WHICH SERVES AS 
         A FLAG TO INDICATE IF ANY ERRORS HAVE OCCURRED.
 #
         DIAG$NO = 0; 
         NEWPAGE; 
 #
         INITIALIZE THE VARIOUS LENGTHS ASSOCIATED WITH THE 
         FINAL MOVE OF THE SOURCE CHARACTER STRING TO THE 
         OBJECT AREA. 
 #
         OFFSET = 0;                               # START WITHIN 
                                                     SOURCE STRING   #
         NO$LEAD$BLK = 0;                          # NUMBER OF
                                                     LEADING BLANKS  #
         NO$TRAIL$BLK = 0;                         # NUMBER OF
                                                     TRAILING BLANKS #
 #
         SET UP THE JUSTIFIED INFORMATION FLAG
 #
         IF GETQUICK(DN$JUST,DNAT$,DNAT$INDEX) EQ 1 
              AND GETQUICK(L$REFMOD,LAT$,LAT$INDEX) EQ 0
            THEN
            JUST$FLAG = TRUE;                      # ITEM JUSTIFIED  #
            ELSE
            JUST$FLAG = FALSE;                     # NOT JUSTIFIED   #
 #
         NOW USE CMU$FLAG AND SRC$VERBCODE TO DECIDE WHAT 
         KIND OF CONVERSION TO DO NOW. THE FOLLOWING CODE 
         MAY NOT BE THE MOST EFFICIENT ALOGORITHM FOR THE 
         DESIRED RESULTS BUT IT DOES CLOSELY MODEL THE
         DOCUMENTATION TO BE FOUND IN THE PLIT ROUTINE. 
         THE COMMENTS BELOW REFER TO SPECIFIC RULES WHICH 
         MAY BE FOUND IN THE AFOREMENTIONED DOCUMENTATION.
 #
         IF NOT CMU$FLAG                           # NO CMU OPTION   #
         THEN 
         BEGIN
         IF SRC$VERBCODE EQ 0                      # MOVE AND OTHERS #
         THEN 
         BEGIN
         NEWPAGE; 
 #
         NO CMU CONVERSIONS 
         ****************** 
  
         UNSUBSCRIPTED AND UNJUSTIFIED MOVE STATEMENT LITERALS
         -----------------------------------------------------
 #
         IF NOT SUBS$FLAG                          # UNSUBSCRIPTED   #
            THEN
            BEGIN 
            # RULE MOVE I.2.A # 
            IF NOT JUST$FLAG                       # NOT JUSTIFIED   #
               THEN 
               BEGIN
               IF LENGTH$DIFF LS 0                 # SOURCE > OBJECT #
                       THEN 
                       BEGIN
                       # RULE MOVE I.2.A.2 #
                       DIAG$NO = MSG012;           # SET TRUNC
                                                     ERROR MESSAGE   #
                       SRC$LIT$LEN = OBJ$LIT$LEN;  # TAKE FIRST 
                                                     PART OF SOURCE  #
                       END
               ELSE IF LENGTH$DIFF GR 0            # SOURCE < OBJECT #
                       THEN 
                       BEGIN
                       # RULE MOVE I.2.A.3 #
                       IF LENGTH$DIFF LS CHARSIN1WORD 
                          THEN
                          # RULE MOVE I.2.A.3.A # 
                          NO$TRAIL$BLK=LENGTH$DIFF;# BLANK FILL 
                                                     LAST PART       #
                          ELSE
                          # RULE MOVE I.2.A.3.B # 
                          NO$TRAIL$BLK = PADTOWORD;# FILL TO
                                                     WORD BOUNDARY   #
                       END
               END                                 # UNJUST UNSUB END#
               NEWPAGE; 
               ELSE 
 #
               UNSUBSCRIPTED AND JUSTIFIED MOVE STATEMENT LITERALS
               ---------------------------------------------------
  
               NOTICE THAT THE RULES SPECIFY THAT THE LITERAL IS
               TO BE ALIGNED ON THE SAME ENDING POSITION AS THE 
               RECEIVING FIELD. HOWEVER FOR THOSE LITERALS WHICH
               EVENTUALLY ARE CONVERTED TO THE SAME SIZE AS THE 
               RECEIVING FIELD THIS IS EQUIVALENT TO ALIGNMENT ON 
               THE SAME STARTING CHARACTER POSITION. FOR THE ONE
               EXCEPTIONAL CASE (RULE I.2.B.3.B) THE CONVERTED
               LITERAL IS ALIGNED ON A WORD BOUNDARY. 
 #
               BEGIN                               # JUSTIFIED       #
               # RULE MOVE I.2.B #
               IF LENGTH$DIFF LS 0                 # SOURCE > OBJECT #
                       THEN 
                       BEGIN
                       # RULE MOVE I.2.B.2 #
                       DIAG$NO = MSG013;           # SET TRUNC
                                                     ERROR MESSAGE   #
                       SRC$LIT$LEN = OBJ$LIT$LEN;  # TAKE LAST
                                                     PART OF SOURCE  #
                       OFFSET = - LENGTH$DIFF;     # SKIP OVER
                                                     FIRST PART      #
                       END
               ELSE IF LENGTH$DIFF GR 0            # SOURCE < OBJECT #
                       THEN 
                       BEGIN
                       # RULE MOVE I.2.B.3 #
                       IF LENGTH$DIFF LS CHARSIN1WORD 
                          THEN
                          # RULE MOVE I.2.B.3.A # 
                          NO$LEAD$BLK=LENGTH$DIFF; # BLANK FILL 
                                                     FIRST PART      #
                          ELSE
                          BEGIN 
                          # RULE MOVE I.2.B.3.B # 
                          OBJ$ALIGN = 0;           # START ON 
                                                     WORD BOUNDARY   #
                          NO$LEAD$BLK = PADTOWORD; # FILL FROM
                                                     WORD BOUNDARY   #
                          END 
                       END
               END                                 # END UNSUBS JUST #
            END                                    # UNSUB END       #
            NEWPAGE;
            ELSE
 #
            SUBSCRIPTED MOVE STATEMENT LITERALS 
            ----------------------------------- 
 #
            BEGIN                                  # SUBSCRIPTED     #
            # RULE MOVE II.1 #
            OBJ$ALIGN = 0;                         # BEGINS ON
                                                     WORD BOUNDARY   #
            IF NOT JUST$FLAG                       # NOT JUSTIFIED   #
               THEN 
               BEGIN
               # RULE MOVE II.2.A # 
               IF LENGTH$DIFF LS 0                 # SOURCE > OBJECT #
                  THEN
                  BEGIN 
                  # RULE MOVE II.2.A.2 #
                  DIAG$NO = MSG012;                # SET ERROR
                                                     MESSAGE NUMBER  #
                  SRC$LIT$LEN = OBJ$LIT$LEN;       # USE ONLY AS MANY 
                                                     CHARS AS NEED   #
                  END 
               END                                 # END SUBS UNJUST #
               ELSE 
               BEGIN                               # SUBS AND JUST   #
               # RULE MOVE II.2.B # 
               IF LENGTH$DIFF LS 0                 # SOURCE > OBJECT #
                  THEN
                  BEGIN 
                  # RULE MOVE II.2.B.2 #
                  DIAG$NO = MSG013;                # SET ERROR
                                                     MESSAGE NUMBER  #
                  SRC$LIT$LEN = OBJ$LIT$LEN;       # REVISE 
                                                     SOURCE LENGTH   #
                  OFFSET = - LENGTH$DIFF;          # SKIP STARTING
                                                     UNUSED CHARS    #
                  END 
               END                                 # END SUBS JUST   #
            END                                    # END SUBSCRIPTED #
         END                                       # END OF MOVE     #
         NEWPAGE; 
         ELSE 
 #
         IF STATEMENT LITERALS
         ---------------------
 #
         BEGIN                                     # IF              #
         IF NOT SUBS$FLAG                          # UNSUBSCRIPTED   #
            THEN
            BEGIN 
            # RULE IF.I # 
            IF OBJ$LIT$LEN LQ COMPARE$LIM          # LIMIT OF 20     #
               THEN 
               BEGIN
               # RULES IF.I.1.1 AND IF.I.2.A #
               OBJ$ALIGN = 0;                      # BEGINS ON
                                                     WORD BOUNDARY   #
               NO$TRAIL$BLK = PADTOWORD;           # SPACE FILL TO
                                                     WORD BOUNDARY   #
               END
               ELSE 
               BEGIN
               # RULE IF.I.2.B #
               IF LENGTH$DIFF GR 0                 # SOURCE < OBJECT #
                  THEN
                  BEGIN 
                  IF LENGTH$DIFF LS CHARSIN1WORD   # SAME WORD\      #
                     THEN 
                     # RULE IF.I.2.B.2.A #
                     NO$TRAIL$BLK = LENGTH$DIFF;   # BLANK PAD
                                                     TO ITEM END     #
                     ELSE 
                     # RULE IF.I.2.B.2.B #
                     NO$TRAIL$BLK = PADTOWORD;     # FILL TO
                                                     WORD BOUNDARY   #
                  END 
               END
            END                                    # UNSUBS IF END   #
            ELSE
            BEGIN                                  # SUBSCRIPTED IF  #
            # SUBSCRIPTED IF - RULE IF.II.1 # 
            OBJ$ALIGN = 0;                         # BEGINS ON
                                                     WORD BOUNDARY   #
            IF OBJ$LIT$LEN LQ COMPARE$LIM          # LIMIT OF 20     #
               THEN 
               # RULE IF.II.2.A # 
               NO$TRAIL$BLK = PADTOWORD;           # BLANKS TO
                                                     WORD BOUNDARY   #
            END                                    # END SUBS IF     #
         END                                       # END OF IF       #
         END                                       # END OF NO CMU   #
         NEWPAGE; 
         ELSE 
 #
         CMU CONVERSIONS
         ***************
  
         UNJUSTIFIED MOVE STATEMENT LITERALS
         -----------------------------------
 #
         BEGIN
         IF SRC$VERBCODE EQ 0                      # MOVE AND OTHERS #
         THEN 
         BEGIN
         IF NOT JUST$FLAG                          # NOT JUSTIFIED   #
            THEN
            BEGIN 
            IF LENGTH$DIFF LS 0                    # SOURCE > OBJECT #
                    THEN
                    BEGIN 
                    DIAG$NO = MSG012;              # SET TRUNCATION 
                                                     ERROR MESSAGE   #
                    SRC$LIT$LEN = OBJ$LIT$LEN;     # TAKE FIRST 
                                                     PART OF SOURCE  #
                    END 
            ELSE IF LENGTH$DIFF GR 0               # SOURCE < OBJECT #
                    THEN
                    BEGIN 
                    IF LENGTH$DIFF LQ COMPARE$LIM  # LIMIT OF 20     #
                       THEN 
                       NO$TRAIL$BLK = LENGTH$DIFF; # BLANK FILL ALL 
                                                     OF LAST PART    #
                    END 
            END                                    # UNJUST MOVE END #
            NEWPAGE;
            ELSE
 #
            JUSTIFIED MOVE STATEMENT LITERALS 
            --------------------------------- 
 #
            BEGIN                                  # JUSTIFIED       #
            IF LENGTH$DIFF LS 0                    # SOURCE > OBJECT #
                    THEN
                    BEGIN 
                    DIAG$NO = MSG013;              # SET LEFT TRUNC 
                                                     ERROR MESSAGE   #
                    SRC$LIT$LEN = OBJ$LIT$LEN;     # TAKE LAST PART 
                                                     OF SOURCE       #
                    OFFSET = -LENGTH$DIFF;         # SKIP OVER FIRST
                                                     PART OF SOURCE  #
                    END 
            ELSE IF LENGTH$DIFF GR 0               # SOURCE < OBJECT #
                    THEN
                    BEGIN 
                    IF LENGTH$DIFF LQ COMPARE$LIM  # LIMIT OF 20     #
                       THEN 
                       NO$LEAD$BLK = LENGTH$DIFF;  # BLANK FILL UP
                                                     TO DIFFERENCE   #
                    END 
            END                                    # JUST MOVE END   #
         END                                       # END OF MOVE     #
         NEWPAGE; 
         ELSE 
 #
         IF STATEMENT LITERALS
         ---------------------
 #
         BEGIN                                     # IF              #
         IF LENGTH$DIFF GR 0                       # SOURCE < OBJECT #
            THEN
            BEGIN 
            IF LENGTH$DIFF LQ COMPARE$LIM          # LIMIT OF 20     #
               THEN 
               NO$TRAIL$BLK = LENGTH$DIFF;         # BLANK FILL UP
                                                     TO OBJECT SIZE  #
            END 
         END                                       # END OF IF       #
         END                                       # CMU END         #
         NEWPAGE; 
 #
         FINAL MOVE OF THE APPROPRIATE PORTION OF THE SOURCE
         CHARACTER STRING TO THE RESULT AREA WITH LEADING AND 
         TRAILING BLANK FILL PROVIDED IF REQUIRED.
 #
         IF NO$LEAD$BLK NQ 0                       # ANY LEAD FILL\  #
            THEN
              FILLC("          ",OBJ$LIT,0,NO$LEAD$BLK);#LEADING BLANKS#
         SUBSTR(SRC$LIT,OFFSET, 
                OBJ$LIT,NO$LEAD$BLK,SRC$LIT$LEN);  # MOVE SOURCE
                                                     TO OBJECT AREA  #
         OBJ$LIT$LEN = NO$LEAD$BLK + SRC$LIT$LEN;  # LENGTH 
                                                     SO FAR          #
         IF NO$TRAIL$BLK NQ 0                      # ANY TRAIL FILL\ #
            THEN
            BEGIN 
              FILLC("          ",OBJ$LIT,OBJ$LIT$LEN,NO$TRAIL$BLK); 
            OBJ$LIT$LEN 
            = OBJ$LIT$LEN + NO$TRAIL$BLK;          # TOTAL
                                                     OBJECT LENGTH   #
            END 
 #
         GENERATE A DIAGNOSTIC IF NECESSARY 
 #
         IF DIAG$NO NQ 0                           # ANY ERROR\      #
            THEN
            DIAGNOSTIC(DIAG$NO,ADVISORY);          # CHAR TRUNCATION
                                                     ERROR MESSAGE   #
CON2AN30: 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"CON2AN-EXIT         "); 
         TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
         TRACE(CHA$TRACE,"OBJ$LIT           = ",OBJ$LIT,OBJ$LIT$LEN); 
         TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",OBJ$LIT,OBJ$LIT$LEN); 
         TRACE(VAR$TRACE,"OBJ$ALIGN         = ",OBJ$ALIGN); 
         TRACE(VAR$TRACE,"LAT$ALL$FLAG      = ",LAT$ALL$FLAG);
         DEBUGEND $END LISTON;
         END #CON2AN# 
         NEWPAGE; 
PROC     CON2ANEDIT;
         BEGIN
 #
  
         C O N 2 A N E D I T
  
         THIS ROUTINE CONVERTS A SOURCE LITERAL STRING TO AN
         ALPHANUMERIC EDITED ITEM. SPECIAL CARE MUST BE TAKEN 
         WITH ITEMS BEYOND THE QUOTED LITERAL LENGTH LIMIT. 
  
         I N P U T S
  
         SOURCE$LITERAL - VIA SRC$LIT 
         SRC$LIT$LEN
         DNAT INFORMATION - VIA DNAT$INDEX
              DN$REPCOUNT 
         LAT$ALL$FLAG 
  
         O U T P U T S
  
         OBJ$ALIGN
         CONVERTED LITERAL - VIA OBJ$LIT
         OBJ$LIT$LEN
         DNAT INFORMATION - VIA DNAT$INDEX
              DN$TYPE 
  
         C A L L E D   B Y
  
         CHECKCONV
  
         R O U T I N E S   C A L L E D
  
         CON2AN 
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM OBJ$REP$CNT         I;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"CON2ANEDIT-ENTRY    "); 
         TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN); 
         TRACE(CHA$TRACE,"SRC$LIT           = ",SRC$LIT,SRC$LIT$LEN); 
         TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
         TRACE(VAR$TRACE,"DN$REPCOUNT       = ",
               GETQUICK(DN$REPCOUNT,DNAT$,DNAT$INDEX)); 
         DEBUGEND $END LISTON;
 #
         CHECK FOR QUOTED LITERAL LIMIT EXCEEDED. IF SO WE
         ALSO TEST IF THE NUMBER OF REPLACEMENT CHARACTERS
         EXCEEDS THE LIMIT FOR IF IT DOESN"T WE PARTIALLY 
         MOVE THE SOURCE FIELD INTO A FIELD WHOSE LENGTH IS 
         THE NUMBER OF REPLACEMENT CHARACTERS.
 #
         OBJ$REP$CNT
         = GETQUICK(DN$REPCOUNT,DNAT$,DNAT$INDEX); # OBTAIN NUMBER OF 
                                                     REPLACEMENT
                                                     CHARACTERS      #
         IF OBJ$LIT$LEN GR QLIT$LIMIT AND 
            OBJ$REP$CNT GR QLIT$LIMIT 
            THEN
            BEGIN                                  # BOTH LIMITS
                                                     EXCEEDED        #
            OBJ$ALIGN = 0;                         # SET FOR
                                                     WORD BOUNDARY   #
            OBJ$LIT$LEN = SRC$LIT$LEN;             # RETAIN ORIGINAL
                                                     LENGTH          #
            SUBSTR(SRC$LIT,0, 
                   OBJ$LIT,0,OBJ$LIT$LEN);         # MOVE STRING TO 
                                                     OBJECT AREA     #
            GOTO CON2ANEDIT30;
            END 
         NEWPAGE; 
 #
         THE FINAL RESULT LENGTH IS WITHIN THE QUOTED LITERAL 
         LIMIT SO WE CONSTRUCT AN INTERMEDIATE ALPHANUMERIC 
         ITEM TO BE EDITED AT OBJECT TIME.
 #
         OBJ$LIT$LEN = OBJ$REP$CNT;                # SET INTERMEDIATE 
                                                     ITEM LENGTH     #
 #
         CHANGE THE TYPE OF THE COMPILER GENERATED LITERAL
         DNAT ENTRY TO INDICATE TO CGEN WHAT HAS HAPPENED.
 #
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX, 
                  ALPHNUM); 
 #
         CALL THE ALPHANUMERIC CONVERSION ROUTINE TO OBTAIN 
         THE INTERMEDIATE ALPHANUMERIC ITEM 
 #
         CON2AN;
  
CON2ANEDIT30: 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"CON2ANEDIT-EXIT     "); 
         TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
         TRACE(INT$TRACE,"OBJ$LIT           = ",OBJ$LIT,OBJ$LIT$LEN); 
         TRACE(VAR$TRACE,"OBJ$ALIGN         = ",OBJ$ALIGN); 
         TRACE(VAR$TRACE,"DN$TYPE           = ",
               GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX)); 
         DEBUGEND $END LISTON;
         END #CON2ANEDIT# 
          NEWPAGE;
          PROC CON2BOOL;
#         CONVERT A BOOLEAN OR ALPHANUMERIC LITERAL TO A BOOLEAN ITEM  #
#         WITH USAGE DISPLAY.                                          #
          ITEM  JUST$FLAG   B;
          ITEM  LENGTH$DIFF  I; 
          ITEM  NO$LEAD$ZERO  U;
           ITEM  NO$TRL$ZERO  U ; 
          ITEM  OFFSET       I; 
          SWITCH  BOOLVERB  BOOLMISC, BOOLIF, BOOLMOVE; 
          BEGIN 
          SRC$VERBCODE = GETQUICK(L$VCODE,LAT$,LAT$INDEX);
          IF  SRC$LIT$TYPE EQ PLTFGCONZERO  THEN  LAT$ALL$FLAG = FALSE; 
          IF  LAT$ALL$FLAG   # ALL LITERAL# 
          THEN
              BEGIN 
              IF  OBJ$LIT$LEN GR 255 AND SRC$VERBCODE EQ 0
              THEN   # EXPRESSION -- TRUNCATE LITERAL#
                  BEGIN 
                  DIAGNOSTIC(MSG004,0); 
                  OBJ$LIT$LEN = 255;
                  END 
              IF  GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX) EQ BOOLBIT 
              THEN BOOLEXPANDER;
              ELSE  XPANDER;
              IF  LAT$ALL$FLAG         #NEEDS EXECUTION TIME EXPANSION# 
              THEN
                  BEGIN 
                  OBJ$ALIGN = 0;
                  SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,BOOLDSP); 
                  RETURN; 
                  END 
              END 
          DIAG$NO = 0;
          OFFSET = 0; 
          NO$LEAD$ZERO = 0; 
          NO$TRL$ZERO = 0;
          LENGTH$DIFF = OBJ$LIT$LEN - SRC$LIT$LEN;
          IF  GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX) EQ BOOLBIT 
          THEN  OBJ$ALIGN = 0;
          SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,BOOLDSP); 
        GOTO  BOOLVERB[SRC$VERBCODE]; 
 BOOLMISC:  
          GOTO  BOOLFINISH; 
 BOOLMOVE:  
          IF  GETQUICK(DN$JUST,DNAT$,DNAT$INDEX) EQ 1 
          THEN  JUST$FLAG = TRUE; 
          ELSE  JUST$FLAG = FALSE;
          IF  NOT SUBS$FLAG 
          THEN
              BEGIN 
              IF  NOT JUST$FLAG 
              THEN
                  BEGIN 
                  IF  LENGTH$DIFF LS 0
                  THEN
                      BEGIN 
                      DIAG$NO = MSG012; 
                      SRC$LIT$LEN = OBJ$LIT$LEN;
                      END 
                  IF  LENGTH$DIFF GR 0
                  THEN
                      BEGIN 
                      IF  LENGTH$DIFF LS CHARSIN1WORD 
                      THEN  NO$TRL$ZERO = LENGTH$DIFF;
                      ELSE  NO$TRL$ZERO = PADTOWORD;
                      END 
                  END   #NOT JUSTIFIED# 
              ELSE      #JUSTIFIED# 
                  BEGIN 
                  IF  LENGTH$DIFF LS 0
                  THEN
                      BEGIN 
                      DIAG$NO = MSG013; 
                      SRC$LIT$LEN = OBJ$LIT$LEN;
                      OFFSET = -LENGTH$DIFF;
                      END 
                  IF  LENGTH$DIFF GR 0
                  THEN
                      BEGIN 
                      IF  LENGTH$DIFF LS CHARSIN1WORD 
                      THEN
                          NO$LEAD$ZERO = LENGTH$DIFF; 
                      ELSE
                          BEGIN 
                          OBJ$ALIGN = 0;
                          NO$LEAD$ZERO = PADTOWORD; 
                          END 
                      END 
                  END   #JUSTIFIED# 
              END   #UNSUBSCRIPTED# 
          ELSE      #SUBSCRIPTED# 
              BEGIN 
              OBJ$ALIGN = 0;
              IF  NOT  JUST$FLAG
              THEN
                  BEGIN 
                  IF  LENGTH$DIFF LS 0
                  THEN
                      BEGIN 
                      DIAG$NO = MSG012; 
                      SRC$LIT$LEN = OBJ$LIT$LEN;
                      END 
                  END   #UNJUSTIFIED# 
              ELSE      #JUSTIFIED# 
                  BEGIN 
                  IF  LENGTH$DIFF LS 0
                  THEN
                      BEGIN 
                      DIAG$NO = MSG013; 
                      SRC$LIT$LEN = OBJ$LIT$LEN;
                      OFFSET = -LENGTH$DIFF;
                      END 
                  END 
              END   #SUBSCRIPTED# 
          GOTO  BOOLFINISH; 
 BOOLIF:  
          IF  NOT SUBS$FLAG 
          THEN
              BEGIN 
              IF  OBJ$LIT$LEN LQ COMPARE$LIM
              THEN
                  BEGIN 
                  OBJ$ALIGN = 0;
                  NO$TRL$ZERO = PADTOWORD;
                  END 
              ELSE
                  BEGIN 
                  IF  LENGTH$DIFF GR 0
                  THEN
                      BEGIN 
                      IF  LENGTH$DIFF LS CHARSIN1WORD 
                      THEN
                          NO$TRL$ZERO = LENGTH$DIFF;
                      ELSE
                          NO$TRL$ZERO = PADTOWORD;
                      END 
                  END 
              END   #UNSUBSCRIPTED# 
          ELSE      #SUBSCRIPTED# 
              BEGIN 
              OBJ$ALIGN = 0;
              IF  OBJ$LIT$LEN LQ COMPARE$LIM
              THEN  NO$TRL$ZERO = PADTOWORD;
              END   #SUBSCRIPTED# 
          GOTO  BOOLFINISH; 
 BOOLFINISH:  
          IF  NO$LEAD$ZERO NQ 0 
          THEN  FILLC("0000000000",OBJ$LIT,0,NO$LEAD$ZERO); 
          SUBSTR(SRC$LIT,OFFSET,OBJ$LIT,NO$LEAD$ZERO,SRC$LIT$LEN);
          OBJ$LIT$LEN = SRC$LIT$LEN + NO$LEAD$ZERO; 
          IF  NO$TRL$ZERO NQ 0
          THEN
              BEGIN 
              FILLC("0000000000",OBJ$LIT,OBJ$LIT$LEN,NO$TRL$ZERO);
              OBJ$LIT$LEN = OBJ$LIT$LEN + NO$TRL$ZERO;
              END 
          IF  DIAG$NO  NQ 0  THEN  DIAGNOSTIC(DIAG$NO,ADVISORY);
          RETURN; 
          END 
          NEWPAGE;
PROC      CON2NUM;
 #
  
          C O N 2 N U M 
  
          THIS ROUTINE CONVERTS A NUMERIC SOURCE LITERAL STRING TO A
          NUMERIC ITEM, ZERO FILLED AND SET TO THE LENGTH OF THE
          ASSOCIATED FIELD. 
  
          I N P U T S 
  
          SOURCE$LITERAL - VIA SRC$LIT
          SRC$LIT$LEN 
          DNATINFORMATION - VIA DNAT$INDEX
  
          O U T P U T S 
  
          OBJ$ALIGN 
          CONVERTED LITERAL - VIA OBJ$LIT 
          OBJ$LIT$LEN 
          DNAT INFO - VIA DNAT$INDEX
              DN$TYPE 
  
          C A L L E D   B Y 
  
          CHECKCONV 
  
          R O U T I N E S    C A L L E D
  
          SCANLIT 
          LIT2RN
  
 #
          BEGIN 
          XREF PROC LIT2RN; 
          XREF PROC SCANLIT;
 #
          LOCAL STORAGE 
 #
          ARRAY PARAMSX [1:1] S(2); 
              BEGIN 
              ITEM SCANLITPAR      U(0,0,60);  #PARAM FOR SCANLIT#
              ITEM SCANLITP1       U(0,0,02) = [1];  #CONST OF 1# 
              ITEM SCANLITLEN      U(0,2,10);    #LENGTH OF LIT#
              ITEM SCANLITSIGN     U(0,41,01) = [0];  #SIGN FLAG# 
              ITEM SCANLITADDR       U(0,42,18); #ADDRESS OF LITERAL# 
              ITEM LIT2RNPAR       U(1,00,60);   #PARAM FOR LIT2RN# 
              ITEM LIT2RNP1        U(1,00,02) = [1];  #CONST OF 1#
              ITEM LIT2RNLEN       U(1,02,10);   #LENGTH OF RESULT# 
              ITEM LIT2RNADDR      U(1,12,48);   #ADDRESS OF LIT# 
              END 
          ITEM ACTUALLEN I; 
          ITEM ACTUALPOINT I; 
          ITEM CONVWD1 C(10); 
          ITEM CONVWD2 C(10); 
          ITEM NUMLITSTR C(20); 
          ITEM OBJ$POINT I; 
          ITEM OFFSET I;
          NEWPAGE;
          LISTOFF;  $BEGIN DEBUGBEGIN 
          TRACE(POS$TRACE,"CON2NUM-ENTRY       ");
          TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN);
          TRACE(CHA$TRACE,"SRC$LIT           = ",SRC$LIT,SRC$LIT$LEN);
          TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX); 
          DEBUGEND  $END  LISTON; 
          SCANLITLEN = SRC$LIT$LEN; 
          SCANLITADDR = LOC(SRC$LIT); 
 #     SCAN THE LITERAL TO ASCERTAIN ITS ACTUAL CHARACTERISTICS        #
          SCANLIT(SCANLITPAR, ACTUALLEN, ACTUALPOINT);
          OBJ$POINT = GETQUICK (DN$POINT,DNAT$,DNAT$INDEX); 
          IF LIT$NEG EQ 1 AND GETQUICK(DN$SIGNBIT,DNAT$,DNAT$INDEX) EQ 0
          THEN
              BEGIN 
              DIAGNOSTIC(MSG010,0); 
              SETFIELD(DN$SIGNBIT,DNAT$,DNAT$INDEX,1);
              END 
          IF (NOT CMU$FLAG
            AND (ACTUALLEN GR 9 
              OR OBJ$LIT$LEN GR 9 
            ) 
            ) 
          OR ACTUALPOINT GR OBJ$POINT 
          OR (( ACTUALLEN - ACTUALPOINT  GR 
                OBJ$LIT$LEN - OBJ$POINT) AND OBJ$POINT GR 0)
          OR ACTUALLEN GR OBJ$LIT$LEN 
              OR GETQUICK(DN$SIGNBIT,DNAT$,DNAT$INDEX) NQ 0 
          THEN
              BEGIN 
              NO$POOL$FLAG = TRUE;   #DONT POOL IT - DOES NOT QUALIFY#
              GOTO CON2NUMEX; 
              END 
          LIT2RNLEN = SRC$LIT$LEN;
          LIT2RNADDR = LOC (SRC$LIT); 
 #     CONVERT LITERAL TO PROPER FORMAT - FILLS WITH ZEROS AND SUCH    #
          LIT2RN(LIT2RNPAR, OBJ$LIT$LEN, OBJ$POINT, 0, CONVWD1, 
              CONVWD2); 
          C<0,10> NUMLITSTR = CONVWD1;
          C<10,10> NUMLITSTR = CONVWD2; 
          IF CMU$FLAG 
          THEN
              OFFSET = 20 - OBJ$LIT$LEN;
          ELSE
              OFFSET = 10 - OBJ$LIT$LEN;
          IF CMU$FLAG 
          THEN
 #     PROCESSING FOR CMU NUMERIC LITERALS - POOL WITH NO ZERO FILL    #
              BEGIN 
              SUBSTR (NUMLITSTR, OFFSET, OBJ$LIT, 0, OBJ$LIT$LEN);
              OBJ$ALIGN = 0;
              END 
          ELSE
 #     PROCESS NON-CMU LITERALS FOR IF STATEMENTS                      #
              BEGIN 
              OBJ$ALIGN = OFFSET; 
              SUBSTR (CONVWD2, OFFSET, OBJ$LIT, 0, OBJ$LIT$LEN);
              IF OBJ$LIT$LEN LS 3 
              THEN
                  SHORT$FLAG = TRUE;   #SET FOR UNPOOLED LIT TYPE#
              END 
          PADTOWORD = 0;
 CON2NUMEX: 
          LISTOFF;  $BEGIN DEBUGBEGIN 
          TRACE(POS$TRACE,"CON2NUM-EXIT        ");
          TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN);
          TRACE(CHA$TRACE,"OBJ$LIT           = ",OBJ$LIT,OBJ$LIT$LEN);
          TRACE(VAR$TRACE,"OBJ$ALIGN         = ",OBJ$ALIGN);
          DEBUGEND  $END LISTON;
          END 
          CONTROL  EJECT; 
          PROC  CON2NUMMOVE;
 #     CONVERT A NUMERIC LITERAL TO THE APPROPRIATE FORM FOR           #
 #        MOVING AS IS TO A NUMERIC ITEM. FORMAT OF THE LITERAL IS     #
 #        AS FOR THE VALUE CLAUSE.                                     #
          ARRAY  PARAMSX[1:1];
              BEGIN 
              ITEM  LIT2RNPAR      U(0, 0,60);  #PARAM FOR LIT2RN      #
              ITEM  LIT2RNP1       U(0, 0, 2) = [1];
              ITEM  LIT2RNLEN      U(0, 2,10);  #LENGTH RESULT         #
              ITEM  LIT2RNSIGN     U(0,12,30);  #LITERAL SIGN          #
               ITEM  LIT2RNADDR    U(0,42,18);  #ADDRESS OF LITERAL    #
              END 
          ITEM  CONVWD1;
          ITEM  CONVWD2;
          ITEM  LITINDEX; 
          ITEM  LIT$SIGN; 
          ITEM  NUMLITSTR C(20);
          ITEM  OBJ$NUMLEN; 
          ITEM  OBJ$POINT;
          ITEM  OBJ$SIGN; 
          ITEM  SIGNCHAR C(10); 
          ITEM  SIGNCHARS C(10) = "!JKLMNOPQR"; 
          BEGIN 
          OBJ$POINT = GETQUICK(DN$POINT,DNAT$,DNAT$INDEX);
          OBJ$NUMLEN = GETQUICK(DN$NUMLEN,DNAT$,DNAT$INDEX);
          IF GETQUICK(DN$SIGNGRP,DNAT$,DNAT$INDEX) NQ 0 
          THEN  OBJ$SIGN = 1; 
          ELSE  OBJ$SIGN = 0; 
          LIT2RNLEN = SRC$LIT$LEN;
          LIT2RNADDR = LOC(SRC$LIT);
          LIT2RNSIGN = LIT$NEG; 
          LIT2RN(LIT2RNPAR,OBJ$NUMLEN,OBJ$POINT,OBJ$SIGN,CONVWD1, 
                 CONVWD2);
          LIT$SIGN = 0; 
          IF  C<0,1>CONVWD1 EQ "9"
          THEN
              BEGIN 
              CONVWD1 = LNO CONVWD1;
              CONVWD2 = LNO CONVWD2;
              LIT$SIGN = -1;
              END 
          C<0,10>NUMLITSTR = C<0,10>CONVWD1;
          C<10,10>NUMLITSTR = C<0,10>CONVWD2; 
          IF  GETQUICK(DN$SCHAR,DNAT$,DNAT$INDEX) NQ 0
          THEN
              BEGIN          #SIGN SEPARATE CHARACTER#
              IF LIT$SIGN GQ 0
              THEN  SIGNCHAR = "+"; 
              ELSE  SIGNCHAR = "-"; 
              IF  GETQUICK(DN$LSIGN,DNAT$,DNAT$INDEX) EQ 0
              THEN
                  BEGIN      #TRAILING SIGN#
                  C<0,19>NUMLITSTR = C<1,19>NUMLITSTR;
                  C<19,1>NUMLITSTR = C<0,1>SIGNCHAR;
                  END 
              ELSE           #LEADING SIGN# 
                  C<20-OBJ$LIT$LEN,1>NUMLITSTR = C<0,1>SIGNCHAR;
              END 
          ELSE               #SIGN INCLUDED#
              BEGIN 
              IF  LIT$SIGN LS 0 
              THEN
                  BEGIN 
                 LITINDEX = 0;
                  IF GETQUICK(DN$LSIGN,DNAT$,DNAT$INDEX)  EQ 0
                  THEN
                      BEGIN 
                      C<9,1>LITINDEX = C<19,1>NUMLITSTR;
                      LITINDEX = LITINDEX - O"33";
                      C<19,1>NUMLITSTR = C<LITINDEX ,1> SIGNCHARS;
                      END 
                  ELSE
                      BEGIN 
                      C<9,1>LITINDEX = C<20-OBJ$LIT$LEN,1>NUMLITSTR;
                      LITINDEX = LITINDEX - O"33";
                      C<20-OBJ$LIT$LEN>NUMLITSTR =
                                       C<LITINDEX,1>SIGNCHARS;
                      END 
                  END 
              END 
          SUBSTR(NUMLITSTR,20-OBJ$LIT$LEN,OBJ$LIT,0,OBJ$LIT$LEN); 
          RETURN; 
          END 
         NEWPAGE; 
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
 #                                                                   #
 #                                                                   #
 #      S U P E R V I S O R   R O U T I N E S                        #
 #                                                                   #
 #                                                                   #
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
PROC     DIVER; 
         BEGIN
 #
         D I V E R
  
         THIS ROUTINE GIVEN A CONVERTED LITERAL ADDS IT TO
         THE LITERAL POOL SO THAT THE POOL CONTAINS ONLY
         SINGLE INSTANCES OF EACH FORM. 
  
         I N P U T S
  
         CONVERTED LITERAL - VIA OBJ$LIT
         OBJ$LIT$LEN
         OBJ$ALIGN
         LITERAL POOL 
         LPOOL$LEN
  
         O U T P U T S
  
         LPOOL$INDEX
  
         C A L L E D   B Y
  
         ALIT 
         POOLBUILD
  
         R O U T I N E S   C A L L E D
  
         PADTOWORD
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM SRC$WD$LEN          I,
              SRC$PAD$LEN         I,
              LPOOL$WD$LEN        I,
              LPOOL$SR$LEN        I;
          ITEM  I;
          ITEM  INCORE; 
          ITEM  LP$FIRST; 
          ITEM  LP$LAST;
          ITEM  LP$START; 
          ITEM  MATCH;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"DIVER-ENTRY         "); 
         TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
         TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",OBJ$LIT,OBJ$LIT$LEN); 
         TRACE(VAR$TRACE,"OBJ$ALIGN         = ",OBJ$ALIGN); 
         TRACE(VAR$TRACE,"LPOOL$LEN         = ",LPOOL$LEN); 
         DEBUGEND $END LISTON;
 #
         PREPARATION OF THE LITERAL FOR POOLING 
  
         IF THE ITEM IS NOT ALIGNED ON A WORD BOUNDARY WE 
         MUST FILL UP TO THE APPROPRIATE BOUNDARY WITH OCTAL
         ZEROS TO FACILATE CODE GENERATION. IN ADDITION THE 
         LITERAL MUST BE PADDED WITH ZEROS ON THE RIGHT 
         HAND SIDE TO A WORD BOUNDARY.
 #
         SRC$LIT$LEN = OBJ$LIT$LEN;                # SET POOLABLE 
                                                     LITERAL LENGTH  #
         IF OBJ$ALIGN NQ 0                         # WORD BOUNDARY\  #
            THEN
              FILLC(0,SRC$LIT,0,OBJ$ALIGN); #LEADING ZEROS             #
         SUBSTR(OBJ$LIT,0,
                SRC$LIT,OBJ$ALIGN,SRC$LIT$LEN);    # PLACE LITERAL
                                                     IN POOL AREA    #
         SRC$PAD$LEN = PADTOWORD;                  # CALC DISTANCE
                                                     TO NEXT WORD    #
         SRC$LIT$LEN = SRC$LIT$LEN + OBJ$ALIGN;    # CALC TOTAL 
                                                     LENGTH SO FAR   #
         IF SRC$PAD$LEN NQ 0                       # ANY OVERHANG\   #
            THEN
            BEGIN 
              FILLC(0,SRC$LIT,SRC$LIT$LEN,SRC$PAD$LEN); #TRAILING ZEROS#
            SRC$LIT$LEN 
            = SRC$LIT$LEN + SRC$PAD$LEN;           # BUMP POOLABLE
                                                     LITERAL LENGTH  #
            END 
         SRC$WD$LEN = SRC$LIT$LEN/CHARSIN1WORD;    # CALCULATE ITEM 
                                                     WORD LENGTH     #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"DIVER-MIDDLE        "); 
         TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN); 
         TRACE(INT$TRACE,"SRC$LIT OCTAL     = ",SRC$LIT,SRC$LIT$LEN); 
         DEBUGEND $END LISTON;
         NEWPAGE; 
         LPOOL$WD$LEN = LPOOL$LEN/CHARSIN1WORD;    # GET POOL 
                                                     WORD LENGTH     #
         LPOOL$SR$LEN = LPOOL$WD$LEN - SRC$WD$LEN; # CALCULATE POOL 
                                                     EFFECTIVE LENGTH#
 #
         SEARCHING OF THE LITERAL POOL UP TO ITS CALCULATED 
         EFFECTIVE LENGTH - THAT IS THE REAL LENGTH OF THE
         POOL LENGTH MINUS THE LENGTH OF THE CONVERTED LITERAL
         SINCE THE LITERAL WILL NOT BE FOUND BEYOND THIS
         EFFECTIVE LENGTH.
 #
#    LITERAL POOL WILL BE SEARCHED IN SECTIONS AS KEPT IN CORE BY      #
#    VIRTUAL STARTING WITH SECTION CURRENTLY IN CORE AND PROCEEDING    #
#    END-AROUND UNTIL A MATCH IS FOUND OR ALL SECTIONS HAVE BEEN       #
#    SEARCHED.  WHEN COMPILING WITH RESTRICTED FIELD LENGTH THIS MAY   #
 #   CAUSE INCOMPLETE POOLING FOR MULTIWORD LITERALS SINCE MATCHING    #
#    CANNOT BE DONE ACROSS SECTIONS                                    #
  
          IF     LPOOL$WD$LEN GQ SRC$WD$LEN 
          THEN
          BEGIN 
          LP$START = TTABFCENT[TABLETYPE"LPOOL$"]; #FIRST CORE ENTRY   #
          LP$FIRST = LP$START;
          IF  TTABLCENT[TABLETYPE"LPOOL$"] LS LPOOL$WD$LEN - 1
          THEN  LP$LAST = TTABLCENT[TABLETYPE"LPOOL$"]; 
          ELSE  LP$LAST = LPOOL$WD$LEN - 1; 
          INCORE= LP$LAST - LP$FIRST + 1; 
          LSEARCH(LPOOL,INCORE,SRC$LIT,SRC$WD$LEN,MATCH); 
          IF  MATCH GQ 0
          THEN
              BEGIN 
              LPOOL$INDEX = MATCH + LP$FIRST; 
              GOTO DIVER30; 
              END 
          FOR  I = I WHILE LP$LAST LS LPOOL$WD$LEN - 1 DO 
              BEGIN 
              LP$FIRST = LP$LAST + 1; 
              I = VIRTUAL(TABLETYPE"LPOOL$",LP$FIRST); #GET NXT SECTION#
              IF  TTABLCENT[TABLETYPE"LPOOL$"] LS LPOOL$WD$LEN - 1
              THEN  LP$LAST = TTABLCENT[TABLETYPE"LPOOL$"]; 
              ELSE  LP$LAST = LPOOL$WD$LEN - 1; 
              INCORE = LP$LAST - TTABFCENT[TABLETYPE"LPOOL$"] + 1;
              IF  INCORE LS SRC$WD$LEN  THEN  TEST; 
              LSEARCH(LPOOL,INCORE,SRC$LIT,SRC$WD$LEN,MATCH); 
              IF  MATCH GQ 0
              THEN
                  BEGIN 
                  LPOOL$INDEX = TTABFCENT[TABLETYPE"LPOOL$"] + MATCH; 
                  GOTO DIVER30; 
                  END 
              END 
          END 
          IF  LP$START NQ 0  #START OVER AT START OF TABLE             #
          THEN
              BEGIN 
              LP$FIRST = 0; 
              FOR I = I WHILE LP$LAST LS LP$START DO
                  BEGIN 
                  I = VIRTUAL(TABLETYPE"LPOOL$",LP$FIRST);
                  LP$FIRST = TTABFCENT [TABLETYPE"LPOOL$"]; 
                  LP$LAST = TTABLCENT[TABLETYPE"LPOOL$"]; 
                  INCORE = LP$LAST - LP$FIRST + 1;
                  IF  INCORE LS SRC$WD$LEN
                  THEN
                      BEGIN 
                      LP$FIRST = LP$LAST + 1; 
                      TEST; 
                      END 
                  LSEARCH(LPOOL,INCORE,SRC$LIT,SRC$WD$LEN,MATCH); 
                  IF  MATCH GQ 0
                  THEN
                      BEGIN 
                      LPOOL$INDEX = LP$FIRST + MATCH; 
                      GOTO DIVER30; 
                      END 
                  LP$FIRST = LP$LAST + 1; 
                  END 
              END 
         NEWPAGE; 
 #
         ADDITION OF CONVERTED FORM TO END OF POOL IF NOT FOUND 
 #
         LPOOL$INDEX = LPOOL$WD$LEN;               # SAVE POOL
                                                     WORD INDEX      #
         FOR OBJ$INDEX = 0 STEP 1 
                         UNTIL SRC$WD$LEN - 1 DO   # ADD LITERAL
                                                     WORD BY WORD    #
             BEGIN
             SETFIELD(LP$WORD,LPOOL$, 
                      LPOOL$INDEX + OBJ$INDEX,
                      SRC$WORD[OBJ$INDEX]);        # ADD WORD 
                                                     TO THE POOL     #
             END                                   # END OF LOOP     #
         LPOOL$LEN = LPOOL$LEN + SRC$LIT$LEN;      # UPDATE POOL
                                                     CHARACTER LENGTH#
DIVER30:  
         LPOOL$INDEX = LPOOL$INDEX * CHARSIN1WORD; # CHANGE TO
                                                     CHARACTER INDEX #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"DIVER-EXIT          "); 
         TRACE(VAR$TRACE,"LPOOL$INDEX       = ",LPOOL$INDEX); 
         TRACE(VAR$TRACE,"LPOOL$LEN         = ",LPOOL$LEN); 
         DEBUGEND $END LISTON;
         END #DIVER#
         NEWPAGE; 
PROC     CHECKCONV; 
         BEGIN
 #
         C H E C K C O N V
  
         THIS ROUTINE PERFORMS THE FUNCTIONS OF 
         1) EXTRACTING THE PERTINENT INFORMATION FROM THE 
            PLT AND DNAT ENTRIES REFERENCED BY THE CURRENT
            LAT ENTRY 
         2) BASED ON THE EXTRACTED INFORMATION,THE CALLING
            OF VARIOUS ROUTINES TO PERFORM CONVERSION OF
            THE SOURCE LITERAL TO THE DESIRED OBJECT FORMAT 
         THE MAIN FEATURE OF THIS ROUTINE IS A LARGE SWITCH 
         STATEMENT WHICH USES THE SOURCE AND OBJECT LITERAL 
         TYPES TO SELECT THE APPROPRIATE CASE NUMBER WHEREIN
         THE NECESSARY CONVERSION AND CHECKING ROUTINES ARE 
         CALLED.
  
         I N P U T S
  
         LAT$INDEX
         LOW$VALUE
         HIGH$VALUE 
  
         O U T P U T S
  
         CONVERTED LITERAL - VIA OBJ$LIT
         NO$POOL$FLAG 
         HI$LO$FLAG 
         SUBS$FLAG
  
         C A L L E D   B Y
  
         PLIT 
  
         R O U T I N E S   C A L L E D
  
         ALPHACHECK 
         CON2AN 
         CON2ANEDIT 
         DIAGNOSTIC 
         SRCHAUXTAB 
 #
 #
         DECLARATION OF CONVERSION CASES SWITCH 
 #
         SWITCH CONVCASE CHECKCONV0,CHECKCONV1,CHECKCONV2,
                         CHECKCONV3,CHECKCONV4,CHECKCONV5,
                         CHECKCONV6,CHECKCONV7,CHECKCONV8,
                         CHECKCONV9,CHECKCONV10;
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM CASE$NUMBER         I,
              PROCCASE2           B,
              SRC$ORIGIN          I;
         NEWPAGE; 
 #
         L I T E R A L   C O N V E R S I O N   T A B L E
  
                        02      03      04      05     06      09 
            SOURCE
            TYPE      INTEGER NUMERIC FL.PT.  FIGCON QUOTED  BOOLEAN
   OBJECT             LITERAL LITERAL LITERAL ZERO   LITERAL LITERAL
   TYPE 
01 ALPHABETIC           03      02      02      02     06      01 
02 ALPHABETIC-EDIT      02      02      02      02     07      01 
03 ALPHANUMERIC         03      02      02      03     03      03 
04 ALPHNUMERIC-EDIT     04      02      02      04     04      04 
05 ERROR                02      02      02      02     02      02 
06 NUMERIC-EDIT         02      02      02      02     02      01 
07 NUMERIC              08      08      02      08     10      01 
08 UNUSED               01      01      01      01     01      01 
09 COMP-4               02      02      02      02     02      01 
10 COMP-2               02      02      02      02     02      01 
11 UNUSED               01      01      01      01     01      01 
12 COMP-1               02      02      02      02     02      01 
13 UNUSED               01      01      01      01     01      01 
14 INDEX-DATA           02      02      02      02     02      01 
15 INDEX-NAME           02      02      02      02     02      01 
16 GROUP                05      05      05      03     03      03 
17 VARIABLE-GROUP       05      05      05      03     03      03 
18 NONDATA              01      01      01      01     03      01 
19 BOOLEAN BIT          09      01      01      09     09      09 
20 BOOLEAN DISPLAY      09      01      01      09     09      09 
  
  
         THE STORAGE REQUIRED FOR THE ABOVE TABLE CURRENTLY IS 90 
         WORDS (18*5). THIS MAY BE REDUCED TO 9 WORDS BY PACKING THE
         TABLE ENTRIES 10 PER WORD WITH EACH HALF WORD CONTAINING 
         THE ENTRIES OF ONE ROW OF THE TABLE AS DESCRIBED ABOVE. THE
         ENTRIES COULD THEN BE ACCESSED USING THE FOLLOWING METHOD. 
  
         WORDNUMBER  = (OBJ$LIT$TYPE + 1)/2 
         STARTINWORD = MOD(OBJ$LIT$TYPE + 1,2)*30 
         STARTINDEX  = (SRC$LIT$TYPE - 2)*6 
  
         THE TABLE COULD BE THEN DECLARED AS AN ARRAY OF 9 WORDS, 
         INITIALIZED WITH THE APPROPRIATE VALUES AS ABOVE AND THEN
         ACCESSED WITH A PARAMETERIZED DEF OF THE FOLLOWING FORM
  
         DEF CONV$TABLE(OBJ$LIT$TYPE,SRC$LIT$TYPE)
             "B<STARTINWORD + STARTINDEX,6>CONVARRAY[WORDNUMBER]" 
  
         THIS METHOD,WHILE SAVING STORAGE,WOULD REQUIRE MORE ACCESS 
         TIME AND BE LESS AMENABLE TO FUTURE MODIFICATION.
 #
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"* * * * * * * * * * "); 
         TRACE(POS$TRACE,"CHECKCONV-ENTRY     "); 
         TRACE(VAR$TRACE,"LAT$INDEX         = ",LAT$INDEX); 
         TRACE(VAR$TRACE,"L$IMMEDIATE       = ",
               GETQUICK(L$IMMEDIATE,LAT$,LAT$INDEX)); 
         TRACE(VAR$TRACE,"L$SPACES          = ",
               GETQUICK(L$SPACES,LAT$,LAT$INDEX));
         TRACE(VAR$TRACE,"L$PLT             = ",
               GETQUICK(L$PLT,LAT$,LAT$INDEX)); 
         TRACE(VAR$TRACE,"L$VCODE           = ",
               GETQUICK(L$VCODE,LAT$,LAT$INDEX)); 
         DEBUGEND $END LISTON;
 #
         DETERMINE THE ORIGIN OF THE SOURCE LITERAL TO
         BE CONVERTED AND SET UP THE APPROPRIATE SOURCE 
         LITERAL TYPE. THE POSSIBILITIES ARE
  
         SRC$ORIGIN    SOURCE               TYPE
         ----------    ------               ----
  
         0             PLT                 FROM PLT 
         1             IMMEDIATE SPACES    QLIT 
         2             IMMEDIATE INTEGER   ILIT 
 #
         PLT$INDEX
         = GETQUICK(L$PLT,LAT$,LAT$INDEX);         # ACCESS PTR 
                                                     FROM LAT        #
         IF GETQUICK(L$IMMEDIATE,LAT$,LAT$INDEX) EQ 1 
            THEN
            BEGIN 
            IF GETQUICK(L$SPACES,LAT$,LAT$INDEX) EQ 1 
               THEN 
               BEGIN
               SRC$ORIGIN = 1;                     # IMMEDIATE
                                                     SPACES          #
               SRC$LIT$TYPE = PLTQUOTEDLIT; 
               END
               ELSE 
               BEGIN
               SRC$ORIGIN = 2;                     # IMMEDIATE
                                                     INTEGER         #
               SRC$LIT$TYPE = PLTINTLIT;
               END
            END 
            ELSE
            BEGIN 
            SRC$ORIGIN = 0;                        # VALUE FROM 
                                                     THE PLT         #
            SRC$LIT$TYPE
            = GETQUICK(PL$CODE,PLT$,PLT$INDEX);    # ACCESS TYPE
                                                     FROM PLT ENTRY  #
            END 
         NEWPAGE; 
 #
         ACCESS DNAT ITEM TYPE INFORMATION
 #
         DNAT$INDEX 
         = GETQUICK(L$DNAT,LAT$,LAT$INDEX);        # CURRENT DNAT 
                                                     ENTRY INDEX     #
         OBJ$LIT$TYPE 
         = GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX);     # ACCESS TYPE
                                                     FROM DNAT       #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(VAR$TRACE,"PLT$INDEX         = ",PLT$INDEX); 
         TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
         TRACE(DIV$TRACE,"PL$LINE           = ",
               GETQUICK(PL$LINE,PLT$,PLT$INDEX)); 
         TRACE(VAR$TRACE,"PL$COLUMN         = ",
               GETQUICK(PL$COLUMN,PLT$,PLT$INDEX)); 
         TRACE(VAR$TRACE,"SRC$ORIGIN        = ",SRC$ORIGIN);
         TRACE(VAR$TRACE,"SRC$LIT$TYPE      = ",SRC$LIT$TYPE);
         TRACE(VAR$TRACE,"OBJ$LIT$TYPE      = ",OBJ$LIT$TYPE);
         DEBUGEND $END LISTON;
 #
         CHECK FOR BAD SOURCE AND OBJECT TYPE. IF SO
         SET CASE NUMBER AND DIAGNOSTIC NUMBER. 
 #
         IF SRC$LIT$TYPE LS PLTINTLIT 
          OR  SRC$LIT$TYPE GR PLTBOOLLIT
            THEN
            BEGIN 
            CASE$NUMBER = 0;                       # COMPILER ERROR  #
            DIAG$NO = MSG995; 
            END 
 #
            SELECT APPROPRIATE CONVERSION SWITCH NUMBER 
 #
            ELSE
            CASE$NUMBER 
            =CONV$TABLE[OBJ$LIT$TYPE,SRC$LIT$TYPE];# GET CASE NUMBER
                                                     FROM TABLE      #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(VAR$TRACE,"CASE$NUMBER       = ",CASE$NUMBER); 
         DEBUGEND $END LISTON;
         NEWPAGE; 
 #
         ARE THE SOURCE AND LITERAL TYPES SUCH THAT A CONVERTED 
         RESULT MUST BE GENERATED. IF SO OBTAIN FURTHER INFORMATION 
         FROM THE DNAT AND THE PLT. 
 #
         IF CASE$NUMBER GR 1
            THEN
            BEGIN 
 #
            OBTAIN THE ALL INFORMATION FROM THE LAT. THE LAT
            ALL BIT IS SET OFF SINCE,WHEN ON,IT INDICATES TO
            CGEN THAT THE CONVERTED LITERAL MUST BE FURTHER 
            EXPANDED TO FILL THE RECEIVING FIELD. 
 #
            IF GETQUICK(L$ALL,LAT$,LAT$INDEX) EQ 1 # REPLICATION\    #
          AND CASE$NUMBER NQ 2 AND CASE$NUMBER NQ 8 
               THEN 
               BEGIN
               LAT$ALL$FLAG = TRUE; 
               SETFIELD(L$ALL,LAT$,LAT$INDEX,0);   # RESET THE
                                                     FLAG TO ZERO    #
               END
               ELSE 
               LAT$ALL$FLAG = FALSE;
            OBJ$LIT$LEN 
            = GETQUICK(DN$ITMLEN,DNAT$,DNAT$INDEX);# ACCESS LENGTH
                                                     FROM DNAT       #
            OBJ$ORG$LEN = OBJ$LIT$LEN;             # SAVE ORIGINAL
                                                     LENGTH          #
         NEWPAGE; 
 #
            ACCESS THE VERB CODE FROM THE LAT ENTRY. THE
            FOLLOWING VALUES OF L$VCODE ARE DEFINED:  
  
            VALUE  VERB           ACTION                       CODE 
            -----  ----           ------                       ---- 
            0      DEFAULT        MOVE CONVERSIONS IN CON2AN    0 
            1      IF             SPECIAL PROCESSING IN CON2AN  1 
            2      MOVE           SHORT LITERALS SPECIAL CASE   0 
            3      INSPECT        SPACES POOLED                 0 
                   STRING         SPACES POOLED 
                   UNSTRING       SPACES POOLED 
                   ENTER          SPACES AND ZEROES POOLED
 #
            SRC$VERBCODE
            = GETQUICK(L$VCODE,LAT$,LAT$INDEX);    # ACCESS VERB
                                                     CODE FROM LAT   #
            IF SRC$VERBCODE EQ 2                   # MOVE STATEMENT  #
          AND NOT CMU$FLAG
          AND GETQUICK(DN$MAJMSEC,DNAT$,DNAT$INDEX) NQ SECSMSEC 
               THEN 
               SHORT$FLAG = TRUE;                  # SHORT LITERALS 
                                                     INTO DNAT ENTRY #
               ELSE 
               SHORT$FLAG = FALSE;                 # SHORT LITERALS 
                                                     INTO POOL       #
          IF  (CASE$NUMBER EQ 8 OR CASE$NUMBER EQ 10) 
              AND SRC$VERBCODE NQ 2 
          THEN  CASE$NUMBER = 2;
            IF SRC$VERBCODE NQ 1                   # ALL EXCEPT IF   #
               THEN 
              BEGIN 
               SRC$VERBCODE = 0;                   # INTERNAL 
                                                     CODE VALUE      #
              IF CASE$NUMBER LS 3 
              THEN
                  BEGIN 
                  PROCCASE2 = FALSE;
                  GOTO CHECKCONVNOC;   #NO CONVERSION FOR NUM LITS# 
                  END 
              END 
          ELSE
              BEGIN 
              IF OBJ$LIT$TYPE NQ NUMERIC
              OR GETQUICK(DN$SIGNGRP,DNAT$,DNAT$INDEX) NQ 0 
              OR GETQUICK(DN$SDEPTH,DNAT$,DNAT$INDEX) NQ 0
              OR  CCTLBZ           # LBZ OPTION...DONT POOL # 
              THEN
                  BEGIN 
                  PROCCASE2  = FALSE;   #CANNOT BE POOLED#
                  IF CASE$NUMBER LS 3 
                  THEN
                      GOTO CHECKCONVNOC;
                  END 
              ELSE
                  PROCCASE2 = TRUE;   #POOL THIS NUMERIC LITERAL# 
              END 
            HI$LO$FLAG = FALSE;                    # TURN OFF FLAG
                                                     FOR SPECIAL CASE#
            NEWPAGE;
 #
            OBTAIN THE SOURCE CHARACTER STRING AND LENGTH 
 #
            SWITCH SRCCASE        CHECKCONVPLT,    # 0 #
                                  CHECKCONVSPA,    # 1 #
                                  CHECKCONVIMM;    # 2 #
          LIT$NEG = 0;
  
            GOTO SRCCASE[SRC$ORIGIN];              # SELECT CODE TO 
                                                     ACCESS LITERAL  #
CHECKCONVPLT: 
 #
            LITERAL IS TO BE OBTAINED FROM THE PLT
  
            CHECK FOR THE SPECIAL CASE OF HIGH AND LOW VALUES 
 #
            IF GETQUICK(PL$FIGLOWV,PLT$,PLT$INDEX) EQ 1 
               THEN 
               BEGIN
               LAT$ALL$FLAG = TRUE;                # TO BE REPEATED  #
               HI$LO$FLAG = TRUE;                  # SET SPECIAL
                                                     CASE FLAG       #
               SRC$LIT$LEN = 1;                    # ONE CHARACTER   #
               PUTCHAR(LOW$VALUE,SRC$LIT,0);       # USE PROGRAM
                                                     LOW VALUE       #
               END
               ELSE 
            IF GETQUICK(PL$FIGHIGHV,PLT$,PLT$INDEX) EQ 1
               THEN 
               BEGIN
               LAT$ALL$FLAG = TRUE;                # TO BE REPEATED  #
               HI$LO$FLAG = TRUE;                  # SET SPECIAL
                                                     CASE FLAG       #
               SRC$LIT$LEN = 1;                    # ONE CHARACTER   #
               PUTCHAR(HIGH$VALUE,SRC$LIT,0);      # USE PROGRAM
                                                     HIGH VALUE      #
               END
               ELSE 
 #
               IN THE NORMAL CASE OBTAIN THE SOURCE CHARACTER 
               STRING FROM THE PLT AND SET THE REPLICATION
               INDICATOR FOR FIGURATIVE CONSTANTS.
 #
               BEGIN                               # NON SPECIAL LIT #
               IF GETQUICK(PL$FIGCON,PLT$,PLT$INDEX)
               NQ 0 
                  THEN
                  LAT$ALL$FLAG = TRUE;             # TO BE REPEATED  #
               SRC$LIT$LEN
               =GETQUICK(PL$LENGTH,PLT$,PLT$INDEX);# LITERAL LENGTH 
                                                     IN CHARACTERS   #
               GETPLST(PLT$INDEX,LOC(SRC$LIT));    # MOVE LITERAL 
                                                     TO SOURCE AREA  #
          IF GETQUICK(PL$SIGNEDFLG,PLT$,PLT$INDEX) EQ 1 AND 
              GETQUICK(PL$SIGNFLAG,PLT$,PLT$INDEX) EQ 0 
          THEN  LIT$NEG = 1;           #NEGATIVE LITERAL #
               END
            GOTO CHECKCONV00;                      # SKIP TO MORE 
                                                     INFO ACCESS     #
            NEWPAGE;
CHECKCONVSPA: 
 #
            LITERAL IS AN IMMEDIATE VALUE OF SPACES 
 #
            SRC$LIT$LEN = 1;                       # ONE CHARACTER
                                                     LENGTH          #
            PUTCHAR(OCT$BLANK,SRC$LIT,0);          # INSERT SPACE 
                                                     IN SOURCE AREA  #
            LAT$ALL$FLAG = TRUE;                   # TURN ON
                                                     REPLICATION     #
            GOTO CHECKCONV00;                      # SKIP TO MORE 
                                                     INFO ACCESS     #
CHECKCONVIMM: 
 #
            LITERAL IS AN IMMEDIATE BINARY INTEGER TO BE
            CONVERTED TO A SOURCE CHARACTER STRING
 #
            IF PLT$INDEX EQ 0                      # ZERO VALUE      #
               THEN 
               BEGIN
               SRC$LIT$LEN = 1;                    # LENGTH OF
                                                     1 CHARACTER     #
               PUTCHAR(OCT$ZERO,SRC$LIT,0);        # PUT A ZERO 
                                                     IN SOURCE AREA  #
               END
               ELSE 
               BEGIN                               # NON ZERO VALUE  #
               SRC$LIT$LEN = 0;                    # INITIALIZE 
                                                     SOURCE LENGTH   #
               ASLONGAS PLT$INDEX NQ 0 DO          # LOOP DIGIT 
                                                     BY DIGIT        #
               BEGIN
               CHAR$VAL 
               = MOD(PLT$INDEX,10) + OCT$ZERO;     # LAST DIGIT TO
                                                     DISPLAY CODE    #
               SRC$LIT$LEN = SRC$LIT$LEN + 1;      # INCREMENT
                                                     RESULT LENGTH   #
               PUTCHAR(CHAR$VAL,
                       SRC$LIT,10-SRC$LIT$LEN);    # PLACE DIGIT IN 
                                                     SOURCE AREA     #
               PLT$INDEX = PLT$INDEX/10;           # EFFECTIVE RIGHT
                                                     SHIFT OF SOURCE #
               END                                 # END OF LOOP     #
 #
               MOVE THE DIGIT CHARACTER STRING FROM THE RIGHTMOST 
               HALF OF THE 1ST WORD OF SRC$LIT TO THE LEFTMOST HALF.
               WE DON"T HAVE TO WORRY ABOUT AN OVERLAPPING MOVE SINCE 
               THE MAXIMUM CONVERTED STRING LENGTH IS 5 DIGITS. 
 #
               SUBSTR(SRC$LIT,10 - SRC$LIT$LEN, 
                      SRC$LIT,0,SRC$LIT$LEN);      # MOVE SOURCE
                                                     LEFT ALIGNED    #
               END                                 # FALL THROUGH    #
            NEWPAGE;
CHECKCONV00:  
            SUBS$FLAG = FALSE;                     # INITIALIZE FOR 
                                                     NO SUBSCRIPTING #
 #
            CHECK FOR THE SPECIAL CASE OF IMPLEMENTOR NAMES 
            WHICH MUST BE WORD ALIGNED WITHIN THE POOL BUT
            NOT MUCH ELSE 
 #
            IF OBJ$LIT$TYPE EQ NONDATA
            THEN
            OBJ$ALIGN = 0;                         # FORCE WORD 
                                                     ALIGNMENT       #
            ELSE
            BEGIN 
 #
            DETERMINE BEGINNING CHARACTER POSITION AND SUBSCRIPT
            INFORMATION FROM THE DNAT OF THE OBJECT ITEM
 #
            OBJ$MSEC
            =GETQUICK(DN$MAJMSEC,DNAT$,DNAT$INDEX);# ACCESS DNAT
                                                     MAJOR MSEC      #
            IF OBJ$MSEC EQ FDMSEC OR OBJ$MSEC EQ LINKMSEC 
               THEN                                # SPECIAL CASES   #
               OBJ$OFFSET = GETQUICK(DN$BYTEOFFS,DNAT$, 
                                     DNAT$INDEX);  # USE SHORT OFFSET#
               ELSE 
               OBJ$OFFSET = GETQUICK(DN$LONGOFF,DNAT$,
                                     DNAT$INDEX);  # USE LONG OFFSET #
            OBJ$ALIGN 
            = MOD(OBJ$OFFSET,CHARSIN1WORD);        # GET ITEM 
                                                     ALIGNMENT       #
            OBJ$SUB$DPTH
            = GETQUICK(DN$SDEPTH,DNAT$,DNAT$INDEX);# GET ITEM 
                                                     SUBS LEVEL      #
            IF OBJ$SUB$DPTH NQ 0                   # SUBSCRIPTED\    #
               THEN 
               BEGIN
               SRCHAUXTAB;                         # FIND PROPER
                                                     AUX ENTRY       #
               OBJ$OCC$LEN
               =GETQUICK(AX$OCCLEN,AUX$,AUX$INDEX);# GET OCCURRENCE 
                                                     LENGTH FOR ITEM #
               IF MOD(OBJ$OCC$LEN,CHARSIN1WORD)    # MULTIPLE OF 10\ #
               NQ 0 
                  THEN
                  BEGIN 
                  SUBS$FLAG = TRUE;                # SET FLAG 
                                                     FOR SUBSCRIPTING#
                  END 
              SHORT$FLAG = FALSE; 
               END
            END 
            NEWPAGE;
 #
            DEBUG TRACE OF SOURCE AND OBJECT INFORMATION
 #
            LISTOFF; $BEGIN DEBUGBEGIN
            TRACE(VAR$TRACE,"LAT$ALL$FLAG      = ",LAT$ALL$FLAG); 
            TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN);
            TRACE(VAR$TRACE,"OBJ$ORG$LEN       = ",OBJ$ORG$LEN);
            TRACE(VAR$TRACE,"SRC$VERBCODE      = ",SRC$VERBCODE); 
            TRACE(VAR$TRACE,"SHORT$FLAG        = ",SHORT$FLAG); 
            TRACE(VAR$TRACE,"SRC$LIT$LEN       = ",SRC$LIT$LEN);
            TRACE(CHA$TRACE,"SRC$LIT           = ",SRC$LIT,SRC$LIT$LEN);
            TRACE(INT$TRACE,"SRC$LIT OCTAL     = ",SRC$LIT,SRC$LIT$LEN);
            TRACE(VAR$TRACE,"OBJ$SUB$DPTH      = ",OBJ$SUB$DPTH); 
            TRACE(VAR$TRACE,"OBJ$OFFSET        = ",OBJ$OFFSET); 
            TRACE(VAR$TRACE,"OBJ$MSEC          = ",OBJ$MSEC); 
            TRACE(VAR$TRACE,"OBJ$ALIGN         = ",OBJ$ALIGN);
            TRACE(VAR$TRACE,"SUBS$FLAG         = ",SUBS$FLAG);
            IF SUBS$FLAG
               THEN 
               TRACE(VAR$TRACE,"OBJ$OCC$LEN       = ",OBJ$OCC$LEN); 
            DEBUGEND $END LISTON; 
            END 
         NEWPAGE; 
 #
         THE FOLLOWING SWITCH STATEMENT,DEPENDENT UPON OBJECT 
         AND SOURCE LITERAL TYPES,PERFORMS APPROPRIATE SYNTAX 
         MONITORING AND CONVERSIONS BY CALLING THE VARIOUS
         CHECKING AND CONVERSION ROUTINES.
 #
 CHECKCONVNOC:  
         GOTO CONVCASE[CASE$NUMBER];               # CHOSE APPROPRIATE
                                                     CONVERSION CODE #
 #
         * * CASE  0 * *
         COMPILER ERROR 
 #
CHECKCONV0: 
         BEGIN
         NO$POOL$FLAG = TRUE; 
         DIAGNOSTIC(DIAG$NO,SEVERE);
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"** BAD SRC OR OBJ **"); 
         DEBUGEND $END LISTON;
         LISTOFF; $BEGIN
         IF CCTICHKOUT[0] 
            THEN
            BEGIN 
            TRACE(POS$TRACE,"BAD DNAT OR PLT TYPE");
            TRACE(VAR$TRACE,"LAT INDEX         = ",LAT$INDEX);
            TRACE(VAR$TRACE,"DNAT INDEX        = ",DNAT$INDEX); 
            TRACE(VAR$TRACE,"PLT INDEX         = ",PLT$INDEX);
            TRACE(REG$TRACE,"LAT ENTRY         = ", 
                  GETQUICK(L$GROUP,LAT$,LAT$INDEX));
            END 
         $END LISTON; 
         GOTO CHECKCONV30;
         END #CHECKCONV0# 
 #
         * * CASE  1 * *
         COMPILER ERROR 
 #
CHECKCONV1: 
         BEGIN
         NO$POOL$FLAG = TRUE; 
         DIAGNOSTIC(MSG999,SEVERE); 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"** BAD TABLE TYPE **"); 
         DEBUGEND $END LISTON;
         GOTO CHECKCONV30;
         END #CHECKCONV1# 
         NEWPAGE; 
 #
         * * CASE  2 * *
         ANY LITERAL   :  ERROR-TYPE
                       :  NUMERIC 
                       :  NUMERIC-EDIT
                       :  SHORT-FLOAT 
                       :  BINARY
                       :  INDEX-DATA
                       :  INDEX-NAME
 #
CHECKCONV2: 
         BEGIN
            IF PROCCASE2
            THEN
                CON2NUM;    #CONVERT LITERAL TO POOL TYPE#
            ELSE
                NO$POOL$FLAG = TRUE;  #DO NOT POOL THIS NUM LIT#
         GOTO CHECKCONV30;
         END #CHECKCONV3# 
 #
         * * CASE  3 * *
         INTEGER-LIT   :  ALPHANUMERIC
         QUOTED-LIT    :  ALPHANUMERIC
                       :  GROUP 
                       :  VARIABLE-GROUP
                       :  IMPL-NAME 
         FIG-CON-ZERO  :  ALPHANUMERIC
                       :  GROUP 
                       :  VARIABLE-GROUP
 #
CHECKCONV3: 
         BEGIN
         CON2AN;
         GOTO CHECKCONV30;
         END #CHECKCONV3# 
         NEWPAGE; 
 #
         * * CASE  4 * *
         INTEGER-LIT   :  ALPHANUMERIC-EDIT 
         QUOTED-LIT    :  ALPHANUMERIC-EDIT 
         FIG-CON-ZERO  :  ALPHANUMERIC-EDIT 
 #
CHECKCONV4: 
         BEGIN
         CON2ANEDIT;
         GOTO CHECKCONV30;
         END #CHECKCONV4# 
 #
         * * CASE  5 * *
         INTEGER-LIT   :  GROUP 
                       :  VARIABLE-GROUP
         NUMERIC-LIT   :  GROUP 
                       :  VARIABLE-GROUP
         FLOAT-LIT     :  GROUP 
                       :  VARIABLE-GROUP
  
         BECAUSE A PHYSICAL MOVE OF THE ORIGINAL LITERAL
         IS IMPLYED, ANY SIGN ONCE PRESENT MUST BE RESTORED.
 #
CHECKCONV5: 
         BEGIN
         IF GETQUICK(PL$SIGNEDFLG,PLT$,PLT$INDEX) 
         EQ 1 
            THEN                                   # SIGN PRESENT    #
            BEGIN 
            SUBSTR(SRC$LIT,0, 
                   SRC$LIT,1,SRC$LIT$LEN);         # SHIFT SOURCE 1 
                                                     PLACE TO RIGHT  #
            IF GETQUICK(PL$SIGNFLAG,PLT$,PLT$INDEX) 
            EQ 1                                   # WHICH SIGN\     #
               THEN 
               CHAR$VAL = OCT$PLUS; 
               ELSE 
               CHAR$VAL = OCT$MINUS;
            PUTCHAR(CHAR$VAL,SRC$LIT,0);           # RESTORE EITHER 
                                                     PLUS OR MINUS
                                                     AS 1ST CHARACTER#
            SRC$LIT$LEN = SRC$LIT$LEN + 1;         # INCREMENT
                                                     LENGTH FOR SIGN #
            END 
         CON2AN;
         GOTO CHECKCONV30;
         END #CHECKCONV5# 
         NEWPAGE; 
 #
         * * CASE  6 * *
         QUOTED-LIT    :  ALPHABETIC
 #
CHECKCONV6: 
         BEGIN
         CON2AN;
         ALPHACHECK;
         GOTO CHECKCONV30;
         END #CHECKCONV6# 
 #
         * * CASE  7 * *
         QUOTED-LIT    :  ALPHABETIC-EDIT 
 #
CHECKCONV7: 
         BEGIN
         CON2ANEDIT;
         ALPHACHECK;
         GOTO CHECKCONV30;
         END #CHECKCONV7# 
 CHECKCONV8:  
          SHORT$FLAG = FALSE; 
          CON2NUMMOVE;
          GOTO  CHECKCONV30;
#         * *  CASE  9 * *                                             #
#         LITERAL : BOOLEAN ITEM                                       #
 CHECKCONV9:  
          SHORT$FLAG = FALSE; 
          IF  GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX) EQ BOOLBIT 
          THEN  OBJ$LIT$LEN = GETQUICK(DN$BITLEN,DNAT$,DNAT$INDEX); 
          CON2BOOL; 
          GOTO  CHECKCONV30;
 CHECKCONV10:      #MOVE QUOTED LITERAL TO NUMERIC# 
          IF  LAT$ALL$FLAG
          THEN  ALL2NUM;
          ELSE  NO$POOL$FLAG = TRUE;
          GOTO  CHECKCONV30;
CHECKCONV30:  
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"CHECKCONV-EXIT      "); 
         TRACE(VAR$TRACE,"NO$POOL$FLAG      = ",NO$POOL$FLAG);
         TRACE(VAR$TRACE,"HI$LO$FLAG        = ",HI$LO$FLAG);
         DEBUGEND $END LISTON;
         END #CHECKCONV#
         NEWPAGE; 
PROC     POOLBUILD; 
         BEGIN
 #
         P O O L B U I L D
  
         THIS ROUTINE ENTERS CONVERTED LITERALS INTO THE LITERAL
         POOL AND PATCHES UP THE ASSOCIATED DNAT ENTRY. 
  
         I N P U T S
  
         LAT$ALL$FLAG 
         SET$COL$FLAG 
         HI$LO$FLAG 
         SHORT$FLAG 
         OBJ$LIT$LEN
         CONVERTED LITERAL - VIA OBJ$LIT
         DNAT$INDEX 
         LAT$INDEX
  
         O U T P U T S
  
         DNAT INFORMATION - VIA DNAT$INDEX
              DN$ITMLEN 
              DN$MAJMSEC
              DN$LONGOFF
              DN$CHARPOS
              DN$ALLBIT 
              DN$ALLCHAR
         LAT INFORMATION - VIA LAT$INDEX
              L$ALL 
              L$SPACES
  
         C A L L E D   B Y
  
         PLIT 
  
         R O U T I N E S   C A L L E D
  
         DIVER
 #
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM ALL$FLAG            B;
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"POOLBUILD-ENTRY     "); 
         TRACE(VAR$TRACE,"HI$LO$FLAG        = ",HI$LO$FLAG);
         TRACE(VAR$TRACE,"SET$COL$FLAG      = ",SET$COL$FLAG);
         TRACE(VAR$TRACE,"SHORT$FLAG        = ",SHORT$FLAG);
         TRACE(VAR$TRACE,"LAT$INDEX         = ",LAT$INDEX); 
         TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
         TRACE(VAR$TRACE,"OBJ$LIT$LEN       = ",OBJ$LIT$LEN); 
         TRACE(INT$TRACE,"OBJ$LIT OCTAL     = ",OBJ$LIT,OBJ$LIT$LEN); 
         DEBUGEND $END LISTON;
 #
         INITIALIZE CONVERTED LITERAL POOLING VALUES
 #
         OBJ$MSEC = LITMSEC;                       # SET UP MSEC AS 
                                                     LITERAL POOL    #
         ALL$FLAG = FALSE;                         # INITIALIZE 
                                                     REPETITION FLAG #
         SPACES$FLAG = FALSE;                      # INITIALIZE 
                                                     BLANKS FLAG     #
         ZEROS$FLAG = FALSE;                       # INITIALIZE 
                                                     ZEROS FLAG      #
 #
         CHECK FOR SPECIAL CASE OF HIGH-VALUES OR LOW-VALUES WHEN 
         ALPHABET NAMES AND SET COLLATING SEQUENCE STATEMENTS ARE 
         PRESENT. IF SO THESE FIGURATIVE CONSTANTS MUST BE TREATED
         AS PSEUDO DATA ITEMS AND NOT PLACED IN THE LITERAL POOL. 
 #
         IF HI$LO$FLAG AND SET$COL$FLAG            # BOTH NECESSARY  #
            THEN
            BEGIN 
            SETFIELD(L$HILO,LAT$,LAT$INDEX,1);     # TURN ON FLAG 
                                                     FOR CGEN        #
            LAT$ALL$FLAG = TRUE;                   # INCOMPLETE 
                                                     REPLICATION     #
            OBJ$LIT$LEN = OBJ$ORG$LEN;             # USE ORIGINAL 
                                                     FIELD LENGTH    #
            LPOOL$INDEX = 0;                       # LITERAL NOT
                                                     IN THE POOL     #
            GOTO POOLBUILD3;                       # SKIP TO
                                                     DNAT FIXUP      #
            END 
         NEWPAGE; 
 #
         DECIDE IF THE LITERAL CONSISTS OF A REPEATED CHARACTER 
         THEN DECIDE IF THE REPEATED CHARACTER IS A SPACE 
         INDICATING THAT THE CONVERTED RESULT IS ALL SPACES.
         THE REPEATED CHARACTER WILL BE LATER SAVED IN THE
         DNAT ENTRY FOR POSSIBLE FUTURE USE BY CGEN.
 #
         CHAR$VAL = GETCHAR(OBJ$LIT,0);            # ACCESS 
                                                     1ST CHARACTER   #
         FOR OBJ$INDEX = 1 STEP 1 
                         UNTIL OBJ$LIT$LEN - 1 DO  # LOOP THROUGH 
                                                     REST OF STRING  #
             BEGIN
             IF GETCHAR(OBJ$LIT,OBJ$INDEX)
             NQ CHAR$VAL                           # SAME CHARACTER\ #
                THEN
                GOTO POOLBUILD1;                   # STOP TESTING    #
             END
         IF OBJ$LIT$LEN EQ OBJ$ORG$LEN             # FULLY FILLED\   #
         OR CHAR$VAL EQ OCT$BLANK                  # BLANK FILL OK   #
         OR (CHAR$VAL EQ OCT$ZERO                  # ZERO FILL OK    #
            AND GETQUICK(L$IMMEDIATE,LAT$,LAT$INDEX) EQ 0 
            AND GETQUICK(PL$FIGCON,PLT$,PLT$INDEX) NQ 0 ) 
            THEN
            ALL$FLAG = TRUE;                       # SET FLAG FOR 
                                                     REPLICATION     #
         IF ALL$FLAG AND CHAR$VAL EQ OCT$BLANK
            THEN
            SPACES$FLAG = TRUE;                    # RESULT IS
                                                     ALL SPACES      #
         IF ALL$FLAG AND CHAR$VAL EQ OCT$ZERO 
            THEN
            ZEROS$FLAG = TRUE;                     # RESULT IS
                                                     ALL ZEROS       #
POOLBUILD1: 
         NEWPAGE; 
 #
         TEST FOR A CONVERTED LITERAL WHICH MAY BE HANDLED AS AN
         IMMEDIATE REGISTER OPERAND BY THE CODE GENERATORS. SUCH
         LITERALS ARE LESS THAN 3 CHARACTERS IN LENGTH OR 3 
         CHARACTERS IN LENGTH IF THE FIRST CHARACTER WILL NOT BE
         SIGN EXTENDED BY MACHINE REGISTER OPERATIONS.
  
         HOWEVER CERTAIN TYPES OF LITERALS CAN"T BE HANDLED AS
         IMMEDIATE OPERANDS BY CGEN: CURRENTLY ONLY UNSUBSCRIPTED 
         MOVE STATEMENT LITERALS ARE SPECIALLY HANDLED. FOR 
         ALL OTHER CASES WE FORCE THE POOLING OF THE ALREADY
         CONVERTED RESULT.
 #
         IF NOT SHORT$FLAG                         # LITERALS IN POOL#
            THEN
            GOTO POOLBUILD2;                       # OMIT TEST FOR
                                                     SHORT LITERAL   #
         IF OBJ$LIT$LEN NQ OBJ$ORG$LEN             # TOTAL CONVERT\  #
            THEN
            GOTO POOLBUILD2;                       # SHORT TEST ONLY
                                                     IF COMPLETE     #
         IF OBJ$LIT$LEN LS 3
         OR (OBJ$LIT$LEN EQ 3 AND CHAR$VAL LS OCT$40) 
            THEN
            BEGIN 
            OBJ$ALIGN = CHARSIN1WORD - OBJ$LIT$LEN;# GET NEW DNAT 
                                                     CHAR POSITION   #
            SETFIELD(DN$CHARPOS,DNAT$,DNAT$INDEX, 
                     OBJ$ALIGN);                   # ENTER NEW BCP
                                                     INTO DNAT ENTRY #
            LPOOL$INDEX 
            = B<0,OBJ$LIT$LEN*6>OBJ$CHAR[0];       # VALUE IS 
                                                     IMMEDIATE       #
            SETFIELD(DN$SHORTLIT,DNAT$,DNAT$INDEX,LPOOL$INDEX); 
            LPOOL$INDEX = 0;
            OBJ$MSEC = UNLITMSEC;                  # SET FOR
                                                     NO POOLING      #
            GOTO POOLBUILD3;                       # SKIP TO
                                                     DNAT FIXUP      #
            END 
         NEWPAGE; 
 #
         TEST FOR A CONVERTED RESULT OF ALL BLANKS FOR WHICH
         NO CONVERTED RESULT IS NECESSARY BECAUSE OF SPECIAL
         HANDLING BY THE CODE GENERATORS. 
         HOWEVER FOR BLANK LITERALS WHICH APPEAR IN INSPECT,
         STRING OR UNSTRING STATEMENTS, WE FORCE THE POOLING
         OF THE CONVERTED RESULT TO SIMPLIFY CGEN PROCESSING. 
 #
POOLBUILD2: 
         IF SPACES$FLAG 
            THEN
            BEGIN 
            IF GETQUICK(L$VCODE,LAT$,LAT$INDEX) EQ 3
            THEN
            SPACES$FLAG = FALSE;                   # TREAT AS IF
                                                     WASN"T SPACES   #
            ELSE
            BEGIN 
            LAT$ALL$FLAG = TRUE;                   # INCOMPLETE 
                                                     REPLICATION     #
            LPOOL$INDEX = 0;                       # NO LITERAL 
                                                     TO BE POOLED    #
            OBJ$LIT$LEN = OBJ$ORG$LEN;             # USE LENGTH 
                                                     OF ORIGINAL     #
            GOTO POOLBUILD3;                       # SKIP TO
                                                     DNAT FIXUP      #
            END 
            END 
 #
         ENTER THE CONVERTED FORM INTO THE LITERAL POOL 
         USING THE DIVER ROUTINE. 
 #
         DIVER; 
  
         LPOOL$INDEX = LPOOL$INDEX + OBJ$ALIGN;    # ACTUAL POOL
                                                     CHAR OFFSET     #
         NEWPAGE; 
 #
         UPDATE THE APPROPRIATE DNAT FIELDS WITH INFORMATION
         EITHER FROM POOL OR DECIDED ABOVE AS A SPECIAL CASE
 #
POOLBUILD3: 
         SETFIELD(DN$MAJMSEC,DNAT$,DNAT$INDEX,
                  OBJ$MSEC);                       # ENTER MSEC 
                                                     INTO DNAT ENTRY #
         SETFIELD(DN$LONGOFF,DNAT$,DNAT$INDEX,
                  LPOOL$INDEX);                    # UPDATE OBJECT
                                                     ADDRESS IN DNAT
                                                     WITH POOL OFFSET#
         SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX, 
                  OBJ$LIT$LEN);                    # UPDATE LENGTH
                                                     IN DNAT WITH 
                                                     RESULT LENGTH   #
         NEWPAGE; 
 #
         SET THE APPROPRIATE LAT FIELDS DEPENDING ON THE
         LAT ALL FLAG AND THE SPACES FLAG.
 #
         IF LAT$ALL$FLAG                           # REPEAT MORE\    #
            THEN
            SETFIELD(L$ALL,LAT$,LAT$INDEX,1);      # SET LAT ALL
                                                     INDICATOR       #
         IF SPACES$FLAG                            # ALL SPACES\     #
            THEN
            SETFIELD(L$SPACES,LAT$,LAT$INDEX,1);   # SET LAT ALL
                                                     SPACES BIT      #
         IF ZEROS$FLAG
            THEN
            SETFIELD(L$ZEROS,LAT$,LAT$INDEX,1);    # SET LAT ALL
                                                     ZEROS BIT       #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"POOLBUILD-EXIT      "); 
         TRACE(VAR$TRACE,"DN$MAJMSEC        = ",
               GETQUICK(DN$MAJMSEC,DNAT$,DNAT$INDEX));
         TRACE(VAR$TRACE,"DN$LONGOFF        = ",
               GETQUICK(DN$LONGOFF,DNAT$,DNAT$INDEX));
         TRACE(REG$TRACE,"DN$LONGOFF OCTAL  = ",
               GETQUICK(DN$LONGOFF,DNAT$,DNAT$INDEX));
         TRACE(VAR$TRACE,"DN$ITMLEN         = ",
               GETQUICK(DN$ITMLEN,DNAT$,DNAT$INDEX)); 
         TRACE(VAR$TRACE,"DN$CHARPOS        = ",
               GETQUICK(DN$CHARPOS,DNAT$,DNAT$INDEX));
         TRACE(VAR$TRACE,"L$ALL             = ",
               GETQUICK(L$ALL,LAT$,LAT$INDEX)); 
         TRACE(VAR$TRACE,"L$SPACES          = ",
               GETQUICK(L$SPACES,LAT$,LAT$INDEX));
         TRACE(VAR$TRACE,"L$HILO            = ",
               GETQUICK(L$HILO,LAT$,LAT$INDEX));
         DEBUGEND $END LISTON;
         END #POOLBUILD#
         NEWPAGE; 
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
 #                                                                   #
 #                                                                   #
 #      M O N I T O R   R O U T I N E S                              #
 #                                                                   #
 #                                                                   #
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
PROC     ALIT;
         BEGIN
 #
         A L I T
  
         THIS ROUTINE MANAGES ALPHABET NAME LITERALS WHICH OCCUR
         IN THE ENVIRONMENT DIVISION. THE APPROPRIATE TRANSLATION 
         TABLES ARE CONSTRUCTED AND POOLED IN THE OBJECT TIME 
         LITERAL POOL. THE SEMANTIC CORRECTNESS OF THE ALPHABET 
         NAME SPECIFICATIONS IS ALSO VERIFIED WITH APPROPRIATE
         DIAGNOSTICS BEING GENERATED IF NECESSARY.
  
         I N P U T S
  
         ALNAME$START 
         ALNAME$END 
         CSEQ$DNAT
         NATIVE$LOW 
         NATIVE$HIGH
         LPOOL$LEN
  
         O U T P U T S
  
         LOW$VALUE
         HIGH$VALUE 
         UPDATED LITERAL POOL 
         LPOOL$LEN
  
         C A L L E D   B Y
  
         LP 
  
         R O U T I N E S   C A L L E D
  
         DIAGNOSTIC 
         DIVER
         TRANSTAB 
 #
         NEWPAGE; 
 #
         DECLARATION OF LOCAL STORAGE 
 #
         ITEM AUX$OLD             I;
 #
         DECLARATION OF COLLATING SEQUENCE SWITCH 
 #
         SWITCH ALPHCASE          ALIT0,ALIT1,ALIT2,
                                  ALIT3,ALIT4,ALIT5,
                                  ALIT6,ALIT7,ALIT8,ALIT9;
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"ALIT-ENTRY          "); 
         TRACE(VAR$TRACE,"ALNAME$START      = ",ALNAME$START);
         TRACE(VAR$TRACE,"ALNAME$END        = ",ALNAME$END);
         TRACE(VAR$TRACE,"CSEQ$DNAT         = ",CSEQ$DNAT); 
         TRACE(INT$TRACE,"NATIVE$LOW OCTAL  = ",NATIVE$LOW,1);
         TRACE(INT$TRACE,"NATIVE$HIGH OCTAL = ",NATIVE$HIGH,1); 
         TRACE(VAR$TRACE,"LPOOL$LEN         = ",LPOOL$LEN); 
         DEBUGEND $END LISTON;
 #
         TEST IF THERE ARE ANY ALPHABET NAMES TO PROCESS. 
         IF NOT SET THE PROGRAM HIGH AND LOW VALUES WHICH 
         WILL BE THOSE DEFINED AS NATIVE. 
 #
         IF ALNAME$START EQ 0                      # NO ALPHA NAMES\ #
            THEN
            BEGIN 
            LOW$VALUE = NATIVE$LOW; 
            HIGH$VALUE = NATIVE$HIGH; 
            GOTO ALIT30;                           # SKIP TO EXIT    #
            END 
 #
         SET UP THE ALIGNMENT SO THAT THE GENERATED 
         TRANSLATION TABLES WILL BE ALIGNED ON WORD 
         BOUNDARIES WITHIN THE LITERAL POOL 
 #
         OBJ$ALIGN = 0;                            # SET FOR WORD 
                                                     ALIGNMENT       #
         NEWPAGE; 
 #
         WE LOOP THROUGH THE ALPHABET NAME PORTION OF THE 
         DNAT PROCESSING ONLY ALPHABET NAMES FOR WHICH A
         LITERAL STRING IS SPECIFIED. THE FAILSAFE METHOD 
         IS TO IGNORE ERRORONEOUS ALPHABET NAMES. 
 #
         FOR DNAT$INDEX = ALNAME$START STEP 1 
                          UNTIL ALNAME$END DO      # LOOP THROUGH 
                                                     ALPHA NAMES     #
         BEGIN
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"ALIT-LOOP           "); 
         TRACE(DIV$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
         TRACE(VAR$TRACE,"DN$TYPE           = ",
               GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX)); 
         TRACE(VAR$TRACE,"DN$ANTYPE         = ",
               GETQUICK(DN$ANTYPE,DNAT$,DNAT$INDEX)); 
         DEBUGEND $END LISTON;
 #
         WATCH FOR ERRORS OR NON LITERAL ALPHABET NAMES 
 #
         IF GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX)
         EQ ERRTYPE                                # ERROR TYPE\     #
            THEN
            TEST DNAT$INDEX;                       # IGNORE ENTRY    #
         IF GETQUICK(DN$ANTYPE,DNAT$,DNAT$INDEX)
         EQ ANLITERAL                              # ONLY LITERALS   #
            THEN
            BEGIN 
            NO$POOL$FLAG = FALSE;                  # INITIALIZE 
                                                     ERROR FLAG      #
            AUX$INDEX 
            = GETQUICK(DN$AUXREF,DNAT$,DNAT$INDEX);# GET FIRST
                                                     AUX ENTRY       #
            AUX$OLD = AUX$INDEX;                   # SAVE FIRST 
                                                     ENTRY POINTER   #
            TRANSTAB;                              # GENERATE THE 
                                                     COLLATING TABLE #
            NEWPAGE;
            IF NOT NO$POOL$FLAG                    # TABLE GENERATED\#
               THEN 
               BEGIN
 #
               ATTACH THE HIGH-VALUES LOW-VALUES AUX ENTRY TO 
               THE ASSOCIATED ALPHABET NAME DNAT ENTRY . THE
               AUX ENTRIES CONTAINING LITERAL INFORMATION WILL
               HAVE BEEN EFFECTIVELY DISCARDED SINCE TRANSTAB,
               DURING ITS REORDERING OF THE LITERAL AUX ENTRIES,
               WILL HAVE SET THE LINK FIELD OF AUX$OLD TO ZERO. 
 #
               SETFIELD(AX$TTYPE,AUX$,AUX$OLD,
                        AUXHILO);                  # SPECIFY TYPE 
                                                     OF ENTRY        #
               SETFIELD(AX$LOVALUE,AUX$,AUX$OLD,
                        LOW$VALUE);                # INSERT THE 
                                                     LOW VALUE       #
               SETFIELD(AX$HIVALUE,AUX$,AUX$OLD,
                        HIGH$VALUE);               # INSERT THE 
                                                     HIGH VALUE      #
               LISTOFF; $BEGIN DEBUGBEGIN 
               TRACE(POS$TRACE,"ALIT-SETUP          "); 
               TRACE(VAR$TRACE,"AUX$OLD           = ",AUX$OLD); 
               TRACE(VAR$TRACE,"AX$TTYPE          = ",
                     GETQUICK(AX$TTYPE,AUX$,AUX$OLD));
               TRACE(REG$TRACE,"AX$LOVALUE OCTAL  = ",
                     GETQUICK(AX$LOVALUE,AUX$,AUX$OLD));
               TRACE(REG$TRACE,"AX$HIVALUE OCTAL  = ",
                     GETQUICK(AX$HIVALUE,AUX$,AUX$OLD));
               TRACE(VAR$TRACE,"AX$TNEXTPTR       = ",
                     GETQUICK(AX$TNEXTPTR,AUX$,AUX$OLD)); 
               DEBUGEND $END LISTON;
               NEWPAGE; 
 #
               PLACE TRANSLATION TABLE IN THE POOL AND UPDATE 
               THE ASSOCIATED ALPHABET NAME DNAT ENTRY
 #
               DIVER;                              # ADD TABLE
                                                     TO LITERAL POOL #
               SETFIELD(DN$MAJMSEC,DNAT$,DNAT$INDEX,
                        LITMSEC);                  # LITERAL
                                                     MEMORY SECTION  #
               SETFIELD(DN$LONGOFF,DNAT$,DNAT$INDEX,
                        LPOOL$INDEX);              # LOCATION 
                                                     WITHIN POOL     #
               SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX, 
                        OBJ$LIT$LEN);              # SIZE OF TABLE
                                                     WITHIN POOL     #
               LISTOFF; $BEGIN DEBUGBEGIN 
               TRACE(POS$TRACE,"ALIT-SUCCESS        "); 
               TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
               TRACE(VAR$TRACE,"DN$MAJMSEC        = ",
                     GETQUICK(DN$MAJMSEC,DNAT$,DNAT$INDEX));
               TRACE(VAR$TRACE,"DN$LONGOFF        = ",
                     GETQUICK(DN$LONGOFF,DNAT$,DNAT$INDEX));
               TRACE(VAR$TRACE,"DN$ITMLEN         = ",
                     GETQUICK(DN$ITMLEN,DNAT$,DNAT$INDEX)); 
               DEBUGEND $END LISTON;
               END                                 # END OF TABLE 
                                                     OKAY SECTION    #
               NEWPAGE; 
               ELSE 
               BEGIN                               # NO TRANS TABLE  #
 #
               IF AN ERROR HAS BEEN DETECTED IN THE PROCESSING OF 
               THIS LITERAL ALPHABET NAME WE CHANGE THE TYPE TO 
               NATIVE AS A RECOVERY ACTION TO PREVENT PROBLEMS IN 
               THE CODE GENERATORS FOR SET COLLATING STATEMENTS 
 #
               DIAGNOSTIC(DIAG$NO,SEVERE);         # GENERATE 
                                                     ERROR MESSAGE   #
               SETFIELD(DN$ANTYPE,DNAT$,DNAT$INDEX, 
                        ANNATIVE);                 # CHANGE ALPHA 
                                                     NAME TYPE       #
               LISTOFF; $BEGIN DEBUGBEGIN 
               TRACE(POS$TRACE,"ALIT-ERROR          "); 
               TRACE(VAR$TRACE,"DNAT$INDEX        = ",DNAT$INDEX);
               TRACE(VAR$TRACE,"DN$ANTYPE         = ",
                     GETQUICK(DN$ANTYPE,DNAT$,DNAT$INDEX)); 
               DEBUGEND $END LISTON;
               END                                 # END OF NO
                                                     TABLE SECTION   #
            END                                    # END OF LITERAL 
                                                     CODE SECTION    #
         END                                       # END OF ALPHA 
                                                     NAME DNAT LOOP  #
         NEWPAGE; 
 #
         DETERMINE THE HIGH AND LOW VALUES TO BE USED IN
         THE PROCEDURE DIVISION INSTANCES FOR THESE FIG 
         CONSTANTS. THE VALUES ARE IN FACT DEPENDENT UPON 
         THE SPECIFIED PROGRAM COLLATING SEQUENCE BUT 
         WILL BE VARIABLE IF ANY SET COLLATING SEQUENCE 
         STATEMENTS ARE PRESENT IN THE PROGRAM. WE WILL 
         DETERMINE THEIR INITIAL VALUES TO BE PUT INTO
         THE CCT FOR CGEN"S USE IN INITIALIZING DATA
         DIVISION VALUE CLAUSE ITEMS SPECIFIED WITH ONE 
         OF THESE FIGURATIVE CONSTANTS. THE STRANGE CASE
         OF VARIABLE LOW-VALUES AND HIGH-VALUES WILL BE 
         INVESTIGATED IN THE POOLBUILD ROUTINE. 
 #
         HIGH$VALUE = NATIVE$HIGH;                 # USE NATIVE 
                                                     HIGH VALUE      #
         LOW$VALUE = NATIVE$LOW;                   # USE NATIVE 
                                                     LOW VALUE       #
         IF CSEQ$DNAT NQ 0                         # SEQ. SPECIFIED  #
            THEN
            BEGIN 
            IF GETQUICK(DN$TYPE,DNAT$,CSEQ$DNAT)
            EQ ERRTYPE                             # ERROR TYPE      #
               THEN 
               GOTO ALIT30;                        # SKIP TO EXIT    #
            SRC$LIT$TYPE
            = GETQUICK(DN$ANTYPE,DNAT$,CSEQ$DNAT); # ACCESS PROGRAM 
                                                     COLL SEQ TYPE   #
            LISTOFF; $BEGIN DEBUGBEGIN
            TRACE(POS$TRACE,"ALIT-CSEQ           ");
            TRACE(VAR$TRACE,"SRC$LIT$TYPE      = ",SRC$LIT$TYPE); 
            DEBUGEND $END LISTON; 
            NEWPAGE;
 #
            BRANCH TO THE SELECTION OF THE APPROPRIATE HIGH 
            AND LOW VALUES. THE VALUES ARE MOSTLY PREDEFINED
            WITH THE EXCEPTION OF THOSE FOR A LITERAL ALPHABET
            NAME WHICH WILL JUST HAVE BEEN CALCULATED ABOVE 
            AND PLACED IN THE ASSOCIATED AUX TABLE ENTRY. 
 #
            GOTO ALPHCASE[SRC$LIT$TYPE];           # SELECT 
                                                     SETUP CODE      #
ALIT0:                                             # ERROR VALUE     #
            INTERCEPTOR(0,0,MSG997,SEVERE);        # COMPILER ERROR  #
            GOTO ALIT30;                           # SKIP TO EXIT    #
ALIT1:                                             # LIT ALPHA NAME  #
            AUX$INDEX 
            = GETQUICK(DN$AUXREF,DNAT$,CSEQ$DNAT); # GET AUX
                                                     ENTRY POINTER   #
            LOW$VALUE 
            = GETQUICK(AX$LOVALUE,AUX$,AUX$INDEX); # SET LOW VALUE   #
            HIGH$VALUE
            = GETQUICK(AX$HIVALUE,AUX$,AUX$INDEX); # SET HIGH VALUE  #
            GOTO ALIT30;                           # SKIP TO EXIT    #
ALIT2:                                             # STANDARD-1      #
            GOTO ALIT7;                            # SAME AS ASCII   #
ALIT3:                                             # NATIVE          #
            GOTO ALIT30;                           # ALREADY SETUP   #
ALIT4:                                             # CDC 63          #
ALIT5:                                             # CDC 64          #
            LOW$VALUE = OCT$55;                    # BLANK           #
            HIGH$VALUE = OCT$44;                   # NINE            #
            GOTO ALIT30;                           # SKIP TO EXIT    #
ALIT6:                                             # ASCII 63        #
ALIT7:                                             # ASCII 64        #
            LOW$VALUE = OCT$55;                    # BLANK           #
            HIGH$VALUE = OCT$65;                   # UNDERLINE       #
            GOTO ALIT30;                           # SKIP TO EXIT    #
ALIT8:                                             # UNI             #
            LOW$VALUE = OCT$55;                    # BLANK           #
            HIGH$VALUE = OCT$57;                   # PERIOD          #
            GOTO ALIT30;
ALIT9:                                             # EBCDIC          #
            LOW$VALUE = OCT$55;                    # BLANK           #
            HIGH$VALUE = OCT$44;                   # NINE            #
            # FALL THROUGH #
            END 
         NEWPAGE; 
 #
         END OF ROUTINE AND DESTINATION OF ABOVE SWITCH EXITS 
 #
ALIT30: 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"ALIT-EXIT           "); 
         TRACE(INT$TRACE,"LOW$VALUE OCTAL   = ",LOW$VALUE,1); 
         TRACE(INT$TRACE,"HIGH$VALUE OCTAL  = ",HIGH$VALUE,1);
         TRACE(VAR$TRACE,"LPOOL$LEN         = ",LPOOL$LEN); 
         DEBUGEND $END LISTON;
         END #ALIT# 
         NEWPAGE; 
PROC     PLIT;
         BEGIN
 #
         P L I T
  
         THIS ROUTINE MANAGES PROCEDURE DIVISION LITERALS 
         WITH A PASS BEING MADE OVER THE PROCEDURE DIVISION 
         SECTION OF THE LITERAL ATTRIBUTE TABLE. THE
         CHECKCONV ROUTINE IS CALLED FOR EACH LITERAL 
         RESULTING A CONVERTED OBJECT FORM IF POSSIBLE. 
         THE POOLBUILD ROUTINE IS THEN CALLED TO PUT THE
         CONVERTED LITERAL IN THE POOL. ALL ERRORS DETECTED 
         ARE DIAGNOSED AS ADVISORY. 
  
         I N P U T S
  
         LAT$PD$START 
         LAT$PD$END 
         LITERAL POOL 
         LPOOL$LEN
  
         O U T P U T S
  
         UPDATED LITERAL POOL 
         LPOOL$LEN
  
         C A L L E D   B Y
  
         LP 
  
         R O U T I N E S   C A L L E D
  
         CHECKCONV
         POOLBUILD
 #
         NEWPAGE; 
 #
  
         LITERAL POOLING RULES FOR CYBER COBOL L-POOLER 
         ---------------------------------------------- 
  
         THESE RULES APPLY ONLY TO THE NON-CMU LITERAL POOLER PHASE 
         THE CMU LITERAL POOLING RULES ARE GIVEN BELOW. 
  
         ALPHANUMERIC LITERALS
         ---------------------
  
         1. IF THE LITERAL VALUE IS SPACES, NOTHING IS POOLED.
            IF THE CONVERTED LITERAL LENGTH IS LESS THAN 2
            CHARACTERS OR 3 CHARACTERS IF THE LEADING CHARACTER 
            IS LESS THAN 40B, THEN NOTHING IS POOLED. 
            OTHERWISE 
  
         2. THE LITERAL IS BINARY ZERO FILLED UP TO THE FIRST 
            CHARACTER IN THE FIRST LITERAL WORD.
  
         3. THE LITERAL IS BINARY ZERO FILLED AFTER THE LAST
            CHARACTER IN THE LAST LITERAL WORD. 
  
         THUS, GIVEN
               01 A.
                  02 B PIC XX.
                  02 C PIC XXXX.
                  02 D PIC XXXX.
         AND
                  MOVE "ZZ" TO C. 
         THE LITERAL WORD WOULD BE "00ZZ 0000"
         WHERE "0" IS A BINARY ZERO BYTE. 
  
         4. IN THE FOLLOWING RULES, THE FORMULA 
            (BCP(LIT) + SZ(LIT) + 9)/10 = (BCP(REC) + SZ(REC) + 9)/10 
            WHERE 
               BCP = BEGINNING CHARACTER POSITION (0 TO 9)
               SZ  = SIZE (ITEM LENGTH) OF FIELD
               REC = RECEIVING FIELD
               LIT = LITERAL FIELD
            ASKS WHETHER THE LITERAL AND RECEIVING FIELD, AFTER BCP 
            ALIGNMENT WITHIN THE FIRST WORD, OCCUPY THE SAME NUMBER 
            OF WORDS. 
 #
         NEWPAGE; 
 #
            THIS FORMULA CAN BE SIMPLIFIED, IN THE CASES WHERE IT IS
            USED, IN THE FOLLOWING FASHION: 
  
            (BCP(LIT) + SZ(LIT) + 9)/10 = (BCP(REC) + SZ(REC) + 9)/10 
  
            BECAUSE OF INTEGER DIVISION THIS IS EQUIVALENT TO 
  
            BCP(LIT) + SZ(LIT) + 9 + X = BCP(REC) + SZ(REC) + 9 + Y 
  
            WHERE 0 <= X <= 9 AND 0 <= Y <= 9. BECAUSE OF BEGINNING 
            CHARACTER POSITION ALIGNMENT, BCP(LIT) AND BCP(REC) ARE 
            EQUAL. REMOVING THESE TERMS ALONG WITH THE 9"S WE HAVE
  
            SZ(LIT) + X = SZ(REC) + Y 
  
            SZ(REC) - SZ(LIT) = X - Y 
  
            BECAUSE OF THE RESTRICTIONS ON X AND Y, WE HAVE 
  
            - 9 <= (X - Y) <= 9 
  
            ELIMINATING THE NEGATIVE VALUES (IMPLYING LITERAL SIZE
            GREATER THAN RECEIVING FIELD SIZE WHEN THE RULE IS NOT
            USED) AND RECOGNIZING THE QUANTITY SZ(REC) - SZ(LIT) AS 
            THE PROGRAM VARIABLE LENGTH$DIFF, WE HAVE THE SIMPLIFIED
            EXPRESSION: 
  
            LENGTH$DIFF <= 9
  
            LENGTH$DIFF < CHARSIN1WORD
  
            THIS FORMULA WILL BE USED IN THE CON2AN ROUTINE IN PLACE
            OF THE ORIGINAL EXPRESSION. 
  
         5. ALIGNMENT AND SIZE
  
 #
         NEWPAGE; 
 #
  
         MOVE STATEMENT LITERALS
         -----------------------
  
         I.  RECEIVING FIELD IS UNSUBSCRIPTED (OR SUBSCRIPTED AND 
             OCCURRENCE LENGTH IS A MULTIPLE OF 10 CHARACTERS)
  
             1. LITERAL ALIGNMENT 
  
                A. RECEIVING FIELD IS NOT JUSTIFIED--THE LEFTMOST 
                   LITERAL CHARACTER IS ALIGNED ON THE SAME BEGINNING 
                   CHARACTER POSITION AS THE RECEIVING FIELD. 
  
                B. RECEIVING FIELD IS JUSTIFIED--THE LITERAL IS 
                   ALIGNED ON THE SAME ENDING CHARACTER POSITION
                   AS THE RECEIVING FIELD, I.E. 
                   BCP(REC) + SIZE(REC) - 1 
                   WHERE BCP MEANS BEGINNING CHARACTER POSITION AND 
                         REC MEANS THE RECEIVING FIELD. 
  
             2. LITERAL SIZE
  
                A. RECEIVING FIELD IS NOT JUSTIFIED 
                   1. IF THE LITERAL SIZE IS THE SAME AS THE RECEIVING
                      FIELD SIZE DO NOTHING TO MODIFY THE LITERAL.
                   2. IF THE LITERAL SIZE IS GREATER THAN THE RECEIVING 
                      FIELD SIZE, TRUNCATE THE LITERAL ON THE RIGHT TO
                      EQUAL THE RECEIVING FIELD SIZE. 
                   3. IF THE LITERAL SIZE IS LESS THAN THE RECEIVING
                      FIELD SIZE
                      A. IF THE LITERAL AND THE RECEIVING FIELD WILL
                         OCCUPY THE SAME NUMBER OF WORDS, APPEND BLANKS 
                         TO THE RIGHT END OF THE LITERAL OUT TO THE 
                         SIZE OF THE RECEIVING FIELD. 
                      B. OTHERWISE APPEND BLANKS TO THE RIGHT END OF
                         THE LITERAL TO THE NEAREST WORD BOUNDARY.
  
                B. RECEIVING FIELD IS JUSTIFIED 
                   1. IF THE LITERAL SIZE IS THE SAME AS THE RECEIVING
                      FIELD SIZE, DO NOTHING TO MODIFY THE LITERAL. 
                   2. IF THE LITERAL SIZE IS GREATER THAN THE RECEIVING 
                      FIELD SIZE, TRUNCATE THE LITERAL ON THE LEFT TO 
                      EQUAL THE RECEIVING FIELD SIZE. 
                   3. IF THE LITERAL SIZE IS LESS THAN THE RECEIVING
                      FIELD SIZE
                      A. IF THE LITERAL AND THE RECEIVING FIELD WILL
                         OCCUPY THE SAME NUMBER OF WORDS, PREFIX BLANKS 
                         TO THE LEFT END OF THE LITERAL OUT TO THE SIZE 
                         OF THE RECEIVING FIELD.
                      B. OTHERWISE PREFIX BLANKS TO THE LEFT END OF THE 
                         LITERAL FROM THE NEAREST WORD BOUNDARY.
  
 #
         NEWPAGE; 
 #
  
         II. RECEIVING FIELD IS SUBSCRIPTED AND THE OCCURRENCE LENGTH 
             IS NOT A MULTIPLE OF 10 CHARACTERS 
  
             1. LITERAL ALIGNMENT--ALIGN THE FIRST LITERAL CHARACTER
                ON A WORD BOUNDARY. 
  
             2. LITERAL SIZE
  
                A. RECEIVING FIELD IS NOT JUSTIFIED 
                   1. IF THE LITERAL SIZE IS THE SAME AS THE SIZE 
                      OF ONE OCCURRENCE OF THE RECEIVING FIELD, DO
                      NOTHING TO MODIFY THE LITERAL.
                   2. IF THE LITERAL SIZE IS GREATER THAN THE SIZE
                      OF ONE OCCURRENCE OF THE RECEIVING FIELD, 
                      TRUNCATE THE LITERAL ON THE RIGHT TO EQUAL
                      THE RECEIVING FIELD OCCURRENCE LENGTH.
                   3. IF THE LITERAL SIZE IS LESS THAN THE SIZE OF
                      ONE OCCURRENCE OF THE RECEIVING FIELD, DO 
                      NOTHING TO MODIFY THE LITERAL.
  
                B. RECEIVING FIELD IS JUSTIFIED 
                   1. IF THE LITERAL SIZE IS THE SAME AS THE SIZE 
                      OF ONE OCCURRENCE OF THE RECEIVING FIELD, DO
                      NOTHING TO MODIFY THE LITERAL.
                   2. IF THE LITERAL SIZE IS GREATER THAN THE SIZE
                      OF ONE OCCURRENCE OF THE RECEIVING FIELD, 
                      TRUNCATE THE LITERAL ON THE LEFT TO EQUAL THE 
                      RECEIVING FIELD OCCURRENCE LENGTH.
                   3. IF THE LITERAL SIZE IS LESS THAN THE SIZE OF
                      ONE OCCURRENCE OF THE RECEIVING FIELD, DO 
                      NOTHING TO MODIFY THE LITERAL.
  
 #
         NEWPAGE; 
 #
  
         IF STATEMENT ALPHANUMERIC LITERALS 
         ---------------------------------- 
  
         I.  COMPARE FIELD IS UNSUBSCRIPTED (OR SUBSCRIPTED AND 
             OCCURRENCE LENGTH IS A MULTIPLE OF 10 CHARACTERS)
  
             1. LITERAL ALIGNMENT 
  
                1. IF THE COMPARE FIELD SIZE IS LESS THAN OR EQUAL TO 
                   20 CHARACTERS, ALIGN THE LEFTMOST CHARACTER OF THE 
                   LITERAL ON A WORD BOUNDARY.
  
                2. OTHERWISE ALIGN THE LEFTMOST CHARACTER OF THE
                   LITERAL ON THE SAME BEGINNING CHARACTER POSITION 
                   AS THE COMPARE FIELD.
  
             2. LITERAL SIZE
                A. IF THE COMPARE FIELD SIZE IS LESS THAN OR EQUAL TO 
                   20 CHARACTERS, APPEND BLANKS AFTER THE RIGHTMOST 
                   CHARACTER OF THE LITERAL TO THE NEAREST WORD 
                   BOUNDARY.
                B. OTHERWISE
                   1. IF THE LITERAL SIZE IS GREATER THAN THE SIZE
                      OF THE COMPARE FIELD, DO NOTHING TO MODIFY
                      THE LITERAL.
                   2. IF THE LITERAL SIZE IS LESS THAN THE COMPARE
                      FIELD SIZE
                      A. IF THE LITERAL FIELD AND THE COMPARE FIELD 
                         OCCUPY THE SAME NUMBER OF WORDS, APPEND
                         BLANKS ON THE RIGHT END OF THE LITERAL OUT 
                         TO THE COMPARE FIELD SIZE. 
                      B. OTHERWISE APPEND BLANKS ON THE RIGHT END OF
                         THE LITERAL TO THE NEAREST WORD BOUNDARY.
  
         II. COMPARE FIELD IS SUBSCRIPTED AND THE OCCURRENCE LENGTH 
             IS NOT A MULTIPLE OF 10 CHARACTERS 
  
             1. LITERAL ALIGNMENT--ALIGN THE FIRST LITERAL CHARACTER
                ON A WORD BOUNDARY. 
  
             2. LITERAL SIZE
                A. IF THE SIZE OF ONE OCCURRENCE OF THE COMPARE FIELD 
                   IS LESS THAN OR EQUAL TO 20 CHARACTERS, APPEND 
                   BLANKS AFTER THE RIGHTMOST CHARACTER OF THE LITERAL
                   TO THE NEAREST WORD BOUNDARY.
                B. OTHERWISE, DO NOTHING TO MODIFY THE LITERAL. 
  
         III. THERE IS NO SUCH THING AS A JUSTIFIED IF LITERAL (THE 
              DNATJUST BIT MUST BE OFF).
  
 #
         NEWPAGE; 
 #
  
         "ALL" LITERALS AND FIGURATIVE CONSTANTS
         ---------------------------------------
  
         1. IF THE LITERAL VALUE IS ALL SPACES, NOTHING IS POOLED.
  
         2. IF THE RECEIVING FIELD IS 30 CHARACTERS OR LESS IN LENGTH,
            THE LITERAL IS EXPANDED TO THE RECEIVING FIELD LENGTH 
            AND POOLED AS THOUGH IT WERE AN ORDINARY ALPHANUMERIC 
            LITERAL (LATALL BIT OFF). 
  
         THE FOLLOWING RULES APPLY ONLY IF THE CONDITIONS IN RULES 1
         AND 2 ARE FALSE. 
  
         3. THE LITERAL ALWAYS STARTS ON A WORD BOUNDARY. 
  
         4. THE LITERAL IS ZERO FILLED AFTER THE LAST CHARACTER IN
            THE LAST WORD.
  
         5. A 1,2,5 OR 10 CHARACTER ITEM IS EXPANDED TO 10 CHARACTERS.
            A 4 OR 20 CHARACTER ITEM IS EXPANDED TO 20 CHARACTERS.
            A 3,6 OR 15 CHARACTER ITEM IS EXPANDED TO 30 CHARACTERS.
            ALL OTHER ITEMS ARE EXPANDED TO THE FIRST MULTIPLE OF THE 
            LITERAL LENGTH WHICH IS GREATER THAN 10 CHARACTERS. 
  
         6. "ALL" LITERALS ARE NOT JUSTIFIED IN JUSTIFIED RECEIVING 
            FIELD.
  
         7. THE LATALL BIT IS SET ON FOR LITERALS WHICH 
            MUST BE REPEATED. 
  
         8. DNATALL BIT IS SET ON FOR ONE CHARACTER ALL OR FIGURATIVE 
            CONSTANT ITEMS. 
  
 #
         NEWPAGE; 
 #
  
         ALPHANUMERIC EDITED ITEMS
         -------------------------
  
         1. FOR AN ALPHANUMERIC EDITED RECEIVING FIELD
            A. IF THE RECEIVING FIELD HAS 30 OR LESS REPLACEMENT
               CHARACTERS, A PSEUDO ALPHANUMERIC ITEM IS DEFINED
               WHOSE SIZE IS THE NUMBER OF REPLACEMENT CHARACTERS 
               IN THE ALPHANUMERIC EDITED ITEM. THE LITERAL IS
               CONVERTED AS THOUGH IT WERE BEING ACTUALLY MOVED 
               TO THIS PSEUDO-ITEM AND POOLED (OR NOT POOLED IF ALL 
               SPACES). THE LITERAL TYPE IS SET TO ALPHANUMERIC.
            B. IF THE RECEIVING FIELD IS MORE THAN 30 REPLACEMENT 
               CHARACTERS, THE LITERAL IS POOLED (OR NOT POOLED IF
               ALL SPACES) UNMODIFIED, LEFT ALIGNED IN THE FIRST
               WORD, AND BINARY ZERO FILLED AFTER THE RIGHTMOST 
               CHARACTER IN THE LAST WORD.
  
  
         CONVERTED AND READY TO POOL LITERAL LENGTH < THAN 2 CHARS
         ---------------------------------------------------------
         OR 3 CHARACTERS IF THE LEADING CHARACTER VALUE < 40B 
         ---------------------------------------------------- 
  
         1. THESE LITERALS FOLLOW THE SAME RULES AS ABOVE, EXCEPT 
            THEY ARE NOT POOLED. THE DNAT IS MODIFIED TO REFLECT
            THE MODIFIED ATTRIBUTES.
  
         1. A LITERAL CONSISTING OF ONE OR TWO SPACES FOLLOWS 
            THE UNPOOLED LITERAL RULES, NOT THE SPACES RULES. 
            THE LATSPACES BIT IS SET ON.
  
         3. THE UNPOOLED LITERAL VALUE IS PUT INTO THE DNAT BYTE
            OFFSET FIELD. 
  
         4. THE ITEM LENGTH FIELD IN THE DNAT IS SET TO THE SIZE
            OF THE UNPOOLED LITERAL.
  
         5. THE DNATCHARPOS FIELD IS SET TO 10 - LITERAL SIZE.
  
         6. THE MSEC IS SET TO THE UNPOOLED LITERAL MSEC. 
  
 #
         NEWPAGE; 
 #
  
         LITERALS WHOSE CONVERTED VALUE IS ALL SPACES 
         -------------------------------------------- 
         WITH A LENGTH GREATER THAN 2 CHARACTERS
         ---------------------------------------
  
         1. THE LITERAL VALUE IS NOT POOLED OR PUT INTO THE DNAT
            BYTE OFFSET FIELD.
  
         2. LATALL AND LATSPACES BITS ARE SET ON. 
  
         3. DNATMSEC IS SET TO LITMSEC. 
  
         4. THE SIZE IS SET TO THE RECEIVING FIELD SIZE.
  
         5. THE DNAT BYTE OFFSET FIELD IS SET TO 0. 
  
  
         FIGURATIVE CONSTANTS HIGH VALUES AND LOW VALUES
         -----------------------------------------------
         WHEN ALPHABET NAMES AND SET COLLATING SEQUENCE CLAUSES ARE 
         ---------------------------------------------------------- 
         PRESENT (THE VALUE CHANGES AT EXECUTION TIME)
         ---------------------------------------------
  
         1. THE LITERAL VALUE IS NOT POOLED OR PUT INTO THE DNAT
            BYTE OFFSET FIELD.
  
         2. LATALL BIT IS SET ON. 
  
         3. DNATMSEC IS SET TO LITMSEC. 
  
         4. THE SIZE IS SET TO THE RECEIVING FIELD SIZE.
  
         5. THE DNAT BYTE OFFSET FIELD IS SET TO 0. 
  
         6. THE LAT$HILO BIT IS SET ON TO INDICATE THIS 
            SPECIAL CASE TO CGEN. 
  
 #
         NEWPAGE; 
 #
  
         CMU LITERAL POOLING RULES
         -------------------------
  
         THESE RULES APPLY TO THE PROCESSING OF ALPHANUMERIC
         LITERALS WHEN THE COMPARE-MOVE-UNIT OPTION IS IN EFFECT. 
  
         ALPHANUMERIC LITERALS
         ---------------------
  
         1. IF THE LITERAL VALUE IS SPACES, PROCESS SAME AS NON-CMU.
  
         2. MOVE STATEMENT LITERALS 
            ----------------------- 
  
            I.  THE LITERAL MAY BE ALIGNED ON ANY BCP.
  
            II. LITERAL SIZE
  
                A. RECEIVING FIELD IS NOT JUSTIFIED 
                   1. IF THE SIZE OF THE LITERAL EQUALS THE SIZE OF 
                      THE RECEIVING FIELD, DO NOTHING TO MODIFY THE 
                      LITERAL.
                   2. IF THE SIZE OF THE LITERAL IS GREATER THAN THE
                      SIZE OF THE RECEIVING FIELD, TRUNCATE THE 
                      LITERAL ON THE RIGHT TO EQUAL THE RECEIVING 
                      FIELD SIZE. 
                   3. IF THE LITERAL SIZE IS LESS THAN THE RECEIVING
                      FIELD SIZE
                      A. IF THE SIZE DIFFERENCE IS LESS THAN 20 
                         CHARACTERS, APPEND BLANKS TO THE LITERAL 
                         TO THE SIZE OF THE RECEIVING FIELD.
                      B. OTHERWISE DO NOTHING TO MODIFY THE LITERAL.
  
                B. RECEIVING FIELD IS JUSTIFIED 
                   1. IF THE SIZE OF THE LITERAL EQUALS THE SIZE OF 
                      THE RECEIVING FIELD, DO NOTHING TO MODIFY THE 
                      LITERAL.
                   2. IF THE SIZE OF THE LITERAL IS GREATER THAN THE
                      SIZE OF THE RECEIVING FIELD, TRUNCATE THE 
                      LITERAL ON THE LEFT TO EQUAL THE RECEIVING
                      FIELD SIZE. 
                   3. IF THE LITERAL SIZE IS LESS THAN THE RECEIVING
                      FIELD SIZE
                      A. IF THE SIZE DIFFERENCE IS LESS THAN OR 
                         EQUAL TO 20 CHARACTERS, PREFIX BLANKS
                         TO THE LITERAL TO THE SIZE OF THE RECEIVING
                         FIELD. 
                      B. OTHERWISE DO NOTHING TO MODIFY THE LITERAL.
 #
         NEWPAGE; 
 #
  
         3. IF STATEMENT LITERALS 
            --------------------- 
  
            I.  THE LITERAL MAY BE ALIGNED ON ANY BCP.
  
            II. LITERAL SIZE
  
                A. IF THE LITERAL SIZE IS GREATER THAN OR EQUAL TO
                   THE COMPARE FIELD SIZE, DO NOTHING TO MODIFY THE 
                   LITERAL. 
                B. IF THE LITERAL SIZE IS LESS THAN THE COMPARE 
                   FIELD SIZE 
                   1. IF THE SIZE DIFFERENCE IS LESS THAN OR EQUAL
                      TO 20 CHARACTERS, APPEND BLANKS TO THE LITERAL
                      UP TO THE SIZE OF THE COMPARE FIELD.
                   2. OTHERWISE DO NOTHING TO MODIFY THE LITERAL. 
 #
         NEWPAGE; 
 #
  
         ALPHANUMERIC EDITED ITEMS
         -------------------------
  
         1. USE THE SAME RULES AS THE NON-CMU PROCESSING. 
  
  
         LITERALS WHOSE CONVERTED VALUE IS ALL SPACES 
         -------------------------------------------- 
  
         1. USE THE SAME RULES AS THE NON-CMU PROCESSING. 
  
  
         FIGURATIVE CONSTANTS HIGH-VALUES AND LOW-VALUES WHEN 
         ---------------------------- 
         ALPHABET NAMES AND SET COLLATING SEQUENCE CLAUSES
         -------------------------------------------------
         ARE PRESENT
         -----------
  
         1. USE THE SAME RULES AS THE NON-CMU PROCESSING. 
  
  
         ALL LITERALS AND FIGURATIVE CONSTANTS
         -------------------------------------
  
         1. USE THE SAME RULES AS THE NON-CMU PROCESSING EXCEPT 
  
         2. IN RULE 5, EXPAND 1,2,5 OR 10 CHARACTER LITERALS OUT
            TO 30 CHARACTERS. 
 #
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"PLIT-ENTRY          "); 
         TRACE(VAR$TRACE,"LAT$PD$START      = ",LAT$PD$START);
         TRACE(VAR$TRACE,"LAT$PD$END        = ",LAT$PD$END);
         TRACE(VAR$TRACE,"LPOOL$LEN         = ",LPOOL$LEN); 
         DEBUGEND $END LISTON;
         FOR LAT$INDEX = LAT$PD$START STEP 1
                         UNTIL LAT$PD$END DO       # INDEX THRU 
                                                     PROC. DIV. LAT # 
         BEGIN
         NO$POOL$FLAG = FALSE;                     # SET UP SWITCH
                                                     FOR POOLING     #
         CHECKCONV;                                # EXTRACTION,
                                                     CHECKING AND 
                                                     CONVERSION      #
         IF NOT NO$POOL$FLAG
            THEN
            POOLBUILD;                             # IF POSSIBLE ADD
                                                     LITERAL TO POOL #
         END
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"PLIT-EXIT           "); 
         TRACE(VAR$TRACE,"LPOOL$LEN         = ",LPOOL$LEN); 
         TRACE(VAR$TRACE,"LAT$INDEX         = ",LAT$INDEX); 
         DEBUGEND $END LISTON;
         END #PLIT# 
         NEWPAGE; 
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
 #                                                                   #
 #                                                                   #
 #       L P O O L E R   L O C A L   C O D E                         #
 #                                                                   #
 #                                                                   #
 #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
         LISTOFF; $BEGIN LISTON;
         DEBUG$SW = FALSE;                         # DEFAULT NO TRACE#
         IF CCTICHKOUT[0]                          # DEBUG ENABLED\  #
            THEN
            BEGIN 
              CHAR$VAL = C<6,1>PARAMC[0];          #LOOK AT 
                                                     PARAMETER AREA  #
            IF CHAR$VAL EQ OCT$Y
               THEN DEBUG$SW = TRUE;               # TRACE IF Y      #
            END 
         $END LISTON; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"LP-ENTRY            "); 
         DEBUGEND $END LISTON;
 #
         OBTAINING INFORMATION FROM THE COMPILER CONTROL TABLE
 #
         ALNAME$START = CCTFIRSTAN;                # 1ST ALPHA NAME 
                                                     DNAT ENTRY      #
         ALNAME$END = CCTLASTAN;                   # LAST ALPHA NAME
                                                     DNAT ENTRY      #
         LAT$PD$START = CCTLATDDLNGT + 1;          # GET FIRST LAT
                                                     PROC DIV ENTRY  #
         LAT$PD$END = CCTLATLEN;                   # GET LAST 
                                                     LAT ENTRY       #
         LPOOL$LEN = CCTLPOOLLEN;                  # GET LITERAL
                                                     POOL LENGTH     #
         SET$COL$FLAG = CCTHILO[0];                # COLLATING AND
                                                     ALPHABET SWITCH #
         CSEQ$DNAT = CCTCOLLSEQ;                   # INDEX OF PROGRAM 
                                                     COLL SEQ DNAT   #
         CMU$FLAG = CCTCMU[0];                     # COMPARE MOVE 
                                                     UNIT OPTION     #
         NEWPAGE; 
 #
         DETERMINE THE NATIVE SET HIGH AND LOW VALUES 
         BY USING THE CCT VARIABLE CCTIPCSET WHICH IS 
         ESSENTIALLY A COPY OF THE SYSTEM INSTALLATION
         PARAMETER IP.CSET. THE VARIOUS POSSIBILITIES 
         ARE CDC63,CDC64,ASCII63,ASCII64 AND DISPLAY. 
 #
         SWITCH NATIVECASE        LP0,LP1,LP2,
                                  LP3,LP4,LP5;     # SWITCH 
                                                     DEFINITION      #
         NATIVE$SW = CCTIPCSET;                    # ACCESS VALUE 
                                                     FROM CCT        #
         GOTO NATIVECASE[NATIVE$SW];               # SELECT NATIVE
                                                     COLLATING SEQ   #
              BEGIN 
LP0:                                               # ERROR VALUE     #
              INTERCEPTOR(0,0,MSG996,SEVERE);      # COMPILER ERROR 
                                                     AND FALL THRU   #
LP1:                                               # CDC 63          #
LP2:                                               # CDC 64          #
              NATIVE$LOW = OCT$55;                 # BLANK           #
              NATIVE$HIGH = OCT$44;                # NINE            #
              GOTO LP6; 
LP3:                                               # ASCII 63        #
LP4:                                               # ASCII 64        #
              NATIVE$LOW = OCT$55;                 # BLANK           #
              NATIVE$HIGH = OCT$65;                # UNDERLINE       #
              GOTO LP6; 
LP5:                                               # DISPLAY CODE    #
              NATIVE$LOW = OCT$00;                 # DISPLAY MIN     #
              NATIVE$HIGH = OCT$77;                # DISPLAY MAX     #
              END 
LP6:  
         NEWPAGE; 
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(VAR$TRACE,"ALNAME$START      = ",ALNAME$START);
         TRACE(VAR$TRACE,"ALNAME$END        = ",ALNAME$END);
         TRACE(VAR$TRACE,"LAT$PD$START      = ",LAT$PD$START);
         TRACE(VAR$TRACE,"LAT$PD$END        = ",LAT$PD$END);
         TRACE(VAR$TRACE,"LPOOL$LEN         = ",LPOOL$LEN); 
         TRACE(VAR$TRACE,"NATIVE$SW         = ",NATIVE$SW); 
         TRACE(VAR$TRACE,"SET$COL$FLAG      = ",SET$COL$FLAG);
         TRACE(VAR$TRACE,"CSEQ$DNAT         = ",CSEQ$DNAT); 
         TRACE(VAR$TRACE,"CMU$FLAG          = ",CMU$FLAG);
         TRACE(INT$TRACE,"NATIVE$LOW OCTAL  = ",NATIVE$LOW,1);
         TRACE(INT$TRACE,"NATIVE$HIGH OCTAL = ",NATIVE$HIGH,1); 
         DEBUGEND $END LISTON;
 #
         MAIN PROCESSING
 #
         ALIT;                                     # ALPHABET NAME
                                                     LITERALS        #
         PLIT;                                     # PROCEDURE
                                                     DIVISION 
                                                     LITERALS        #
 #
         UPDATING INFORMATION IN THE COMPILER CONTROL TABLE 
 #
         CCTLOVALUE[0] = LOW$VALUE;                # PROGRAM INITIAL
                                                     LOW-VALUE       #
         CCTHIVALUE[0] = HIGH$VALUE;               # PROGRAM INITIAL
                                                     HIGH-VALUE      #
         CCTMSECLEN[LITMSEC] = LPOOL$LEN;          # SET MEMORY 
                                                     SECTION LENGTH  #
         CCTLPOOLLEN = LPOOL$LEN;                  # SET LIT POOL 
                                                     CHAR LENGTH     #
         LISTOFF; $BEGIN DEBUGBEGIN 
         TRACE(POS$TRACE,"LP-EXIT             "); 
         DEBUGEND $END LISTON;
         NEWPAGE; 
 #
         APPEARANCES TO THE MIND ARE OF FOUR KINDS. THINGS EITHER ARE 
         WHAT THEY APPEAR TO BE: OR THEY NEITHER ARE, NOR APPEAR TO BE: 
         OR THEY ARE, AND DO NOT APPEAR TO BE: OR THEY ARE NOT AND
         YET APPEAR TO BE. RIGHTLY TO AIM IN ALL THESE CASES IS THE 
         WISE MANS TASK.
                                       EPICTETUS
                                       CIRCA 60 A.D.
  
         I HATE QUOTATIONS. TELL ME WHAT YOU KNOW.
                                       RALPH WALDO EMERSON
                                       MAY 1849 
 #
         END #LP# 
TERM
