*DECK,REFMAP
          IDENT  REFMAP 
          TITLE    REFMAP - PRINT REFERENCE MAP 
*CALL     SSTCALL 
 B=REFMP  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
 SYM1     EQU    12B
 SYMEND   EQU    13B
 PROGRAM  EQU    56B
  
 WPL      EQU    13                MAXIMUM WORDS/LINE 
 N.LRB    EQU    7                 NUMBER OF LOCAL RELOCATION BASES 
  
          EXT    R=FLAG,RSELECT,LWAWORK,E.UDEFL,VALUE.
          EXT    N.FILES,N.COM,ORGTAB,SWC,CONDEC,ST.,SYMORD 
          EXT    L.EQV,N.FP,O.LBLK,START. 
          EXT    N.EQUF 
  
          TABLES COM,LOOP,UDV 
          SPACE  3
*         AUTHOR - S.I. JASIK - CDC-SUNNYVALE - WINTER 1969 
  
*** 
*         REFMAP - SYMBOLIC REFERENCE MAP PRINTOUT
* 
*         FUNCTIONS:  
*                PRINT OUT ANY MISSING LABELS 
*                COMPUTE PROGRAM LENGTH, ADJUST RA FIELD OF WORD B OF 
*                ALL PROGRAM RELOCATABLE SYMBOLS IN SYMTAB
* 
*                PRINT THE REFERENCE MAP FROM INFORMATION IN: 
*                 THE SYMBOL TABLE
*                 ORGTAB AND THE LOCAL BLOCK LENGTH TABLE 
*                 "REFMAP" FILE OF SYMBOL REFERENCES AND SAVED COM/EQV
*                 INFO
*                 THE LOOP TABLE - FORMED BY "PRE" AND "DOPROC" 
*                 THE "UDV" TABLE FORMED AT THE END OF PASS 1 
* 
          SPACE  3
  
*         BLOCK ORDERING , USED TO FORCE THE LITERALS TO COME FIRST 
  
          USE    DATA              DATA GENERATED BY VARIOUS MACROS 
          USE    IO$$        FOR 7RM MACRO EXPANSIONS 
          USE    CODE 
          TITLE              STORAGE ASSIGNMENTS AND EQU S
          USE    /TABLES/ 
 O.CELLS  EQU    *
  
 BLKCOM   BSS    1                 ADDRESS OF BLANK COMMON IN ORGTAB
 L.PROG   BSS    1                 PROGRAM LENGTH 
 O.LRB    BSS    N.LRB             FWA OF THE LOCAL RELOCATION BASES
 L.SCOM   BSS    1                 SCM COMMON LENGTH (EXCLUDING BLANK)
 L.LCOM   BSS    1                 LCM COMMON LENGTH (EXCLUDING BLANK)
 L.SBLK   BSS    1                 SCM BLANK COMMON LENGTH
 L.LBLK   BSS    1                 LCM BLANK COMMON LENGTH
 L.BUFIO  BSS    1                 I/O BUFFER LENGTH
 L.PROGP  BSS    1                 PROGRAM LENGTH THAT IS PRINTED OUT 
*                                  PROG LEN - IO BUFFER LENGTH
  
*         POINTERS SET IN THE LEXIGRAPHIC SORT
  
 O.REFBAS BSS    1                 BASE OF THE REFERENCE TABLE
 O.REFTAB BSS    1                 FIRST AVAILABLE WORD FOR REFERENCE 
*                                  LIST 
 O.CNTBL  BSS    1                 FWA OF CHANGED NAME TABLE
 L.CNTBL  BSS    1                 LENGTH 
  
 O.NAME   BSS    1                 SYMBOLIC NAMES 
 O.LABEL  BSS    1                 STMT LABELS
 O.LFN    BSS    1                 LOGICAL FILE NAMES 
 O.LGL    BSS    1                 LOOP GENERATED LABELS
  
*         POINTERS SET IN THE CATEGORY SORT 
  
 O.ENT    BSS    1                 ENTRY POINTS 
 O.VAR    BSS    1                 VARIABLES,ARRAYS,F.P. S, RETURNS 
 O.EXT    BSS    1                 EXTERNAL REFERENCES
 O.ASF    BSS    1                 INTRINSIC AND AS FUNCTIONS 
 O.NML    BSS    1                 NAMELIST GROUP NAMES 
 O.CGS    BSS    1                 COMPILER GENERATED SYMBOLS 
 O.UDBG   BSS    1                 UNUSED DEBUG VARIABLES 
 VLFN     BSS    1                 NE 0 IF VARIABLES USED AS FILE NAMES 
 NEXTE    BSS    1                 HOLDS POINTER TO NEXT LIST ELEMENT 
*                                  DURING PRINT LOOPS 
  
*         LIST POINTERS USED BY SORTRL
  
 WORDA    BSS    1                 SYMTAB ADDRESS OF WORD A 
 O.REFS   BSS    1                 REFERENCES   (60/FWA OF LIST ) 
 O.DEFS   BSS    1                 DEFINITIONS AND USES 
 O.FREF   BSS    1                 FILE REFERNCES 
 DSRB     BSS    3                 DUMMY SORT BUCKETS FOR SORTRL
  
*         LOCATIONS ASSOCIATED WITH FMT AND LISTR 
  
 REFACC   BSS    1                 1S59 IF REFERENCES ACCUMULATED 
 TEMP     BSS    1                 A TEMPORARY
 TEMPA    BSS    1                 A TEMPORARY ( LISTR )
 APL      BSS    1                 ADDRESS OF HEADER LIST ( LISTV ) 
  
 BFILL    BSS    1                 BLANK FILL FLAG FOR LISTR
 DLINE    BSS    1                 COL/10 TO PAD INIT LINE INFO TO
*                                  FOR THE LONG MAP 
 VBUF     BSS    7                 ITEMS TO BE FORMATTED
 SFMTW    BSS    1                 POSSIBLE SECOND WORD OF FORMAT SPEC
 LBUF     BSS    14                LINE BUFFER
  
 PBUF     BSS    14                ALTERNATE LINE BUFFER
 ACCWC    BSS    1                 ACCUMULATED WORD COUNT FOR PBUF
 LI       BSS    2                 LOOP INDEX AND LIMIT FOR FBNB
 CLOC     BSS    2                 CURRENT LOC AND LINK FOR COMMON BLOCK
 LTEMP    EQU    CLOC 
 LPLEN    EQU    VBUF+5            WHERE THE LOOP LENGTH IS STORED
 CLI      EQU    CLOC              2 TEMPORARIES FOR EQUIV MAP
  
 L.CELLS  EQU    *-O.CELLS
          USE    *
          SPACE  3
*         WORDS THAT THE ASSOCIATED BITS ARE IN 
  
 FP       EQU    1
 FUN      EQU    1
 DEF      EQU    1
 DIM      EQU    1
 COM      EQU    1
 ASF      EQU    2
 LIB      EQU    2
 VAR      EQU    2
  
*         BIT FIELD DEFINITIONS FOR DO LOOP PROPERTIES AS SET 
*         IN LABELS GENERATED BY THE DO PROCESSOR 
  
 DL.E     EQU    6                 ENTERED FROM OUTSIDE RANGE 
 DL.X     EQU    5                 EXITS - REFERENCES TO LABELS OUTSIDE 
*                                  THE LOOP 
 DL.I     EQU    4                 LOOP IS NOT INNERMOST
 DL.M     EQU    3                 CONTROL VARIABLE MUST BE MATERIALIZED
 DL.J     EQU    1                 EXTERNAL REFS
  
 P.DLP    EQU    48                BASE OF DO LOOP PROPERTY FIELD 
 L.DLP    EQU    7                 LENGTH 
  
 V.OPT    EQU    127B              BITS NON ZERO IF LOOP IS NOT OPTIMUM 
          SPACE  3
*         BIT FIELD DEFINITIONS OF THE FIELDS IN THE REFERENCE
*         TABLE BUILT BY "SORTR"
  
 P.REP    EQU    48                REP COUNT FIELD ( ALSO REF/DEF ) 
 L.REP    EQU    12 
 P.BCDLN  EQU    18                DISPLAY CODED LINE NUMBER
 L.BCDLN  EQU    24                4 CHARACTERS LONG
  
*         THE LINK FIELD IS IN BITS 0 - 17
          TITLE              TABLES 
*         TABLE OF BLANKS 
  
 BLANKS   LIT  0,1L ,2L  ,3L   ,4L    ,5L     ,6L      ,7L       ,8L
,    ,9L         ,10L 
          SPACE  3
*         TYPE TABLE FOR TYPES 1 - 7
  
 TYPTBL   DATA   7LLOGICAL
          DATA   7LINTEGER
          DATA   7LREAL 
          DATA   7LDOUBLE 
          DATA   7LCOMPLEX
  
 #DAL     IFEQ   .DAL,0      .ZR. IF LCM DIRECT ACCESS NOT ALLOWED
          DATA   7LECS
 #DAL     ELSE
          DATA   7LLCM
 #DAL     ENDIF 
  
          DATA   7L                TYPE 6 ARE LABELS
          DATA   7LRETURNS
  
*         FILE MODE TABLE 
  
 FMODTAB  DATA   7LMIXED
          DATA   7L 
          DATA   7LFMT
          DATA   7LUNFMT
          DATA   7LBUF
          DATA   7LNAME 
          DATA   7LFREE 
  
*         LOCAL FUNCTION TYPE TABLE 
  
 ASFINT   DATA   8L  INTRIN 
          DATA   8L    SF 
  
*         STATEMENT LABEL TYPE TABLE
  
          DATA   9L 
 SLATAB   DATA   9L  NO REFS
          DATA   9L INACTIVE
  
*         STATEMENT LABEL ACTIVITY TABLE
  
 SLTAB    DATA   6L*UNDEF 
          DATA   6L   FMT 
          DATA   6L                EXEC 
  
*         DO INDEX MATERIALIZED FLAG
*         THIS REFMAP FEATURE DISABLED AS A RESULT OF FCC2059 
  
 DO.MAT   DATA   3L                INDEX NOT MATERIALIZED 
          DATA   3L *              INDEX MATERIALIZED 
  
 MAPTITL  DATA   38C          SYMBOLIC REFERENCE MAP (R=0)
  
*         STORAGE TYPE
  
 SDS      DATA   4L    ,4L "LCM"
 LCMLMT   DATA   400000B     LCM LIMIT WITHOUT LCM=I
  
*         ERROR  MESSAGE
  
 OVERFL   DATA   36C0"SCM" REQUIRED FOR LOAD EXCEEDS 131K.
 STGERR   DATA   47C0"LCM" FL EXCEEDS 131,071 WORDS (LCM=I REQUIRED)
          TITLE              CONVERSION ROUTINES
*** 
*         Z8 - CONVERT OCTAL DIGITS TO DISPLAY CODE IN 8L FORMAT
*         WITH LEADING ZERO SUPPRESSION 
* 
*         ON ENTRY: 
*                X1 = BINARY NUMBER RIGHT JUSTIFIED 
* 
*         ON EXIT:  
*                X6 = NUMBER IN DISPLAY CODE
* 
 Z8L      BX2    -X3*X1            EXTRACT A DIGIT
          AX1    3
          SX4    B4+X2             CONVERT TO DPC 
          LX5    B2,X4
          SB2    B2+6 
          IX6    X6+X5
          NZ     X1,Z8L 
 Z8 
 Z8P      SA5    =8L               INITIALIZE RESULT
          SB4    1R0-1R 
          MX3    57 
          SB2    12 
          BX6    X5 
          EQ     Z8L
  
*         PLUGS USED TO CHANGE BETWEEN LEADING BLANK AND ZERO FILL
  
          IF     DEF,ZEROFILL 
 Z8PLUG   SA5    =8L  000000       FOR LEADING ZERO FILL
          SB4    0
  
 Z8RESTR  SA5    =8L
          SB4    1R0-1R 
          ENDIF 
  
*** 
*         OCTC - CONVERT BINARY NUMBER TO OCTAL 
*         ON ENTRY: 
*                X1 = NUMBER RIGHT JUSTIFIED ( < 400 000B ) 
*         ON EXIT:  
*                X6 = 8L   NNNB 
* 
 OCTL     BX2    -X3*X1            EXTRACT A DIGIT
          AX1    3
          SX4    B4+X2
          LX5    B2,X4
          SB2    B2+6 
          IX6    X6+X5
          NZ     X1,OCTL
 OCTC 
          SA5    =8L       B
          SB2    18 
          SB4    1R0-1R 
          MX3    57 
          BX6    X5 
          EQ     OCTL 
          TITLE              PSTITLE - PRINT SUB TITLE
*** 
*         PSTITLE - PRINT SUB TITLE LINE
* 
*         ON ENTRY: 
*                A1 = FWA OF SUBTITLE LINE
* 
*         ON EXIT:  
*         DLINE = COL/10 ( R " 0 ) OR 0 FOR THE USE OF "FMT"
* 
  
  
 PSTITLE  ENTRY. *           ** ENTRY/EXIT ** 
  
*         MOVE SUBTITLE LINE TO CENTRAL I/O LISTING BUFFER. 
  
          SB1    1
          MX0    -12
          SB7    B0          (B7) = SUBTITLE LENGTH ACCUMULATOR 
 PST2     BX7    X1 
          SB7    B7+B1
          SA1    A1+B1
          BX6    -X0*X7 
          SA7    =XO.STITL-1+B7 
          NZ     X6,PST2     IF NOT END OF SHORT MAP LINE 
          SA5    REFACC      MAP TYPE FLAG (.ZR. = SHORT, 1S59 = LONG)
          SX3    B7 
          AX5    59                SIGN EXTEND
          BX6    X5*X3             COL/10 OR 0
          SA6    DLINE             SET PAD COLUMN 
          PL     X5,PST4     IF SHORT MAP 
  
*         ADD LONG MAP INFO TO SUBTITLE LINE. 
  
          SX2    2R 
          BX7    X7+X2             FILL OUT LAST WORD 
          SA7    A7 
 PST3     BX7    X1 
          SB7    B7+B1
          SA1    A1+B1
          BX6    -X0*X7 
          SA7    =XO.STITL-1+B7 
          NZ     X6,PST3     IF NOT END OF LONG MAP LINE
  
*         POST SUBTITLE LENGTH (WORDS). 
  
 PST4     SX6    B7 
          SA6    =XL.STITL
  
*         LIST SUBTITLE IN MID-PAGE IF MORE THAN 4 LINES ARE LEFT.
  
          SA1    =XN.LINES
          SX6    X1+4 
          PL     X6,PST6     IF LESS THAN 4 LINES LEFT ON PAGE
          SX7    B7 
          SA7    TEMP        TEMP SAVE SUBTITLE LENGTH (WORDS)
          LISTL  (=2C  ),1   BLANK LINE 
          SA1    TEMP 
          LISTL  =XO.STITL,X1 
          SB5    1
          EQ     PSTITLE     EXIT 
  
 PST6     NUPAGE
          SB5    1
          EQ     PSTITLE     EXIT 
          TITLE              LISTV - LIST ROUTINE 
*** 
*         STITLE - MACRO TO CALL PSTITLE TO OUTPUT A SUB TITLE
* 
*         SMTITLE - SHORT MAP TITLE 
*         COL - NUMBER OF COLUMNS IN INITIAL INFO PUT OUT BY REFMAP 
*                COL = 18,28,38,48
*         LMTITLE - TEXT TO BE ADDED TO THE SUB TITLE FOR THE LONG MAP
* 
  
 STITLE   MACRO  SMTITLE,COL,LMTITLE
          LOCAL  LOCLABEL 
          USE    DATA 
 LOCLABEL DATA   COL_C   SMTITLE
          DIS    ,/LMTITLE/ 
          USE    *
          SA1    LOCLABEL 
          RJ     PSTITLE
          ENDM
          SPACE  3
*** 
*         LISTV - LIST REFERENCES FOR A NAME IN THE SYMBOL TABLE
* 
*         CALLS "SORTRL" TO SORT THE REFERENCE LIST FOR THE SYMBOL
*         INTO CATEGORIES ON THE REFERENCE TYPE AND THEN CALLS "LISTR"
*         TO FORMAT AND LIST THE REFERENCES FOR EACH CATEGORY.
* 
*         ON ENTRY: 
*                A5 = ADDRESS OF LIST OF HEADER WORDS OR 0
* 
  
*         NO HEADER CASE
  
 LISTVN   SA2    DLINE
          SA3    O.DEFS 
          SA4    =10H 
          BX6    X4 
          ZR     X3,LISTVN1        IF NOT DEFINED 
  
          MX0    L.BCDLN
          SA4    X3                DEFINITION LINE
          LX0    L.BCDLN+P.BCDLN
          BX5    -X0*X6 
          BX7    X0*X4             EXTRACT
          IX6    X5+X7
  
 LISTVN1  SA6    B7+X2
          SB1    X2+B5
          SX7    X2+B5             DLINE = DLINE+1
          SA7    A2 
          SA1    O.REFS 
          ZR     X1,LISTVN2        IF NO REFERENCES 
          MX2    0
          RJ     LISTR             LIST THE REFERENCES
  
 LISTVN2  SA2    DLINE
          SX7    X2-1 
          SA7    A2                RESTORE DLINE
          ZR     B1,LISTV          IF NOTHING TO DUMP 
  
*         DUMP THE LAST PARTIAL LINE
  
 LISTVX   SB6    B7-B5
          SA5    B6+B1
          MX0    48 
          BX6    X0*X5             TRAILING ZERO BYTE 
          SA6    A5 
          SB7    B1                (B7) = LINE LENGTH (WORDS) 
          SB1    1
          LISTL  LBUF,B7
          SB5    1
  
 LISTV                             ** ENTRY/EXIT ** 
          SX6    A5 
          SA6    APL               SAVE ADDRESS OF ARG LIST 
          SB7    LBUF              B7 = FWA OF LINE BUFFER
          RJ     SORTRL            SORT THE REFERENCES
          SA5    APL
          ZR     X5,LISTVN         IF NO HEADERS REQUESTED
  
          SA1    O.REFS 
          ZR     X1,LISTV1         IF NO REFERENCES 
          SA2    X5                BCD PREFIX 
          RJ     LISTR             LIST THE REFERENCES
  
 LISTV1   SA1    O.DEFS 
          ZR     X1,LISTV2         IF NO DEFINITIONS
          SA5    APL
          SA2    X5+B5             BCD PREFIX 
          RJ     LISTR
  
 LISTV2   SA1    O.FREF 
          ZR     X1,LISTV3         IF NO FILE REFS
          SA5    APL
          SA2    X5+2              BCD PREFIX 
          RJ     LISTR
  
 LISTV3   ZR     B1,LISTV          EXIT IF NOTHING TO DUMP
          EQ     LISTVX 
          EJECT 
*** 
*         LISTR - LIST REFERENCES FOR A VARIABLE
* 
*         FORMATS THE REFERENCE LIST INTO LINES OF THE FORM:  
*         TN,K(3X,I4,3X) WHERE: N = DLINE*10 AND K = WPL-DLINE ,
*         AND PRINTS THEM.
*         REPEATED REFERENCES ON THE SAME LINE ARE FORMATTED AS:  
*         I3*IN WHERE I3 IS THE REP COUNT AND N THE NUMBER OF DIGITS
*         IN THE LINE NUMBER. 
* 
*         ON ENTRY: 
*                X1 = ADDRESS OF REFERENCE LIST 
*                X2 = "SUBTITLE" WORD 
*                B1 = WORD COUNT FOR THE CURRENT LINE 
* 
*         ON EXIT:  
*                B1 = WORD COUNT FOR CURRENT LINE 
*                B2 = WORD COUNT RESET IF B1 = 0
  
 COMP     VFD    18/3R   ,24/0,18/3R
  
 LISTR                             ** ENTRY/EXIT LINE **
          BX7    X2 
          NZ     B1,LISTR1         IF WC .NE. 0 
          SB1    B2                WC = DLINE 
 LISTR1   ZR     X2,LISTR.O        IF NO HEADER WORD
          SA7    B7+B1             STORE HEADER WORD
          SB1    B1+B5             WC = WC+1
  
 LISTR.O  SA3    COMP 
          MX0    L.BCDLN
          SB6    WPL               WORDS/LINE 
          LX0    L.BCDLN+P.BCDLN
          MX4    L.REP             REP COUNT MAP
  
*         LOOP THROUGH THE LIST 
  
 LISTR.I  SA2    X1                X2 = WORD
          BX6    X0*X2             EXTRACT INTEGER
          IX7    X3+X6             ADD COMPLEMENT 
          SA7    B7+B1
          BX5    X4*X2             EXTRACT REP COUNT
          NZ     X5,LISTR.R        IF A REP COUNT 
  
 LISTR.II SB1    B1+B5             WC = WC+1
          EQ     B1,B6,LISTR.D     JUMP IF A FULL LINE
  
          SX1    X2 
          NZ     X1,LISTR.I        LOOP IF NOT END OF LIST
          SX5    B1+2-WPL 
          NG     X5,LISTR          EXIT IF AT LEAST 2 WORDS LEFT
  
*         DUMP THE ACCUMULATED LINE 
  
 LISTR.D  SX6    X2 
          SA6    TEMPA             SAVE LIST ADDRESS
          MX0    48 
          BX7    X0*X7             CREATE A ZERO BYTE 
          SA7    A7 
          SB7    B1 
          SB1    1
          LISTL  LBUF,B7
          SA1    TEMPA
  
*         RESET B7 , WORD COUNT AND FIRST DLINE WORDS OF BUFFER 
  
          SA4    DLINE
          SA2    BFILL             BLANK FILL FLAG
          SB7    LBUF 
          SB5    B1 
          SB1    X4 
          ZR     X2,LISTR.D1       IF FIRST DLINE WORDS ARE BLANK FILLED
          BX7    X2 
          MX6    0
          SA6    A2                CLEAR FLAG 
          SB2    B0 
  
+         SA7    B7+B2
          SB2    B2+B5
          LT     B2,B1,*
  
 LISTR.D1 NZ     X1,LISTR.O        IF MORE REFS 
          SB2    B1                B2 = WC RESET IF LISTR IS CALLED AGAI
          SB1    B0 
          EQ     LISTR
  
*         PROCESS REP COUNT 
  
 LISTR.R  BX6    X2 
          SA6    TEMPA
          LX5    L.REP
          SX1    X5+B5
          SB6    B1 
          SB1    1
          CALL   CDD               RETURNS (X6) = INTEGER, DPC -A- FMT
          SB5    B1 
          SB1    B6 
  
*         FORM REPS*LINE NUMBER 
  
          SA2    TEMPA
          MX4    L.REP             RESTORE REP COUNT MASK 
          SA1    A7                REFETCH WORD 
          MX7    60-18
          SX5    1R*
          LX1    60-6 
          BX6    -X7*X6            EXTRACT 3 DIGITS 
          LX6    6
          IX5    X5+X6             X5 = 4RNNN*
          BX3    -X4*X2 
          AX3    P.BCDLN+L.BCDLN
          SB3    X3+12             B3 = SC FOR REP COUNT
          LX5    B3,X5
          MX7    60-24
          LX3    B3,X7
          BX1    X3*X1             REMOVE 4 CHARACTERS
          BX7    X1+X5             AND ADD IN REP COUNT 
          SA7    A7 
          SB6    WPL               ** X0 , B7 , B1 UNTOUCHED BY CONDEC
          SA3    COMP 
          EQ     LISTR.II 
          TITLE              FMT - FORMAT LINE
*** 
*         FMT - FORMAT DATA IN VBUF AND STORE IN LBUF 
*         EQUIVALENT TO A FORMATTED WRITE STMT IN "FORTRAN" 
* 
*         ON ENTRY: 
*                A5 = ADDRESS OF FORMAT SPEC
*                NEXTE = 0 IF NO MORE ELEMENTS IN LIST
*                DLINE = 0 IF SHORT MAP 
*                ELSE = NUMBER OF WORDS TO PAD PARTIAL LINE OUT TO
* 
*         ON EXIT:  
*                IF THE SHORT MAP OPTION IS ON, THEN THE LINE IS DUMPED 
*                TO THE LIST FILE.
*                IF THE LONG MAP OPTION IS ON , THEN THE LINE IS PADDED 
*                OUT WITH BLANKS FOR "DLINE" WORDS , B1 = "DLINE" AND 
*                BLANK FILL FLAG, "BFILL" IS SET TO BLANKS .
* 
*         REGISTER ASSIGNMENTS
* 
*         X0     FORMAT SPEC
*         X1     NEXT ITEM FROM VBUF
*         X7     CURRENT WORD 
  
 WC       MICRO  1,,/B1/           WORD COUNT 
 BC       MICRO  1,,/B3/           BIT COUNT ( NUMBER OF BITS IN ITEM ) 
 60       MICRO  1,,/B6/           CONSTANT 60
 BL       MICRO  1,,/B7/           BITS LEFT IN THE WORD
  
 FMT
          SX7    A1 
          SA7    WORDA             SAVE SYMTAB ADDRESS FOR SORTRL 
          BX0    X5                FORMAT SPEC TO X0
          SA0    LBUF              STORE ADDRESS
          S"BL"  60                BITS LEFT
          S"WC"  B0                WORD COUNT 
          SA5    A5+B5             POSSIBLE SECOND WORD 
          MX7    0                 CLEAR ACCUMULATED WORD 
          BX6    X5 
          S"60"  "BL"              FOR COMPARES 
          SA6    A0-B5             SAVE 
          SA1    VBUF              FIRST ITEM 
  
*         EXTRACT FORMAT SPEC 
  
 FMT.L    LX0    3
          MX5    60-3 
          BX2    -X5*X0            EXTRACT INDEX
          LX0    4
          MX5    60-4 
          BX3    -X5*X0            EXTRACT FIELD WIDTH
          SB2    X2                INDEX
          SB4    X3                CHAR COUNT 
          S"BC"  B4+B4
          LX3    2
          S"BC"  "BC"+X3           BIT COUNT = 6*CHAR COUNT 
          JP     B2+FMT.TBL 
  
 FMT.TBL  SA2    DLINE             0 - TERMINATE LINE 
          EQ     FMT.FIN
  
          SA2    A0-B5             1 - FETCH NEXT FORMAT WORD ( 2 MAX ) 
          BX0    X2 
          EQ     FMT.L
  
+         BX5    X1                2 - AN 
          SA1    A1+B5
          EQ     FMT.ADD
  
          SA5    BLANKS+B4         3 - NX 
          EQ     FMT.ADD
  
          EQ     FMT.IN            4 - IN INTEGER FIELD OF WIDTH N
  
          EQ     FMT.Z8            5 - OCTAL DIGITS WITH LEADING 0 SUPP 
  
          RJ     OCTC              6 - OCTAL CONVERSION WITH TRAILING B 
          EQ     FMT.NXT
  
 FMT.Z8   RJ     Z8 
 FMT.NXT  SA1    A1+B5             NEXT ITEM
          BX5    X6 
          SPACE  3
*         ADD CHARACTERS TO THE STRING
*         X5 = NL_STRING , X7 = WORD , BL , 60 , BC REGISTERS SET 
  
 FMT.ADD  LE     "BC","BL",FMT.ADD1   IF BC .LE. BL 
          MX2    1
          SB2    "BL"-B5
          AX3    B2,X2             MASK(BL) 
          BX4    X3*X5
          LX6    "BL",X4
          IX7    X7+X6             ACCUMULATE WORD
          SA7    A0+"WC"           STORE WORD 
          BX5    -X3*X5 
          S"BC"  "BC"-"BL"
          LX7    "BL",X5           POSITION REMAINING CHARACTERS
          S"WC"  "WC"+B5
          S"BL"  "60"-"BC"         UPDATE BITS LEFT 
          EQ     FMT.L
  
 FMT.ADD1 LX5    "BL",X5           JUSTIFY STRING 
          BX7    X7+X5
          S"BL"  "BL"-"BC"         UPDATE BIT COUNT 
          NZ     "BL",FMT.L        IF WORD IS NOT FILLED UP 
          SA7    A0+"WC"           STORE WORD 
          S"WC"  "WC"+B5           WC = WC+1
          MX7    0
          S"BL"  "60"              RESET BITS LEFT
          EQ     FMT.L
  
*         INTEGER CONVERSION
  
 FMT.IN   SA7    A0+"WC"           SAVE CURRENT WORD
          PX1    X1                PACK INTEGER 
          SA4    =1H
          SA2    =0.1000000001P48  X2 = .1 + ROUNDING FACTOR
          SA3    =10.0P0
          SB4    1R0-1R 
          BX6    X4                SET RESULT TO BLANKS 
          SB2    "60"-"BC"         INITIALIZE SHIFT COUNT 
  
 INL      DX4    X1*X2             N*.1 
          FX1    X1*X2             N*.1 
          LX6    54 
          SB2    B2+6              SC = SC+6
          FX5    X4*X3             REMAINDER
          SX7    X5+B4             CONVERT TO DPC 
          IX6    X6+X7             ADD TO STRING
          UX5    X1 
          NZ     X5,INL 
  
          LX6    54 
          SB4    "BC"-B5
          MX4    1
          LX5    B2,X6             JUSTIFY
          AX4    B4,X4             MASK(BC) 
          SA3    A0+"WC"
          S"60"  60                RESTORE COMPARE REGISTER 
          BX7    X3 
          SA1    A1+B5             NEXT ITEM
          BX5    X4*X5
          EQ     FMT.ADD
          SPACE  3
*         END OF FORMAT 
  
FMT.FIN   NZ     X2,FMT.FIN1       IF PADDING REQUIRED
  
*         SHORT MAP - FILL OUT LINE WITH BLANKS, MOVE IT TO PBUF
*         AND PRINT IT IF WE HAVE A FULL LINE OR NEXTE = 0
  
          SA5    BLANKS+B4
          GT     B4,B5,FMT.X       IF AT LEAST A ZERO BYTE LEFT 
  
          LX3    "BL",X5           FILL OUT CURRENT WORD
          BX6    X7+X3
          SA6    A0+"WC"
          S"BL"  B0 
          MX7    0
          S"WC"  "WC"+B5
          SA5    =10H 
  
 FMT.X    LX6    "BL",X5
          BX7    X7+X6             LAST WORD = 10LXXX 
          SA7    A0+"WC"
          S"WC"  "WC"+B5           WC = WC+1
  
          SA1    ACCWC             MOVE LINE TO PBUF AND DUMP IF NECESS 
          SB6    WPL               WORD LIMIT FOR THE LINE
          SB4    X1+B1             TOTAL WORD COUNT 
          LE     B4,B6,FMT.X1      IF ENOUGH ROOM TO ADD
  
          SX6    B1 
          SA6    A1                SAVE WORD COUNT IN ACCWC 
          SB7    PBUF 
          SB1    X1 
          RJ     DLL               DUMP LINE
          SA1    ACCWC
          SB7    LBUF 
          SA5    NEXTE
          SB1    X1 
          MX1    0
          ZR     X5,FMT.X2         IF THIS IS THE LAST IN THE LIST
  
 FMT.X1   SA2    LBUF              ADD WORDS IN LBUF TO LINE BEING FORME
          SB7    PBUF              IN PBUF
          SA5    NEXTE
          SB2    B1 
          LX7    X1 
  
+         BX6    X2                MOVE WORDS TO PBUF 
          SA2    A2+B5
          SB2    B2-B5
          SA6    B7+X7
          SX7    X7+B5
          NZ     B2,*-1            LOOP IF MORE TO GO 
          SA7    A1                UPDATE ACCWC 
          NZ     X5,FMT            IF MORE ELEMENTS IN THE LIST 
          SB1    X7 
  
*         END OF LIST - DUMP LAST PARTIAL LINE
  
 FMT.X2   MX7    0
          SA7    A1                ACCWC = 0
          RJ     DLL               DUMP THE LINE
          EQ     FMT
  
*         LONG MAP - PAD UP TO COL DLINE*10 WITH BLANKS 
  
 FMT.FIN1 SA1    =10H 
          SA3    BLANKS+B4
          SB2    X2 
          BX6    X1 
          SA6    BFILL             SET BLANK FILL FLAG FOR LISTV
          LX4    "BL",X3
          EQ     "BL","60",FMT.FINL  IF CURRENT WORD IS EMPTY 
          BX7    X7+X4             FILL OUT CURRENT WORD
          SA7    A0+"WC"
          S"WC"  "WC"+B5
  
 FMT.FINL EQ     "WC",B2,FMT       IF FINISHED
          SA6    A0+"WC"
          S"WC"  "WC"+B5           WC = WC+1
          EQ     FMT.FINL 
          TITLE              MACROS 
 F=       EQU    0                 TERMINATE THE STRING 
 F=A      EQU    2                 AN 
 F=X      EQU    3                 XN  ( NX ) 
 F=I      EQU    4                 IN 
 F=Z      EQU    5                 Z8 
 F=O      EQU    6                 O6,*B *
          SPACE  3
*         MACRO TO CREATE A FORMAT SPEC FOR "FMT" 
  
*         FORMAT SPEC IS WRITTEN AS (TZ1,TZ2,...) 
*         WHERE T MAY BE: A,I,O,X OR Z AND 0 @ ZI @ 11
  
 FORMAT   MACRO  STRING 
          LOCAL  IC,C,SEP,CH,FL 
 FL       SET    0
 IC       SET    0                 ITEMS IN CURRENT WORD
 C        SET    1                 COLUMN POINTER 
  
          DUP    72 
 CH       MICRO  C,1,/STRING/ 
 C        SET    C+1
          VFD    3/F="CH"          INDEX
  
 OT       IFNE   F="CH",0 
 CH       MICRO  C,1,/STRING/ 
 SEP      MICRO  C+1,1,/STRING/ 
 C        SET    C+2
          IFC    NE,/"SEP"/,/,2 
 C        SET    C+1
 CH       MICRO  1,,/"CH""SEP"/    FIELD WIDTH
          VFD    4/"CH" 
 IC       SET    IC+1 
 FL       SET    FL+"CH"
  
 ET       IFEQ   IC,8 
          VFD    4/2               CODE = 1 ( GET SECOND WORD ) 
 IC       SET    0
 ET       ENDIF 
  
 OT       ELSE
 IC       SET    FL/10
 IC       SET    FL-IC*10 
          VFD    4/10-IC,$/0       COUNT TO FILL OUT WORD 
          STOPDUP 
 OT       ENDIF 
  
          ENDD
  
          ENDM
          EJECT 
 FMTL     MACRO  STRING            FORMAT AND OPTIONALLY PRINT A LINE 
          LOCAL  X
          USE    DATA 
 X        BSS    0
          FORMAT (STRING) 
          USE    *
          SA5    X
          RJ     FMT
          ENDM
  
 LISTR    MACRO  A,B,C
          LOCAL  X
O         IFC    EQ,/A/NOHEAD/
          SA5    B0                NO HEADER CASE 
O         ELSE
          USE    DATA 
 X        DATA   10L_A
          DATA   10L_B
          DATA   10L_C
          USE    *
          SA5    X
O         ENDIF 
          RJ     LISTV
          ENDM
  
*         MACROS FOR THE PRINT LOOPS
  
 CLIST    MACRO  POINTER,LABEL     CHECK FOR AN EMPTY LIST
          SA5    POINTER
          ZR     X5,RMAP.LABEL
          ENDM
  
 LOOPT    MACRO  DUMMY,LABEL       PRINT LOOP TERMINATOR TEST 
          SA5    NEXTE             POINTER TO NEXT ELEMENT
          NZ     X5,RMAP.LABEL
          ENDM
  
 GSYM     MACRO  STORE             SET UP REGISTERS 
  
*         ON ENTRY:  X5 = POINTER TO NEXT ELEMENT 
  
          SA4    X5                30/NEXT,30/WORD A
          MX0    L.NAME 
          SA1    X4                WORD A 
          BX6    X0*X4
          SA2    A1-B5             WORD B 
          AX6    30 
          SB7    VBUF+1 
          BX7    X0*X1             EXTRACT NAME 
          SA6    NEXTE             SAVE POINTER TO NEXT ELEMENT 
          IFC    NE,/STORE//,1
          SA7    STORE             STORE NAME 
          ENDM
  
 EFIELD   MACRO  FIELD             EXTRACT A FIELD FROM SYMTAB
*                                  ENTRY IN X1 AND X2 
          IF     DEF,L.FIELD
          BX3    X2 
          MX0    60-L.FIELD 
          ELSE
          BX3    X.FIELD
          MX0    59 
          ENDIF 
          AX3    P.FIELD
          BX6    -X0*X3 
          ENDM
  
 LOOKUP   MACRO  TABLE             LOOKUP DPC REPRESENTATION IN TABLE 
          SA4    X6+TABLE 
          BX7    X4 
          ENDM
  
 TBIT     MACRO  BIT,LABEL,DPC
          BX3    X.BIT
          LX3    59-P.BIT 
          SB1    DPC
          NG     X3,RMAP.LABEL
          ENDM
  
 TBITN    MACRO  BIT,LABEL,DPC
          BX3    X.BIT
          LX3    59-P.BIT 
          SB1    DPC
          PL     X3,RMAP.LABEL
          ENDM
  
*         R=0 - TEST FOR LONG MAP OPTION OFF
  
 R=0      MACRO  LABEL             IF( R .EQ. 0 ) GO TO LABEL 
          SA5    REFACC 
          ZR     X5,RMAP.LABEL
          ENDM
          TITLE              MAIN LOOP
*         CLEAR LISTING SUBTITLE LINE.
  
 RMAPX    SX6    2R0
          SX7    1
          LX6    48 
          SA7    =XL.STITL         RESTORE LENGTH (WORDS OR CHARACTERS) 
          SA6    =XO.STITL
  
*         RESTORE ANY CHANGED NAMES 
  
          SA2    L.CNTBL
          ZR     X2,RMAPX1         IF NO CHANGED NAMES
          SA1    O.CNTBL           FWA
          MX0    L.NAME 
          SB1    X1                FWA
          SB2    B1+X2             LWA+1
  
 RMAPX.L  SA2    B1                42/7L_NAME,18/ADDRESS
          SA3    X2                WORD A OF SYMTAB 
          BX6    X0*X2
          SB1    B1+B5
          BX4    -X0*X3 
          IX7    X6+X4             RESTORE WORD A 
          SA7    A3 
          LT     B1,B2,RMAPX.L     LOOP TO THE END OF THE TABLE 
  
 RSOR     IFC    EQ, "C" .
  
*         RESTORE ALL FILE NAMES BACK TO INSTALLATION SELECTED
*         SPECIAL CHARACTER OF PERIOD.
  
          SA1    N.FILES
          ZR     X1,RSOR3          IF NO FILE NAMES 
          SB1    X1                N.FILES
  
          MX0    60-6 
          SA1    SYM1 
          SA2    X1-4 
  
 RSOR1    SB3    12                SHIFT COUNT
          LX2    60-12
  
 RSOR2    LX2    60-6 
          BX7    -X0*X2            EXTRACT A CHARACTER
          SX6    X7-1R
          SB3    B3+6 
          ZR     X6,RSOR2          IF A BLANK CHARACTER 
  
          LX2    B3,X2
          SX7    1R.-1R#
          LX7    B3,X7
          IX7    X2+X7             CONVERT # TO . 
          SA7    A2 
          SB1    B1-B5             N.FILES = N.FILES - 1
          SA2    A2-2              NEXT FILE NAME 
          NZ     B1,RSOR1          IF MORE FILES TO GO
  
 RSOR3    BSS    0
 RSOR     ENDIF 
 RMAPX1   SA1    RSELECT
          SA2    =XCP.LSTF
          PL     X1,RMAPX2   IF R .LT. 2
          NZ     X2,RMAPX2   IF L.NE.0
          SA2    =1H0 
          BX6    X2 
          SA6    =XO.TITL    IF L=0 AND R.GT.1 RESET FOR DOUBLE SPACE 
*         COMPUTE SCM REQUIREMENTS
 RMAPX2   SA1    L.PROGP
          SA2    L.BUFIO
          SA3    L.SCOM 
          IX4    X1+X2
          SA5    L.SBLK 
          IX4    X4+X3
          MX0    -17
          IX4    X4+X5
          BX4    X0*X4
          ZR     X4,RMAPX3   IF .LT. 131K OF SCM IS REQUIRED
  
          SX6    B1 
          SA6    =XCER.FL    HONOR THE A PARAMETER IF SPECIFIED 
          SB1    1
          LISTL  OVERFL,4 
          SB5    B1 
          SA2    N.FERR 
          SX7    X2+B1
          SA7    A2 
          NZ     X2,RMAPX3   IF FATAL ERROR ALREADY OCCURRED
          SX1    B5 
          CALL   IEM
  
 RMAPX3   SA1    BLKCOM 
          ZR     X1,REFMAP         IF NO BLANK COMMON 
          SA2    X1 
          SA3    =7L
          MX6    -18
          BX2    -X6*X2 
          BX6    X3+X2
          SA6    A2                RESTORE ORGTAB ENTRY 
  
 REFMAP   ENTRY.                   *** ENTRY/EXIT *** 
  
          SB5    1
          RJ     CPL               INITIALIZE, COMPUTE PROGRAM LENGTH 
          SPACE  2
**        DUMP SYMBOL TABLE 
* 
          SA2    SYMEND      LOW END
          SA3    SYM1        HIGH END 
          IX3    X3-X2       LENGTH 
          SX2    X2+1        START LOCATION TO WRITE
          SX3    X3-2        NUMBER OF WORDS TO WRITE 
          OUTSYM ZZ.SYM,X2,X3 
          SPACE  2
**        DUMP COMMON TABLE 
* 
          SA3    N.COM
          OUTSYM ZZ.COM,ORGTAB,X3 
          SPACE  2
          SA1    R=FLAG 
          SA2    E.UDEFL
          BX3    X1+X2
          CX4    X3 
          ZR     X4,RMAPX1         TERMINATE IF R=0 AND NO MISSING LABEL
  
          RJ     SORTSYM           SORT SYMTAB ALPHABETICALLY 
  
          SA1    E.UDEFL
          ZR     X1,RMAP1          IF NO MISSING LABELS 
          RJ     PML               PRINT THEN OUT 
          SA1    R=FLAG 
          ZR     X1,RMAPX          IF R = 0 
 RMAP1    SA1    R=FLAG 
          SA2    MAPTITL+3         (X2) = *AP (R=0)..*
          LX1    18 
          SB1    1
          IX6    X2+X1             ADD REF MAP LEVEL
          SA6    A2                LEVEL TO SUBTITLE TEXT 
          SA3    RSELECT
          PL     X3,RMAP1A   IF R .LT. 2
          SA2    =1H1 
          BX6    X2 
          SA6    =XO.TITL    IF R.GT.1 SET FOR PAGE EJECT 
 RMAP1A   NUPAGE
          LISTL  MAPTITL,4
          SB5    B1 
          RJ     SORTC             SORT THE NAMES INTO CATEGORIES 
          RJ     SORTR             SORT THE REFERENCES ( R .NE. 0 ) 
  
*         SEARCH FOR STRAY NAMES
*         I.E. - USEAGE DEFINED VARIABLES WITH ONLY ONE REFERENCE 
  
          SA2    L.UDV
          ZR     X2,RMAP4          IF NO UDV TABLE
          SA1    O.UDV
          SB1    X1                FWA
          SB2    B1+X2             LWA+1
          SA5    O.REFBAS 
          SA4    SYM1 
          SA0    X4                A0 = SYM1
          MX0    60-18
          SX7    V.FUN
          SA3    VALUE. 
          ZR     X3,RMAP2          IF NOT A FUNCTION SUBPROGRAM 
          SB1    B1+B5             SKIP VALUE. ENTRY
          EQ     B1,B2,RMAP4       IF ONLY 1 ENTRY
  
 RMAP2    SA1    B1                UDV TAB ENTRY 2J/X,18/SYMORD,18/X
          SB1    B1+B5
          AX1    18 
          SB3    X1                SYMORD 
          SA2    X5+B3             REFTAB BUCKET
          AX2    30 
          SA3    X2                FIRST REFERENCE
          BX4    -X0*X3            LINK 
          NZ     X4,RMAP3          IF MORE THAN ONE REF 
          SB3    B3+B3
          SA1    A0-B3             WORD A OF SYMTAB ENTRY 
          BX6    X7+X1
          SA6    A1 
 RMAP3    LT     B1,B2,RMAP2
 RMAP4    BSS    0
          SPACE  3
*         PRINT OUT THE ENTRY POINTS
  
          CLIST  O.ENT,LN          IF NO ENTRY POINTS 
          STITLE (ENTRY POINTS),18,(DEF LINE     REFERENCES)
          SA5    O.ENT
          AX5    30 
  
 RMAP.EP  GSYM   B7                GET SYMTAB ENTRY AND STORE NAME
          EFIELD RA                PROGRAM RELATIVE ADDRESS 
          SA3    =XQFLAG
          ZR     X3,RMAP5          IF NOT Q MODE
          SX6    B0                ADDRESS = 0
 RMAP5    SA6    B7-B5
          FMTL   (Z8,X2,A7)        FORMAT AND PRINT LINE
          R=0    EP2               IF R = 0 
  
          LISTR  NOHEAD            LIST THE REFERENCES
 RMAP.EP2 LOOPT  O.ENT,EP          LOOP IF MORE NAMES 
          TITLE              LOCAL NAMES
*         PRINT THE VARIABLE AND ARRAY NAMES, ETC 
  
 RMAP.LN  CLIST  O.VAR,FN          IF NO VARIABLES
          STITLE (VARIABLES     SN  TYPE           RELOCATION),48 
          SA5    O.VAR
          AX5    30 
  
 RMAP.LNL GSYM                     SET UP REGISTERS 
          EFIELD FUN               STRAY NAME FLAG
          SA4    DO.MAT+X6
          LX4    18 
          BX7    X4+X7             NAME + STRAY NAME INDICATOR
          SA7    B7 
          EFIELD RB 
          SB2    X6 
          AX3    P.RA-P.RB
          BX0    X1 
          SX6    X3                RA 
          LX0    59-P.FP
          AX0    59 
          BX6    -X0*X6            0 OR PROGRAM ADDRESS 
          SA3    =XQFLAG
          ZR     X3,RMAP.LNX       IF NOT Q MODE
          SX6    B0                ADDRESS = 0
 RMAP.LNX SA6    B7-B5
  
          EFIELD TYP               EXTRACT TYPE 
          LOOKUP TYPTBL 
          SA7    A7+B5             STORE IN VBUF
  
*         PROPERTY
  
          SX0    X6-T.RTN 
          SB1    =7L
          ZR     X0,RMAP.LN1       IF RETURNS 
          BX3    X1 
          LX3    59-P.DEF 
          MI     X3,RMAP.LN0 IF DEFINED 
          LX3    P.DEF-P.FP 
          SB1    =7L*UNDEF
          PL     X3,RMAP.LN1 IF NOT F.P.
 RMAP.LN0 TBIT   DIM,LN1,(=7L ARRAY )  IF DIMENSIONED 
          TBIT   VAR,LN1,(=7L       )    IF A VARIABLE
          SB1    =7L*UNUSED 
 RMAP.LN1 SA4    B1 
          BX7    X4 
          SA7    A7+B5
  
*         RELOCATION
  
          TBIT   FP,LN2,(=7L F.P.  )     IF A F.P.
          TBITN  COM,LN2,(=7L       )    IF NOT IN COMMON 
          SB1    ORGTAB-1+B2       ORGTAB(RB) 
 RMAP.LN2 SA4    B1 
          MX0    42 
          BX7    X0*X4
          SA7    A7+B5
  
          FMTL   (Z8,X2,A10,A7,X3,A7,X3,A7) 
          R=0    LN3               IF R = 0 
  
          LISTR  (   REFS   ),( DEFINED  ),( I/O REFS ) 
          SA1    VLFN 
          SA2    O.FREF 
          BX6    X1+X2             SET VARIABLE FILE NAME REFS FLAG 
          SA6    A1 
  
 RMAP.LN3 LOOPT  O.VAR,LNL         LOOP IF MORE NAMES 
          SPACE  3
*         PRINT THE FILE NAMES
  
 RMAP.FN  CLIST  O.LFN,FN4         IF NO FILE NAMES 
          STITLE (FILE NAMES        MODE),38
          SA5    O.LFN
          AX5    30 
  
 RMAP.FNL GSYM                     GET SYMTAB ENTRY 
          EFIELD FMODE             FILE MODE
          SB2    B0 
          ZR     X6,RMAP.FNO
          CX0    X6 
          SB2    B0-B5
          AX0    1
          NZ     X0,RMAP.FNO
          NX3    B2,X6
          SB3    B2-48
          SB2    B0-B3
  
 RMAP.FNO SA4    B2+FMODTAB+1 
          SA5    N.FILES
          ZR     X5,RMAP.FN1       IF NOT A PROGRAM 
  
*         PROGRAM - PRINT BUFFER ADDRESS, NAME AND MODE 
  
          EFIELD RA 
          SA5    =XQFLAG
          ZR     X5,RMAP.FNM       IF NOT Q MODE
          SX6    B0                ADDRESS = 0
 RMAP.FNM SA6    B7-B5             RA 
          SA7    B7                NAME 
          BX6    X4 
          SA6    A7+B5             MODE 
          FMTL   (Z8,X2,A7,X3,A7)  FORMAT LINE
          EQ     RMAP.FN2 
  
*         SUBPROGRAM - PRINT NAME AND MODE
  
 RMAP.FN1 SA7    B7-B5             NAME 
          BX6    X4 
          SA6    A7+B5             MODE 
          FMTL   (X10,A7,X3,A7) 
  
 RMAP.FN2 R=0    FN3               IF R = 0 
  
          LISTR  (  WRITES  ),(   READS  ),(  MOTION  ) 
 RMAP.FN3 LOOPT  O.LFN,FNL         IF MORE NAMES
  
 RMAP.FN4 SA5    VLFN 
          ZR     X5,RMAP.EX        IF NO VARIABLES WERE USED AS FILE NAM
          SA5    =48LVARIABLES USED AS FILE NAMES, SEE ABOVE
          RJ     PIL
          TITLE              EXTERNAL REFERENCES
 RMAP.EX  SA5    =7LNO TYPE        ADJUST TYPE TABLE
          BX6    X5 
          SA6    TYPTBL+T.ECS      MILNE KLUDGE 
  
*         EXTERNAL REFERENCES 
  
          CLIST  O.EXT,IF          IF NO EXTERNAL REFS
          STITLE (EXTERNALS          TYPE   ARGS),38,REFERENCES 
          SA5    O.EXT
          AX5    30 
  
 RMAP.EXL GSYM   B7-B5             STORE NAME 
          TBITN  FUN,EX1,(=7L       )    IF NOT A FUNCTION
          EFIELD TYP               EXTRACT THE TYPE 
          SB1    TYPTBL+X6
  
 RMAP.EX1 SA4    B1 
          BX7    X4 
          SA7    A7+B5             STORE FUNCTION TYPE OR BLANKS
  
          EFIELD FARG 
          SA6    A7+B5             NUMBER OF ARGS 
  
*         FLAG SPECIAL PROPERTIES OF FUNCTION 
  
          TBIT   LIB,EX2,(=8L LIBRARY)   IF A FORTRAN LIBRARY FUNCTION
          TBITN  FP,EX2,(=8L        )    IF NOT A FORMAL PARAMETER
          SB1    =8L   F.P. 
  
 RMAP.EX2 SA4    B1 
          BX7    X4 
          SA7    A6+B5
          FMTL   (X10,A7,X3,A7,I5,A8) 
  
          R=0    EX3               IF R = 0 
  
          SB7    LBUF 
          RJ     SORTRL            SORT THE REFERENCE LIST
          SA1    O.REFS 
          MX2    0
+         ZR     X1,*+1            IF NO REFS  ( SHOULD NEVER HAPPEN )
          RJ     LISTR             LIST THE REFERENCES
          ZR     B1,RMAP.EX3       IF NOTHING TO DUMP 
          SB6    B7-B5
          SA5    B6+B1
          MX0    48 
          BX6    X0*X5
          SA6    A5                ZERO BYTE FOR THE LAST WORD
          SB6    B7 
          SB7    B1 
          SB1    1
          LISTL  B6,B7
          SB5    1
 RMAP.EX3 LOOPT  O.EXT,EXL         LOOP IF MORE NAMES 
          TITLE              LOCAL FUNCTIONS
*         INLINE FUNCTIONS
  
 RMAP.IF  CLIST  O.ASF,NL          IF NO LOCAL FUNCTIONS
          STITLE (INLINE FUNCTIONS   TYPE   ARGS),38,( DEF LINE  REFEREN
,CES) 
          SA5    O.ASF
          AX5    30 
  
 RMAP.IFL GSYM   B7-B5             GET SYMTAB ENTRY AND STORE NAME
  
          EFIELD TYP
          LOOKUP TYPTBL            GET FUNCTION TYPE
          SA7    A7+B5
  
          EFIELD FARG              NUMBER OF ARGS 
          SA6    A7+B5
  
          EFIELD ASF
          LOOKUP ASFINT            INT OR ASF 
          SA7    A6+B5
  
          FMTL   (X10,A7,X3,A7,I5,A8) 
  
          R=0    IF1               IF R = 0 
  
          LISTR  NOHEAD            LIST THE REFERENCES
 RMAP.IF1 LOOPT  O.ASF,IFL         LOOP IF MORE NAMES 
          SPACE  4
*         NAMELIST GROUP NAMES
  
 RMAP.NL  CLIST  O.NML,SL          IF NO NAMELIST NAMES 
          STITLE (NAMELISTS),18,(DEF LINE     REFERENCES) 
          SA5    O.NML
          AX5    30 
  
 RMAP.NLL GSYM   B7-B5             GROUP NAME 
          FMTL   (X10,A7) 
  
          R=0    NL1               IF R = 0 
  
          LISTR  NOHEAD            LIST THE REFERENCES
 RMAP.NL1 LOOPT  O.NML,NLL         LOOP IF MORE NAMES 
          TITLE              LABELS 
*         STATEMENT LABELS
  
 RMAP.SL  CLIST  O.LABEL,LP        IF NO LABELS 
          STITLE (STATEMENT LABELS),28,(  DEF LINE   REFERENCES)
          SA5    O.LABEL
  
 RMAP.SLL GSYM                     GET SYMTAB ENTRY 
          LX7    6
          BX7    X7*X0             5LNNNNN
          SA7    B7 
  
          EFIELD RA                RELATIVE ADDRESS 
          SA3    =XQFLAG
          ZR     X3,RMAP.SLM       IF NOT Q MODE
          SX6    B0                ADDRESS = 0
 RMAP.SLM SA6    B7-B5
  
          EFIELD SLD               DEFINITION FIELD 
          LOOKUP SLTAB
          SA7    A7+B5             ^ DEF  , FORMAT OF EXEC
  
*         CHECK FOR INACTIVE OR UNREFERENCED LABELS 
  
          BX3    X2 
          SX0    45B               RSN , RFN , DLT
          AX3    P.DLT
          BX5    X0*X3
          SA4    =9L
          NZ     X5,RMAP.SL1       IF REFERENCED
          SA4    SLATAB-1+X6       NO REFS   ,INACTIVE
 RMAP.SL1 BX7    X4 
          SA7    A7+B5
  
          FMTL   (Z8,X2,A5,A6,A9) 
  
          R=0    SL2               IF R = 0 
          LISTR  NOHEAD            LIST THE REFERENCES
  
 RMAP.SL2 LOOPT  O.LABEL,SLL       LOOP IF MORE LABELS
          SPACE  3
*         MACRO TO TEST FOR DO LOOP PROPERTY AND STORE BCD MESSAGE
  
 TDLP     MACRO  BIT,BCD
          LOCAL  NEXT 
          BX0    X1 
          LX0    59-DL.BIT
          PL     X0,NEXT
          SA4    =10L_BCD 
          BX7    X4 
          SA7    A7+B5
 NEXT     BSS    0
          ENDM
          TITLE              LOOPS
 RMAP.LP  SA1    O.LOOP 
          SA2    L.LOOP 
          ZR     X1,RMAP.CB        IF NO LOOP TABLE ( ERRORS OR R = 0 ) 
          ZR     X2,RMAP.CB        IF NO LOOPS
          MX6    1
          SA6    REFACC 
          STITLE (LOOPS  LABEL    INDEX     FROM-TO    LENGTH),48,PROPER
,TIES 
          SA5    O.LGL
          AX5    30 
  
 RMAP.LPL GSYM                     GET GENERATED SYMBOL 
          EFIELD RA 
          SA6    B7-B5             FWA OF LOOP
          EFIELD DLP
          SA6    LTEMP             SAVE LOOP PROPERTIES 
  
          SA4    SYM1 
          SA5    O.LOOP 
          SA0    X4 
          SA1    X5          12/ORD(CV),12/ORD(LABEL),18/0,18/LENGTH
          SX6    X5+2        ADVANCE TABLE POINTER
          SA6    A5 
          SX7    X1 
          SA7    LPLEN             LENGTH 
  
          AX1    36-1 
          MX3    -13
          BX2    -X3*X1 
          SB2    X2 
          NZ     B2,RMAP.LP1       IF NOT AN I/O LOOP 
          SA4    =5L
          EQ     RMAP.LP2 
 RMAP.LP1 SA2    A0-B2
          MX0    30 
          LX2    6
          BX4    X0*X2
 RMAP.LP2 BX7    X4 
          SA7    B7                LABEL
  
          AX1    13 
          LX1    1
          BX1    -X3*X1 
          SB2    X1 
          SA2    A0-B2             WORD A OF CV 
          MX0    L.NAME 
          BX7    X0*X2
          LX7    L.NAME            JUSTIFY TO BIT 42
          SA4    DO.MAT      MATERIALIZATION FLAG DISABLED(FCC2059) 
          BX7    X4+X7
          SA7    A7+B5       INDEX
          SA5    X5+B5             WORD 2 OF LOOP INFO 24/,18/LSN,18/FSN
          SX1    X5 
          AX5    18 
          CALL   CDD         CONVERT FSN
          SX1    X5 
          BX5    X6 
          SA4    =5L
          ZR     X1,RMAP.LPZ IF LSN = 0 
          CALL   CDD         CONVERT LSN
 RMAP.LPZ BX7    X4 
          MX0    L.BCDLN
          LX5    36 
          BX6    X0*X5       FROM 
          BX7    X0*X4       TO 
          SA6    A7+B5
          SA7    A6+B5
          FMTL   (Z8,X2,A5,X1,A10,X3,A4,X1,A4,O8,X1)
          SB7    LBUF 
  
*         PROPERTIES
  
          SA1    LTEMP             LOOP PROPERTIES
          SX0    V.OPT
          SB4    =10L 
          BX7    X0*X1
          NZ     X7,RMAP.LP3       IF NOT OPTIMIZABLE 
          SB4    =10L    OPT
          SA3    LPLEN
          SX4    X3-L.STACK 
          PL     X4,RMAP.LP3       IF LOOP DOESN"T FIT IN THE INST STK
          SB4    =10L INSTACK 
  
 RMAP.LP3 SA4    B4 
          BX7    X4 
          SA7    B7+B1
          TDLP   J,(EXT REFS  ) 
          TDLP   E,( ENTRIES  ) 
          TDLP   X,(  EXITS   ) 
          TDLP   I,(NOT INNER ) 
          SA5    =8L             TERMINATE THE LINE 
          BX7    X5 
          SA7    A7+B5
          SB2    A7+B5
          SB6    B7 
          SB1    1
          SB7    B2-B7
          LISTL  B6,B7
          SB5    1
 RMAP.LPX LOOPT  O.LGL,LPL
          TITLE              COMMON BLOCKS
 RMAP.CB  SA1    N.COM
          ZR     X1,RMAP.EC        IF NO COMMON 
          SA2    R=FLAG 
          SX3    X2-3 
          MX6    0
          NZ     X3,RMAP.CB2       IF NOT R=3 
          SA4    L.COM
          ZR     X4,RMAP.CB2       IF FC ERROR IN DECLARATIVES
          MX6    1
 RMAP.CB2 SA6    REFACC 
  
          SA1    N.COM
          ZR     X1,RMAP.EC        IF NO COMMON 
          R=0    CB1               IF R = 0 
          SA2    L.COM
          SB6    RBUF              (B6) = FWA INPUT BUFFER
          SX7    B6+X1
          IX3    X1+X2
          SA7    O.COM             FWA OF COMTAB
          SB1    1
          READW  =XF.RMAP,B6,X3    -ORGTAB- AND -COMTAB- TO *RBUF)
          SB5    B1 
  
 RMAP.CB1 STITLE (COMMON BLOCKS   LENGTH),28,(MEMBERS - BIAS NAME(LENGTH
,)) 
          MX6    0
          SA6    TEMP              I = 0
  
 RMAP.CL  SA2    X6+ORGTAB         BLOCK NAME AND LENGTH
          MX0    L.NAME 
          BX6    X0*X2
          SA6    VBUF              NAME 
          MX0    60-17
          BX7    -X0*X2 
          SA7    A6+B5             LENGTH 
          LX2    -17
          MX0    -1 
          BX2    -X0*X2 
          SA5    SDS+X2            STORAGE DESCRIPTOR 
          BX6    X5 
          SA6    A7+1 
  
          FMTL   (X10,A7,I8,A4)    FORMAT THE LINE
  
          R=0    CL2               IF R = 0 
  
*         COLLECT AND LIST BLOCK MEMBERS
  
          SA1    TEMP 
          SA2    RBUF+X1           INDEX TO COMTAB
          SA3    O.COM
          SB7    LBUF 
          IX6    X2+X3             FWA OF BLOCK 
          SA4    X6+B5
          BX7    X4                 SAVE NAME OF FIRST BLOCK MEMBER FOR 
          SA7    A2                 EQV PRINTOUT
  
 RMAP.CBL SA1    X6                BLOCK PREFIX WORD
          SA6    CLOC              CURRENT LOC
          SX7    X1 
          SA7    A6+B5             LINK 
          AX1    18 
          SX6    X6+B5             FWA
          SX7    X1                N.MEMBERS
          RJ     FBNB              FORMAT AND PRINT MEMBERS 
          SA1    CLOC 
          SA2    A1+B5             LINK 
          IX6    X1+X2
          NZ     X2,RMAP.CBL       IF MORE APPEARENCES
          RJ     DLL               DUMP LAST LINE 
  
 RMAP.CL2 SA1    TEMP 
          SA2    N.COM
          SX6    X1+B5
          IX3    X6-X2             I - L
          SA6    A1 
          NG     X3,RMAP.CL        IF MORE BLOCKS TO GO 
  
          SA1    L.SCOM 
          MX0    -17
          BX2    X1*X0
          ZR     X2,RMAP.EC  IF LENGTH WITHIN BOUNDS
          MX6    42 
          BX6    -X6
          SA6    A1 
          TITLE              EQUIVALENCE CLASS S
 RMAP.EC  SA1    L.EQV
          ZR     X1,RMAP.PS        IF NO EQUIV INFO 
          SA2    R=FLAG 
          SX3    X2-3 
          NZ     X3,RMAP.PS 
          SX6    B5 
          MX6    1
          SB1    1
          SA6    REFACC 
          READW  =XF.RMAP,EBUF,X1+B1     EQUIVALENCE INFO 
          SB5    B1 
  
          STITLE (EQUIV CLASSES   LENGTH),28,(MEMBERS - BIAS NAME(LENGTH
,)) 
          SX5    EBUF 
  
 RMAP.ECL SA1    X5 
          ZR     X1,RMAP.PS        IF FINISHED
          SX7    X1 
          SA2    SYM1 
          SX6    X5+B5             FWA OF MEMBERS 
          SA0    X2 
          SA6    CLI
          SA7    A6+B5             NUMBER OF MEMBERS IN CLASS 
          AX1    18-1 
          SB2    X1 
          MX0    L.NAME 
          SA2    A0-B2             WORD A OF BASE 
          BX6    X0*X2
          SA6    VBUF+1 
          AX1    36-17
          SX7    X1                CLASS LENGTH 
          SA7    A6+B5
          NZ     X7,RMAP.EC1       IF NO ERRORS 
          SB4    =7L*ERROR* 
          EQ     RMAP.EC2 
  
 RMAP.EC1 SB4    =7L
          PL     X1,RMAP.EC2       IF NOT IN COMMON 
          SA2    A2-B5              WORD B OF BASE
          EFIELD RB 
          SA3    RBUF-1+X6
          AX3    18-1 
          SB3    X3                 2*ORD OF BASE OF COMMON BLOCK 
          SB4    A0-B3
 RMAP.EC2 SA4    B4 
          MX0    L.NAME 
          BX6    X0*X4
          SA6    A6-B5
          FMTL   (X2,A7,X1,A7,I8)  FORMAT INITIAL INFO
  
          SB1    3           WC = 3 
          SA1    CLI
          SA2    A1+B5
          BX6    X1                FWA
          IX7    X1+X2
          SA7    A1 
          BX7    X2                LENGTH 
          SB7    LBUF 
          RJ     FBNB              FORMAT AND PRINT CLASS MEMBERS 
          RJ     DLL               DUMP LAST LINE 
          SA5    CLI               FWA OF NEXT CLASS
          EQ     RMAP.ECL 
 PPS      SPACE  3
 LISTS    MACRO  LOC,TEXT,NOTEST
          LOCAL  X
          USE    DATA 
 X        DIS    3,     TEXT
          USE    *
          SA1    LOC
          SA2    X
          IFC    EQ,//NOTEST/,1 
+         ZR     X1,*+1 
          RJ     PPS
          ENDM
  
*** 
*         PPS - PRINT PROGRAM STATISTICS
* 
 PPS1     FMTL   (A10,A10,A10,X1,O8,I8) 
 PPS
          SA3    A2+B5
          BX6    X2 
          SA6    VBUF 
          BX7    X3 
          SA7    A6+B5
          SA4    A3+B5
          BX7    X4 
          SA7    A7+B5
          BX6    X1                LENGTH 
          SA6    A7+B5
          SA6    A6+B5
          EQ     PPS1 
          SPACE  3
*         PRINT OUT MISCELLANEOUS STATISTICS
  
 RMAP.PS  MX6    0
          SA6    REFACC            CLEAR LONG MAP FLAG
          STITLE (STATISTICS),18
          IFNE   TEST,0 
          SA1    SYMORD 
          SA3    =XL.DIM
          SX4    X1-1              N.SYMBOLS
          LX4    1
          IX1    X3+X4             L.SYMTAB+L.DIMTAB
          SA2    =30H     SYMTAB+DIMTAB 
          RJ     PPS               PRINT COMBINED LENGTH OF SYM+DIMTAB
          ENDIF 
          SA1    =XQFLAG
          ZR     X1,RMAP.PSS       IF NOT Q MODE
          SX7    B0 
          SA7    L.PROGP           PROGRAM LENGTH = 0 
          SA7    L.BUFIO           BUFFER LENGTH = 0
 RMAP.PSS LISTS  L.PROGP,(PROGRAM LENGTH),NOTEST
          LISTS  L.BUFIO,(BUFFER LENGTH ) 
          LISTS  L.SCOM,("SCM" LABELED COMMON LENGTH) 
          LISTS  L.SBLK,("SCM" BLANK COMMON LENGTH) 
          LISTS  L.LCOM,("LCM" LABELED COMMON LENGTH) 
          LISTS  L.LBLK,("LCM" BLANK COMMON LENGTH) 
          SA1    =XPR.MXFL
          RJ     OCTC 
          SX7    2R 
          BX6    X6+X7
          LX6    -6 
          SA6    CMUSED+1 
          LISTL  A6-B1,3     *    NNNB SCM USED * 
  
 RMAPPSA  SB5    1
          IFNE   TEST,0 
          SA1    N.FP 
          ZR     X1,RMAPX    IF NO FORMAL PARAMS
          SA3    SYM1 
          SB1    X1 
          MX1    0
          SA4    X3-5        WORD B OF FIRST F.P. 
  
 RMAP.PS1 AX4    P.RA 
          SX5    X4 
          SB1    B1-B5
          IX1    X5+X1             ACCUMULATE SUM 
          SA4    A4-2 
          NZ     B1,RMAP.PS1       IF NOT FINISHED
          ZR     X1,RMAPX          IF NO ADDSUBS
          SA2    =30H          ADDSUBS
          RJ     PPS
          ENDIF 
          EQ     RMAPX
  
 CMUSED   DATA   20H
          DATA   8L"SCM" USED 
          TITLE              COMMON/EQUIV PRINT ROUTINES
*** 
*         FBNB - FORMAT BIAS, NAME AND BASE 
* 
*         ON ENTRY: 
*                X6,X7 = FWA AND LENGTH OF BNB TABLE
*                B1,B7 = WC AND FWA OF LINE BUFFER
* 
  
 FBNB 
          SA6    LI 
          IX7    X6+X7
          SA7    A6+B5
  
 FBNB1    SA1    X6 
          RJ     PBNB              PRINT AN ELEMENT 
          SA1    LI 
          SA2    A1+B5             LIMIT
          SX6    X1+B5
          IX0    X6-X2             I - L
          SA6    A1 
          NG     X0,FBNB1          IF NOT FINISHED
          EQ     FBNB 
          SPACE  3
*** 
*         DLL - DUMP THE LAST LINE
* 
 DLL
          ZR     B1,DLL 
          SB2    B1-B5
          SA1    B7+B2
          MX0    48 
          SB6    B7 
          SB7    B1 
          BX7    X0*X1             ZERO BYTE
          SB1    1
          SA7    A1 
          LISTL  B6,B7
          SB5    1
          EQ     DLL
          EJECT 
*** 
*         PBNB - PRINT BIAS,NAME AND LENGTH 
* 
*         ON ENTRY: 
*                B1,B7 = WC AND FWA OF LINE 
*                X1 = TABLE WORD, FORMAT: 
*                                  6/J,18/WC,18/SYMORD,18/BIAS
* 
  
 PBNB 
          NZ     B1,PBNB1          IF WC .NE. 0 
          SB1    3
  
 PBNB1    BX0    X1 
          SX1    X1 
          SB6    B1                (-CDD- DOES NOT USE B6)
          SB1    1
          CALL   CDD               RETURNS (X6) = INTEGER, DPC -A- FMT
          SA1    SYM1 
          AX0    18-1 
          SX2    X0                2*SYMORD 
          SA6    VBUF 
          IX3    X1-X2
          SA4    X3                WORD A 
          AX0    36-17
          MX5    L.NAME 
          SX1    X0                LENGTH 
          BX0    X5*X4
          CALL   CDD               RETURNS (X6) = INTEGER, DPC -A- FMT
          SB5    B1                (B5) = 1 
          LX6    6
          SX5    1R)-1R 
          SB1    B6                (B1) = LINE LENGTH (RESTORED)
          IX6    X6+X5             10L   NNN) 
          SB3    60 
          SB4    B3-B2
          MX5    60-6 
          LX6    B4,X6             NN)    N 
          BX7    X5*X6
          SX4    1R 
          BX6    -X5*X6 
          BX7    X4+X7             NN)
          SA2    =3R( 
          BX1    X0+X2             NAME ( 
          LX1    60-6 
          BX3    X5*X1
          BX6    X3+X6
          SA6    A6+B5
          SA7    A6+B5
  
          SB6    WPL-3
          LE     B1,B6,PBNB3       IF ROOM FOR 3 WORDS
  
          RJ     DLL               DUMP LINE
          SA1    BFILL
          SB1    3
          SB7    LBUF 
          ZR     X1,PBNB3          IF WE BLANK FILLED THE LINE
          BX7    X1 
          SB2    B0 
  
+         SA7    B7+B2             BLANK FILL THE FIRST 30 COULUMS
          SB2    B2+B5
          LT     B2,B1,*
  
 PBNB3    SA1    VBUF 
          SA2    A1+B5
          SA3    A2+B5
          BX6    X1 
          LX7    X2 
          SA6    B7+B1
          SA7    A6+B5
          BX6    X3 
          SA6    A7+B5
          SB2    A6+B5
          SB1    B2-B7
          EQ     PBNB 
          SPACE  3
*** 
*         PIL - PRINT INDENTED LINE ( 10X,TEXT )
* 
*         ON ENTRY: 
*                A5 = FWA OF LINE 
* 
 PIL
          SA4    =10H 
          SB1    1                 (B1) = 1 
          SB6    LBUF              (B6) = LINE FWA
          SB7    B1                (B7) = LINE LENGTH (WORDS) 
          BX7    X4 
          MX0    60-12
          SA7    B6 
 PIL1     LX7    X5 
          BX6    -X0*X5 
          SA5    A5+B1
          SA7    B6+B7
          SB7    B7+B1
          NZ     X6,PIL1           IF NOT END OF LINE 
          LISTL  B6,B7
          SB5    1
          EQ     PIL
          TITLE              SORTRL - SORT A SINGLE REFERENCE LIST
*** 
*         THE FOLLOWING ROUTINES ARE BUCKET SORTS ON THE VARIOUS
*         ATTRIBUTES WHICH THE SYMBOL TABLE AND REFERENCE LIST IS SORTED
*         ON. 
* 
*         IN EACH CASE THE SORT USES A BASE TABLE OF FIXED LENGTH 
*         THE THE REST OF WORKING STORAGE TO FORM THE LISTS THAT IT 
*         IS BUILDING.
*         THE BASE TABLE OR BUCKET IS ALWAYS OF THE FORM: 
*         30/ADDRESS OF THE FIRST LIST ELEMENT
*         ,30/ADDRESS OF THE LAST LIST ELEMNT 
* 
*         THE LISTS THEMSELVES, ARE OF VARIOUS FORMATS, BUT IN
*         GENERAL, THE WORD HOLDS A POINTER TO THE NEXT LIST ELEMENT
*         AND INFORMATION ABOUT THE CURRENT ELEMENT 
* 
  
 FRSTB    MACRO  TYPE              FIRST BUCKET MACRO 
 F.TYPE   VFD    30/O.TYPE,30/O.TYPE
          ENDM
  
*** 
*         SORTRL - SORT REFERENCES FOR A VARIABLE INTO REFERENCE AND
*         DEFINITION LISTS, MERGES REFERENCES WITH THE SAME LINE NUMBER 
* 
*         ON ENTRY: 
*                WORDA = ADDRESS OF WORD A OF SYMBOL
* 
*         ON EXIT:  
*                O.DEFS,O.REFS,O.FREF = 0 OR 60/FWA OF LIST 
* 
 SORTRL 
          SA1    SYM1 
          SA2    WORDA
          SA3    O.REFBAS 
          IX4    X1-X2
          AX5    B5,X4             ORDINAL = (SYM1-ADDRESS)/2 
          IX6    X3+X5
  
          MX0    L.BCDLN+6
          LX0    L.BCDLN+6+P.BCDLN  MASK TO EXTRACT LINE NO AND SC
          SA2    X6                FETCH BUCKET 
          AX2    30                POSITION 
  
*         SET UP THE BUCKETS AND DUMMY BUCKETS
  
          SA3    SORTR.B           FETCH PRESET BUCKETS 
          SA4    A3+B5
          MX7    0
          SA5    A4+B5
          BX6    X3 
          SA7    O.REFS            CLEAR O.REFS,O.DEFS,O.FREF 
          SA6    DSRB 
          SA7    A7+B5
          BX6    X4 
          SA6    A6+B5
          SA7    A7+B5
          BX6    X5 
          SA6    A6+B5
  
          SX5    B5 
          LX5    P.REP             TO INCREMENT THE REP COUNT 
  
          SB3    57 
          SB2    DSRB              FWA OF THE BUCKETS 
          EQ     SORTRLL
  
*         TWO ENTRIES THE SAME
  
 SORTRLI  IX6    X4+X5             INCREMENT REP COUNT
          SA6    A4                STORE ENTRY
  
*         SORT LOOP 
  
 SORTRLL  SX1    X2 
          SA2    X1                FETCH ENTRY
          ZR     X1,SORTRL         IF FINISHED
          AX7    B3,X2             POSITION REF/DEF BITS
          BX6    X2*X0             EXTRACT LINE NUMBER
          SA3    X7+B2             FETCH BUCKET 
  
          BX7    X0*X3             X7 = 30/FWA,30/0 
          SA4    X3                X4 = LAST ENTRY
          BX3    X0*X4             X3 = LINE NUMBER OF LAST ENTRY 
          SA6    A2                STORE ENTRY
          IX3    X3-X6
          ZR     X3,SORTRLI        JUMP IF THE SAME 
  
*         ADD ITEM TO LIST
  
          BX6    X4+X1             UPDATE THE LAST ENTRY
          IX7    X7+X1             UPDATE BUCKET
          SA6    A4 
          SA7    A3 
          EQ     SORTRLL           LOOP FOR THE NEXT ITEM 
          SPACE  3
*         PRESET DUMMY BUCKETS ( MOVED TO DSRB )
  
 SORTR.B  FRSTB  REFS 
          FRSTB  DEFS 
          FRSTB  FREF 
          TITLE              SORTR - REFERENCE TABLE SORT 
*** 
*         SORTR - SORT THE REFERENCE TABLE
* 
*         INPUT:   "REFMAP" FILE - THE REFERENCES GROUPED BY LINE NUMBER
* 
*         SORTS THE ACCUMULATED REFERENCE TABLE A LINE AT A TIME, 
*         BUILDING A BASE TABLE STARTING AT (O.REFBAS), WHOSE FORMAT
*         IS: 30/FIRST,30/LAST
* 
*         AND A REFERENCE LIST STARTING AT (O.REFBAS) + NSYMBOLS
*         FOR EACH REFERENCED NAME IN THE SYMBOL TABLE
*         FORMAT:  12/REF BITS,6/6*NCHAR,24/4R LINE NO ,18/LINK 
* 
*         (REFACC) = 1S59 IF REFERENCES WERE ACCUMULATED
* 
  
*         ERROR MESSAGES
  
 LOSTREF  DIS    ,*0  REFERENCES AFTER LINE     0 LOST* 
 INCFL    DIS    ,/  ** INCREASE FL BY NNNNNNB/ 
          SPACE  3
 SRT2     PL     B2,SRT3           IF END-OF-BUFFER, GO REFILL IT 
          SB5    B1 
  
 SORTR                             ** ENTRY/EXIT LINE **
          SA5    RSELECT
          PL     X5,SORTR    EXIT IF R .LT. 2 
  
#RM       IFEQ   CP#RM,0
          READ   =XF.RMAP,RCL 
#RM       ENDIF 
          SB1    1
          SA1    O.CNTBL           LWA+1 OF WORKING STORAGE 
          SA2    O.REFBAS 
          SA3    O.REFTAB 
          MX6    1
          IX4    X1-X3             LWAWORK - O.REFTAB 
          NG     X4,SORTERR        IF NOT ENOUGH ROOM FOR A BASE TABLE
          SA6    REFACC            SET REFERENCES ACCUMULATED FLAG
          IX1    X3-X2             (X1) = BASE TABLE LENGTH 
          SETZERO   X2,X1          CLEAR BASE TABLE 
          SA6    RBUF+RBUFL        LINE TERMINATOR TO *RBUF* LWA+1
  
*         FILL *RBUF* WITH REF/DEF INFORMATION. 
  
 SRT3     SX6    RBUF 
          SA6    TEMP              INITIALIZE BUFFER POINTER
          READW  =XF.RMAP,X6,RBUFL
          MI     X1,SRT9           IF PREMATURE EOF 
  
*         BEGIN PROCESSING NEW REF/DEF LINE.
  
 SRT4     SA1    TEMP 
          MX0    -12
          SA2    X1                (X2) = FIRST WORD OF LINE
          SB2    X1-RBUF-RBUFL
          ZR     X2,SRT2           IF END OF DATA OR END OF BUFFER
  
*         FIND END OF LINE. 
  
 SRT5     BX6    -X0*X2 
          SA2    A2+B1
          NZ     X6,SRT5           IF NOT END OF LINE 
          SB7    X1                (B7) = LINE FWA (-CDD- DOES NOT USE) 
          SX6    A2                LINE LWA+1 
          SX7    A2-B7             LINE LENGTH
          SA6    A1 
          SA7    SWC
  
*         LOOP PROLOGUE 
  
          SA1    B7                (X1) = FIRST WORD OF LINE
          AX1    45 
          CALL   CDD
          MX7    60-L.BCDLN 
          BX0    -X7*X6            4R LINE NO 
          SX2    B2 
          LX2    L.BCDLN           JUSTIFY SHIFT COUNT
          IX0    X2+X0
          LX0    P.BCDLN           12/0,6/6*NCHAR,24/ 4R LINE NO,18/0 
  
*         COUNT THE NUMBER OF PARCELS IN THE LINE USING THE PARCEL COUNT
*         FOR THE LAST WORD PLACED IN IT BY "ADDREF"
*         NUM OF PARCELS = 4*( WC - 1 ) + PARCEL COUNT - 1
  
          SA1    SWC
          SB5    15                (B5) = 15 = SHIFT COUNT DECREMENT
          SX2    X1-1              WC-1 
          SA3    B7+X2             (X3) = LAST WORD OF LINE 
          SB2    B5+B5             (B2) = 30 = INITIAL SHIFT COUNT
          SA1    B7                (X1) = FIRST WORD OF LINE
          MX7    57 
          AX3    12 
          BX6    -X7*X3            NUMBER OF PARCELS IN THE LAST WORD 
          LX2    2                 4*(WC-1) 
          IX7    X6+X2
          SB7    X7-1 
  
          SA4    O.REFBAS 
          SA5    O.REFTAB 
          SA3    O.CNTBL
          SB3    X4 
          SB6    X5 
          MX4    60-12
          IX3    X3-X5             STORAGE LEFT 
          SB7    B6+B7             LWA+1 TO BE STORED INTO
          MX5    3
          SB4    B2+B5             (B4) = 45 = SHIFT COUNT RESET
          IX6    X3-X7             LEFT - NEEDED
          NG     X6,SORTERR2       IF NOT ENOUGH
          SX6    B7 
          SA6    A5                UPDATE O.REFTAB ( NEXT WORD AVAILABLE
          SPACE  3
* 
*                            X0 = 4R LINE NR S18
*         A1 = ADR CURR WORD X1 = CURRENT WORD        B1 = 1
*         A2 = BUCKET ADD    X2 = BUCKET              B2 = SHIFT COUNT
*         A3 =LAST REF ADD   X3 = LAST REFERENCE IN BK  B3 = (O.REFBAS) 
*                            X4 = MASK(48)            B4 = 45 
*                            X5 = MASK(3)             B5 = 15 
*                                                     B6 = (O.REFTAB) 
*                            X7 = THIS REF            B7 = LWA+1
* 
 SRT6     PL     B2,SRT7           IF MORE PARCELS IN CURRENT WORD
          SA1    A1+B1             (X1) = NEXT WORD 
          SB2    B4                RESET SHIFT COUNT
 SRT7     AX7    X1,B2             RIGHT JUSTIFY PARCEL TO BE PROCESSED 
          SB2    B2-B5             SHIFT COUNT - 15 
          BX3    -X4*X7            EXTRACT VARIABLE ORDINAL 
          SA2    B3+X3             FETCH BUCKET 
          LX7    45 
          SA3    X2                FETCH LAST ENTRY 
          BX6    X5*X7             EXTRACT REF/DEF BITS 
          AX2    30                POSITION BUCKET
          IX7    X6+X0             REF + LINE NUMBER
          SA7    B6                STORE
          SX6    B6                ADDRESS OF THIS ENTRY
          NZ     X2,SRT8           IF NOT FIRST BUCKET ENTRY
          SA3    B3                A3 = (O.REFBAS)
          BX2    X6                X2 = ADDR OF THIS ENTRY
  
*         ADD REFERENCE TO LIST 
  
 SRT8     BX7    X3+X6
          SA7    A3                UPDATE THE REFERENCE 
          LX2    30                POSITION FWA 
          SB6    B6+B1             WSA + 1
          IX6    X2+X6             30/FWA,30/LAST 
          SA6    A2                STORE NEW BUCKET 
          LT     B6,B7,SRT6        IF LINE NOT ALL PROCESSED
          EQ     SRT4              LOOP FOR NEXT LINE 
  
*         PROCESS PREMATURE EOF ON -REFMAP- FILE. 
  
 SRT9     BSS    0
 .T       IFEQ   TEST,0 
          SB5    1
          EQ     SORTR             EXIT 
 .T       ELSE
          MESSAGE   RMAPERR,,RCL
          EQ     -1                ABORT JOB
 RMAPERR  DIS    ,/** PREMATURE EOF ON -REFMAP- FILE./
 .T       ENDIF 
          TITLE              ERROR HANDLING ( NOT ENOUGH STORAGE )
*         NOT ENOUGH STORAGE TO BUILD A FULL REFERENCE TABLE
  
 SORTERR  BX6    -X4
          SB1    1
          SA6    TEMP              SAVE EXTRA FL NEEDED 
          EQ     SERR4
  
 SORTERRX LISTL  LOSTREF,4         PUT OUT LOST REFERENCES MESSAGE
          SA1    TEMP 
          RJ     INCRFL            ISSUE A PLEA FOR MORE FL 
          SB5    1
          EQ     SORTR             EXIT 
  
 SORTERR2 AX0    18                POSITION LINE NUMBER 
          SA3    LOSTREF+2
          MX2    60-L.BCDLN 
          BX0    -X2*X0 
          BX3    X3*X2
          IX6    X3+X0
          SA6    A3 
          SX7    A1-RBUF-RBUFL
          BX7    -X7               LENGTH OF DATA IN INPUT BUFFER 
          LX7    2                 *4 = (APPROX) NR PARCELS LEFT
          SB1    1
          SA7    TEMP 
  
*         READ THE REST OF THE FILE AND ESTIMATE HOW MUCH STORAGE 
*         IS NECESSARY FOR A FULL MAP 
  
 SERR3    SA1    RBUF+RBUFL-1      LAST WORD IN BUFFER
          NZ     X1,SERR4    IF NOT AT THE END OF REFERENCES BLOCK
          SA1    A1-1        2ND LAST WORD IN PRU 
          MX6    -12         MASK FOR END OF LINE INDICATOR 
          BX1    -X6*X1 
          ZR     X1,SORTERRX IF AT END OF REFERENCES BLOCK
          ZR     X1,SORTERRX       IF END OF REFERENCES 
 SERR4    READW  =XF.RMAP,RBUF,RBUFL
          SA2    TEMP 
          SX6    X2+RBUFL*4 
          SA6    A2 
          ZR     X1,SERR3          IF NOT EOR/EOF 
          EQ     SORTERRX 
          SPACE  3
*** 
*         INCRFL - ISSUE A LINE TO THE OUTPUT FILE FOR MORE FL
*         ON ENTRY: 
*                X1 = AMOUNT OF FL NECESSARY
 INCRFL   ROUTINE 
          SX1    X1+77B            ROUND UP FL NECESSARY
          AX1    6
          LX1    6
          RJ     OCTC              CONVERT TO DISPLAY CODE
          SA6    INCFL+2           STORE IN MESSAGE 
          SB1    1
          LISTL  INCFL,3           PLACE MESSAGE ON OUTPUT
          SB5    1
          EQ     INCRFL 
          TITLE              PML - PRINT MISSING LABELS 
*** 
*         PML - PRINT MISSING LABELS
* 
 PML
          SB1    1
          SB6    =2C
          LISTL  B6,B1             BLANK LINE 
          SB5    B1 
          SA5    =18L UNDEFINED LABELS
          RJ     PIL               PRINT HEADER LINE
          SA5    O.LABEL
  
 PML.LP   MX3    2                 LOOP PROLOGUE
          SB1    B5                WC = 1 
          MX0    30 
          LX3    2+P.SLD
          SB6    WPL
          SB7    LBUF              FWA OF BUFFER
  
  
 PML.L    SA5    X5 
          SA1    X5                WORD A 
          SA2    A1-B5             WORD B 
          BX4    X3*X2
          AX5    30 
          ZR     X4,PML.U          IF UNDEFINED 
 PML.L1   NZ     X5,PML.L          IF MORE TO GO
          RJ     DLL               DUMP THE LINE
          EQ     PML
  
*         UNDEFINED LABEL - FORMAT IT AND PRINT IT OUT
  
 PML.U    LX1    6
          SA2    =5L
          BX4    X0*X1             5L_LABEL 
          LX2    30 
          BX7    X4+X2
          SA7    B7+B1
          SB1    B1+B5             WC = WC+1
          LT     B1,B6,PML.L1      IF NOT A FULL LINE 
  
          SX6    X5 
          MX0    48 
          SA6    TEMP 
          BX7    X0*X7
          SA7    A7                ZERO BYTE TO THE LAST WORD 
          SB6    B7 
          SB7    B1 
          SB1    1
          LISTL  B6,B7
          SA5    TEMP 
          SB5    1
          ZR     X5,PML            IF FINISHED
          EQ     PML.LP            LOOP 
          TITLE              SORTC - CATEGORY SORT
*** 
*         STORAGE PAST THIS POINT OVERLAID AFTER THE CATEGORY SORT
* 
 RBUF     BSS    0                 FWA OF INPUT BUFFER FOR SORTR
 RBUFL    =      100B              BUFFER LEN (SEE -ADDREF- IN -PS1CTL-)
 EBUF     EQU    RBUF+M.NCB+7      FWA OF EQV CLASS BUFFER
          SPACE  3
*** 
*         SORTC - CATEGORY SORT FOR FOR SYMBOLIC NAMES
* 
*         SORTS THE UNDIFFERENTIATED LIST OF NAMES IN TO THE
*         FOLLOWING LISTS:  
* 
*         O.VAR - VARIABLES,ARRAYS,FORMAL PARAMETERS AND RETURNS NAMES
*         O.ASF - INTRINSIC AND ARITHMETIC STMT FUNCTIONS 
*         O.EXT - EXTERNAL REFERENCES ( FUNCTIONS AND SUBROUTINES ) 
*         O.NML - NAMELIST GROUP NAMES
*         O.ENT - ENTRY POINT NAMES 
*         O.LFN - LOGICAL FILE NAMES
*         O.UDBG - UNUSED DEBUG VARIABLES 
* 
*         EACH POINTER IS OF THE FORM 30/NEXT ENTRY,30/0
* 
  
*         PRESET BUCKETS FOR THE CATEGORY SORT
*         THE EFFECT OF THESE BUCKETS IS TO AVOID THE FIRST TIME LOGIC
*         AND HELP THIS SORT LOOP REMAIN IN STACK 
  
          FRSTB  ENT               ENTRY POINTS 
          FRSTB  NML               NAMELIST 
          FRSTB  EXT               EXTERNAL REFS
          FRSTB  VAR               VARIABLES, ETC 
          FRSTB  ASF               LOCAL FUNCTIONS
          FRSTB  LFN               FILE NAMES 
          FRSTB  CGS               COMPILER GENERATED SYMBOLS 
          FRSTB  UDBG              UNUSED DEBUG VARIABLES 
          SPACE  3
 SORTC
          SA1    O.NAME 
          ZR     X1,SORTC          IF NO NAMES
  
          MX0    L.TYP
          SB7    -B5
          SX4    B5+B5             X4 = 2 
          MX5    59 
  
 SORTCL   SA1    X1                30/NEXT,30/WORD A
          SA2    X1+B7             WORD B 
          AX1    30 
          SA3    A2+B5             WORD A 
          SX7    A2+B5
          AX3    P.FUN
          SA7    A1                CLEAR LINK FIELD 
          BX6    -X5*X3            0 OR 1 
          NG     X2,SORTC1         IF NAMELIST , ENTRY , ETC
  
          AX2    P.EXT-1
          BX7    X4*X2             0 OR 2 
          IX6    X6+X7             FUN + 2*EXT BITS 
          SA2    EBUCADD+X6 
  
*         ADD ENTRY TO LIST , B1 = ADDRESS OF BUCKET
  
 SORTCA   SA2    X2                BUCKET - 30/FIRST,30/LAST
          SA3    X2                LAST ENTRY 
          AX2    30 
          SX6    A1 
          LX6    30 
          BX7    X6+X3             POINT PREVIOUS ENTRY TO THIS ONE 
          SA7    A3 
          BX6    X6+X2             30/LAST,30/FIRST 
          LX6    30 
          SA6    A2                UPDATE BUCKET
          NZ     X1,SORTCL         IF NOT FINISHED
          EQ     SORTC
  
 SORTC1   BX3    X0*X2             EXTRACT TYPE 
          LX3    L.TYP
          SA2    BUCKADD-T.NML+X3 
          EQ     SORTCA 
  
*         INDEX TABLE FOR VARIABLE NAME FETCH 
  
*                                 EXT  FUN
 EBUCADD  VFD    60/F.VAR          0   0
          VFD    60/F.ASF          0   1
          VFD    60/F.EXT          1   0
          VFD    60/F.EXT          1   1
  
*         INDEX TABLE FOR TYPES 10 - 17 ( NAMELIST , ENTRY , 0 , UNDBG )
  
 BUCKADD  VFD    60/F.NML 
          VFD    60/F.UDBG         UNUSED 
          VFD    60/F.ENT 
          VFD    60/F.LFN 
          VFD    60/F.CGS 
          DUP    T.DBG-T.CGS,1
          VFD    60/F.UDBG
          TITLE              SORTSYM - SYMBOL TABLE SORT
***** 
*         TABLES INVOLVED:  
* 
*         SYMBOL TABLE - 2 WORDS / ENTRY
*         FORMAT:  60/FLAGS,48/8H_NAME,12/FLAGS 
* 
*         POINTER TABLE - 1 WORD / ENTRY
*         FORMAT:  30/LINK TO NEXT POINTER,30/ADDRESS OF SYMTAB ENTRY 
* 
*         BUCKET TABLE 100B WORDS LONG
*         FORMAT:  30/ADDR OF FIRST ELEMENT,30/ADDR OF LAST ELEMENT 
*** 
*         A RADIX SORT ON THE CHARACTER IS USED TO SORT THE POINTER 
*         TABLE INTO 64 BUCKETS. THE POINTER TABLE IS THEN LINKED UP
*         USING THE POINTERS IN THE BUCKETS.  AFTER THE POINTER TABLE 
*         HAS BEEN SORTED ON ALL 7 CHARACTERS OF THE NAME, THE POINTER
*         TABLE WILL BE IN ALPHABETICAL ORDER.
* 
*         ONE SHOULD NOTE THAT COMPILER GENERATED SYMBOLS ARE ELIMINATED
*         VIRTUE OF THE FACT THAT WHEN WE RELINK THE POINTER TABLE, WE
*         DISCARD ALL ENTRIES THAT FALL INTO BUCKETS ABOVE 45B .
* 
*         THE RESULTS OF SORTING THE POINTER TABLE ARE 4 LINKED LISTS 
*         AND POINTERS TO THE HEAD OF THEM
* 
*         POINTER                  LIST 
*         O.NAME                   NAMES
*         O.LABEL                  STMT LABELS
*         O.LGL                    LOOP GENERATED LABELS
          SPACE  3
*         MACRO TO LINK 2 BUCKETS UP, X0 HAS 30 BIT MASK AND X1 BUCKET A
  
 LINKB    MACRO  BKB
          SA2    B3+BKB 
          RJ     LINKUP 
          ENDM
  
 CHANGE   MACRO  BKB               CHANGE NAMES WITH CHARACTER BKB APPEN
          SA2    B3+1R_BKB
          SX7    55B-1R_BKB 
+         ZR     X2,*+1 
          RJ     CNAME
          ENDM
          EJECT 
*** 
*         ERROR EXITS - INSUFFICIENT STORAGE
*         IT IS HIGHLY UNLIKELY THAT EITHER OF THE BELOW ERRORS WILL
*         EVER OCCUR UNLESS SOMEONE FOWLS UP THE WORKS IN THE PROCESS OF
*         DEBUGGING THE COMPILER
* 
 CNERR    SX6    A0-B7             INSUFFICIENT STORAGE TO BUILD CNTBL
          SX7    B7+B5
          SA6    L.CNTBL
          SA7    O.CNTBL
          SX6    -200B
  
 SORTCER  BX6    -X6
          SA6    TEMP 
          SB1    1
          LISTL  SERMSG,3 
          SA1    TEMP 
          RJ     INCRFL            ISSUE A NEED MORE FL MESSAGE 
          EQ     RMAPX             BY PASS THE REFERENCE MAP
  
 SERMSG   DATA   C*0CANT SORT THE SYMBOL TABLE.*
          SPACE  3
 SORTSYM                           *** ENTRY/EXIT *** 
          SA3    SYMORD 
          SA5    LWAWORK
          SX4    LWA.R             X4 = FWA OF WORKING STORAGE
          BX7    X5 
  
          SA7    O.CNTBL           INITIALIZE O.CNTBL 
          IX6    X3+X4             O.REFBAS = FWAWORK+NSYMBOLS
          IX7    X6+X3             O.REFTAB = O.REFBAS+NSYMBOLS 
          SX3    X3-1 
          SA6    O.REFBAS 
          SA7    O.REFTAB 
  
 SOR      IFC    EQ, "C" .
  
*         IF THE INSTALLATION SELECTED . AS THE FILE CHARACTER
*         MAKE A PASS OVER THE FILE NAMES AND CONVERT THEM TO A # 
*         CHARACTER APPENDED FOR THE DURATION OF REFMAP.  THEY WILL BE
*         CHANGED BACK ON EXIT
*         CHANGE ALL FILE NAMES SO THAT THEY ARE APPENDED WITH A #
*         INSTEAD OF A .   THIS PREVENTS CONFUSION WITH BASIC EXTERNAL
*         NAMES IN THE SYMBOL TABLE 
  
          SA1    N.FILES
          ZR     X1,SOR3           IF NO FILE NAMES 
          SB1    X1 
  
          MX0    60-6 
          SA1    SYM1 
          SA2    X1-4 
  
 SOR1     SB3    12                SHIFT COUNT
          LX2    60-12
  
 SOR2     LX2    60-6 
          BX7    -X0*X2            EXTRACT A CHARACTER
          SX6    X7-1R"C" 
          SB3    B3+6 
          NZ     X6,SOR2           IF NOT THE FILE CHARACTER
  
          LX2    B3,X2
          SX7    1R#-1R"C"
          LX7    B3,X7
          IX7    X2+X7             CONVERT "C" TO # 
          SA7    A2                REPLACE MODIFIED NAME IN SYMTAB
          SB1    B1-B5             N.FILES = N.FILES - 1
          SA2    A2-2              NEXT FILE NAME 
          NZ     B1,SOR1           IF MORE FILES TO GO
 SOR3     BSS    0
 SOR      ENDIF 
  
*         REPLACE VALUE. WITH NAME OF FUNCTION SUBPROGRAM 
  
          SA1    VALUE. 
          ZR     X1,SORTS1         IF NOT A FUNCTION SUBPROGRAM 
          SA2    SYM1 
          LX1    1
          IX7    X2-X1
          SA1    X7                WORD A OF VALUE. 
          MX0    L.NAME 
          BX6    X0*X1
          IX7    X6+X7
          SA7    X5                STORE CNTBL ENTRY
          SX6    B5 
          SA6    L.CNTBL           L.CNTBL = 1
          SA2    X2-2              WORD A OF SUBPROGRAM NAME
          BX6    X0*X2
          BX7    -X0*X1 
          IX6    X6+X7
          SA6    A1                SUBSTITUTE PROG NAME FOR VALUE.
  
 SORTS1   IX5    X5-X4             WORKING STORAGE
          IX7    X5-X3             WORKING STORAGE FOR SORT, ETC. 
          SX6    X7-102B
          NG     X6,SORTCER        IF NOT ENOUGH STORAGE
  
*         SET UP POINTER TABLE 30/*+1,30/SYMTAB ENTRY 
  
          SA2    SYMEND 
          SB1    X4                B1 = FWA WORK
          SB3    B1+X3             FWA OF THE BUCKETS 
          LX4    30                FWAWORK/0
          IX6    X4+X2             30/*,30/SYM
          SA5    =10000000002B
          SB2    B1                I = FWAWORK
  
 LA       IX6    X6+X5             SET UP POINTER TABLE 
          SA6    B2 
          SB2    B2+B5             I = I+1
          LT     B2,B3,LA 
  
          SX6    X6 
          SA6    A6                NO LINK ON LAST WORD 
  
          SB4    42                SHIFT COUNT
          SB2    B1                POINTER TO FIRST ENTRY 
  
*         SORT THE POINTER TABLE
  
*         DURING THE LOOP THE B REGISTERS ARE USED AS FOLLOWS:  
*         B1 = FWAWORK  B2 = FIRST  B3 = FWA OF THE BUCKETS 
*         B4 = SHIFT COUNT  B5 = 1
  
 LOOP     MX7    0
          SB6    B3+77B 
          MX0    54                ONE CHARACTER MASK 
  
 LB       SA7    B6                CLEAR THE BUCKETS
          SB6    B6-B5
          GE     B6,B3,LB 
  
*         SORT POINTER TABLE INTO 64 LINKED LISTS 
  
BINL      SA1    B2                30/NEXT,30/SYMTAB
          SA2    X1                SYMTAB ENTRY 
          LX3    B4,X2
          BX4    -X0*X3            EXTRACT CHARACTER
          SA5    B3+X4             FETCH BUCKET 
  
          SX6    X1 
          NZ     X5,ABUC           JUMP IF NOT THE FIRST ENTRY
  
          SA6    A1                STORE 30/0,30/SYMTAB 
          SX5    B2 
          EQ     ADDB1
  
*         LINK LAST ENTRY TO NEXT ENTRY 
  
 ABUC     SA2    X5                30/0,30/SYMTAB OF LAST ENTRY 
          SX3    A1 
          SA6    A1                STORE 30/0,30/SYMTAB 
          LX3    30 
          IX6    X3+X2             30/NEXT,30/SYMTAB
          AX5    30 
          SA6    A2 
  
 ADDB1    LX5    30                30/FIRST,30/0
          SX2    A1 
          IX6    X2+X5
          AX1    30 
          SA6    A5                STORE BUCKET 
          SB2    X1 
          NZ     X1,BINL           LOOP IF MORE LINKS 
  
          SB6    B4-6 
          ZR     B6,LINK           IF THE FIRST CHARACTER 
  
*         SORT THE . BUCKET KEEPING ONLY THOSE NAMES WITH THE 
*         BASIC EXTERNAL FUNCTION BIT SET 
  
          SA1    B3+1R. 
          MX7    0
          SA7    A1                CLEAR THE BUCKET 
  
 FBEF     AX1    30 
          ZR     X1,CHNAM          IF END OF THE LIST 
          SA1    X1                LIST ELEMENT 
          SA2    X1-1              WORD B 
          LX2    59-P.BEF 
          PL     X2,FBEF           IF NOT A BASIC EXTERNAL
  
          SX7    A1 
          LX7    30                30/FIRST,30/0
          SX6    A2+B5
          SA6    A1                A6 = LAST BUCKET ADD,X6 = LAST ENTRY 
  
 FBEFL    AX1    30 
          ZR     X1,FBEFX          IF END OF THE LIST 
          SA1    X1                LIST ELEMENT 
          SA2    X1-1              WORD B 
          LX2    59-P.BEF 
          PL     X2,FBEFL          IF NOT A BASIC EXTERNAL
  
          SX0    A1 
          LX0    30 
          BX6    X0+X6             LINK LAST TO THIS
          SA6    A6 
          SX6    A2+B5
          SA6    A1 
          EQ     FBEFL
  
 FBEFX    SX6    A6 
          BX7    X7+X6
          SA7    B3+1R.            UPDATE THE BUCKET
  
*         CHANGE NAMES OF ENTRIES IN SYMTAB WITH A $ . OR # APPENDED TO 
*         THEM.  SAVE OLD NAMES IN CNTBL, FORMAT: 42/7L_NAME,18/L(WORD A
  
 CHNAM    SB6    60 
          SB4    B6-B4             60-SC
          SA4    O.CNTBL           FWA
          SA5    L.CNTBL           LENGTH 
          SA0    X4                A0 = O 
          SB7    X5 
          MX0    L.NAME 
          SB7    A0-B7             B7 = O-L = NEXT STOREING ADDRESS 
          SB6    B3+100B           LWA OF THE BUCKETS 
  
          CHANGE $                 CHANGE NAMES WITH $ APPENDED 
          CHANGE .                 CHANGE NAMES OF BASIC EXTERNALS
          IFC    EQ, "C" . ,2 
          CHANGE #                 CHANGE THE FILE NAMES
          ELSE   1
          CHANGE "C"               CHANGE THE FILE NAMES
  
*         UPDATE TABLE LENGTH, RESTORE B4 
  
          SB6    60 
          SB4    B6-B4             RESTORE B4 
          SX6    A0-B7             X7 = O - ( O - L ) = L 
          SA6    L.CNTBL           UPDATE TABLE LENGTH
  
*         LINK UP SPECIAL BUCKETS - 0 BLANK . $ AND # ( FILE NAMES )
  
          SA1    B3                0 BUCKET 
          MX0    30 
          LINKB  55B               LINK BLANK TO ZERO BUCKET
          LINKB  1R$               LINK $ BUCKET TO RESULT
          LINKB  1R.               . BUCKET ( BASIC EXTERNAL FUNCTIONS )
          IFC    EQ, "C" . ,2 
          LINKB  1R#               FILE NAME CHARACTER
          ELSE   1
          LINKB  1R"C"             FILE NAME CHARACTER
          SA6    B3                STORE RESULT 
  
*         RELINK THE POINTER TABLE
  
 LINK     SB7    B3+1R9+1          LWA+1 OF BUCKETS TO BE LINKED
          SB6    B3                FWA
          MX6    0
  
 FLINK    SA1    B6 
          SB6    B6+B5             ADD = ADD+1
          NZ     X1,LINKA          JUMP IF FOUND A NON EMPTY POCKET 
          LT     B6,B7,FLINK
  
          EQ     SORTSN            GO SORT THE STMT NUMBERS 
  
 LINKA    LX1    30 
          SB2    X1                RESET FIRST
          MX0    30 
          LX1    30                FL(A)/LL(A)
  
 LINKC    GE     B6,B7,LINKZ
          SA2    B6                X2 = FL(B)/LL(B) 
          SB6    B6+B5
          ZR     X2,LINKC 
  
          SA3    X1                ( LLA) ) 
          BX4    X0*X2             FL(B)/0
          IX6    X4+X3             FL(B)/(LL(A))
          SA6    A3 
          BX1    X2                X1 = FL(B)/LL(B) 
          EQ     LINKC
  
 LINKZ    SB4    B4-6 
          NZ     B4,LOOP           LOOP FOR 7 CHARACTERS
  
          SX6    B2 
          SA6    O.NAME            SAVE POINTERS TO THE NAMES 
  
 SORTSN   SA4    O.CNTBL
          SA5    A4+B5             L.CNTBL
          SX4    X4+B5
          IX6    X4-X5             ADJUST ORIGIN OF THE TABLE 
          SA6    A4 
  
          SB6    6
          GT     B4,B6,SORTSYM     IF WE DIDNT FINISH THE ALPHA SORT
  
          SA1    B3+1R)            LOOP GENERATED LABELS
          BX6    X1 
          SA6    O.LGL
          SPACE  3
*         SORT THE STATEMENT NUMBERS ON THE NUMBER OF CHARACTERS
*         THAT EACH ONE HAS TO BRING THEM IN ASCENDING ORDER
  
          SA1    B3+1R. 
          ZR     X1,SORTSYM        EXIT IF NO STMT NUMBERS
          AX1    30 
          SB2    X1                SET B2 = FIRST 
          SA5    =10H 
          BX0    X5                X0 = 55 55 55 55 ........
          SA4    =10H5555555555    X4 = 40404040404040... 
  
          MX7    0
          SB6    B3+10D 
+         SA7    B6                CLEAR THE BUCKETS
          SB6    B6-B5
          GE     B6,B3,*
  
 BINS     SA1    B2                30/NEXT,30/SYMTAB
          SA2    X1                FETCH SYMTAB ENTRY 
  
          AX2    24                SHIFT OFF TRASH
          SX5    B5                X5 = 1 
          BX3    X2-X0             JJJJ 00 00 00
          IX6    X3-X5             JJJ J-1 77 77 77 
          BX5    -X6+X3            77 77 77 4X 00 00 00 
          BX2    X4*X5             40 40 40 00 00 00
          CX3    X2                BUCKET NUMBER IN X3
          SA5    B3+X3             FETCH BUCKET 
  
          SX6    X1 
          SA6    A1                STORE 30/0,30/SYMTAB 
          NZ     X5,ABUCS          JUMP IF NOT THE FIRST ENTRY
  
          SX5    B2 
          EQ     ADDBS
  
*         LINK LAST ENTRY TO NEXT ENTRY 
  
 ABUCS    SA2    X5                30/0,30/SYMTAB OF LAST ENTRY 
          SX3    A1 
          LX3    30 
          IX6    X3+X2
          SA6    A2 
          AX5    30 
  
 ADDBS    LX5    30                30/FIRST,30/0
          SX2    A1 
          IX6    X2+X5
          SA6    A5                STORE BUCKET 
          AX1    30 
          SB2    X1 
          NZ     X1,BINS           LOOP IF MORE LINKS 
  
*         RELINK THE POINTER LIST BY USING THE BUCKETS
  
 LINKS    SB7    B3+10D            LWA OF BUCKETS TO BE LINKED
          SB6    B3 
          MX6    0
 FLINKS   SA1    B6 
          SB6    B6+B5
          NZ     X1,LINKAS         JUMP IF FOUND A NON EMPTY POCKET 
          LE     B6,B7,FLINKS 
          EQ     SORTSYM           EXIT 
  
 LINKAS   LX1    30 
          SX6    X1 
          SA6    O.LABEL           SAVE LIST POINTER
          LX1    30                FL(A)/LL(A)
          MX0    30 
  
 LINKCS   GT     B6,B7,SORTSYM     IF FINISHED
          SA2    B6                X2 = FL(B)/LL(B) 
          SB6    B6+B5
          ZR     X2,LINKCS
          SA3    X1                ( LL(A) )
          BX4    X0*X2             FL(B)/0
          IX6    X4+X3             FL(B)/(LL(A))
          SA6    A3 
          BX1    X2 
          EQ     LINKCS 
          TITLE              SUBROUTINES TO HANDLE SPECIAL SYMBOLS
*** 
*         LINKUP - LINKUP 2 BUCKETS IN X1 AND X2
* 
*         ON EXIT:  
*                X1,X6 = RESULT BUCKET
* 
 LINKUP 
          BX6    X1 
          ZR     X2,LINKUP
          BX6    X2 
          ZR     X1,LINKUP1 
  
          BX6    -X0*X2            /LL(B) 
          BX5    X0*X1             FL(A)/ 
          SA3    X1                ( LL(A) )
          BX4    X0*X2             FL(B)/0
          IX6    X6+X5
          BX7    X3+X4
          SA7    A3                STORE UPDATED ENTRY
 LINKUP1  BX1    X6 
          EQ     LINKUP 
          SPACE  3
*** 
*         CNAME - CHANGE NAMES IN SYMTAB TO REMOVE SPECIAL CHARACTERS 
*         SAVE ORIGINAL NAME IN CNTAB 
* 
*         ON ENTRY: 
*                X0 = MASK(42) , X2 = BUCKET , X7 = 1R -1R_CHAR 
*                A0 = FWA OF CNTBL
*                B7 = FWA-LENGTH OF THE TABLE 
* 
  
 CNAME.L  SA2    X2                30/NEXT,30/WORD A
          SA3    X2                WORD A 
          BX7    X0*X3             NAME 
          SX4    X2                ADDRESS
          IX7    X7+X4
          SA7    B7                STORE CNTBL ENTRY
          SB7    B7-B5
  
          IX6    X3+X1             CHANGE WORD A OF SYMTAB ENTRY
          SA6    A3 
          AX2    30 
          LT     B7,B6,CNERR       IF WE RAN OUT OF STORAGE 
          NZ     X2,CNAME.L        LOOP IF NOT FINISHED 
 CNAME
          AX2    30 
          LX1    B4,X7             POSITION CHAR FOR NAME CHANGE
          EQ     CNAME.L
          TITLE              CPL - INITIALIZATION 
*** 
*         CPL - INITIALIZE REFMAP , COMPUTE PROGRAM LENGTH, ETC.
*         SET UP BIAS TABLE ( O.LRB ) TO FWA OF LOCAL BLOCKS
  
 CPL      ROUTINE 
          SETZERO O.CELLS,L.CELLS 
          SA5    SYM1 
          SA0    X5                A0 = FWA OF SYMTAB 
          SA1    =XN.FERR 
          NZ     X1,CPL8           SKIP RELOCATION IF FATAL ERRORS
  
*         COMPUTE THE FWA"S OF THE LOCAL BLOCKS AND THE PROGRAM LENGTH
  
          SA1    O.LBLK            LENGTH OF FIRST LOCAL BLOCK
          SB1    O.LRB             FWA OF TABLE 
          SB2    O.LRB+N.LRB
          SA3    PROGRAM
  
+         SA6    B1 
          IX6    X6+X1             SUM BLOCK LENGTH 
          SB1    B1+B5
          SA1    A1+B5             NEXT BLOCK LENGTH
          LT     B1,B2,*-1         LOOP THROUGH THE LOCAL BLOCKS
  
          SA6    L.PROG            PROGRAM LENGTH 
          UX4    B3,X3
          ZR     B3,CPL2           IF A PROGRAM 
          ZR     X3,CPL3           IF A BLOCK DATA SUBPROGRAM 
  
*         COMPUTE THE LENGTH OF THE FORMAL PARAMETER RELOCATION BASES 
  
          SA4    N.FP 
          ZR     X4,CPL3           IF NO FORMAL PARAMETERS
          SB3    X4 
          SA1    A0-5              WORD B OF FIRST F.P. 
          SB1    P.RA 
  
 CPL.FP   AX2    B1,X1             POSITION BLOCK LENGTH
          SB3    B3-B5
          SX3    X2 
          IX6    X6+X3             SUM
          SA1    A1-2 
          NZ     B3,CPL.FP         IF NOT FINISHED
  
          SA6    L.PROG 
          EQ     CPL3 
  
*         COMPUTE BUFFER LENGTH 
  
 CPL2     SA1    =XOT.RM
          SA2    =XN.FILES
          SX3    5           K=LEN LIBLNK(3)+FLINK APL TERM(1)+TRACE(1) 
          SX4    L.FIT6+1    +1 FOR FLINK TABLE ENTRY 
          ZR     X1,CPL2.2   IF CRM OBJECT MODE 
          SX3    2           K = LEN - PRINTLIM(1) + TRACE(1) 
          SX4    L.FIT7+1 
 CPL2.2   SA1    =XSTART.    BUF LEN + N.FILES*(L.FIT+1) + K
          SA5    N.EQUF      NR OF EQUIVALENCED FILES 
          ZR     X5,CPL2.3
          IX1    X1-X5       START. - NR OF EQUIVALENCED FILES
          IX2    X2-X5       NR OF FILES - NR OF EQUIVALENCED FILES 
 CPL2.3   IX2    X2*X4
          IX3    X1-X3
          IX7    X3-X2       BUF LEN
          IX6    X6-X7             PROGRAM LENGTH - BUFFER LENGTH 
          SA7    L.BUFIO
  
 CPL3     SA6    L.PROGP           PROGRAM LENGTH THAT WE PRINT 
  
*         SCAN THE SYMBOL TABLE, CHANGING THE ADDRESS"S OF LOCAL SYMBOLS
*         FROM BLOCK RELATIVE TO PROGRAM RELATIVE 
  
          SA4    ST.
          SA5    SYMORD 
          LX4    1
          SA0    A0-B5             A0 = SYM1 - 1
          LX5    1
          SB1    X4                B1 = INDEX = 2*ORD(ST.)
          SB2    X5                B2 = LIMIT 
          MX0    60-L.RL
          SA1    A0-B1
          MX7    60-L.RB
          SB3    B5+B5
          BX6    X1                X6 = WORD B
          SB4    O.LRB             B4 = BASE OF LOCAL BLOCK ADDR TBL
          SB7    P.RA 
  
 CPL5     LX6    60-P.RL
          SB1    B1+B3
          BX5    -X0*X6            RL 
          LX6    P.RL-P.RB
          SB6    X5 
          BX4    -X7*X6            RB 
          SA1    A1-B3             NEXT 
          NE     B6,B5,CPL6        IF NOT PROGRAM RELATIVE
          LX6    P.RB 
          SA4    X4+B4             O.LRB(RB)
          LX5    B7,X4
          IX6    X5+X6
          SA6    A1+B3
 CPL6     BX6    X1 
          LT     B1,B2,CPL5 
  
          SX3    B5 
          RJ     RPN               RELOCATE ORDINAL 1 
  
*         SCAN FOR BLANK COMMON AND CHANGE ITS NAME TO */ /    *
  
 CPL8     SA2    N.COM
          MX6    0
          SA6    L.SCOM            INITIALIZE COMMON LENGTHS
          SA6    A6+B5
          SA6    A6+B5
          SA6    A6+B5
          ZR     X2,CPL            IF NO COMMON 
          SB1    ORGTAB 
          SB2    B1+X2             LWA+1
          SB3    54 
  
 CPL9     SA1    B1 
          AX2    B3,X1
          SX3    X2+77B-1R
          SB1    B1+B5
          MX4    -17
          MX0    -1 
          BX2    X1 
          BX7    -X4*X1 
          LX2    -17
          BX2    -X0*X2 
          ZR     X3,CPL10          IF FOUND 
          SA3    X2+L.SCOM
          IX6    X3+X7
          SA6    A3 
          LT     B1,B2,CPL9        IF NOT FINISHED
          SA3    =XDIRECT 
          NZ     X3,CPL9A    IF LCM = I IS SPECIFIED
          SA3    L.LCOM      TOTAL LCM ALLOCATION 
          SA4    LCMLMT      LCM LIMIT WITHOUT LCM=I
          IX3    X4-X3
          PL     X3,CPL9A    IF TOTAL LCM ALLOCATION .LE. 400K
          SB1    1
          LISTL  STGERR,5    ISSUES LCM .GT. 400K MES (WITHOUT LCM=I) 
 CPL9A    EQ     CPL
  
 CPL10    SA4    =7L/ /            CHANGE NAME
          MX0    -18
          BX6    -X0*X1      LCM BIT + LENGTH 
          BX6    X4+X6
          SA6    A1 
          SX6    A6 
          SA6    BLKCOM 
          SA7    X2+L.SBLK
          EQ     CPL9 
          SPACE  3
*** 
*         RPN - RELOCATE PROGRAM NAME 
* 
*         ON ENTRY: 
*                X3 = ORDINAL OF SYMBOL TO BE RELOCATED 
*                A0 , B4 , B7 , AND X7 AS SET FOR LOOP AT CPL5
* 
 RPN
          LX3    1
          SB3    X3 
          SA2    A0-B3             WORD B OF SYMBOL 
          LX2    60-P.RB
          BX3    -X7*X2            RB 
          LX2    P.RB 
          SA4    X3+B4             O.LRB(RB)
          LX5    B7,X4
          IX6    X5+X2             RELOCATE THE ADDRESS 
          SA6    A2 
          EQ     RPN
          USE    LWA
 LWA.R    BSS    0
          END    FTN25
