*DECK CDCM
          IDENT  CDCM 
  
 CDCM     TITLE  CDCM - CHECK FOR DANGEROUS CODE MODIFICATION.
          COMMENT  CDCM V1.0 - CHECK DANGEROUS CODE MODIFICATION. 
*CALL CDCMOPT 
  
          SST 
          B1=1
 CDCM     TITLE  INTERMEDIATE FILE FORMAT.
**        FORMAT OF INTERMEDIATE FILE.
* 
*         THE LENGTH OF INTERMEDIATE ENTRIES IS DETERMINED BY THE 
*         SYMBOLS *INTLTH* AND *LINELTH*.  BOTH ARE DEFINED IN
*         COMDECK *CDCMOPT*.
* 
*         WORD 0 = HEADER WORD: 
* 
*            1/F,50/0,9/QI
* 
* 
* 
*         WORDS 1 -> INTLTH = REFERENCE WORDS:  
* 
*            1/E,1/0,1/G,9/Q,48/SYM 
* 
* 
* 
*         WORDS INTLTH+1 -> INTLTH+LINELTH = LINE IMAGE WORDS:  
* 
*            CONTENTS OF LINE IMAGE 
* 
* 
*   WHERE F    = 1 IF THE STATEMENT IS TO BE LISTED.
*         QI   = QUALIFIER INDEX OF THE QUAL BLOCK CONTAINING THE 
*                  INSTRUCTION.  ZERO IF IN THE GLOBAL BLOCK. 
*         E    = 1 IF SYMBOL IS AN EXTERNAL.
*         G    = 1 IF SYMBOL IS EXPLICITLY QUALIFIED. 
*         Q    = QUAL INDEX OF SYMBOL (0 IF EXPLICIT GLOBAL QUALIFIER). 
*         SYM  = NAME OF A SYMBOL RELATED TO THE STORE  (OR ZERO).
 CDCM     TITLE  MANAGED TABLES.
  
**        MANAGED TABLES. 
* 
*         THESE TABLES ARE KEPT AS CMM VARIABLE-POSITION BLOCKS.  FOR 
*         A DESCRIPTION OF THE TABLE POINTERS, SEE ROUTINE *ADW*. 
 CDCM     SPACE  4,8
**        O.ENT - ENTRY POINT NAMES.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/NAME,18/0 
* 
*         NAME = ENTRY POINT NAME, LEFT JUSTIFIED ZERO FILL.
  
 O.ENT    VFD    30/0,30/0     WORD 0 - CMM POINTER WORD
          VFD    42/0,18/0     WORD 1 - USER LENGTH 
          VFD    42/0,18/200B  WORD 2 - INCREASE AMOUNT 
 CDCM     SPACE  4,8
**        O.EXT - EXTERNAL NAMES. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/NAME,18/0 
* 
*         NAME = EXTERNAL NAME, LEFT JUSTIFIED ZERO FILL. 
  
 O.EXT    VFD    30/0,30/0     WORD 0 - CMM POINTER WORD
          VFD    42/0,18/0     WORD 1 - USER LENGTH 
          VFD    42/0,18/200B  WORD 2 - INCREASE AMOUNT 
 CDCM     SPACE  4,8
**        O.LOC - LOCATION SYMBOLS. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    1/E,2/0,9/Q,48/NAME
* 
*         E    = 1 IF SYMBOL IS AN ENTRY POINT. 
*         Q    = NZ - QUALIFIER INDEX (INDEX INTO *O.QUL*). 
*                0  - UNQUALIFIED SYMBOL. 
*         NAME = LOCATION SYMBOL NAME.
  
 O.LOC    VFD    30/0,30/0     WORD 0 - CMM POINTER WORD
          VFD    42/0,18/0     WORD 1 - USER LENGTH 
          VFD    42/0,18/10B   WORD 2 - INCREASE AMOUNT 
 CDCM     SPACE  4,8
**        O.QUL - QUALIFIER NAMES.
* 
*         CONTAINS ONE ENTRY FOR EACH UNIQUE QUALIFIER NAME IN THE
*         PROGRAM.  THE TABLE IS EMPTY IF NO QUALIFIERS ARE PRESENT.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    48/NAME,12/0 
* 
*         NAME = QUALIFIER NAME.
  
 O.QUL    VFD    30/0,30/0     WORD 0 - CMM POINTER WORD
          VFD    42/0,18/0     WORD 1 - USER LENGTH 
          VFD    42/0,18/10B   WORD 2 - INCREASE AMOUNT 
 CDCM     SPACE  4,8
**        O.QUS - QUALIFIER STACK.
* 
*         LENGTH DEPENDS ON THE CURRENT SELECTION OF QUALIFIERS IN
*         EFFECT AT ANY GIVEN TIME FOR THE CURRENT PROGRAM. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    51/0,9/QI
* 
*         QI = QUALIFIER INDEX = INDEX INTO *O.QUL*.
*              ZERO IF QUALIFIER IN EFFECT IS THE GLOBAL BLOCK. 
  
 O.QUS    VFD    30/0,30/0     WORD 0 - CMM POINTER WORD
          VFD    42/0,18/0     WORD 1 - USER LENGTH 
          VFD    42/0,18/10B   WORD 2 - INCREASE AMOUNT 
 CDCM     TITLE  GLOBAL VALUES. 
  
**        GLOBAL VALUES.
  
  
 LFNI     DATA   0LINPUT     INPUT FILE NAME FROM *I* PARAMETER 
  
 LFNL     DATA   0LOUTPUT    OUTPUT FILE NAME FROM *L* PARAMETER
  
 LOOPT    CON    0           LIST OPTION FROM *LO* PARAMETER
                              DEFAULT = A - LIST CODE MODIFICATION LINES
  
 PRINTCT  CON    0           NUMBER OF CODE MODIFICATION LINES LISTED 
  
 PRINTL   CON    100         MAXIMUM NUMBER OF CODE MODIFICATION LINES
                              TO BE PRINTED FROM *PL* PARAMETER 
  
 SO.JP    CON    1           UNCONDITIONAL JUMP PROCESSING OPTION 
                              DEFAULT IS TO FORGET REGISTER CONTENTS
                               BETWEEN UNCONDITIONAL JUMPS
  
 SO.SM    CON    1           SYSTEM MACRO PROCESSING OPTION 
                              DEFAULT IS TO RECOGNIZE SYSTEM MACROS 
  
 SO.LM    CON    0           LOCAL MACRO PROCSSSING OPTION
                              DEFAULT IS TO NOT RECOGNIZE LOCAL MACROS
  
 IFETCH   CON    0           FETCH POINTER FOR WORK SPACE IN CM OR LCM
  
 IFWA     CON    0           FWA OF WORKSPACE IF IN CM OR LCM 
                               FWA FROM CMM IF WORKSPACE IN CM
                               ALWAYS = 0 IF WORKSPACE IN LCM 
  
 IMAX     CON    0           MAXIMUM ALLOWABLE CM OR LCM WORKSPACE SIZE 
                              DETERMINED BY *CWS* 
  
  
 INEXT    CON    0           STORE POINTER FOR WORK SPACE IN CM OR LCM
  
 ISIZE    CON    0           OFFSET TO END OF DATA IN WORKSPACE 
  
 SF       CON    0           0 - USE 1ST INTERMEDIATE FILE NAME 
                             1 - USE 2ND INTERMEDIATE FILE NAME 
  
 SP       CON    0           0 OR LFN OF INTERMEDIATE FILE BEING READ 
          CON    0           0 OR LFN OF INTERMEDIATE FILE BEING WRITTEN
 CDCM     TITLE  MAIN ROUTINE.
  
**        CDCM - MAIN LOOP. 
* 
  
          ENTRY  CDCM 
 CDCM     SB1    1           MAIN *CDCM* ENTRY POINT
          RJ     /SCO/SCO    SET CONTROL STATEMENT OPTIONS
          RJ     CWS         COMPUTE WORK SPACE SIZE
          RJ     INF         INITIALIZE FILES 
  
**        PASS 1.  CONSISTS OF READING THE COMPILE FILE AND BUILDING
*         TABLES.  MOST OF THE WORK IS DONE IN PASS 1, BECAUSE IT ALSO
*         CONSISTS OF READING THE INTERMEDIATE FILE AS CREATED FOR
*         EACH PROGRAM AND SHRINKING IT OF ALL ENTRIES WHICH ARE
*         NEITHER IN LOCATION TABLE *O.LOC* NOR CONTAIN ONE OR MORE 
*         REFERENCES TO EXTERNALS.
* 
  
 CD10     RJ     NXTLINE     READ NEXT LINE 
          NZ     X1,CD20     IF EOF - PASS 1 COMPLETE 
          RJ     PCS         PROCESS CURRENT STATEMENT
          EQ     CD10        PASS 1 LOOP
  
**        PASS 2.  CONSISTS OF MAKING ONE FINAL CHECK THROUGH THE 
*         INTERMEDIATE FILE FOR ENTRIES TO BE LISTED DUE TO MATCHING
*         ENTRY POINTS/EXTERNALS AND THEN WRITING THE LIST OUTPUT.
* 
  
 CD20     RJ     RWF         REWIND INTERMEDIATE FILE 
 CD21     RJ     RIF         READ INTERMEDIATE FILE 
          NZ     X1,CD50     IF COMPLETED 
          SA3    INTENT 
          MI     X3,CD26     IF THIS ENTRY TO BE LISTED 
  
*         MAKE FINAL CHECK FOR A MATCH WITH AN *O.LOC* ENTRY IN ORDER 
*         TO PICK UP THOSE ENTRIES WHICH REFERENCE EXTERNALS. 
  
          SB5    B1          INDEX FOR WORD WITHIN ENTRY
          SB6    INTLTH      MAXIMUM INDEX + 1
 CD22     SA2    B5+INTENT   NEXT SYMBOL (IF ZERO)
          NZ     X2,CD24     IF A SYMBOL PRESENT
 CD23     SB5    B5+B1       ADVANCE INDEX
          LT     B5,B6,CD22  LOOP FOR NUMBER OF SYMBOLS POSSIBLE (2)
          EQ     CD21        DO NOT LIST THIS ENTRY 
  
*         SEARCH *O.LOC* FOR CURRENT SYMBOL NAME. 
  
 CD24     SA1    O.LOC       FWA OF *O.LOC* 
          BX7    X2 
          SA3    A1+B1       LENGTH OF *O.LOC*
          IX4    X1+X3       (B4) = LWA+1 *O.LOC* 
          ZR     X3,CD23     IF *O.LOC* EMPTY 
          SB4    X4 
          SA5    B4          SAVE (LWA+1) 
          SA7    B4          STORE TARGET AT (LWA+1)
          SA4    X1-1        FIRST - 1 ENTRY
 CD25     SA4    A4+B1       NEXT ENTRY 
          BX3    X4-X2
          NZ     X3,CD25     LOOP UNTIL MATCH 
          BX6    X5          RESTORE (LWA+1)
          SB3    A4 
          SA6    B4 
          EQ     B3,B4,CD23  IF SYMBOL NOT FOUND
  
*         SYMBOL MATCHES WITH AN *O.LOC* ENTRY.  THIS ENTRY WAS FOR A 
*         REFERENCE TO AN EXTERNAL. 
  
*         LIST THE SOURCE LINE REPRESENTED BY THIS ENTRY, PROVIDED
*         LIST OUTPUT WAS SELECTED AND THE PRINT LIMIT HAS NOT BEEN 
*         EXCEEDED. 
  
 CD26     SA2    PRINTCT     ADVANCE NUMBER OF LINES LISTED 
          SX6    X2+B1
          SA6    A2 
          SA5    LFNL 
          ZR     X5,CD21     IF NO LIST OUTPUT
          SA1    LOOPT
          NZ     X1,CD21     IF SHORT LISTING SELECTED
          SA3    PRINTL      CHECK IF PRINT LIMIT EXCEEDED
          IX4    X3-X6
          MI     X4,CD21     IF PRINT LIMIT EXCEEDED
          SB6    INTENT+INTLTH  FWA OF LINE IMAGE 
          SB7    LINELTH
          RJ     WRLINE      WRITE LINE 
          EQ     CD21        LOOP 
  
 CD50     SA4    LFNL 
          ZR     X4,CD51     IF NO LIST OUTPUT
          RJ     WRITEX      COMPLETE OUTPUT FILE 
  
 CD51     MESSAGE  CDDFM1,,RCL  *CDCM COMPLETE* DAYFILE MESSAGE 
          SA1    PRINTCT
          RJ     =XCDD=      CONVERT TO DECIMAL DISPLAY 
          SA2    CDDFM2 
          LX6    3*6         SHIFT COUNT LEFT 3 PLACES AND MERGE
          MX1    -3*6         WITH MESSAGE
          BX6    X1*X6
          BX6    X2+X6
          SA6    A2 
          MESSAGE  A6,,RCL   ISSUE LINE COUNT DAYFILE MESSAGE 
          ENDRUN             ALL DONE - RETURN TO SYSTEM
  
 CDDFM1   DATA   C* CDCM COMPLETE*
 CDDFM2   DATA   3R CO,C*DE-MODIFICATION LINES* 
 ANT      TITLE  STATEMENT PROCESSING SUBROUTINES.
**        ANT - ADD NAME TO TABLE.
* 
*         ADDS A NAME TO A MANAGED TABLE IF NOT ALREADY PRESENT.
* 
*         ENTRY  (X1) = NAME, LEFT JUSTIFIED, ZERO FILL.
*                (B1) = 1.
*                (A2) = TABLE POINTER.
* 
*         EXIT   (X1) = NAME, LEFT JUSTIFIED, ZERO FILL.
* 
*         USES   X - 2, 3, 4, 6, 7. 
*                B - 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  ADW=.
  
  
 ANT      EQ     *+1S17      ENTRY / EXIT 
          SA3    A2+B1
          ZR     X3,ANT2     IF TABLE EMPTY, GO ADD 
          SB5    X2          (B5) = FWA TABLE 
          SA4    B5+X3       SAVE (LWA+1) 
          BX7    X4 
          SB7    A4          (B7) = LWA+1 
          BX6    X1 
          SA6    A4          SET TARGET VALUE AT LWA+1
          SA4    B5-1        FIRST-1 ENTRY
 ANT1     SA4    A4+B1       SEARCH LOOP
          BX4    X6-X4
          NZ     X4,ANT1     LOOP UNTIL HIT 
          SB6    A4 
          SA7    B7          RESTORE (LWA+1)
          NE     B6,B7,ANT   IF NAME ALREADY IN TABLE, EXIT 
 ANT2     RJ     ADW         ADD WORD TO TABLE
                              (A2) = TABLE POINTER, (X1) = WORD 
          EQ     ANT         RETURN 
 CRT      TITLE  STATEMENT PROCESSING SUBROUTINES.
**        CRT - CLEAR REGISTER TABLE. 
* 
*         CLEARS THE REGISTER TABLE *OR.REG*.  THIS CAUSES CDCM TO
*         FORGET ANY PREVIOUS REFERENCES TO ADDRESSES IN ANY OF THE 
*         REGISTERS.  CALLED AT THE BEGINNING OF EACH PROGRAM UNIT
*         (*IDENT* STATEMENT), AND AFTER AN UNCONDITIONAL JUMP IF THE 
*         *JP* OPTION IS SELECTED.
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   NONE.
* 
*         USES   X - 6. 
*                B - 6, 7.
*                A - 6. 
  
  
 CRT      EQ     *+1S17      ENTRY / EXIT 
          SB6    B0 
          SB7    LE.REG 
          MX6    0
 CRT1     SA6    B6+OR.REG
          SB6    B6+B1
          LT     B6,B7,CRT1  LOOP 
          EQ     CRT         RETURN 
 FBF      TITLE  STATEMENT PROCESSING SUBROUTINES.
**        FBF - FIND BEGINNING OF FIELD.
* 
*         SCANS FORWARD TO THE NEXT NON-BLANK IN THE STRING BUFFER. 
* 
*         ENTRY  (B1) = 1.
*                *NEXTCOL* POINTS TO A CHARACTER IN THE STRING BUFFER.
* 
*         EXIT   (X6) = *NEXTCOL* = COLUMN NUMBER OF FIRST ENCOUNTERED
*                       NON-BLANK CHARACTER.  MAY NOT HAVE CHANGED. 
* 
*         USES   X - 1, 2, 3, 6.
*                B - NONE.
*                A - 1, 2, 6. 
  
  
 FBF      EQ     *+1S16      ENTRY / EXIT 
          SA1    NEXTCOL
          SA2    X1+OR.LINE-2  INITIALIZE FETCH 
          SX6    1R          BLANK
          SX3    A2+B1       ADDRESS OF FIRST CHAR FETCHED
 FBF1     SA2    A2+B1       NEXT CHAR
          IX2    X6-X2
          ZR     X2,FBF1     LOOP ON BLANK
          SX2    A2 
          IX6    X2-X3
          IX6    X1+X6       ADVANCE COLUMN POINTER 
          SA6    A1 
          EQ     FBF         RETURN 
 GSE      TITLE  STATEMENT PROCESSING SUBROUTINES.
**        GSE - GET STATEMENT ELEMENT.
* 
*         *GSE* SCANS CHARACTERS IN A STATEMENT LINE AND INDICATES THE
*         PRESENCE OF THE FOLLOWING.  NOTE THAT MANY ELEMENT TYPES AS 
*         DEFINED FOR THE *COMPASS* ADDRESS FIELD ARE NOT PRESENTLY 
*         HANDLED BECAUSE THEY DO NOT HAVE TO BE HANDLED IN ORDER THAT
*         *CDCM* PROVIDE CORRECT RESULTS IN THE GREAT MAJORITY OF CASES.
* 
*         - REGISTERS (A0-A7, B0-B7, X0-X7, A.0-A.7, B.0-B.7, X.0-X.7). 
*         - SYMBOLS (1-8 CHARS IN LENGTH ACCORDING TO *COMPASS* RULES). 
*         - QUALIFIED SYMBOLS ( /SYMBOL NAME/ ).
*         - EXTERNAL NAMES OF THE FORM =XNAME OR =YNAME.  NAME MUST 
*           ADHERE TO THE RULES FOR LINKAGE SYMBOLS.
* 
*         ENTRY  (B1) = 1.
*                LINE BUFFER BEGINS AT OR.LINE. 
*                *NEXTCOL* POINTS TO THE FIRST COLUMN TO BE FETCHED.
* 
*         EXIT   (B1) = 1.
*                (B2) = TYPE OF ITEM RETURNED AS FOLLOWS: 
*                       0 - REGISTER. 
*                       1 - ORDINARY SYMBOL 
*                       2 - QUALIFIED SYMBOL
*                       3 - EXTERNAL SYMBOL 
*                       4 - ANYTHING ELSE 
*                (X1) = ITEM VALUE AS FOLLOWS:  
*                       FOR B2 = 0, REGISTER INDEX IN RANGE (0-23); 
*                         I.E., 0=A0, 1=A1, 7=A7, 15=B7, 16=X1, ETC.
*                       FOR B2 = 1-3, NAME LEFT JUSTIFIED, ZERO FILL. 
*                       FOR B2 = 4, 1ST CHAR RIGHT JUSTIFIED. 
*                                   MI IF POSITION UNDEFINED. 
*                (X2) = FOR B2 = 0-3, CHARACTER FOLLOWING ITEM IN X1. 
*                       FOR B2 = 4, 2ND CHAR RIGHT JUSTIFIED. 
*                                   MI IF POSITION UNDEFINED. 
*                (ITEMLTH) = REGISTER/SYMBOL LENGTH IN CHARACTERS, IF 
*                         B2 = 0 - 3. 
*                (NEXTCOL) POINTS TO THE CHARACTER PAST THE CHARACTER 
*                         IN (X2) ABOVE.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  GSN. 
  
  
 GSE      EQ     *+1S17      ENTRY / EXIT 
          RJ     GSN         GET NEXT CHAR
          R=     X2,X1-1R=
          NZ     X2,GSE10    IF NOT = 
  
*         = IS FIRST CHAR.  CHECK FOR =X OR =Y. 
  
          BX3    X1          SAVE = 
          RJ     GSN         GET 2ND CHAR 
          BX4    X1          SAVE 2ND CHAR
          R=     X2,X1-1RY
          ZR     X2,GSE1     IF =Y
          R=     X2,X2+1RY-1RX
          NZ     X2,GSE17    IF NEITHER =X NOR =Y, TYPE 4 
 GSE1     RJ     GSN         GET NEXT CHAR
          R=     X2,X1-1RZ-1
          PL     X2,GSE16    FIRST CHAR MUST BE ALPHA FOR EXTERNAL NAME 
          ZR     X1,GSE16 
  
*         FORM NAME FOR EXTERNAL.  ANY OF THE FOLLOWING CHARACTERS
*         WILL SIGNAL THE END OF THE NAME:  + - * / (BLANK) , (CARAT) 
  
          SB7    54          SHIFT COUNT FOR FIRST CHAR 
          LX4    X1,B7       FIRST CHAR OF NAME 
          SX6    B1          CURRENT NAME LENGTH
          SA6    ITEMLTH
 GSE2     SB7    B7-6        SHIFT COUNT FOR NEXT CHAR
          RJ     GSN         GET NEXT CHAR
          R=     X2,X1-1R+
          MI     X2,GSE3     IF CHAR LEGAL FOR NAME 
          R=     X2,X2+1R+-1R/-1
          MI     X2,GSE4     IF ANY OF + - * /
          R=     X2,X1-1R,
          ZR     X2,GSE4     IF , 
          R=     X2,X2+1R,-1R 
          ZR     X2,GSE4     IF (BLANK) 
          R=     X2,X1-1R^
          ZR     X2,GSE4     IF (CARAT) 
 GSE3     LX1    X1,B7       POSITION CHAR
          SA2    ITEMLTH     ADVANCE NAME LENGTH
          SX7    X2+B1
          SA7    A2 
          BX4    X4+X1
          SX3    X7-8        CHECK 7-CHAR MAX LENGTH FOR EXTERNAL NAMES 
          PL     X3,GSE15    IF NAME TOO LONG, RETURN TYPE 4 - UNDEF
          EQ     GSE2        LOOP FOR NAME
  
*         TYPE 3 RETURN - EXTERNAL NAME.
  
 GSE4     BX2    X1          (X2) = CHARACTER FOLLOWING NAME
          R=     B2,3 
          LX1    X4          (X1) = NAME
          EQ     GSE         RETURN 
  
*         CHECK REMAINING POSSIBLE FIRST CHARS. 
  
 GSE10    BX3    X1          SAVE 1ST CHAR
          R=     X2,X1-1R*
          ZR     X2,GSE12    IF FIRST CHAR IS * 
          R=     X2,X1-1R-
          ZR     X2,GSE12    IF FIRST CHAR IS - 
          R=     X2,X1-1R+
          ZR     X2,GSE12    IF FIRST CHAR IS + 
          R=     X2,X1-1R/
          NZ     X2,GSE19    IF FIRST CHAR NOT / GO CHECK FOR SYMBOL
  
*         / IS FIRST CHAR.
  
          RJ     GSN         GET NEXT CHAR
          SB2    2           SET FOR QUALIFIER
          EQ     GSE20       GO CHECK FOR SYMBOL AFTER /
  
*         TYPE 4 RETURN CASES.
  
 GSE11    NE     B2,B1,GSE13 IF QUALIFIER, TWO CHARS ALREADY FETCHED
 GSE12    RJ     GSN         GET NEXT CHAR
 GSE13    BX2    X1          (X2) = 2ND CHAR
          BX1    X3          (X1) = 1ST CHAR
          EQ     GSE18       ISSUE TYPE 4 RETURN
  
 GSE15    SX1    -B1         UNDEFINED RETURN 
          SX2    -B1
          EQ     GSE18
  
 GSE16    SA1    NEXTCOL     BACK UP ONE COLUMN 
          SX6    X1-1 
          SA6    A1 
 GSE17    BX1    X3          (X1) = 1ST CHAR FETCHED
          BX2    X4          (X2) = 2ND CHAR FETCHED
 GSE18    SB2    4
          EQ     GSE         RETURN 
  
*         CHECK FOR LEGAL FIRST CHAR FOR A SYMBOL NAME.  ANY CHAR IS
*         LEGAL EXCEPT (COLON) (NUMERIC) + - * / $ = (BLANK) , (CARAT)
  
 GSE19    SB2    B1          (B2) = 1 FOR SYMBOL
 GSE20    ZR     X1,GSE11    IF FIRST CHAR IS COLON 
          R=     X2,X1-1R0
          MI     X2,GSE21    ALPHA - LEGAL 1ST CHAR 
          R=     X2,X2+1R0-1R9-1
          MI     X2,GSE11    NUMERIC NOT LEGAL
          R=     X2,X1-1R+
          ZR     X2,GSE11    + NOT LEGAL
          R=     X2,X1-1R-
          ZR     X2,GSE11    - NOT LEGAL
          R=     X2,X1-1R*
          ZR     X2,GSE11    * NOT LEGAL
          R=     X2,X1-1R/
          ZR     X2,GSE11    / NOT LEGAL
          R=     X2,X1-1R$
          ZR     X2,GSE11    $ NOT LEGAL
          R=     X2,X1-1R=
          ZR     X2,GSE11    = NOT LEGAL
          R=     X2,X1-1R 
          ZR     X2,GSE11    (BLANK) NOT LEGAL
          R=     X2,X1-1R,
          ZR     X2,GSE11    , NOT LEGAL
          R=     X2,X1-1R^
          ZR     X2,GSE11    (CARAT) NOT LEGAL
  
*         FORM SYMBOL NAME.  REMAINING CHARS MAY BE ANYTHING EXCEPT 
*         + - * / (BLANK) , (CARAT) 
  
 GSE21    SX6    B1          STARTING SYMBOL LENGTH 
          SA6    ITEMLTH
          SB7    54          STARTING CHAR SHIFT COUNT
          MX4    0           (X4) = SYMBOL
 GSE22    LX1    X1,B7       SHIFT CHAR TO POSITION 
          BX4    X4+X1       ADD CHAR TO SYMBOL 
          SB7    B7-6        ADVANCE SHIFT COUNT FOR NEXT CHAR
          RJ     GSN         GET NEXT CHAR
          R=     X2,X1-1R+
          MI     X2,GSE23    LEGAL CHAR IF COLON OR ALPHANUMERIC
          R=     X2,X1-1R/-1
          MI     X2,GSE30    AT END OF SYMBOL IF + - * OR / 
          R=     X2,X1-1R 
          ZR     X2,GSE30    AT END OF SYMBOL IF (BLANK)
          R=     X2,X1-1R,
          ZR     X2,GSE30    AT END OF SYMBOL IF ,
          R=     X2,X1-1R^
          ZR     X2,GSE30    AT END OF SYMBOL IF (CARAT)
 GSE23    SA2    ITEMLTH     ADVANCE SYMBOL LENGTH
          SX6    X2+B1
          SA6    A2 
          SX3    X6-9        CHECK 8-CHAR MAX LENGTH
          MI     X3,GSE22    IF SYMBOL NOT TOO LONG 
          EQ     GSE15       TYPE 4 RETURN - UNDEFINED
  
*         DETERMINE IF SYMBOL NAME IS ALSO A LEGAL REGISTER NAME. 
*         (X1) = TERMINATING CHAR; (X4) = SYMBOL NAME.
  
 GSE30    SB7    X1          SAVE TERMINATING CHAR
          MX7    -6          CHAR MASK
          NE     B2,B1,GSE40 IF QUALIFIER, DO NOT CHECK FOR REGISTER
          SA2    ITEMLTH
          SX2    X2-2        (X2) = 0 IF LENGTH = 2, 1 IF LENGTH = 3
          ZR     X2,GSE31    IF LENGTH = 2
          SX3    X2-1 
          NZ     X3,GSE40    IF LENGTH .NE. 2 OR 3 - NOT REGISTER 
 GSE31    BX3    X4 
          LX3    6           GET FIRST CHAR 
          BX1    -X7*X3 
          SB6    B0          SET FOR A-REG NAME 
          R=     X1,X1-1RA
          ZR     X1,GSE32    IF FIRST CHAR = A
          SB6    8           SET FOR B-REG NAME 
          R=     X1,X1+1RA-1RB
          ZR     X1,GSE32    IF FIRST CHAR = B
          SB6    16          SET FOR X-REG NAME 
          R=     X1,X1+1RB-1RX
          NZ     X1,GSE40    FIRST CHAR NOT A, B, OR X - NOT REGISTER 
 GSE32    ZR     X2,GSE33    IF LENGTH = 2
          LX3    6           CHECK 2ND CHAR FOR . 
          BX1    -X7*X3 
          R=     X1,X1-1R.
          NZ     X1,GSE40    IF NOT A.N, B.N, OR X.N FORM 
 GSE33    LX3    6           GET LAST (2ND OR 3RD) CHAR TO CHECK 0-7
          BX1    -X7*X3 
          R=     X2,X1-1R0
          MI     X2,GSE40    IF LAST CHAR NOT NUMBERIC - NOT REGISTER 
          R=     X3,X2-8
          PL     X3,GSE40    IF LAST CHAR NOT 0-7 - NOT REGISTER
  
*         TYPE 0 RETURN.  SYMBOL NAME IS ALSO A REGISTER NAME.  COMPUTE 
*         INDEX FOR A0-A7 = 0-7, B0-B7 = 8-15, AND X0-X7 = 16-23. 
  
          SX1    B6+X2       (X1) = REGISTER INDEX
          SX2    B7          (X2) = TERMINATING CHAR
          SB2    B0 
          EQ     GSE         RETURN 
  
*         TYPE 1 RETURN.  ORDINARY SYMBOL NAME. 
*         TYPE 2 RETURN.  QUALIFIER SYMBOL NAME.
  
 GSE40    BX1    X4          (X1) = SYMBOL NAME 
          SX2    B7          (X2) = TERMINATING CHAR
          EQ     GSE         RETURN 
  
*         SUBROUTINE TO GET NEXT CHAR AND ADVANCE COLUMN COUNT. 
*         ONLY USES A1, A2, A6, X1, X2, X6
  
 GSN      EQ     *+1S17      ENTRY / EXIT 
          SA2    NEXTCOL     NEXT COLUMN NUMBER (1 IS FIRST)
          SA1    X2+OR.LINE-1  NEXT CHAR
          SX6    X2+B1       ADVANCE COLUMN 
          SA6    A2 
          EQ     GSN         RETURN 
  
 COMCOL   CON    DEFCOL      STARTING COMMENTS COLUMN 
 ITEMLTH  CON    0           SYMBOL LENGTH IN CHARACTERS
 NEXTCOL  CON    0           NEXT COLUMN TO FETCH 
 PCS      TITLE  STATEMENT PROCESSING SUBROUTINES.
**        PCS - PROCESS CURRENT STATEMENT.
* 
*         THE CURRENT SOURCE LINE IS EXAMINED, AND INFORMATION IS 
*         STORED ACCORDING TO THE TYPE OF LINE. 
* 
*         1) IF THE STATEMENT HAS A LOCATION SYMBOL, AND IF EITHER THE
*            OP-CODE FOR THIS STATEMENT OR FOR THE PREVIOUS STATEMENT 
*            IS THAT OF AN EXECUTABLE INSTRUCTION, THEN AN *O.LOC* TABLE
*            ENTRY IS CREATED CONTAINING THE LOCATION SYMBOL. 
* 
*         2) TABLE *OR.REG* IS MAINTAINED WITH THE MOST-RECENT VALUES 
*            OF SYMBOLS FOR THE RESULT REGISTER (IF THERE IS ONE) OF
*            THIS STATEMENT.  THE NUMBER OF SYMBOLS THAT MAY BE SAVED 
*            PER REGISTER IS CONTROLLED BY THE SYMBOL *PCSNVAL*.
* 
*         3) IF THE STATEMENT IS THAT OF A STORE INSTRUCTION (SA6, SA7, 
*            OR EQUIVALENT), THEN AN INTERMEDIATE FILE ENTRY IS CREATED 
*            CONTAINING THE CURRENT SYMBOL NAMES HELD IN THE
*            CORRESPONDING *OR.REG* ENTRY FOR A6 OR A7.  THE LINE IMAGE 
*            IS STORED WITH THE ENTRY.
* 
* 
*         ENTRY  CURRENT STATEMENT IS IN THE STRING BUFFER. 
* 
*         EXIT   ALL TABLES UPDATED ACCORDINGLY.
* 
*         USES   ALL REGISTERS. 
  
  
 PCS      EQ     *+1S17      ENTRY / EXIT 
  
*         MOVE LINE IMAGE INTO ONE CHAR PER WORD STRING BUFFER. 
  
          SA2    OR.LINE-1   INITIALIZE STORE POINTER 
          SB2    B0          CHAR/WORD COUNT
          BX6    X2 
          SB3    10          CHAR/WORD MAX
          SA6    A2 
          MX0    -6 
          SA1    ILINE       GET FIRST WORD 
          SX3    CONCAT 
          SB7    A1+LINELTH 
 PCS1     LX1    6           EXTRACT AND STORE NEXT CHARACTER 
          SB2    B2+B1
          BX6    -X0*X1 
          IX7    X6-X3
          ZR     X7,PCS2     IF CONCATENATION CHAR
          SA6    A6+B1
 PCS2     LT     B2,B3,PCS1  LOOP FOR CURRENT WORD
          SA1    A1+B1       GET NEXT WORD
          SB2    B0          RESET CHAR/WORD COUNT
          SB6    A1          CHECK IF DONE
          LT     B6,B7,PCS1  IF NOT DONE
          SX6    B1          SET TO FIRST COLUMN IN STRING BUFFER 
          SA6    NEXTCOL
  
*         INITIALIZE TEMPORARY AREA FOR NEW STATEMENT.
  
          MX7    0           CLEAR OUT TEMPORARY AREA 
          SB2    PCSA 
          SB3    PCSZ 
 PCS3     SA7    B2 
          SB2    B2+B1
          LT     B2,B3,PCS3 
  
*         PROCESS LOCATION FIELD. 
  
          RJ     FBF         FIND BEGINNING OF FIELD
          SX1    X6-3 
          BX0    X6          (X0) = COLUMN NUMBER FROM *FBF*
          PL     X1,PCS11    IF COLUMN .GT. 3, NO LOCATION FIELD
          RJ     GSE         GET STATEMENT ELEMENT
          SA4    PCSID
          NZ     X4,PCS11    IF EXPECTING *IDENT* STATEMENT 
          NE     B2,B1,PCS10 IF LOCATION FIELD NOT A SYMBOL 
          BX6    X1          SAVE LOCATION SYMBOL 
          SA6    PCSLOC 
 PCS10    RJ     FBF         FIND BEGINNING OF FIELD
          SA2    COMCOL 
          IX3    X6-X2
          MI     X3,PCS20    IF OP-CODE PRESENT 
  
*         LOCATION FIELD, BUT NO OP-CODE.  SET OP-CODE TO *CON*.
  
          SA1    =0LCON      SET OPCODE = *CON* 
          BX7    X1 
          EQ     PCS24       ENTER OP-CODE PROCESSING 
  
*         NO LOCATION FIELD.  CHECK IF OPCODE PRESENT.
  
 PCS11    SA2    COMCOL 
          IX3    X0-X2
          PL     X3,PCS90    IF NO OPCODE, LINE IS COMMENT OR ERRONEOUS 
  
*         PROCESS OPCODE FIELD. 
  
 PCS20    RJ     GSE         GET STATEMENT ELEMENT
          NE     B2,B1,PCS90 IF NOT SYMBOL
          SA3    PCSID
          ZR     X3,PCS21    IF NOT SKIPPING TO *IDENT* STATEMENT 
          SA4    =0LIDENT 
          BX4    X1-X4
          MX6    0
          NZ     X4,PCS90    IF NOT *IDENT*, SKIP STATEMENT 
          SA6    A3          CLEAR *IDENT* FLAG 
 PCS21    BX7    X1          (X7) = OPCODE
          SA7    PCSOC       STORE ORIGINAL OPCODE
  
*         CHECK IF OPCODE HAS A RESULT REGISTER (E.G. BX6, SB.7). 
  
          MX3    4*6
          BX6    -X3*X1 
          MX0    -6          (X0) = CHAR MASK 
          NZ     X6,PCS24    IF LONGER THAN 4 CHARS, NO REGISTER
          LX1    4*6         POSITION TO CHAR 4 
          BX3    -X0*X1 
          LX1    -1*6        POSITION TO CHAR 3 
          ZR     X3,PCS22    IF OPCODE NO MORE THAN 3 CHARS LONG
          BX2    -X0*X1 
          R=     X3,X2-1R.
          NZ     X3,PCS24    IF 3RD CHAR NOT ., NO REGISTER 
          LX1    1*6         POSITION TO CHAR 4 
 PCS22    BX3    -X0*X1 
          R=     X6,X3-1R0   (X6) = REGISTER NUMBER (IF A REGISTER) 
          MI     X6,PCS24    IF 3RD OR 4TH CHAR NOT NUMERIC 
          R=     X3,X6-8
          PL     X3,PCS24    IF 3RD OR 4TH CHAR NOT 0-7, NOT REGISTER 
          BX1    X7          ORIGINAL OPCODE
          LX1    2*6         POSITION TO CHAR 2 
          BX1    -X0*X1 
          R=     X2,X1-1RA
          ZR     X2,PCS23    IF A-REGISTER
          R=     X6,X6+8     SET FOR REGISTER INDEX OF B-REG
          R=     X2,X2+1RA-1RB
          ZR     X2,PCS23    IF B-REGISTER
          R=     X6,X6+8     SET FOR REGISTER INDEX OF X-REG
          R=     X2,X2+1RB-1RX
          NZ     X2,PCS24    IF NOT REGISTER
 PCS23    SA6    PCSRR       SAVE REGISTER INDEX (0-23) 
          MX4    2*6         REMOVE CHARS 3-4 OF OPCODE INVOLVING 
          BX7    X7*X4        RESULT REGISTER AND REPLACE WITH
          SX3    1R0           REGISTER NUMBER OF 0 
          LX3    7*6
          BX7    X7+X3
  
*         FIND OPCODE IN INSTRUCTION TABLE AND SET CHARACTERISTICS. 
  
 PCS24    SA2    PCSTT       TARGET LOCATION IN INSTRUCTION TABLE 
          SA7    X2          STORE OPCODE FOR TABLE SEARCH
          R=     B2,2        (B2) = 2 
          SB4    X2          (B4) = ADDR OF TARGET VALUE
          SA4    PCSITAB-2   FIRST-1 TABLE ENTRY
 PCS25    SA4    A4+B2       NEXT ENTRY 
          BX3    X4-X7
          NZ     X3,PCS25    LOOP UNTIL MATCH 
          SB3    A4 
          EQ     B3,B4,PCS90 IF NOT IN TABLE
          SA1    A4+B1       2ND WORD OF ENTRY
  
*         ENTER PROCESSOR IF AN ADDRESS IS PRESENT. 
  
          SB7    X1 
          ZR     B7,PCS26    IF NO PROCESSOR
          JP     B7          ENTER PROCESSOR
  
 PCS26    PL     X1,PCS90    IF OPCODE DOES NOT RESULT IN ANY CODE
                              (EXECUTABLE OR NON-EXECUTABLE)
          SA2    PCSCLC      SET PREVIOUS EXEC CODE FLAG = CURRENT / 2
          AX6    X2,B1        (= 0 IF LAST INST. WAS UNCONDITIONAL JUMP)
          LX1    1
          SA6    PCSPLC 
          MX6    0           CURRENT EXEC CODE FLAG = 0 
          SA6    A2 
          SX6    B1 
          R=     X7,2 
          PL     X1,PCS80    IF OPCODE IS NOT AN EXECUTABLE INSTRUCTION 
          SA7    A2          CURRENT EXEC CODE FLAG = 2 
          LX1    1
          PL     X1,PCS80    IF NO RESULT REGISTER FOR THIS OPCODE
          SA6    PCSRCG      SET RESULT REGISTER FLAG 
          LX1    1
          MX7    0
          PL     X1,PCS31    IF INSTRUCTION YIELDS RESULT REGISTER WITH 
                              A MEANINGFUL VALUE
          SA2    PCSRR       CLEAR *OR.REG* VALUES FOR RESULT REGISTER
          SB6    B0 
          SB7    PCSNVAL
 PCS30    SA7    X2+OR.REG   CLEAR *OR.REG* ENTRY 
          SX2    X2+NREG
          SB6    B6+B1
          LT     B6,B7,PCS30  LOOP
          EQ     PCS80       GO COMPLETE STATEMENT PROCESSING 
  
 PCS31    SA1    PCSOC
          SA2    =0LSA7 
          IX3    X2-X1
          ZR     X3,PCS32    IF *SA7* 
          SX4    B1 
          LX4    42          00000100000000000000B
          IX3    X3-X4
          ZR     X3,PCS32    IF *SA6* 
          SA2    =0LSA.7
          IX3    X2-X1
          ZR     X3,PCS32    IF *SA.7*
          LX4    -6          00000001000000000000B
          IX3    X3-X4
          NZ     X3,PCS33    IF NOT *SA.6*
 PCS32    SA6    PCSSTF      SET STORE FLAG 
          EQ     PCS50       GO PROCESS ADDRESS FIELD 
  
 PCS33    SA2    =0LR=
          IX3    X2-X1
          SX6    -B1
          NZ     X3,PCS50    IF OPCODE NOT *R=* 
          SA6    PCSSTF      SET STORE FLAG SO FIRST ADDRESS FIELD WILL 
                              BE CHECKED FOR A RESULT REGISTER
  
*         PROCESS ADDRESS FIELD.
  
 PCS50    RJ     FBF         FIND BEGINNING OF FIELD
          SA2    COMCOL 
          IX2    X6-X2
          PL     X2,PCS90    IF NO ADDRESS FIELD
  
*         IF OPCODE WAS *R=*, ADDRESS FIELD SHOULD BEGIN WITH REGISTER. 
  
          SA1    PCSSTF 
          PL     X1,PCS52    IF NOT *R=*
          RJ     GSE         GET STATEMENT ELEMENT
          NZ     B2,PCS90    IF NOT REGISTER
          BX7    X1          REGISTER INDEX 
          SX6    B1          SET FOR STORE
          R=     X3,X1-7     (X1) = 6 OR 7 FOR A6, A7, RESPECTIVELY 
          ZR     X3,PCS51    IF A6
          R=     X3,X3+7-6
          ZR     X3,PCS51    IF A7
          SX6    B0          SET FOR NOT A STORE
 PCS51    SA6    PCSSTF 
          SA7    PCSRR       SET RESULT REGISTER INDEX
 PCS52    RJ     GSE         GET STATEMENT ELEMENT
          SB3    B2-4 
          NZ     B3,PCS55    IF CANNOT BE *+ OR *-
          R=     X3,X1-1R*
          NZ     X3,PCS55    IF 1ST CHAR NOT *
          R=     X3,X2-1R-
          ZR     X3,PCS53    IF *-
          R=     X3,X2-1R+
          NZ     X3,PCS55    IF NEITHER *+ NOR *- 
 PCS53    SA2    PCSSTF 
          ZR     X2,PCS80    IF NOT A STORE INSTRUCTION 
          MX6    1           FORCE INTERMEDIATE FILE ENTRY TO BE LISTED 
          SA6    PCSE 
          EQ     PCS80       GO TO FINAL PROCESSING 
  
*         PROCESS REMAINING ADDRESS FIELDS.  FIRST CHECK FOR REGISTER.
  
 PCS54    RJ     GSE         GET STATEMENT ELEMENT
 PCS55    NZ     B2,PCS57    IF NOT A REGISTER
          SB3    X1          INDEX INTO *OR.REG* FOR PREVIOUS SYMBOLS 
          SA2    PCSVALC     (X2)= NUMBER OF SYMBOLS STORED IN *PCSVALS*
 PCS56    SA3    B3+OR.REG   NEXT SYMBOL, IF ANY
          ZR     X3,PCS54    IF NO MORE SYMBOLS FOR THIS REGISTER 
          SB7    X2-PCSNVAL 
          PL     B7,PCS80    IF MAXIMUM NUMBER OF SYMBOLS ALREADY STORED
          BX6    X3          STORE CURRENT SYMBOL 
          SA6    X2+PCSVALS 
          SX2    X2+B1       ADVANCE COUNT OF SYMBOLS STORED
          BX7    X2 
          SA7    A2 
          SB3    B3+NREG     ADVANCE FETCH INDEX
          EQ     PCS56       LOOP FOR NEXT *OR.REG* SYMBOL
  
*          CHECK FOR AN UN-QUALIFIED SYMBOL.
  
 PCS57    SB3    B0          (B3) = 0 FOR IMPLICIT QUALIFICATION
          MX5    0           (X5) = 0 FOR NO QUALIFIER INDEX
          EQ     B2,B1,PCS63 IF A SYMBOL WITHOUT QUALIFIER
  
*         CHECK FOR EXTERNAL (=X OR =Y).
  
          SX7    B2-3 
          NZ     X7,PCS58    IF NOT EXTERNAL
          SA2    O.EXT
          RJ     ANT         ADD NAME TO TABLE
          EQ     PCS63       GO PROCESS AS SYMBOL 
  
*         CHECK FOR // PRECEDING A SYMBOL.
  
 PCS58    SX7    B2-4 
          SB3    B1          (B3) = 1 FOR EXPLICIT QUALIFICATION
          NZ     X7,PCS59    IF CANNOT BE //
          SX3    X1-1R/ 
          NZ     X3,PCS80    IF 1ST CHAR NOT /
          SX4    X2-1R/ 
          NZ     X4,PCS80    IF 2ND CHAR NOT /
          EQ     PCS62       GO GET SYMBOL
  
*         CHECK FOR /(QUAL-NAME)/ PRECEDING A SYMBOL. 
  
 PCS59    SB2    B2-2 
          NZ     B2,PCS80    IF NOT A QUALIFIER NAME
          SX2    X2-1R/ 
          NZ     X2,PCS80    IF NAME NOT FOLLOWED BY /
  
*         QUALIFIER NAME FOUND.  IF NOT IN *O.QUL*, ADD IT. 
  
          SA2    O.QUL
          SA3    A2+B1       *O.QUL* LENGTH 
          SB2    X2          (B2) = FWA *O.QUL* 
          ZR     X3,PCS61    IF *O.QUL* EMPTY 
          SA5    B2+X3       SAVE (LWA+1) 
          BX7    X5 
          SB7    A5          (B7) = LWA+1 
          BX6    X1 
          SA6    A5          SET TARGET VALUE AT LWA+1
          SA4    B2-B1       FIRST-1 ENTRY
 PCS60    SA4    A4+B1       SEARCH LOOP
          BX4    X6-X4
          NZ     X4,PCS60    LOOP UNTIL HIT 
          SB6    A4 
          SA7    A5          RESTORE (LWA+1)
          EQ     B6,B7,PCS61  IF NAME NOT IN TABLE
          SX5    B6-B2       (X5) = INDEX OF QUALIFIER NAME 
          SX5    X5+B1
          EQ     PCS62
  
 PCS61    RJ     ADW         ADD NEW NAME TO *O.QUL*
                              (X1) = NEW NAME, (A2) = (X2) = O.QUL
          BX5    X3          (X5) = NEW TABLE LENGTH = QUAL-INDEX 
  
*         NEXT ELEMENT AFTER QUALIFIER MUST BE SYMBOL.
  
 PCS62    RJ     GSE         GET STATEMENT ELEMENT
          NE     B2,B1,PCS80 IF NOT A SYMBOL
 PCS63    SA2    PCSVALC
          SB7    X2-PCSNVAL 
          PL     B7,PCS80    IF MAXIMUM NUMBER OF SYMBOLS ALREADY STORED
          BX6    X5+X1       FORM NEW ENTRY AND STORE IN *PCSVALS*
          SX4    B3          G = 1 IF SYMBOL QUALIFIED
          LX4    9
          BX6    X4+X6
          LX6    -12         2/0,1/G,9/QUAL-INDEX,48/NAME 
          SA6    X2+PCSVALS 
          SX7    X2+B1       ADVANCE COUNT OF SYMBOLS STORED
          SA7    A2 
          EQ     PCS54       LOOP FOR NEXT ADDRESS FIELD
  
*         ADD LOCATION SYMBOL(S) TO *O.LOC* IF APPROPRIATE. 
  
 PCS80    SA2    PCSCLC      NZ IF CURRENT INSTRUCTION IS EXECUTABLE
          SA3    PCSPLC      NZ IF PREVIOUS INSTRUCTION WAS EXECUTABLE, 
                              AND NOT AN UNCONDITIONAL, UN-INDEXED JUMP 
          MX6    0
          SA1    PCSPVL      SYMBOL FROM A PREVIOUS BSS 0, IF ANY 
          BX2    X2+X3
          SA6    A1          CLEAR PREVIOUS SYMBOL
          ZR     X2,PCS82    IF EXECUTABLE CRITERIA NOT MET 
          SA5    PCSQI       CURRENT QUAL-INDEX 
          LX5    48 
          ZR     X1,PCS81    IF NO PREVIOUS LOCATION SYMBOL 
          LX1    -12         FORM *O.LOC* ENTRY 
          BX1    X1+X5       1/E,2/0,9/QUAL-INDEX,48/NAME 
          SA2    O.LOC
          RJ     ADW         ADD WORD TO TABLE
 PCS81    SA1    PCSLOC      SYMBOL FROM CURRENT INSTRUCTION, IF ANY
          ZR     X1,PCS82    IF NONE
          LX1    -12         FORM *O.LOC* ENTRY 
          BX1    X1+X5       1/E,2/0,9/QUAL-INDEX,48/NAME 
          SA2    O.LOC
          RJ     ADW         ADD WORD TO TABLE
  
*         IF THE CURRENT STATEMENT HAS A RESULT REGISTER, MOVE ENTRIES
*         FROM TABLE *PCSVALS* TO THE *OR.REG* ENTRIES FOR THE RESULT 
*         REGISTER.  IF THE RESULT REGISTER IS A1-5, ALSO CLEAR THE 
*         *OR.REG* ENTRIES FOR THE CORRESPONDING X-REGISTER.
  
 PCS82    SA1    PCSRCG 
          ZR     X1,PCS85    IF NO RESULT REGISTER
          SA2    PCSRR       RESULT REGISTER INDEX
          SX3    X2-8 
          ZR     X3,PCS85    IF RESULT REGISTER = B0
          SB5    B0          *PCSVALS* FETCH INDEX
          SB7    B0          SET FOR NOT CLEARING X-REGISTER
          R=     B6,PCSNVAL  NUMBER OF ENTRIES TO MOVE
          ZR     X2,PCS83    IF RESULT REGISTER = A0
          SX4    X2-6 
          MX7    0
          PL     X4,PCS83    IF NOT A1 - A5 
          SB7    B1          SET TO CLEAR X-REGISTER
 PCS83    SA3    B5+PCSVALS  NEXT SYMBOL (OR ZERO)
          BX6    X3 
          SB5    B5+B1       ADVANCE FETCH INDEX
          SA6    X2+OR.REG
          SX2    X2+NREG     ADVANCE STORE INDEX
          ZR     B7,PCS84    IF NOT TO CLEAR X-REGISTER 
          SA7    A6+16       CLEAR CORRESPONDING X-REGISTER 
 PCS84    LT     B5,B6,PCS83 LOOP 
  
*         CHECK IF AN INTERMEDIATE ENTRY IS TO BE ADDED.  IT IS IF: 
* 
*            1)  IT IS ALREADY FLAGGED AS TO BE ADDED.
*            2)  CURRENT INSTRUCTION IS A STORE, AND THERE IS AT LEAST
*                ONE NON-ZERO REFERENCE WORD FOR THE RESULT REGISTER IN 
*                *OR.REG*.
* 
  
 PCS85    SA5    PCSE        (X5) = FIRST WORD OF INT. FILE ENTRY 
          MI     X5,PCS87    IF ALREADY DETERMINED TO BE LISTED 
          SA4    PCSSTF 
          ZR     X4,PCS90    IF NOT A STORE INSTRUCTION 
          SA2    PCSRR       RESULT REGISTER INDEX
          SX2    X2+OR.REG
          SB5    B0          NUMBER OF ENTRIES FETCHED
          SB6    PCSNVAL     NUMBER OF ENTRIES TO FETCH 
          SB7    A5+B1       STORE POINTER
          MX4    0           ACCUMULATOR OF NON-NULL VALUES 
 PCS86    SA3    X2          GET NEXT ENTRY 
          BX4    X4+X3
          BX6    X3 
          SA6    B7          STORE WORD FOR INTERMEDIATE FILE 
          SX2    X2+NREG     ADVANCE FETCH POINTER
          SB5    B5+B1
          SB7    B7+B1       ADVANCE STORE POINTER
          LT     B5,B6,PCS86  LOOP
          ZR     X4,PCS90    IF NO SYMBOLS INDICATED IN THIS ENTRY, 
                              DO NOT PUT IT IN INTERMEDIATE FILE
  
*         ADD INTERMEDIATE ENTRY. 
  
 PCS87    SA2    PCSQI       STORE CURRENT QUALIFIER INDEX IN INT ENTRY 
          BX6    X2+X5
          SA6    A5 
          SB2    A5          (B2) = FWA OF INTERMEDIATE ENTRY 
          SB3    INTLTH      (B3) = LENGTH
          RJ     SIF         STORE INTERMEDIATE FILE
          SB2    ILINE       PLACE LINE IMAGE IN INTERMEDIATE FILE
          SB3    LINELTH
          RJ     SIF         STORE INTERMEDIATE FILE
  
*         ALL DONE - RETURN.
  
 PCS90    EQ     PCS         RETURN 
 PCSEXIT  EQU    PCS         RETURN LOCATION IF NO MORE TO DO FOR STMT
 PCSPROC  EQU    PCS80       RETURN LOCATION TO PROCESS LOCATION FIELD
  
 PCSID    CON    1           NZ IF BETWEEN *END* AND *IDENT*
 PCSCLC   CON    0           NZ IF CURRENT STATEMENT IS EXECUTABLE CODE 
 PCSPLC   CON    0           NZ IF PREVIOUS STATEMENT IS EXECUTABLE CODE
 PCSPVL   CON    0           ZERO OR LOCATION SYMBOL OF PREVIOUS STMT 
 PCSQI    CON    0           CURRENT QUALIFIER INDEX
 PCSA     BSS    0           START OF *PCS* TEMPORARY AREA TO BE CLEARED
 PCSE     BSSZ   INTLTH      INTERMEDIATE FILE ENTRY
 PCSVALC  CON    0           NUMBER OF ADRS FOR CURRENT RESULT REGISTER 
 PCSLOC   CON    0           ZERO OR LOCATION SYMBOL OF CURRENT STMT
 PCSOC    CON    0           CURRENT OPCODE WITH ACTUAL REGISTER NUMBER 
 PCSRR    CON    0           REGISTER INDEX OF CURRENT RESULT REGISTER
 PCSRCG   CON    0           NZ IF CURRENT STATEMENT CHANGES A REGISTER 
 PCSSTF   CON    0           NZ IF CURRENT STATEMENT IS A STORE 
 PCSNVAL  EQU    INTLTH-1    NUMBER OF ADDRESSES TO ASSOCIATE WITH EACH 
                              REGISTER (COULD BE SET AS HIGH AS 5)
 PCSVALS  BSSZ   PCSNVAL     ADDRESSES FOR CURRENT RESULT REGISTER
 PCSZ     BSS    0           END OF *PCS* TEMPORARY AREA TO BE CLEARED
 PCS      SPACE  4,8
**        INSTRUCTION TABLE.
* 
*         VFD    60/0L_NAME 
*         VFD    1/A,1/B,1/C,1/D,39/0,18/ADR
* 
*         WHERE  NAME = INSTRUCTION NAME
*                A    = 1 IF ANY CODE RESULTS (EXECUTABLE OR NON-EXEC)
*                B    = 1 IF OPCODE IS THAT OF AN EXECUTABLE INSTR
*                C    = 1 IF OPCODE HAS A RESULT REGISTER 
*                D    = 1 IF OPCODE HAS A RESULT REGISTER, BUT DUE TO 
*                         THE NATURE OF THE INSTRUCTION, ALL PREVIOUS 
*                         ASSOCIATED VALUES SHOULD BE DISCARDED.
*                ADR  = NZ IF ADDRESS OF PROCESSOR
*                       0 FOR NO ASSOCIATED ROUTINE 
  
  
 OPC      MACRO  NAME,A,B,C,D,ADR 
          VFD    60/0L_NAME,1/A,1/B,1/C,1/D,38/0,18/ADR 
 OPC      ENDM
  
 PCSITAB  BSS    0           BEGINNING OF INSTRUCTION TABLE 
  
*         STANDARD COMPASS OPCODES AND PSEUDO INSTRUCTIONS. 
  
          OPC    SA0,1,1,1
          OPC    SB0,1,1,1
          OPC    SX0,1,1,1
          OPC    BX0,1,1,1
          OPC    LX0,1,1,1
          OPC    AX0,1,1,1
          OPC    MX0,1,1,1,1
          OPC    EQ,1,1,0,0,PC.JUMP 
          OPC    NE,1,1 
          OPC    GE,1,1 
          OPC    LE,1,1 
          OPC    GT,1,1 
          OPC    LT,1,1 
          OPC    ZR,1,1,0,0,PC.JUMP 
          OPC    NZ,1,1 
          OPC    PL,1,1 
          OPC    MI,1,1 
          OPC    NG,1,1 
          OPC    RJ,1,1 
          OPC    JP,1,1,0,0,PC.JUMP 
          OPC    PS,1,1,0,0,UJUMP 
          OPC    IR,1,1 
          OPC    OR,1,1 
          OPC    DF,1,1 
          OPC    ID,1,1 
          OPC    NX0,1,1,1,1
          OPC    ZX0,1,1,1,1
          OPC    UX0,1,1,1
          OPC    PX0,1,1,1
          OPC    FX0,1,1,1,1
          OPC    DX0,1,1,1,1
          OPC    IX0,1,1,1
          OPC    RX0,1,1,1,1
          OPC    WX0,1,1
          OPC    NO,1,1 
          OPC    CX0,1,1,1,1
          OPC    R=,1,1,1 
          OPC    CR,1,1 
          OPC    CW,1,1 
          OPC    ES,1,1 
          OPC    RL,1,1 
          OPC    RE,1,1 
          OPC    WL,1,1 
          OPC    WE,1,1 
          OPC    MJ,1,1 
          OPC    XJ,1,1 
          OPC    RI,1,1 
          OPC    IB0,1,1,1,1
          OPC    TB0,1,1,1,1
          OPC    RO,1,1 
          OPC    OB0,1,1,1,1
          OPC    BSS,1,0,0,0,PC.BSS 
          OPC    BSSZ,1,0,0,0,PC.BSS
          OPC    COL
          OPC    CON,1
          OPC    DATA,1 
          OPC    END,0,0,0,0,PC.END 
          OPC    ENTRY,0,0,0,0,PC.ENT 
          OPC    ENTRYC,0,0,0,0,PC.ENT
          OPC    EQU,0,0,0,0,PC.EQU 
          OPC    EXT,0,0,0,0,PC.EXT 
          OPC    IDENT
          OPC    QUAL,0,0,0,0,PC.QUAL 
          OPC    VFD,1
 PCSTA    BSS    0           LWA+1 OF *COMPASS* INSTRUCTIONS AND PSEUDOS
  
*         SYSTEM MACROS OF INTEREST TO *CDCM*.  THESE ARE RECOGNIZED
*         ONLY IF THE *SM* OPTION IS SELECTED (DEFAULT).
  
          OPC    ABORT,1,1,0,0,UJUMP
          OPC    ENDRUN,1,1,0,0,UJUMP 
          OPC    SUBR,1,1 
 PCSTB    BSS    0           LWA+1 OF SYSTEM MACRO DEFINITIONS
  
  
*         LOCAL MACROS OF INTEREST TO *CDCM*.  THESE ARE RECOGNIZED 
*         ONLY IF THE *LM* OPTION IS SELECTED (DEFAULT=OFF).
  
          OPC    RTRN,1,1,0,0,UJUMP 
          OPC    SUBRTN,1,1 
          OPC    TABLE,1
 PCSTC    CON    0           LWA+1 OF LOCAL MACRO DEFINITIONS 
  
 PCSTT    CON    0           LOCATION TO STORE TARGET DURING SEARCH 
 PC.BSS   TITLE  PC.BSS - PROCESS *BSS* AND *BSSZ* STATEMENTS.
**        PC.BSS - PROCESS *BSS* AND *BSSZ* STATEMENTS. 
* 
*         *BSS* AND *BSSZ* STATEMENTS ARE COUNTED AS GENERATING 
*         (NON-EXECUTABLE) CODE, UNLESS THE ADDRESS FIELD CONTAINS ZERO.
  
  
 PC.BSS   BSS    0
          QUAL   PC.BSS 
          SA5    COMCOL 
          RJ     FBF         FIND BEGINNING OF ADDRESS FIELD
          IX5    X6-X5
          PL     X5,BSS2     IF NO ADDRESS FIELD (SAME AS BSS 0)
          RJ     GSE         GET STATEMENT ELEMENT
          SX1    X1-1R0 
          NZ     X1,BSS1     IF ADDRESS FIELD .NE. 0
          SX2    X2-1R
          ZR     X2,BSS2     IF ADDRESS FIELD .EQ. 0
 BSS1     SA3    PCSCLC      SET PREVIOUS EXEC CODE FLAG = CURRENT / 2
          AX6    X3,B1        (= 0 IF LAST INST. WAS UNCONDITIONAL JUMP)
          MX7    0           CURRENT EXEC CODE FLAG = 0 
          SA6    PCSPLC 
          SA7    A3 
          EQ     PCSPROC     GO COMPLETE STATEMENT PROCESSING 
  
 BSS2     SA1    PCSLOC      SAVE CURRENT LOCATION SYMBOL AS A PREVIOUS 
          BX6    X1           SYMBOL FROM BSS 0 
          SA6    PCSPVL 
          EQ     PCSEXIT     EXIT FROM *PCS*
  
          QUAL   *
 PC.END   TITLE  PC.END - PROCESS *END* STATEMENT.
**        PC.END - PROCESS *END* STATEMENT. 
* 
*         WHEN AN *END* STATEMENT IS ENCOUNTERED, THE FOLLOWING 
*         PROCESSING TAKES PLACE: 
* 
*         1) TABLE *O.LOC* IS CHECKED FOR MATCHING NAMES IN *O.ENT*, AND
*            THE *E* (ENTRY POINT) BIT IS SET IN EACH CORRESPONDING 
*            *O.LOC* ENTRY.  NOTE THAT *O.ENT* HAS ENTRIES ONLY FOR 
*            THE CURRENT PROGRAM UNIT.
* 
*         2) THE INTERMEDIATE FILE IS READ, AND EACH ENTRY IN TURN IS 
*            DISCARDED, UNLESS IT MEETS ONE OF THE FOLLOWING CONDITIONS:  
* 
*            - THE ENTRY IS FLAGGED AS TO BE LISTED.
*            - AT LEAST ONE OF THE SYMBOLS IN THE ENTRY HAS A MATCHING
*              NAME IN TABLE *O.EXT*, MEANING THIS ENTRY REPRESENTS AN
*              EXTERNAL.  IN THIS CASE, THE *E* BIT GETS SET IN THE 
*              ENTRY, SO THE ENTRY WILL BE RETAINED.
*            - AT LEAST ONE OF THE SYMBOLS IN THE ENTRY IS AN EXTERNAL. 
*            - AT LEAST ONE OF THE SYMBOLS IN THE ENTRY HAS A MATCHING
*              ENTRY IN TABLE *O.LOC*.  IN THIS CASE, THE ENTRY WILL
*              BECOME FLAGGED TO BE LISTED. 
* 
*            THIS PROCESSING NORMALLY CAUSES THE INTERMEDIATE FILE TO 
*            SHRINK TO A RELATIVELY SMALL SIZE AT THE END OF EACH 
*            PROGRAM UNIT.  FOR THIS REASON, IT IS RE-WRITTEN BY STORING
*            INTO CM OR LCM WHETHER OR NOT IT HAD PREVIOUSLY OVERFLOWED 
*            TO MASS-STORAGE.  SUBSEQUENTLY, IF IT OVERFLOWS AGAIN, IT
*            WILL THEN GO TO MASS-STORAGE, AND THIS PROCESS IS CONTINUED
*            USING TWO ALTERNATE SCRATCH FILES. 
* 
*         3) LOCATION SYMBOLS IN *O.LOC* WHICH ARE NOT THAT OF ENTRY
*            POINTS ARE DISCARDED.
* 
*         4) TABLES AND VARIABLES ARE RESET FOR THE NEXT PROGRAM UNIT.
* 
*         5) AFTER PROCESSING AN *END* PSEUDO, SUBSEQUENT STATEMENTS ARE
*            IGNORED UNTIL AN *IDENT* OR END OF FILE IS ENCOUNTERED.
  
  
 PC.END   BSS    0           ENTRY FROM *PCS* 
          QUAL   PC.END 
  
*         SET THE ENTRY POINT BIT IN ALL *O.LOC* ENTRIES FOR WHICH A
*         MATCHING NAME IS PRESENT IN TABLE *O.ENT*.
  
          SA1    O.LOC       (B2) = FWA *O.LOC* 
          SA2    A1+B1
          SB2    X1 
          ZR     X2,END10    IF *O.LOC* EMPTY 
          SA3    O.ENT       (B5) = FWA *O.ENT* 
          SA4    A3+B1
          SB3    B2+X2       (B3) = LWA+1 *O.LOC* 
          ZR     X4,END10    IF *O.ENT* EMPTY 
          SB5    X3 
          SA5    B5+X4       SAVE (LWA+1 *O.ENT*) 
          MX0    12 
          SB7    A5          (B7) = LWA+1 *O.ENT* 
 END1     SA1    B2          NEXT *O.LOC* ENTRY 
          MI     X1,END3     IF ALREADY SET AS AN ENTRY POINT 
          BX6    -X0*X1 
          LX6    12 
          SA6    A5          STORE TARGET VALUE AT (LWA+1 OF *O.ENT*) 
          SA3    B5-1        FIRST-1 ENTRY
 END2     SA3    A3+B1       SEARCH LOOP
          BX3    X3-X6
          NZ     X3,END2     LOOP UNTIL HIT 
          SB6    A3 
          EQ     B6,B7,END3  IF NAME NOT IN *O.ENT* 
          MX7    1
          BX1    -X0*X1 
          BX6    X1+X7       ADD ENTRY POINT BIT
          SA6    A1 
 END3     SB2    B2+B1       ADVANCE *O.LOC* FETCH POINTER
          LT     B2,B3,END1  LOOP FOR *O.LOC* ENTRIES 
          BX7    X5          RESTORE (LWA+1 OF *O.ENT*) 
          SA7    A5 
  
*         PROCESS INTERMEDIATE FILE.
  
 END10    SA2    SP+1 
          ZR     X2,END11    IF INTERMEDIATE FILE IN CM OR LCM
          WRITER X2,RCL      ISSUE EOR WRITE ON INTERMEDIATE FILE 
 END11    RJ     RWF         REWIND INTERMEDIATE FILE 
  
*         READ NEXT INTERMEDIATE ENTRY. 
  
 END12    RJ     RIF         READ INTERMEDIATE FILE 
          NZ     X1,END50    IF FINISHED READING INTERMEDIATE FILE
          SA3    INTENT      1ST WORD OF ENTRY
          MI     X3,END24    IF THIS ENTRY ALREADY FLAGGED
          SB6    B1          INDEX FOR WORD WITHIN ENTRY
          SB7    INTLTH      MAXIMUM INDEX + 1
          MX0    0           (X0) = KEEP / DO NOT KEEP FLAG 
 END13    SA2    B6+INTENT   NEXT SYMBOL (IF ANY) 
          ZR     X2,END15    IF NO SYMBOL 
          PL     X2,END16    IF NOT AN EXTERNAL 
 END14    SX0    B1          FLAG AS TO KEEP
 END15    SB6    B6+B1       ADVANCE INDEX
          LT     B6,B7,END13  LOOP FOR NUMBER OF SYMBOLS POSSIBLE (2) 
          ZR     X0,END12    IF NOT TO KEEP THIS ENTRY
          EQ     END24       GO KEEP THIS ENTRY 
  
*         IF SYMBOL NAME APPEARS IN EITHER *O.EXT* OR *O.ENT*, THEN SET 
*         THE ENTRY POINT FLAG AND CLEAR THE QUAL-INDEX FIELD FOR 
*         THIS ENTRY. 
  
 END16    SA1    O.EXT       (B2) = FWA OF *O.EXT*
          SB3    B0          INDICATE SEARCHING *O.EXT* 
 END17    SA3    A1+B1
          SB2    X1 
          ZR     X3,END19     IF TABLE EMPTY
          SB5    B2+X3       (B5) = LWA+1 TABLE 
          SA5    B5          SAVE (LWA+1) 
          MX7    12          LEFT JUSTIFY SYMBOL NAME FOR SEARCH
          BX6    X5 
          BX7    -X7*X2 
          LX7    12 
          SA7    B5          STORE TARGET AT (LWA+1)
          SA4    B2-B1       FIRST-1 ENTRY
 END18    SA4    A4+B1       NEXT ENTRY 
          BX4    X4-X7
          NZ     X4,END18    LOOP UNTIL HIT 
          SB4    A4 
          SA6    B5          RESTORE (LWA+1)
          EQ     B4,B5,END19  IF NAME NOT IN TABLE
          LX7    -12
          MX3    1           SET ENTRY POINT BIT IN INTERMEDIATE FILE 
          BX7    X7+X3        ENTRY 
          SA7    A2 
          EQ     END14       GO FLAG TO KEEP
  
 END19    NZ     B3,END20    IF BOTH *O.EXT* AND *O.ENT* SEARCHED 
          SB3    B1 
          SA1    O.ENT       NOW SEARCH *O.ENT* 
          EQ     END17
  
*         SEARCH *O.LOC* FOR CURRENT SYMBOL NAME.  QUALIFIERS ARE 
*         HANDLED AS FOLLOWS: 
* 
*         - IF THE REFERENCE (SYMBOL ENTRY IN THE INTERMEDIATE) IS
*           EXPLICITLY QUALIFIED (G=1), OR IF THE REFERENCE IS IN THE 
*           GLOBAL QUAL BLOCK, THEN THE NAME IN *O.LOC* MUST MATCH THE
*           QUALIFIER INDEX (THIS INCLUDES A QUALIFIER INDEX OF ZERO
*           FOR THE CASE OF AN EXPLICIT GLOBAL QUALIFICATION).
* 
*         - IF THE REFERENCE IS NOT EXPLICITLY QUALIFIED, AND IF
*           THE STORE INSTRUCTION IS NOT IN THE GLOBAL BLOCK, THEN UP TO
*           TWO (2) SEARCHES OF *O.LOC* WILL BE MADE.  THE FIRST WILL 
*           BE FOR A NAME HAVING THE SAME QUALIFIER INDEX AS THE ONE IN 
*           WHICH THE INSTRUCTION RESIDES, AND, IF NOT FOUND, THE SECOND
*           WILL BE FOR A NAME WITH A QUALIFIER INDEX OF ZERO.
  
 END20    MX7    -9          (X1) = QUAL-INDEX OF THIS INSTRUCTION
          SA1    INTENT 
          BX1    -X7*X1 
          SB2    B1          FLAG ONLY ONE SEARCH 
          BX3    X2          (X4) = QUAL-INDEX OF REFERENCE 
          LX3    12               = QUAL-INDEX TO USE IN SEARCH 
          BX4    -X7*X3 
          MX7    48 
          ZR     X1,END21    IF INSTRUCTION IN GLOBAL QUAL BLOCK
          LX3    -12+59-57   CHECK G FLAG 
          MI     X3,END21    IF EXPLICITLY QUALIFIED
          SB2    B0          FLAG TWO SEARCHES, IF NECESSARY
          BX4    X1          SET TO USE QUAL-INDEX OF INSTRUCTION 
 END21    BX3    X2          INTERMEDIATE FILE SYMBOL ENTRY 
          SA1    O.LOC       FWA OF *O.LOC* 
          LX3    12          PUT IN QUAL-INDEX FOR SEARCH 
          BX3    X7*X3
          BX6    X3+X4
          LX6    -12
          SA3    A1+B1       LENGTH OF *O.LOC*
          IX4    X1+X3       (B5) = LWA+1 *O.LOC* 
          ZR     X3,END15    IF *O.LOC* EMPTY 
          SB5    X4 
          SA5    B5          SAVE (LWA+1) 
          SA6    A5          STORE TARGET AT (LWA+1)
          SA4    X1-1        FIRST - 1 ENTRY
 END22    SA4    A4+B1       NEXT ENTRY 
          BX3    X4-X6
          NZ     X3,END22    LOOP UNTIL MATCH 
          BX6    X5          RESTORE (LWA+1)
          SB4    A4 
          MX7    48 
          SA6    B5 
          NE     B4,B5,END23  IF SYMBOL FOUND 
          NZ     B2,END15    IF NOT TO SEARCH USING GLOBAL QUALIFIER
          MX4    0           SET TO SEARCH FOR UNQUALIFIED SYMBOL 
          SB2    B1          SET TO INDICATE 2ND SEARCH 
          EQ     END21       REPEAT SEARCH
  
*         SYMBOL MATCHES WITH AN *O.LOC* ENTRY.  FLAG THIS INTERMEDIATE 
*         ENTRY TO BE LISTED. 
  
 END23    SA1    INTENT      SET *TO BE LISTED* BIT IN WD 0 OF ENTRY
          MX7    1
          BX7    X1+X7
          SA7    A1 
  
*         KEEP CURRENT INTERMEDIATE ENTRY.
  
 END24    SB2    INTENT 
          SB3    INTLTH+LINELTH 
          RJ     SIF         STORE INTERMEDIATE FILE
          EQ     END12       LOOP FOR NEXT INTERMEDIATE ENTRY 
  
*         FINISHED PROCESSING INTERMEDIATE FILE.  RESET VARIOUS 
*         INFORMATION FOR NEXT *IDENT*. 
  
 END50    SX7    B1 
          SA7    PCSID       SET *SKIPPING TO IDENT* FLAG 
          MX6    0
          SA6    PCSCLC      RESET CURRENT EXECUTABLE CODE FLAG 
          SA6    O.ENT+1     RESET ENTRY POINT NAME TABLE 
          SA6    O.EXT+1     RESET EXTERNAL NAME TABLE
          SA6    O.QUL+1     RESET QUALIFIER NAME TABLE 
          SA6    O.QUS+1     RESET QUALIFIER STACK TABLE
          SA6    PCSQI       RESET CURRENT QUALIFIER INDEX
          RJ     CRT         CLEAR REGISTER TABLE 
          SA1    O.LOC       SHRINK *O.LOC* TO ONLY LEAVE THOSE LOCATION
          SA2    A1+B1        SYMBOLS WHICH ARE ENTRY POINTS
          BX6    X2          (X6) = NEW LENGTH
          SB5    B0          (B5) = FETCH POINTER 
          SB6    B0          (B6) = STORE POINTER 
          SB7    X2 
 END51    ZR     B7,END53    IF NO MORE 
          SA3    X1+B5       NEXT ENTRY 
          SB7    B7-B1
          SB5    B5+B1       ADVANCE FETCH POINTER
          PL     X3,END52    IF NOT AN ENTRY POINT
          BX7    X3          STORE ENTRY
          SA7    X1+B6
          SB6    B6+B1       ADVANCE STORE POINTER
          EQ     END51       LOOP 
  
 END52    SX6    X6-1        DECREMENT NEW LENGTH 
          EQ     END51       LOOP 
  
 END53    SA6    A2          STORE UPDATED LENGTH 
          EQ     PCSEXIT     EXIT FROM *PCS*
  
          QUAL   *
 PC.ENT   TITLE  PC.ENT - PROCESS *ENTRY* AND *ENTRYC* STATEMENTS.
**        PC.ENT - PROCESS *ENTRY* AND *ENTRYC* STATEMENTS. 
* 
*         WHEN *ENTRY* OR *ENTRYC* IS ENCOUNTERED, THE SYMBOLS IN THE 
*         ADDRESS FIELD ARE ADDED TO THE TABLE *O.ENT* IF NOT ALREADY 
*         PRESENT.  AT *END* PROCESSING (IN *PC.END*), ALL NEW *O.LOC*
*         ENTRIES FOR THE CURRENT PROGRAM UNIT ARE CHECKED FOR A
*         MATCHING NAME IN *O.ENT*. 
  
  
 PC.ENT   BSS    0           ENTRY FROM *PCS* 
          QUAL   PC.ENT 
          SA5    COMCOL      BEGINNING DEFAULT COMMENT COLUMN 
          RJ     FBF         FIND BEGINNING OF FIELD
          IX5    X6-X5
          PL     X5,PCSEXIT  IF NO ADDRESS FIELD, EXIT
 ENT1     RJ     GSE         GET STATEMENT ELEMENT
          NE     B2,B1,PCSEXIT  IF NOT SYMBOL, ERROR
          SX5    X2-1R,      (X5) = 0 IF NOT END OF ADDRESS FIELD 
          SA2    O.ENT
          RJ     ANT         ADD NAME TO TABLE
          ZR     X5,ENT1     LOOP IF MORE SYMBOLS 
          EQ     PCSEXIT     EXIT FROM *PCS*
          QUAL   *
 PC.EQU   TITLE  PC.EQU - PROCESS *EQU* STATEMENT.
**        PC.EQU - PROCESS *EQU* STATEMENT. 
* 
*         AN *EQU* STATEMENT CAUSES AN ENTRY TO BE ADDED TO TABLE 
*         *O.LOC* IF THE ADDRESS FIELD VALUE IS CURRENTLY IN *O.LOC*. 
*         IF NOT FOUND, THE *EQU* STATEMENT IS IGNORED, BECAUSE 
*         *COMPASS* WOULD NOT HAVE DEFINED THE SYMBOL, AND ANY SUB- 
*         SEQUENT REFERENCES TO IT WOULD CAUSE AN ASSEMBLY ERROR. 
  
  
 PC.EQU   BSS    0           ENTRY FROM *PCS* 
          QUAL   PC.EQU 
          RJ     FBF         FIND BEGINNING OF FIELD
          SA2    COMCOL 
          MX0    1           SET TO TRY CURRENT QUAL-IND, THEN GLOBAL 
                              IF NECESSARY
          IX2    X6-X2
          PL     X2,PCSEXIT  IF NO ADDRESS FIELD, EXIT FROM *PCS* 
          RJ     GSE         GET STATEMENT ELEMENT
          EQ     B2,B1,EQU5  IF SYMBOL
  
*         CHECK FOR QUALIFIER.
  
          SB3    B2-2 
          NZ     B3,EQU2     IF NOT A QUALIFIED SYMBOL
          SX2    X2-1R/ 
          NZ     X2,PCSEXIT  IF NAME NOT FOLLOWED BY /
          SA2    O.QUL
          SA3    A2+B1       *O.QUL* LENGTH 
          ZR     X3,PCSEXIT  IF NO QUALIFIERS DEFINED, MUST BE ERROR
          SB2    X2          (B2) = FWA *O.QUL* 
          SA5    B2+X3       SAVE (LWA+1) 
          BX7    X5 
          SB7    A5          (B7) = LWA+1 
          BX6    X1 
          SA6    A5          SET TARGET VALUE AT LWA+1
          SA4    B2-B1       FIRST-1 ENTRY
 EQU1     SA4    A4+B1       SEARCH LOOP
          BX4    X6-X4
          NZ     X4,EQU1     LOOP UNTIL HIT 
          SB6    A4 
          SA7    A5          RESTORE (LWA+1)
          EQ     B6,B7,PCSEXIT  IF QUALIFIER NAME NOT IN TABLE, ERROR 
          SX0    B6-B2       (X0) = INDEX OF QUALFIER NAME
          SX0    X0+B1
          EQ     EQU4        GO GET SYMBOL
  
 EQU2     SB3    B2-4 
          NZ     B3,PCSEXIT  IF CANNOT BE //
          SX3    X1-1R/ 
          SX4    X2-1R/ 
          ZR     X3,EQU3     IF 1ST CHAR IS / 
          SX3    X1-1R*      CHECK FOR EQU  * 
          NZ     X3,PCSEXIT  IF 1ST CHAR NOT *
          SX4    X2-1R
          NZ     X4,PCSEXIT  IF 2ND CHAR NOT BLANK
          EQ     /PC.BSS/BSS2  GO PROCESS LOCATION SYMBOL SAME AS BSS 0 
  
 EQU3     NZ     X4,PCSEXIT  IF 2ND CHAR NOT /
          MX0    0           SET TO USE GLOBAL QUALIFIER
 EQU4     RJ     GSE         GET STATEMENT ELEMENT
          NE     B2,B1,PCSEXIT  IF NOT SYMBOL, ERROR
  
*         SYMBOL FOUND.  DETERMINE IF IN TABLE *O.LOC*. 
  
 EQU5     PL     X0,EQU7     IF A QUALIFIER WAS SPECIFIED 
          SA5    PCSQI       IF QUALIFIER IN EFFECT, SEARCH *O.LOC* 
          NZ     X5,EQU6     WITH CURRENT QUAL-INDEX
          MX0    0           NO QUALIFIER IN EFFECT SO ONLY SEARCH ONCE 
          EQ     EQU8         USING GLOBAL QUAL-INDEX = 0 
  
 EQU6     LX5    48          INDEX OF CURRENT QUALIFIER 
          EQ     EQU8 
  
 EQU7     BX5    X0          SET QUALIFIER INDEX
          LX5    48 
 EQU8     BX6    X1 
          LX6    -12
          SA2    O.LOC
          BX6    X5+X6       (X6) = VFD 3/0,9/(QUAL-IND),48/NAME
          SA3    A2+B1       *O.LOC* LENGTH 
          SB2    X2          (B2) = FWA *O.LOC* 
          ZR     X3,PCSEXIT  IF *O.LOC* EMPTY, ADDRESS UNDEFINED
          SA5    B2+X3       SAVE (LWA+1) 
          BX7    X5 
          SB7    A5          (B7) = LWA+1 
          SA6    A5          SET TARGET VALUE AT LWA+1
          SA4    B2-B1       FIRST-1 ENTRY
 EQU9     SA4    A4+B1       SEARCH LOOP
          BX4    X6-X4
          NZ     X4,EQU9     LOOP UNTIL HIT 
          SB6    A4 
          SA7    A5          RESTORE (LWA+1)
          NE     B6,B7,EQU10 IF LOCATION SYMBOL FOUND 
          PL     X0,PCSEXIT  IF LAST SEARCH WAS WAS GLOBAL
          MX0    0           NOW SEARCH WITH GLOBAL QUALIFICATION 
          SX5    B0 
          EQ     EQU7 
  
 EQU10    SA4    PCSLOC      CURRENT LOCATION SYMBOL
          SA1    PCSQI       CURRENT QUALIFIER INDEX
          ZR     X4,PCSEXIT  IF THERE WAS NO LOCATION SYMBOL
          BX1    X4+X1
          LX1    48          3/0,9/(QUAL-IND),48/0
          SA2    O.LOC
          RJ     ADW         ADD NEW ENTRY TO *O.LOC* 
          EQ     PCSEXIT     EXIT FROM *PCS*
  
          QUAL   *
 PC.EXT   TITLE  PC.EXT - PROCESS *EXT* STATEMENT.
**        PC.EXT - PROCESS *EXT* STATEMENT. 
* 
*         WHEN AN *EXT* STATEMENT IS ENCOUNTERED, THE SYMBOLS IN THE
*         ADDRESS FIELD ARE ADDED TO THE TABLE *O.EXT* IF NOT ALREADY 
*         PRESENT.  AT *END* PROCESSING IN *PC.END*, DURING THE 
*         PROCESSING OF ADDRESS FIELD SYMBOLS, ANY SYMBOL WHICH HAS A 
*         MATCHING ENTRY IN TABLE *O.EXT* WILL CAUSE THE EP BIT TO BE 
*         SET IN THE RESULTING INTERMEDIATE FILE ENTRY. 
  
  
 PC.EXT   BSS    0           ENTRY FROM *PCS* 
          QUAL   PC.EXT 
          SA5    COMCOL      BEGINNING DEFAULT COMMENT COLUMN 
          RJ     FBF         FIND BEGINNING OF FIELD
          IX5    X6-X5
          PL     X5,PCSEXIT  IF NO ADDRESS FIELD, EXIT
 EXT1     RJ     GSE         GET STATEMENT ELEMENT
          NE     B2,B1,PCSEXIT  IF NOT SYMBOL, ERROR
          SX5    X2-1R,      (X5) = 0 IF NOT END OF ADDRESS FIELD 
          SA2    O.EXT
          RJ     ANT         ADD NAME TO TABLE
          ZR     X5,EXT1     LOOP IF MORE SYMBOLS 
          EQ     PCSEXIT     EXIT FROM *PCS*
          QUAL   *
 PC.JUMP  TITLE  PC.JUMP - PROCESS JUMP INSTRUCTIONS. 
**        PC.JUMP - PROCESS JUMP INSTRUCTIONS.
* 
*         THIS ROUTINE IS USED FOR AN INSTRUCTION WHICH CAN BE AN 
*         UNCONDITIONAL JUMP, DEPENDING ON THE CONTENTS OF THE ADDRESS
*         FIELD.  FOR THE PURPOSES OF CDCM OUTPUT, UNCONDITIONAL
*         ACTUALLY MEANS NOT ONLY UNCONDITIONAL, BUT ALSO NOT LIKELY
*         TO JUMP INTO MODIFIED CODE.  THIS CONDITION IS CONSIDERED TO
*         BE MET IF ONLY IF ALL OF THE FOLLOWING CONDITIONS ARE MET:  
* 
*                A) THERE ARE NO REGISTERS IN THE ADDRESS FIELD.
*                B) THERE ARE NO *+ OR *- DESIGNATORS IN THE ADDRESS
*                   FIELD.  * BY ITSELF IS OK.
  
  
 PC.JUMP  BSS    0           ENTRY FROM *PCS* 
          QUAL   PC.JUMP
          SA1    PCSCLC      SET PREVIOUS EXEC CODE FLAG = CURRENT / 2
          SB3    X1          (B3) = CURRENT *PCSCLC* SETTING
          AX6    X1,B1        (= 0 IF LAST INST. WAS UNCONDITIONAL JUMP)
          R=     X7,2        CURRENT EXEC CODE FLAG = 2 FOR INSTRUCTIONS
          SA6    PCSPLC       OTHER THAN UNCONDITIONAL JUMPS
          SA7    A1 
          SA5    COMCOL      BEGINNING DEFAULT COMMENT COLUMN 
          RJ     FBF         FIND BEGINNING OF ADDRESS FIELD
          IX5    X6-X5
          PL     X5,JMP3     IF NO ADDRESS, EITHER UNCOND. OR ERROR 
 JMP1     RJ     GSE         GET NEXT ADDRESS FIELD ELEMENT 
          NZ     B2,JMP4     IF NOT A REGISTER
          SX1    X1-8        B0 REGISTER OK 
          NZ     X1,PCSPROC  NOT UNCONDITIONAL, GO COMPLETE PROCESSING
 JMP2     NZ     X4,JMP1     IF MORE ADDRESS FIELDS 
 JMP3     SX7    B1          SET FOR UNCONDITIONAL JUMP 
          SA7    PCSCLC 
          SA1    SO.JP
          ZR     X1,PCSPROC  IF *JP* NOT SELECTED 
          RJ     CRT         CLEAR REGISTER TABLE 
          EQ     PCSPROC     GO COMPLETE PROCESSING 
  
  
 JMP4     SX3    X1-1R*      CHECK FOR * IN ADDRESS FIELD 
          SX4    X2-1R       (X4) = 0 IF AT END OF ADDRESS FIELD
          NZ     X3,JMP2     IF ADDRESS DOES NOT BEGIN WITH * 
          ZR     X4,JMP3     IF ADDRESS FIELD CONTAINS * (ALONE)
          EQ     PCSPROC     NOT UNCONDITIONAL, GO COMPLETE PROCESSING
  
          QUAL   *
 UJUMP    EQU    /PC.JUMP/JMP3
 PC.QUAL  TITLE  PC.QUAL - PROCESS *QUAL* STATEMENT.
**        PC.QUAL - PROCESS *QUAL* STATEMENT. 
* 
*         A *QUAL* STATEMENT CAUSES THE TABLES *O.QUL* AND *O.QUS* TO 
*         BE UPDATED AND THE CURRENT QUALIFIER INDEX *PCSQI* TO BE
*         UPDATED.  THERE ARE THREE (3) CASES.
* 
*         1) ADDRESS FIELD CONTAINS A NAME:  NAME IS ADDED TO *O.QUL* 
*            IF NOT ALREADY THERE.  AN ENTRY IS ADDED TO *O.QUS*
*            CONTAINING THE CURRENT QUALIFIER INDEX.  *PCSQI* IS SET
*            TO THE CURRENT QUALIFIER INDEX.
* 
*         2) ADDRESS FIELD IS BLANK:  AN ENTRY IS ADDED TO *O.QUS* FOR
*            GLOBAL QUALIFICATION (ZERO VALUE).  *PCSQI* IS SET TO ZERO.
* 
*         3) ADDRESS FIELD CONTAINS *:  IF THERE ARE ANY ENTRIES IN 
*            *O.QUS*, THE LAST ONE IS REMOVED, THUS POPPING THE STACK.
*            *PCSQI* IS SET TO THE QUALIFIER INDEX FROM THE PREVIOUS
*            *O.QUS* ENTRY (OR ZERO IF *O.QUS* IS EMPTY). 
  
  
 PC.QUAL  BSS    0           ENTRY FROM *PCS* 
          QUAL   PC.QUAL
          RJ     FBF         FIND BEGINNING OF FIELD
          SA2    COMCOL 
          IX2    X6-X2
          PL     X2,QUL3     IF NO ADDRESS FIELD
          RJ     GSE         GET STATEMENT ELEMENT
          NE     B2,B1,QUL5  IF NOT A SYMBOL
          SA2    O.QUL
          SA3    A2+B1       *O.QUL* LENGTH 
          ZR     X3,QUL2     IF *O.QUL* EMPTY 
          SB2    X2          (B2) = FWA *O.QUL* 
          SA5    B2+X3       SAVE (LWA+1) 
          BX7    X5 
          SB7    A5          (B7) = LWA+1 
          BX6    X1 
          SA6    A5          SET TARGET VALUE AT LWA+1
          SA4    B2-1        FIRST-1 ENTRY
 QUL1     SA4    A4+B1       SEARCH LOOP
          BX4    X6-X4
          NZ     X4,QUL1     LOOP UNTIL HIT 
          SB6    A4 
          SA7    A5          RESTORE (LWA+1)
          EQ     B6,B7,QUL2  IF QUALIFIER NAME NOT IN TABLE 
          SX1    B6-B2       (X1) = INDEX OF QUALIFIER NAME 
          SX1    X1+B1
          EQ     QUL4        GO ADD TO *O.QUS*
  
 QUL2     RJ     ADW         ADD WORD TO TABLE *O.QUL*
                              (X1) = NEW NAME, (A2) = (X2) = O.QUL
          BX1    X3          (X1) = NEW LENGTH OF *O.QUL* 
          EQ     QUL4             = CURRENT QUAL-INDEX
  
 QUL3     MX1    0           SET QUAL-INDEX = 0 
 QUL4     SA2    O.QUS
          RJ     ADW         ADD WORD TO TABLE *O.QUS*
          SA6    PCSQI       SET CURRENT QUAL-INDEX 
          EQ     PCS90       RETURN TO MAIN STATEMENT PROCESSOR 
  
 QUL5     SB2    B2-4 
          NZ     B2,PCS90    IF NOT QUAL *
          SX1    X1-1R* 
          NZ     X1,PCS90    IF NOT QUAL *
          SX2    X2-1R
          NZ     X2,PCS90    IF NOT QUAL *
  
*         QUAL * FOUND.  REMOVE THE TOP ENTRY FROM THE QUALIFIER STACK
*         AND SET THE CURRENT QUALIFIER INDEX TO THAT OF THE PREVIOUS 
*         ENTRY.
  
          SA2    O.QUS+1     *O.QUS* LENGTH 
          MX6    0           SET FOR ZERO QUAL-INDEX
          SA1    A2-B1       *O.QUS* FWA
          ZR     X2,QUL6     IF *O.QUS* ALREADY EMPTY 
          SX6    X2-1        SHORTEN BY ONE ENTRY 
          SA6    A2 
          ZR     X6,QUL6     IF NOW EMPTY 
          IX3    X1+X6       NEW LWA+1
          SA4    X3-1        GET THE NEW TOP ENTRY
          BX6    X4 
 QUL6     SA6    PCSQI       SET CURRENT QUAL-INDEX 
          EQ     PCSEXIT     EXIT FROM *PCS*
  
          QUAL   *
 ADW      TITLE  INTERMEDIATE FILE AND TABLE MANAGEMENT.
**        ADW - ADD WORD TO TABLE IN CMM VARIABLE BLOCK.
* 
*         ADDS A WORD TO A MANAGED TABLE.  CMM VARIABLE-POSITION BLOCKS 
*         ARE USED FOR THE TABLES TO ALLOW FOR THE FLEXIBILITY TO 
*         INTERFACE WITH OTHER LANGUAGES IN THE FUTURE. 
* 
*         TABLE POINTERS ARE OF THE FOLLOWING FORMAT: 
* 
*         WD 0   VFD    30/(BLOCK-SIZE),30/(BLOCK-FWA)
*         WD 1   VFD    42/0,18/LENGTH
*         WD 2   VFD    42/0,18/INCR
* 
*         WORD 0 IS THE POINTER WORD WHICH IS MAINTAINED BY CMM.  IT IS 
*         SET TO ZERO UNTIL THE BLOCK IS FIRST ALLOCATED. 
* 
*                LENGTH = LENGTH OF ACTUAL DATA IN BLOCK.  THIS IS
*                         UPDATED BY *ADW* OR BY ANY USERS OF THE BLOCK.
*                INCR   = AMOUNT BY WHICH THE BLOCK-SIZE IS INCREASED 
*                         WHENEVER AN INCREASE IS NECESSARY.  MAY BE
*                         MODIFIED AT RUN-TIME IF DESIRED.
* 
* 
*         ENTRY  (X1) = WORD. 
*                (X2) = CMM POINTER WORD. 
*                (B1) = 1.
*                (A2) = TABLE POINTER.
* 
*         EXIT   (X1) = (X6) = WORD.
*                (X2) = FWA OF TABLE. 
*                (X3) = LENGTH OF TABLE.
*                (B1) = 1.
*                (A6) = ADDRESS OF WORD.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  CMM.ALV, CMM.GLV.
  
  
 ADW      EQ     *+1S17      ENTRY / EXIT 
 ADW1     SA3    A2+B1       USED LENGTH
          BX6    X2          (B7) = CMM LENGTH
          SB6    X3          (B6) = USED LENGTH 
          AX6    30 
          SB7    X6 
          LT     B6,B7,ADW4  IF ROOM FOR ANOTHER WORD 
          BX6    X1          SAVE X1 AND A2 
          SX7    A2 
          SA6    ADWSV
          SA7    A6+B1
          NZ     X2,ADW2     IF TABLE ALREADY ALLOCATED 
          SX4    A2          (X4) = ADDRESS OF POINTER WORD 
          SX3    3*1S6+1     SIZE-CODE = 3 (LWA CAN GROW OR SHRINK) 
                             TYPE-CODE = 1 (CMM UPDATES POINTER WORD) 
          SA2    A3+B1       (X2) = BLOCK-SIZE
          RJ     =XCMM.ALV   ALLOCATE VARIABLE BLOCK
          EQ     ADW3        GO RESTORE ENTRY REGISTERS 
  
 ADW2     BX1    X2          (X1) = BLOCK-FWA 
          SA2    A3+B1       (X2) = AMOUNT OF INCREASE
          RJ     =XCMM.GLV   GROW BLOCK AT LWA
  
 ADW3     SA1    ADWSV       RESTORE X1 AND A2
          SA2    A1+B1
          SA2    X2 
          EQ     ADW1        REPEAT 
  
 ADW4     BX6    X1          (X6) = WORD
          SA6    X2+B6       STORE WORD IN TABLE
          SX7    X3+B1       ADVANCE TABLE USED LENGTH
          BX3    X7          (X3) = NEW USED LENGTH 
          SA7    A3 
          EQ     ADW         RETURN 
  
 ADWSV    BSSZ   2           REGISTER SAVE AREA 
 AWS      TITLE  INTERMEDIATE FILE AND TABLE MANAGEMENT.
**        AWS - ALLOCATE WORK SPACE FOR INTERMEDIATE FILE.
* 
*         ALLOCATES ADDITIONAL WORK SPACE FOR THE INTERMEDIATE FILE.
*         THE FILE IS INITIALLY TARGETTED FOR EITHER CM OR LCM BY *CWS*,
*         WHICHEVER HAS THE LARGER AVAILABLE AREA.
* 
*         IF IN CM, A VARIABLE-POSITION *CMM* BLOCK IS USED, AND IS 
*         INCREASED, WHEN NECESSARY, BY *FLINC* WORDS, UP TO THE
*         ALLOWED MAXIMUM.  IF IN LCM, THE SPACE IS OBTAINED DIRECTLY 
*         BY ISSUING *MEMORY* REQUESTS FOR *FLINL* WORDS, UP TO THE 
*         ALLOWED MAXIMUM.
* 
*         IF EITHER THE CM OR LCM AREA EXCEEDS THE ALLOWED MAXIMUM, THEN
*         AN ERROR STATUS IS RETURNED, AND NO FURTHER ALLOCATION TAKES
*         PLACE.
* 
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   (X6) = 0 IF SPACE WAS OBTAINED.
*                       -1 IF WORK SPACE OVERFLOW.
*                (B1) = 1.
*                IFWA = 0 IF WORK SPACE IS IN LCM.
*                       NZ FWA IF IN CM.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  CMM.ALV, CMM.GLV, SYS=.
  
  
 AWS      EQ     *+1S17      ENTRY / EXIT 
          SA1    IMAX        MAXIMUM WORKSPACE SIZE 
          SA3    IFWA        WORKSPACE FWA
          SA4    AWSM        CURRENT WORKSPACE SIZE 
          IX6    X1-X4       (MAX) - (CURRENT)
          SB7    X3 
          ZR     X3,AWS3     IF FWA = 0, THEN WORKSPACE IS IN LCM 
  
*         CHECK IF ROOM FOR MORE CM WORKSPACE.
  
          SX7    FLINC       AMOUNT OF INCREASE FOR CM
          ZR     X6,AWS5     IF CM WORKSPACE FULL 
  
*         ALLOCATE ADDITIONAL CM WORKSPACE. 
  
          IX2    X6-X7       (X7) = MIN (FLINC, (MAX-CURRENT) ) 
          PL     X2,AWS1
          BX7    X6 
 AWS1     IX6    X4+X7       UPDATE CURRENT SIZE
          SA6    A4 
          BX2    X7          (X2) = BLOCK-SIZE OR AMOUNT OF INCREASE
          NE     B7,B1,AWS2  IF NOT FIRST REQUEST FOR CM WORKSPACE
          SX3    3*1S6+1     SIZE-CODE = 3 (LWA CAN GROW OR SHRINK) 
                             TYPE-CODE = 1 (CMM MAINTAINS POINTER WORD) 
          SX4    IFWA        ADDRESS OF POINTER WORD
          RJ     =XCMM.ALV   ALLOCATE VARIABLE BLOCK
          SX6    B0 
          EQ     AWS         RETURN 
  
 AWS2     SA1    IFWA        (X1) = BLOCK-FWA 
          RJ     =XCMM.GLV   GROW BLOCK AT LWA
          SX6    B0 
          EQ     AWS         RETURN 
  
*         CHECK IF ROOM FOR MORE LCM WORKSPACE. 
  
 AWS3     SX7    FLINL       AMOUNT OF INCREASE FOR LCM 
          ZR     X6,AWS5     IF ALREADY AT MAXIMUM
  
*         ALLOCATE ADDITIONAL SPACE FOR WORKSPACE IN LCM. 
  
          IX2    X6-X7       (X7) = MIN (FLINL, (MAX-CURRENT) ) 
          PL     X2,AWS4
          BX7    X6 
 AWS4     IX7    X4+X7       UPDATE CURRENT SIZE
          SA7    A4 
          LX7    30          FORM *MEMORY* REQUEST FOR NEW LCM FL 
          SA7    MEMARG 
          MEMORY ECS,MEMARG,RCL  REQUEST LCM FL 
          SX6    B0 
          EQ     AWS         RETURN 
  
*         WORKSPACE OVERFLOW. 
  
 AWS5     SX6    -B1
          EQ     AWS         RETURN 
  
 AWSM     CON    0           CURRENT SIZE OF CM OR LCM WORKSPACE
 CVL      TITLE  INTERMEDIATE FILE AND TABLE MANAGEMENT.
**        CALLS THE PP PROGRAM *CVL*. 
* 
*         ENTRY  (X1) = ADDRESS OF PARAMETER BLOCK. 
*                (X2) = REQUEST.
*                (B1) = 1.
* 
*         EXIT   (B1) = 1.
* 
*         USES   X - 1, 2, 6. 
*                B - NONE.
*                A - NONE.
* 
*         CALLS  SYS=.
  
  
 CVL1     RJ     SYS=        MAKE RA+1 CALL 
  
 CVL=     PS                 ENTRY/EXIT 
          MX6    -18         POSITION PARAMETER BLOCK ADDRESS 
          BX1    -X6*X1 
          LX2    18 
          SX6    4RCVLP/16   SET *CVL* CALL 
          BX1    X2+X1       MERGE REQUEST
          LX6    40 
          BX6    X6+X1
          EQ     CVL1        MAKE CALL
 CWS      TITLE  INTERMEDIATE FILE AND TABLE MANAGEMENT.
**        CWS - COMPUTE MAXIMUM SIZE FOR WORK SPACE.
* 
*         DETERMINES THE AMOUNT OF AVAILABLE WORK SPACE FOR THE 
*         INTERMEDIATE FILE.  IT IS ALLOCATED TO EITHER CM OR LCM, BUT
*         NOT BOTH.  IF NOT ON A 180-CLASS MODEL OR A 176 (I.E., A MODEL
*         WITH DIRECT-ACCESS LCM ACCESSIBLE VIA *RXI* OR *WXI* INSTRUC- 
*         TIONS), WORKSPACE MUST GO TO CM.  THE AMOUNT IS DETERMINED BY 
*         THE FOLLOWING:  
* 
*           SPACE = MAX [MIN(AVAILCM,MAXC), MIN((MAXFLLCM-FUDL),MAXL)]
* 
*         WHERE AVAILCM  = AVAILABLE AMOUNT OF CM (ACCORDING TO CMM). 
*               MAXC     = MAXIMUM AMOUNT OF CM THAT WILL BE USED 
*                          (INSTALLATION OPTION). 
*               MAXFLLCM = LCM MAXFL. 
*               FUDL     = AMOUNT TO REDUCE LCM MAXFL TO ENSURE WE CAN
*                          GET IT (INSTALLATION OPTION).
*               MAXL     = MAXIMUM AMOUNT OF LCM THAT WILL BE USED
*                          (INSTALLATION OPTION). 
* 
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   (B1) = 1.
*                IFWA = 0 IF WORKSPACE TO GO IN LCM.
*                       1 IF WORKSPACE TO GO IN CM. 
*                IMAX = MAXIMUM ALLOWABLE SIZE OF WORKSPACE.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 7. 
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  CMM.GFS, CVL=, SYS=. 
  
  
 CWS      EQ     *+1S17      ENTRY / EXIT 
          SX1    B1          GET SIZE OF LARGEST BLOCK THAT CMM WILL
          SX2    B0           ALLOCATE UP TO MAXFL
          RJ     =XCMM.GFS
          AX6    6
          SX6    X6-1        ROUND DOWN 100-177B CM WORDS 
          LX6    6
          SX4    MAXC        INSTALLATION-DEFINED MAXIMUM SIZE FOR CM 
          IX3    X6-X4       (X6) = MIN (AVAILCM,MAXC)
          MI     X3,CWS1
          BX6    X4 
 CWS1     SB7    X6          SAVE CM VALUE
          GETMC  GETMCW      GET MACHINE CHARACTERISTICS
          SA2    GETMCW 
          MX3    3           EXAMINE BITS 18-20 (180-CLASS OR 176)
          LX2    59-20
          BX2    X3*X2
          MX7    0           SET FOR ZERO AVAILABLE LCM 
          ZR     X2,CWS2     IF NOT RUNNING ON 180-CLASS OR 176 MODEL 
          MEMORY ECS,MEMARG,RCL  GET MAXFL FOR LCM
          SA1    MEMARG 
          AX1    30 
          SX7    X1-FUDL
          SX4    MAXL        INSTALLATION-DEFINED MAXIMUM LCM SIZE
          IX3    X7-X4       (X7) = MIN ( (MAXFLLCM-FUDL), MAXL)
          MI     X3,CWS2
          BX7    X4 
 CWS2     SX6    B0          SET FOR *IFWA* = 0 IF USING LCM
          SX4    B7 
          IX3    X7-X4       LCM - CM 
          PL     X3,CWS3     IF (LCM) .GE. (CM) 
          SX6    B1          SET FOR *IFWA* = 1 IF USING CM 
          BX7    X4 
 CWS3     SA7    IMAX        SAVE WORKSPACE SIZE
          SA6    IFWA        SAVE CM / LCM INDICATOR
          EQ     CWS         RETURN 
  
 GETMCW   CON    0           *GETMC* ARGUMENT WORD
 MEMARG   VFD    30/-1,30/0  *MEMORY* ARGUMENT WORD 
 RIF      TITLE  INTERMEDIATE FILE AND TABLE MANAGEMENT.
**        RIF - READ INTERMEDIATE FILE. 
* 
*         READS ONE ENTRY FROM THE INTERMEDIATE FILE.  IF IN CM OR LCM, 
*         THE POSITION IS DETERMINED BY THE POINTERS AS INDICATED BELOW.
*         IF ON A FILE, *RDW=* IS CALLED. 
* 
*         ENTRY  (B1) = 1.
*                *IFWA*   = FWA OF THE WORKSPACE IF IN CM OR LCM. 
*                *IFETCH* = CURRENT POSITION IF IN CM OR LCM. 
*                *ISIZE*  = LWA+1 OF DATA IF IN CM OR LCM.
* 
*         EXIT   (X1) = 0 IF ENTRY READ.
*                       NZ IF AT END OF INTERMEDIATE FILE.
*                (B1) = 1.
*                ENTRY IS STORED AT *INTENT*. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  RDW=.
  
  
*         READ INTERMEDIATE ENTRY FROM LCM. 
  
 RIF1     SX7    B1          (X7) = 1 
          RX6    X4          READ 1ST WORD
          SB4    B1          (B4) = NUMBER OF WORDS READ
          SA6    INTENT      STORE 1ST WORD 
 RIF2     IX4    X4+X7       ADVANCE LCM FETCH ADDRESS
          RX6    X4          READ WORD
          SB4    B4+B1       ADVANCE WORD COUNT 
          SA6    A6+B1       STORE WORD 
          LT     B4,B7,RIF2  LOOP 
          MX1    0           (X1) = 0 FOR TRANSFER COMPLETE 
  
*         ENTRY / EXIT. 
  
 RIF      EQ     *+1S17      ENTRY / EXIT 
          SA2    SP 
          NZ     X2,RIF4     IF INTERMEDIATE ON FILE
          SA2    IFWA        NZ IF CM, ZR IF LCM
          SA3    ISIZE       LENGTH OF STORED DATA
          SA4    IFETCH      (X4) = FETCH POINTER 
          IX6    X4-X3
          SX1    -B1         SET FOR EOI STATUS 
          PL     X6,RIF      IF AT END OF INTERMEDIATE FILE 
          SB7    INTLTH+LINELTH  (B7) = ENTRY LENGTH
          SX7    X4+B7       ADVANCE FETCH POINTER
          SA7    A4 
          ZR     X2,RIF1     IF INTERMEDIATE IN LCM 
          IX2    X4+X2       (X2) = SOURCE
          SX3    INTENT      (X3) = DESTINATION 
          MX7    -1 
 RIF3     SA1    X2          MOVE LOOP
          BX6    X1 
          SA6    X3 
          IX2    X2-X7       ADVANCE SOURCE 
          IX3    X3-X7       ADVANCE DESTINATION
          SB7    B7-B1
          NZ     B7,RIF3     LOOP 
          MX1    0           (X1) = 0 FOR TRANSFER COMPLETE 
          EQ     RIF         RETURN 
  
*         READ INTERMEDIATE FROM FILE.
  
 RIF4     READW  X2,INTENT,INTLTH+LINELTH 
          EQ     RIF         RETURN, (X1) = STATUS
  
 INTENT   BSS    INTLTH      INTERMEDIATE FILE ENTRY
 ILINE    BSS    LINELTH     LINE IMAGE PART OF INTERMEDIATE FILE ENTRY 
 RWF      TITLE  INTERMEDIATE FILE AND TABLE MANAGEMENT.
**        RWF - REWIND INTERMEDIATE FILE. 
* 
*         IF THE INTERMEDIATE FILE IS IN CM OR LCM, THE POINTERS ARE
*         RESET.  IF ON MASS-STORAGE, A *REWIND* IS ISSUED, FOLLOWED BY 
*         A *READ* TO BEGIN THE READING OF DATA WHICH ALWAYS FOLLOWS. 
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   (B1) = 1.
* 
*         USES   X - 1, 2, 6, 7.
*                B - NONE.
*                A - 1, 2, 6, 7.
* 
*         CALLS  CIO=.
  
  
 RWF      EQ     *+1S17      ENTRY / EXIT 
          SA1    INEXT       SET WORKSPACE SIZE FOR READ
          MX7    0           RESET FETCH AND STORE POINTERS 
          BX6    X1 
          SA6    ISIZE
          SA7    A1 
          SA7    IFETCH 
          SA2    SP          CHECK PREVIOUS INTERMEDIATE (SCRATCH-1)
          ZR     X2,RWF1     IF SCRATCH-1 NOT USED
          RETURN X2          RETURN SCRATCH-1 
  
 RWF1     SA2    SP+1        SET INTERMEDIATE JUST WRITTEN TO NOW BE
          BX7    X2           READ (SCRATCH-2 -> SCRATCH-1) 
          SA7    A2-B1
          MX6    0           CLEAR SCRATCH-2 TO START OVER IN CM/LCM
          SA6    A2 
          ZR     X2,RWF      IF SCRATCH-2 NOT ON FILE 
          REWIND X2          REWIND SCRATCH-2 
          READ   X2          BEGIN READ OF INTERMEDIATE 
          EQ     RWF         RETURN 
 SIF      TITLE  INTERMEDIATE FILE AND TABLE MANAGEMENT.
**        SIF - STORE INTERMEDIATE FILE.
* 
*         STORES INFORMATION INTO THE INTERMEDIATE FILE, EITHER CM, LCM,
*         OR MASS-STORAGE.  INCREASES THE WORK SPACE IF NECESSARY.
*         IF THE WORKSPACE CANNOT BE INCREASED, THEN THE WORKSPACE IS 
*         WRITTEN TO A FILE, AND THAT FILE IS USED FOR THE REMAINDER OF 
*         THE CURRENT PROGRAM UNIT. 
* 
*         ENTRY  (B1) = 1.
*                (B2) = FWA OF DATA 
*                (B3) = LENGTH OF DATA. 
*                *IFWA*   = FWA OF THE WORKSPACE IF IN CM OR LCM. 
*                *INEXT*  = CURRENT STORE POINTER IF IN CM OR LCM.
* 
*         EXIT   (B1) = 1.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  AWS, WTO=, WTW=. 
  
  
 SIF      EQ     *+1S17      ENTRY / EXIT 
          SA2    SP+1 
          NZ     X2,SIF11    IF WORKSPACE ON FILE 
  
*         CHECK IF ROOM TO STORE ENTRY IN CURRENT WORKSPACE.
  
 SIF1     SA1    INEXT       NEXT AVAILABLE WORD IN WORK SPACE
          SA2    AWSM        CURRENT SIZE 
          SX1    X1+B3
          IX7    X2-X1
          PL     X7,SIF7     IF ROOM FOR THIS INSERTION 
  
*         INCREASE WORKSPACE SIZE, IF POSSIBLE. 
  
          RJ     AWS         ALLOCATE WORK SPACE
          MI     X6,SIF2     IF WORKSPACE OVERFLOW, COPY TO FILE
          EQ     SIF1        TRY AGAIN
  
*         COPY WORKSPACE TO A FILE. 
  
 SIF2     SX6    B2          SAVE B2 AND B3 
          SX7    B3 
          SA6    SIFA 
          SA7    A6+B1
          SX7    X           SET FOR SCRATCH-1
          SA1    SF 
          ZR     X1,SIF3     IF TO USE SCRATCH-1
          SX7    Y           SET FOR SCRATCH-2
 SIF3     SA7    SP+1        SET FILE NAME FOR INTERMEDIATE WRITE 
          SX3    B1 
          BX6    X1-X3       REVERSE FILE FLAG
          SA6    A1 
          SX2    X7          (X2) = FET ADDRESS 
          SA1    IFWA 
          SA3    INEXT       (X3) = STORE POINTER = AMOUNT TO TRANSFER
          ZR     X1,SIF5     IF WORKSPACE IN LCM
          WRITEW X2,X1,X3 
 SIF4     SA2    SP+1        (X2) = FET ADDRESS 
          SA3    SIFA        RESTORE B2 AND B3
          SA4    A3+B1
          SB2    X3 
          SB3    X4 
          EQ     SIF11       GO WRITE CURRENT ENTRY TO FILE 
  
 SIF5     SX0    B0          (X0) = TRANSFER ADDRESS
          BX5    X3          (X5) = AMOUNT TO TRANSFER
          SB2    X7          (B2) = FET ADDRESS 
 SIF6     RX6    X0          READ WORD FROM LCM 
          WRITEO B2          WRITE WORD FROM (X6) 
          SX1    B1 
          IX0    X0+X1       ADVANCE TRANSFER ADDRESS 
          IX5    X5-X1       REDUCE TRANSFER COUNT
          NZ     X5,SIF6     LOOP 
          EQ     SIF4        TRANSFER COMPLETE
  
*         ADD ENTRY TO WORKSPACE. 
  
 SIF7     SA1    IFWA 
          SA2    INEXT       STORE POINTER
          IX6    X1+X2
          SB7    X6          INITIALIZE STORE ADDRESS 
          SA3    B2-B1       INITIALIZE FETCH ADDRESS 
          SB4    B0          INITIALIZE COUNT 
          SX7    X2+B3       ADVANCE *INEXT*
          SA7    A2 
          ZR     X1,SIF9     IF IN LCM
 SIF8     SA3    A3+B1       FETCH WORD 
          BX6    X3 
          SA6    B7          STORE WORD 
          SB4    B4+B1       ADVANCE COUNT
          SB7    B7+B1       ADVANCE STORE ADDRESS
          LT     B4,B3,SIF8  LOOP 
          EQ     SIF         RETURN 
  
 SIF9     SA3    A3+B1       FETCH FIRST WORD 
          SX7    X2          INITIALIZE STORE ADDRESS 
 SIF10    WX3    X7          STORE WORD 
          SB4    B4+B1       ADVANCE COUNT
          SA3    A3+B1       FETCH NEXT WORD
          SX7    X7+B1       ADVANCE STORE ADDRESS
          LT     B4,B3,SIF10 LOOP 
          EQ     SIF         RETURN 
  
*         WRITE INTERMEDIATE ENTRY TO FILE. 
  
 SIF11    WRITEW X2,B2,B3    WRITE INTERMEDIATE 
          EQ     SIF         RETURN 
  
 SIFA     CON    0,0         B2, B3 SAVE AREA 
 INF      TITLE  INPUT/OUTPUT ROUTINES. 
**        INF - INITIALIZE FILES. 
* 
*         PERFORMS INITIALIZATION OF FILES USED BY CDCM AS FOLLOWS: 
* 
*         - FOR THE INPUT FILE: 
*           - GETS THE INPUT FILE NAME FROM ENTRY POINT *LFNI* AND
*             STORES IT IN FET *I*. 
*           - ISSUES A *REWIND* ON *I* (UNLESS THE FILE NAME = *INPUT*).
*           - ISSUES THE FIRST *READ* ON *I*. 
*         - IF LIST OUTPUT IS SPECIFIED:  
*           - GETS THE LIST FILE NAME FROM ENTRY POINT *LFNL* AND 
*             STORES IT IN FET *L*. 
*           - DETERMINES PRINT DENSITY TO USE (VIA CALL TO *GETPAGE*).
*             IF 8LPI, WRITES CONTROL CHARACTER TO LIST FILE. 
*           - PLACES THE DATE AND TIME IN TITLE LINE FOR LIST FILE. 
*         - FOR THE SCRATCH FILES, WHICH MAY OR MAY NOT BE NEEDED:  
*           - STORES THE TWO FILE NAMES DEFINED BY *DFLTX* AND *DFLTY*
*             IN FETS *X* AND *Y*, RESPECTIVELY, AND ISSUES A *RETURN*
*             ON EACH OF THEM.
* 
*         ENTRY  (B1) = 1.
*                (LFNI) = NAME OF INPUT FILE. 
*                (LFNL) = NAME OF LIST FILE.
* 
*         EXIT   (B1) = 1.
* 
*         USES   X - ALL. 
*                B - ALL. 
*                A - ALL. 
* 
*         CALLS  CIO=, CPM=, SYS=, WTW=.
  
  
 INF      EQ     *+1S17      ENTRY / EXIT 
          SA1    LFNI        NAME OF INPUT FILE 
          SA2    I
          MX0    42          SAVE LOWER 18 BITS OF FET(0) 
          BX6    -X0*X2 
          BX6    X6+X1
          SA6    A2 
          SA4    =0LINPUT 
          IX3    X1-X4
          ZR     X3,INF1     IF NAME = *INPUT*, DO NOT REWIND 
          REWIND I
 INF1     READ   I           INITIATE FIRST READ (AKA 'PRIME THE PUMP') 
          SA1    LFNL        NAME OF OUTPUT FILE
          ZR     X1,INF3     IF NO LIST OUTPUT
          SA2    L
          MX0    42          SAVE LOWER 18 BITS OF FET(0) 
          BX6    -X0*X2 
          BX6    X6+X1
          SA6    A2 
          GETPAGE  WRTEMP    DETERMINE PRINT DENSITY TO USE 
          SA1    WRTEMP 
          MX4    -8 
          AX1    12+8        POSITION TO *PS* 
          BX6    -X4*X1 
          SA6    LINEMAX
          SA6    LINECT      SET TO PUT OUT TITLE FIRST TIME
          MX4    -4 
          AX1    8           POSITION TO *PD* 
          BX6    -X4*X1 
          AX6    3           0 IF 6LPI, 1 IF 8LPI 
          SA6    PAGEPD 
          ZR     X6,INF2     IF 6LPI
          WRITEW L,LPI8,1    WRITE PAGE CONTROL FOR 8LPI
 INF2     DATE   TDATE       GET DATE FOR TITLE 
          CLOCK  TTIME       GET TIME FOR TITLE 
 INF3     SA1    =0L"DFLTX"  NAME OF SCRATCH FILE 1 
          SA3    X
          MX0    42          SAVE LOWER 18 BITS OF FET(0) 
          BX6    -X0*X3 
          BX6    X6+X1
          SA6    A3 
          RETURN A3,RCL      RETURN SCRATCH FILE 1
          SA2    =0L"DFLTY"  NAME OF SCRATCH FILE 2 
          SA4    Y
          BX7    -X0*X4 
          BX7    X7+X2
          SA7    A4 
          RETURN A4,RCL      RETURN SCRATCH FILE 2
          EQ     INF         RETURN 
 NXTLINE  TITLE  INPUT/OUTPUT ROUTINES. 
**        NXTLINE - READ NEXT LINE. 
* 
*         READS THE NEXT LINE OF THE INPUT FILE INTO THE WORKING
*         BUFFER.  LINES ARE IGNORED IF THEY CONSIST OF ANY OF THE
*         FOLLOWING:  
* 
*         - ALL-BLANK LINE. 
*         - * IN COLUMN 1 (COMMENT).
*         - , IN COLUMN 1 (CONTINUATION LINES CURRENTLY IGNORED). 
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   (X1) = 0  - LINE READ INTO *ILINE*.
*                     = NZ - EOF/EOI ENCOUNTERED. 
*                (B1) = 1.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  CIO=, RDH=.
  
  
 NXTLINE  EQ     *+1S17      ENTRY / EXIT 
 NXT1     READH  I,ILINE,LINELTH  READ SOURCE LINE TO WORKING BUFFER
          ZR     X1,NXT2     IF DATA READ (NO EOR/EOF/EOI)
          MI     X1,NXTLINE  IF EOF/EOI, EXIT 
          READ   I           RE-ISSUE THE READ
          EQ     NXT1        LOOP 
  
 NXT2     SA4    ILINE       CHECK FOR LINES TO BE IGNORED
          MX2    -6 
          LX4    6
          BX3    -X2*X4      1ST CHAR OF LINE 
          SX6    X3-1R* 
          ZR     X6,NXT1     SKIP IF * IN COL 1 
          SX7    X3-1R, 
          ZR     X7,NXT1     SKIP IF , IN COL 1 
          EQ     NXTLINE     RETURN, (X1) = 0 
 WRITEX   TITLE  INPUT/OUTPUT ROUTINES. 
**        WRITEX - COMPLETE LIST FILE.
* 
*          - WRITES LINE CONTAINING COUNT OF POTENTIAL CODE-MODIFICATION
*            PROBLEMS.
*          - WRITES ** PRINT LIMIT EXCEEDED ** LINE IF NECESSARY. 
*          - RESETS PRINT DENSITY IF IT WAS SET TO 8LPI.
*          - ISSUES EOR WRITE.
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   NONE.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  CDD=, CIO=, WRTITL, WTW=.
  
  
 WRITEX   EQ     *+1S17      ENTRY / EXIT 
          SA2    PRINTL      PRINT LIMIT
          SA1    PRINTCT     ACTUAL NUMBER OF LINES DETECTED
          IX0    X2-X1
          RJ     =XCDD=      CONVERT ACTUAL TO DECIMAL DISPLAY
          MX7    8*6         SET TO PRINT SHORTER LINE
          SB7    ELINEL1
          PL     X0,WTX1     IF PRINT LIMIT NOT EXCEEDED
          SA2    LOOPT
          NZ     X2,WTX1     IF SHORT LISTING SELECTED
          MX7    10*6        SET TO PRINT LONGER LINE 
          SB7    ELINEL2
 WTX1     BX7    X7*X4
          SA7    ELINEV      STORE COUNT IN LINE
          SX0    B7          (X0) = LINE LENGTH 
          SA2    LINEMAX
          SA3    LINECT 
          IX6    X2-X3
          SX6    X6-3 
          PL     X6,WTX2     IF FINAL LINE WILL FIT ON THIS PAGE
          RJ     WRTITL 
 WTX2     WRITEW L,ELINE,X0  WRITE FINAL LINE 
          SA1    PAGEPD 
          ZR     X1,WTX3     IF 6LPI
          WRITEW L,LPI6,1    RESET PRINTER CONTROL TO 6LPI
 WTX3     WRITER L,RCL       WRITE END OF RECORD
          EQ     WRITEX      RETURN 
 WRLINE   TITLE  INPUT/OUTPUT ROUTINES. 
**        WRLINE - WRITE LINE TO LIST FILE. 
* 
*         WRITES A LINE TO THE LIST FILE VIA *WRITEH*.  KEEPS TRACK OF
*         LINE COUNT AND CALLS *WRTITL* WHEN NECESSARY TO START A NEW 
*         PAGE. 
* 
*         ENTRY  (B1) = 1.
*                (B6) = FWA OF LINE.
*                (B7) = LINE LENGTH IN WORDS. 
* 
*         EXIT   NONE.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  WRTITL, WTH=.
  
  
 WRLINE   EQ     *+1S17      ENTRY / EXIT 
          SA4    LINECT      ADVANCE LINE/PAGE COUNT
          SA3    LINEMAX
          SX6    X4+B1
          SA6    A4 
          IX2    X4-X3
          MI     X2,WRL1     IF NOT PAGE OVERFLOW 
          SX6    B6          SAVE B6, B7
          SX7    B7 
          SA6    WRTEMP 
          SA7    A6+B1
          SX7    4           RESET LINE COUNT 
          SA7    A4 
          RJ     WRTITL      WRITE TITLE LINE 
          SA3    WRTEMP      RESTORE B6, B7 
          SA4    A3+B1
          SB6    X3 
          SB7    X4 
 WRL1     WRITEH L,B6,B7     WRITE CODED LINE 
          EQ     WRLINE      RETURN 
 WRTITL   TITLE  INPUT/OUTPUT ROUTINES. 
**        WRTITL - WRITE TITLE LINE.
* 
*         ADVANCES PAGE NUMBER AND WRITES THE TITLE LINE TO THE LIST
*         FILE. 
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   NONE.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  CDD=, WTW=.
  
  
 WRTITL   EQ     *+1S17      ENTRY / EXIT 
          SA1    PAGENO      ADVANCE PAGE NUMBER
          SX6    X1+B1
          SA6    A1 
          RJ     =XCDD=      CONVERT TO DECIMAL DISPLAY 
          LX6    4*6         STORE PAGE NUMBER IN TITLE 
          MX1    -2*6        INSERT LINE TERMINATOR 
          BX6    X1*X6
          SA6    TPAGE
          WRITEW L,TITL,TITLL  WRITE TITLE
          EQ     WRTITL      RETURN 
 IODATA   TITLE  I/O STORAGE AND FETS.
 WRTEMP   BSS    2           REGISTER SAVE AREA 
 LINEMAX  CON    0           MAXIMUM LINES PER PAGE 
 LINECT   CON    0           NUMBER OF LINES WRITTEN ON CURRENT PAGE
 PAGENO   CON    1           PAGE NUMBER FOR NEXT TITLE TO BE WRITTEN 
 PAGEPD   CON    0           0 - 6LPI, 1 - 8LPI 
 LPI6     DATA   8LS   6LPI 
 LPI8     DATA   8LT   8LPI 
 TITL     DATA   50H1        L I N E S  W I T H  C O D E  M O D I F I 
          DATA   20HC A T I O N 
          DATA   20HCDCM 1.0
 TDATE    DATA   10H
 TTIME    DATA   10H
          DATA   10H      PAGE
 TPAGE    CON    0
          DATA   2L 
          DATA   2L 
 TITLL    EQU    *-TITL 
  
 ELINE    DATA   2L  ,2L
          DATA   30H          LINES WITH POTENTIAL
          DATA   30H CODE-MODIFICATION PROBLEMS - 
 ELINEV   DATA   0
 ELINEL1  EQU    *-ELINE
          DATA   38L          *** PRINT LIMIT EXCEEDED ***
 ELINEL2  EQU    *-ELINE
  
*         FETS AND BUFFERS. 
  
 I        FILEB  IBUF,IBUFL  INPUT FILE FET 
 L        FILEB  LBUF,LBUFL  OUTPUT FILE FET
 X        FILEB  XBUF,XBUFL  INTERMEDIATE FILE-1 FET
 Y        FILEB  YBUF,YBUFL  INTERMEDIATE FILE-2 FET
  
 IBUFL    EQU    2001B       LENGTH OF INPUT CIO BUFFER 
 IBUF     BSS    IBUFL       INPUT CIO BUFFER 
  
 LBUFL    EQU    2001B       LENGTH OF OUTPUT CIO BUFFER
 LBUF     BSS    LBUFL       OUTPUT CIO BUFFER
  
 XBUFL    EQU    2001B       LENGTH OF INTERMEDIATE FILE-1 BUFFER 
 XBUF     BSS    XBUFL       INTERMEDIATE FILE-1 BUFFER 
  
 YBUFL    EQU    2001B       LENGTH OF INTERMEDIATE FILE-2 BUFFER 
 YBUF     BSS    YBUFL       INTERMEDIATE FILE-2 BUFFER 
  
*         --------------------------------------------------------------
 OR.FIX   EQU    *           BEGINNING OF FIXED-LENGTH STORAGE AREA 
*         --------------------------------------------------------------
          TITLE  FIXED-LENGTH STORAGE.
**        FIXED-LENGTH STORAGE. 
* 
*         THE FOLLOWING AREA OVERWRITES THE INITIALIZATION ROUTINES.
          SPACE  4,8
**        OR.REG - REGISTER TABLE.
* 
*         CONTAINS THE NAMES OF THE MOST RECENTLY ENCOUNTERED SYMBOLS 
*         ASSOCIATED WITH EACH OF THE 24 MACHINE REGISTERS. 
*         THE NUMBER OF SYMBOLS SAVED FOR EACH REGISTER IS CONTROLLED 
*         BY *PCSNVAL*. 
* 
*         ENTRY = 1 WORD.  SAME FORMAT AS *O.LOC* ENTRIES.
  
 NREG     EQU    24          NUMBER OF REGISTERS
 LE.REG   EQU    NREG*PCSNVAL  TABLE LENGTH 
 OR.REG   BSS    LE.REG 
          SPACE  4,8
**        OR.LINE - STRING BUFFER.
* 
*         CONTAINS CURRENT LINE IMAGE AS ONE CHARACTER PER WORD WITH
*         EACH CHARACTER STORED IN THE LOW-ORDER CHARACTER POSITION.
  
  
 LE.LINE  EQU    10*LINELTH  STRING BUFFER LENGTH 
 OR.LINE  BSS    LE.LINE     STRING BUFFER
          CON    0           TO END SEARCH FOR NON-BLANK IF ALL-BLANK 
  
 ENDZ     EQU    *           END OF FIXED-LENGTH STORAGE AREA 
 SCO      TITLE  SCO - SET CONTROL STATEMENT OPTIONS. 
**        SCO - SET CONTROL STATEMENT OPTIONS.
* 
*         THIS ROUTINE IS OVERWRITTEN AFTER INITIALIZATION. 
  
  
          ORG    OR.FIX 
          QUAL   SCO
 SCO      EQ     *+1S17      ENTRY / EXIT 
  
*         UNPACK CONTROL STATEMENT BY *UPC=*. 
  
          SA5    RA.CCD      FWA OF CONTROL STATEMENT 
          SB7    ARGLST      FWA FOR UNPACKED ARGUMENTS 
          RJ     =XUPC=      UNPACK CONTROL CARD. 
          SB7    B0 
          NZ     X6,SCO10    IF ERROR DURING UNPACK 
  
*         PROCESS ARGUMENTS.
  
          SB2    ARGLST      (B2) = ARGUMENT POINTER (SKIP NAME CALL) 
          MX0    42 
 SCO1     SB2    B2+B1       NEXT ARGUMENT
          SA1    B2 
          ZR     X1,SCO4     IF NO MORE ARGUMENTS 
          SA2    PARAMS-1    FWA-1 MAIN PARAMETER LIST
          SX3    X1 
          MX5    0           (X5) = 0 IF NO EQUIVALENCE 
          ZR     X3,SCO2     IF NOT EQUIVALENCED
          SX3    X1-1R= 
          SB2    B2+B1
          SA5    B2          (X5) = VALUE IF EQUIVALENCED 
          ZR     X3,SCO2     IF EQUIVALENCED
          SB7    B0          KEYWORD FOLLOWED BY OTHER THAN , ( . ) = 
          EQ     SCO10
  
 SCO2     SA2    A2+B1       NEXT LIST ENTRY
          ZR     X2,SCO3     IF ARGUMENT NOT FOUND
          BX3    X1-X2
          BX3    X0*X3
          NZ     X3,SCO2     LOOP 
          SB3    X2          JUMP TO PROCESSOR
          JP     B3 
  
 SCO3     BX1    X0*X1
          SB7    B1 
          RJ     =XSFN=      SPACE FILL NAME
          LX6    -6 
          SA6    SCOERR1
          EQ     SCO10       GO TO ERROR EXIT 
  
*         SET UP INSTRUCTION TABLE ACCORDING TO *SM* AND *LM* OPTIONS.
  
 SCO4     SX7    PCSTA       SET FOR -SM, -LM 
          SA1    SO.SM
          SA2    SO.LM
          LX1    1
          BX3    X1+X2
          SB6    X3-1 
          MI     B6,SCO6     IF -SM, -LM
          SX7    PCSTB       SET FOR SM, -LM
          EQ     B6,B1,SCO6  IF SM, -LM 
          SX7    PCSTC       SET FOR SM, LM 
          GT     B6,B1,SCO6  IF SM, LM
  
*         IF *LM* BUT NOT *SM* WAS SELECTED, MOVE LOCAL MACRO ENTRIES 
*         DOWN OVER SYSTEM MACRO ENTRIES, AND SET TARGET LOCATION 
*         ACCORDINGLY.
  
          SB7    PCSTC-PCSTB  (B7) = NUMBER OF LOCAL MACROS 
          SX7    PCSTA+PCSTC-PCSTB
          ZR     B7,SCO6     IF NO LOCAL MACRO ENTRIES
          SX2    PCSTB       FETCH ADDRESS = START OF LOCAL MACROS
          SX3    PCSTA       STORE  ADDRESS = START OF SYSTEM MACROS
          MX0    -1 
 SCO5     SA4    X2          MOVE LOOP
          BX6    X4 
          IX2    X2-X0       ADVANCE FETCH ADDRESS
          SA6    X3 
          SB7    B7-B1
          IX3    X3-X0       ADVANCE STORE ADDRESS
          NZ     B7,SCO5     LOOP 
 SCO6     SA7    PCSTT       SET TARGET LOCATION FOR INSTRUCTION TABLE
          EQ     SCO         RETURN 
  
*         ERROR PROCESSING. 
  
 SCO10    MESSAGE  (=C/ CDCM ABORT - CONTROL STATEMENT ERROR/),,RCL 
          ZR     B7,SCO12    IF SYNTAX ERROR
          SB6    SCOERR1     SET FOR APPROPRIATE 2ND MESSAGE
          EQ     B7,B1,SCO11 IF MAIN PARAM NOT RECOGNIZED 
          SB6    SCOERR2     OPTION NOT RECOGNIZED
 SCO11    MESSAGE  B6,,RCL
 SCO12    ABORT 
  
*         *I* PARAMETER.
  
 PR.I     NZ     X5,I.1      IF NAME SPECIFIED
          SA5    DEF.I       SET 2ND DEFAULT
 I.1      BX6    X5 
          SA6    LFNI        SET INPUT FILE NAME
          EQ     L.1         GO TO COMMON CODE
  
 DEF.I    DATA   0LCOMPILE   KEYWORD ONLY DEFAULT FOR INPUT FILE
  
*         *L* PARAMETER.
  
 PR.L     ZR     X5,SCO1     RETURN IF NAME NOT SPECIFIED 
          BX6    X5 
          SA6    LFNL        SET OUTPUT FILE NAME 
          SX2    1R0         CHECK FOR L=0
          LX6    6
          BX6    X2-X6
          NZ     X6,L.1      IF NOT L=0 
          MX7    0
          SA7    A6          ZERO OUTPUT FILE NAME
          EQ     SCO1 
  
 L.1      SB7    B0          SET FOR SYNTAX ERROR 
          SX4    X5 
          NZ     X4,SCO10    IF NAME NOT FOLLOWED BY , . ( )
          BX1    X0*X5
          RJ     CFN         CHECK FOR VALID FILE NAME
          NZ     X6,SCO10    IF FILE NAME BAD 
          EQ     SCO1        RETURN TO MAIN LOOP
  
*         *LO* PARAMETER. 
  
 PR.LO    ZR     X5,SCO1     RETURN IF OPTION NOT SPECIFIED 
          SB7    B0          SET FOR SYNTAX ERROR 
          SX4    X5 
          NZ     X4,SCO10    IF OPTION NOT FOLLOWED BY , . ( )
          SA1    LSTLO
 LO.1     BX2    X1-X5
          ZR     X1,SO.8     IF ILLEGAL OPTION
          SX7    X1          OPTION VALUE 
          BX2    X0*X2
          SA1    A1+B1       NEXT ENTRY 
          NZ     X2,LO.1     LOOP 
          SA7    LOOPT       SET *LO* OPTION
          EQ     SCO1        RETURN TO MAIN ROUTINE 
  
*         *PL* PARAMETER. 
  
 PR.PL    ZR     X5,SCO1     RETURN IF NO VALUE SPECIFIED 
          SB7    B0          SET FOR SYNTAX ERROR 
          SX4    X5 
          NZ     X4,SCO10    IF VALUE NOT FOLLOWED BY , . ( ) 
          SB7    B1          SPECIFY DECIMAL
          SB6    B2          SAVE B2
          RJ     =XDXB=      CONVERT DISPLAY CODE TO BINARY 
          SB7    B0          SET FOR SYNTAX ERROR 
          MX0    42          RESTORE X0 
          SB2    B6          RESTORE B2 
          NZ     X4,SCO10    IF ERROR 
          SA6    PRINTL      SAVE PRINT LIMIT VALUE 
          EQ     SCO1        RETURN TO MAIN ROUTINE 
  
*         *SO* PARAMETER. 
  
 PR.SO    SA3    LSTSO       SET UP ALL 2ND DEFAULT VALUES
 SO.0     SA4    A3+B1       WORD 2 OF TABLE ENTRY
          ZR     X3,SO.1     IF END OF TABLE
          LX4    30          FETCH 2ND DEFAULT VALUE
          SX7    X4 
          SA7    X3 
          SA3    A4+B1
          EQ     SO.0        LOOP 
  
 SO.1     ZR     X5,SCO1     RETURN IF NO OPTIONS SELECTED
          SA1    LSTSO       SET UP ALL INITIAL VALUES
 SO.2     SA2    A1+B1       WORD 2 OF ENTRY
          ZR     X1,SO.3     IF END OF TABLE
          SX6    X2 
          SA6    X1 
          SA1    A2+B1       NEXT TABLE ENTRY WORD 1
          EQ     SO.2        LOOP 
  
 SO.3     SA4    ZEROVAL
          IX4    X4-X5
          BX4    X0*X4
          NZ     X4,SO.5     IF NOT A ZERO VALUE
          SA1    LSTSO       CLEAR ALL OPTIONS
 SO.4     ZR     X1,SO.7     IF END OF TABLE
          MX6    0
          SA6    X1 
          SA1    A1+2        NEXT TABLE ENTRY WORD 1
          EQ     SO.4        LOOP 
  
 SO.5     SX2    X5-1R-      CHECK FOR PRECEDING MINUS SIGN 
          SA1    LSTSO
          SB3    B1+B1
          SX6    B1          SET FOR SETTING OPTION 
          NZ     X2,SO.6     IF OPTION NOT PRECEDED BY MINUS SIGN 
          SX6    B0          SET FOR CLEARING OPTION
          SB2    B2+B1       FETCH OPTION 
          SA5    B2 
 SO.6     BX2    X1-X5       SEARCH TABLE OF *SO* OPTIONS 
          ZR     X1,SO.8     IF ILLEGAL OPTION
          BX2    X0*X2
          SB4    X1          ADDRESS TO SET OR CLEAR OPTION 
          SA1    A1+B3       NEXT TABLE ENTRY 
          NZ     X2,SO.6     LOOP 
          SA6    B4          SET OR CLEAR OPTION
 SO.7     SX1    X5 
          ZR     X1,SCO1     IF NO MORE OPTIONS 
          SB7    B0          SET FOR SYNTAX ERROR 
          SX2    X5-1R/ 
          NZ     X2,SCO10    ERROR IF NOT FOLLOWED BY , ( . ) / 
          SB2    B2+B1       NEXT OPTION
          SA5    B2 
          EQ     SO.3        LOOP 
  
 SO.8     SB7    B1+B1       SET FOR *UNKNOWN OPTION* MESSAGE 
          BX1    X0*X5
          RJ     =XSFN=      SPACE FILL NAME
          LX6    -6 
          SA6    SCOERR2     SET NAME 
          EQ     SCO10       GO TO ERROR EXIT 
  
*         SUBROUTINE TO CHECK FOR VALID FILE NAME.
*         ENTRY - (X1) = NAME LEFT JUSTIFIED ZERO FILL. 
*         EXIT  - (X6) = 0 IF NAME VALID. 
*                        NZ IF NAME NOT VALID.
*         USES  - X2, X3, X4, X6. 
  
  
 CFN      EQ     *+1S17      ENTRY / EXIT 
          SX6    1RZ+1       PRESET ERROR RETURN AND ALLOW ONLY A - Z 
          SX2    X1           FOR FIRST CHAR
          MX3    -6          CHAR MASK
          ZR     X1,CFN      IF ZERO NAME 
          NZ     X2,CFN      ERROR IF MORE THAN 7 CHARS 
          BX2    X1 
 CFN1     LX2    6           LOOK AT NEXT CHAR
          BX4    -X3*X2 
          ZR     X4,CFN2     IF NO MORE CHARS 
          IX4    X4-X6       CHECK 1ST CHAR ALPHA, REMAINING ALPHANUM 
          PL     X4,CFN      IF 
          SX6    1R+         ALLOW A - 9 FOR REMAINING CHARS
          EQ     CFN1        LOOP 
  
 CFN2     MX6    0           NORMAL RETURN
          EQ     CFN
 SCO      TITLE  CONTROL STATEMENT PARAMETER LISTS. 
**        CONTROL STATEMENT TABLES AND VALUES.
* 
*         ARGUMENTS ARE FETCHED FROM RA+70FF BY *UPC=*. 
* 
 ARGLSTL  EQU    30B         LENGTH OF ARGUMENT LIST
 ARGLST   BSS    ARGLSTL     ARGUMENT LIST FORMED BY *UPC=* 
  
**        THE MAIN PARAMETER TABLE CONSISTS OF ONE-WORD ENTRIES AND IS
*         TERMINATED BY A ZERO WORD.  ENTRY FORMAT IS AS FOLLOWS: 
* 
*         VFD    42/PAR,18/PADR 
* 
*         WHERE  PAR  = PARAMETER NAME (1-7 CHARS IN LENGTH, LEFT 
*                       JUSTIFIED ZERO FILL). 
*                PADR = ADDRESS OF PROCESSOR. 
  
  
 PARAMS   VFD    42/0LI,18/PR.I        I  - INPUT FILE
          VFD    42/0LL,18/PR.L        L  - LIST FILE 
          VFD    42/0LLO,18/PR.LO      LO - LIST OPTIONS
          VFD    42/0LPL,18/PR.PL      PL - PRINT LIMIT 
          VFD    42/0LSO,18/PR.SO      SO - SCANNING OPTIONS
          VFD    60/0                  END OF LIST
  
**        TABLE OF OPTIONS FOR THE *LO* PARAMETER.  CONSISTS OF ONE-WORD
*         ENTRIES AND IS TERMINATED BY A ZERO WORD. 
* 
*         VFD    42/OPT,18/VAL
* 
*         WHERE  OPT = NAME OF OPTION.
*                VAL = VALUE OF OPTION. 
  
  
 LSTLO    VFD    42/0LA,18/0           LO=A 
          VFD    42/0LS,18/1           LO=S 
          CON    0                     END OF TABLE 
  
**        TABLE OF OPTIONS FOR THE *SO* PARAMETER.  CONSISTS OF TWO-WORD
*         ENTRIES AND IS TERMINATED BY A ZERO WORD.  THE SECOND DEFAULT 
*         AND THE INITIAL VALUES FOR ALL OPTIONS ARE SET FROM THE 2ND 
*         WORD OF EACH ENTRY. 
* 
*         VFD    42/OPT,18/ADRS 
*         VFD    30/DEF2,30,IV
* 
*         WHERE  OPT  = NAME OF OPTION
*                ADRS = ADDRESS TO STORE VALUE
*                DEF2 = 2ND DEFAULT 
*                IV   = INITIAL VALUE 
  
 LSTSO    VFD    42/0LJP,18/SO.JP      SO=JP
          VFD    30/1,30/1
          VFD    42/0LSM,18/SO.SM      SO=SM
          VFD    30/1,30/1
          VFD    42/0LLM,18/SO.LM      SO=LM
          VFD    30/1,30/0
          CON    0                     END OF TABLE 
 ZEROVAL  VFD    6/1H0,48/0,6/1H/      ZERO SPECIFICATION IN OPTION LIST
  
 SCOERR1  DATA   C*           UNRECOGNIZABLE* 
 SCOERR2  DATA   C*           UNKNOWN OPTION* 
  
          END    CDCM 
