*DECK,MAP 
          IDENT  MAP
 MAP      SECT   (STORAGE MAP AND CROSS REFERENCE.) 
 MAP      SPACE  4
*         IN ALLOC
          EXT    ADW,ALC
  
*         IN FSNAP
          EXT    DMT= 
  
*         IN FTN
          EXT    CO.PS,CO.PW,CO.SNAP,CP.BLF,F.REF 
  
*         IN PUC
          EXT    BLNKCOM,FAILSFT,HDRBL,LCNT,LINEBUF,LOSTREF,MOD,O.STITL 
          EXT    PASS,PIA,REFIO,S=VALUE,T=BLKS,T=ECT,T=REF,T=SCR,T=SYM
          EXT    T.BLKS,T.CON,T.DIM,T.ECT,T.REF,T.SCR,T.SYM,WOF,WO.LOA
          EXT    WO.LOM,WO.LOR,WO.QC,T.ENTP 
  
*         IN RLINK
          EXT    SCSA,SCS 
  
*         IN UTILITY
          EXT    CDD,CIO=,MVE=,RDW=,SBM=,SFN,SST,WOD,ZTB
  
 FIN      BSSENT 0           END OF OVERLAY WHEN MAP AND OLIST ARE OFFF 
 MACROS   EJECT 
          TITLE  MACRO AND MICRO DEFINITIONS
**        ALL MACROS LOCAL TO THE DECK MAP ARE DEFINED HERE.
  
  
**        DDTE - DEFINE A DEPENDENT TABLE ENTRY.
* 
*         DEFINES AN ENTRY IN A TABLE THAT DEPENDS ON THE ORDER 
*         IN WHICH THE DIFFERENT MAP SEGMENTS ARE OUTPUT. 
*         THE MACRO WILL CAUSE AN ASSEMBLY ERROR IF THE ORDER 
*         OF THE TABLE BEING GENERATED IS NOT THE SAME AS THE 
*         ORDER OF *MST*. 
* 
*         DDTE   TEST,STMT1,STMT2.
  
          PURGMAC  DDTE 
  
 DDTE     MACRO  TEST,STMT1,STMT2 
 .1       SET    STO+1
 STO      SET    .1 
          ERRNZ  TEST-.1
          STMT1 
          STMT2 
 DDTE     ENDM
 MACROS   SPACE  4,10 
**        DTE -  DEFINE TABLE ENTRY.
* 
*         DEFINES ENTRY IN A TABLE OF ROUTINE ADDRESSES.
*         USED TO CREATE AN ADDRESS TABLE FOR MAP FORMATTERS. 
* 
*         DTE    ADRS1,ADRS2. 
  
          PURGMAC  DTE
  
 DTE      MACRO  ADRS1,ADRS2
          VFD    30/ADRS1,30/ADRS2
 DTE      ENDM
 MACROS   SPACE  4,10 
**        DMSTE -  DEFINE MAP SEGMENT TABLE ENTRY.
* 
*         MAKES ENTRY IN MAP SEGMENT TABLE AND DEFINES A SYMBOL 
*         WHICH DESCRIBES THE POSITION OF THE SEGMENT WITHIN THE
*         TABLE.
* 
*         DMSTE  SEG,IR.
  
          PURGMAC  DMSTE
  
 DMSTE    MACRO  SEG,IR 
          VFD    30/SEG,30/IR 
 SEG_P    SET    STO+1
 STO      SET    SEG_P
 DMSTE    ENDM
 MACROS   SPACE  4,10 
**        RESR - RESTORE CONTENTS OF REGISTERS. 
* 
*         FETCHES PREVIOUSLY STORED REGS FROM A MEMORY BLOCK .
*         IF A1 IS IN THE LIST, IT MUST BE LAST.
* 
*         RESR   (R1,R2...R5),ADRS. 
* 
*         USES   A1,B7,X1.
  
          PURGMAC  RESR 
  
 RESR     MACRO  REG,ADRS 
          IRP    REG
          SA1    ADRS+SV_REG
          S_REG  X1 
          IRP 
 RESR     ENDM
 MACROS   SPACE  4,10 
**        SAVR - SAVE CONTENTS OF REGISTERS.
* 
*         STORES THE LOW 18 BITS OF UP TO 4 REGISTERS INTO A
*         MEMORY BLOCK. USED TO IMPROVE READABILITY OF CODE 
*         IN PLACES WHERE POINTERS USED BY THE CONTROLLER MUST
*         EXIST ACROSS SUBROUTINE OR MACRO CALLS. 
* 
*         SAVR   (R1,R2,...R4),ADRS 
* 
*         USES   X7.
  
          PURGMAC  SAVR 
  
 SAVR     MACRO  REG,ADRS 
          IRP    REG
          SX7    REG
          SA7    ADRS+SV_REG
          IRP 
 SAVR     ENDM
 MACROS   SPACE  4,10 
**        WLINE -            WRITE A LINE.
* 
*         WILL BLANK FILL THE LAST WORD OF A LINE,
*         WRITE A LINE, AND IF THE LINE WAS IN MAPBUFF, 
*         WILL ZERO THE BUFFER AND RESET PCB PARAMETERS. CAN
*         HANDLE OUTPUT OF BLANK LINES BOTH BEFORE AND AFTER
*         WRITING THE LINE. 
* 
*         WLINE  ADRS,NW,BEF,AFT. 
* 
*         USES   X - 1,5,6  A - 1,6.
* 
*         CALLS  PLINE,SETMEM,SFN.
  
          PURGMAC  WLINE
  
 WLINE    MACRO  ADRS,NW,BEF,AFT
          =X5    NW 
 #OS      IFNE   .OS,2,4     NO COLON PROBLEM WITH W-RECS.
          =X1    NW-1 
          SA1    ADRS+X1
          CALL   SFN
          SA6    A1          BLANK FILL THE LAST WORD 
          PLINE  ADRS,X5,BEF
          IFC    NE,$AFT$0$,1 
          PLINE  ,,AFT
          IFC    EQ,$ADRS$IRBA$,1 
          SKIP   6
          IFC    NE,$ADRS$MOCBUF$,5 
          SETMEM ADRS,X5,0
          SX6    60 
          SA6    PCB.SC 
          =X6    -2 
          SA6    PCB.WO 
 WLINE    ENDM
 MACROS   SPACE  4,10 
**        THE FOLLOWING MACRO IS USED AS A DEBUGGING TOOL ONLY. 
*         IT IS USED TO SUPPRESS OUTPUT OF PROCESSORS.
  
          PURGMAC  XOUT 
  
 XOUT     MACRO 
          LX4    30 
          SB6    X4 
          SA1    MOC.XXS
          RJ     PCB
          EQ     MOC.RB 
 XOUT     ENDM
 MACROS   SPACE  4,10 
**        XTRCT -  EXTRACT A FIELD FROM A REGISTER. 
* 
*         WILL EXTRACT ANY FIELD DEFINED BY FTN5TXT *DEFINE* MACRO. 
* 
*         XTRCT  FLD,SXR,DXR. 
* 
*         USES   *SXR*,*DXR*,X0.
  
          PURGMAC  XTRCT
  
 XTRCT    MACRO  FLD,SXR,DXR
          MX0    -FLD_L 
          L_SXR  -FLD_P 
          B_DXR  -X0*SXR
 XTRCT    ENDM
 MICROS   EJECT 
**        ALL MICROS LOCAL TO THE DECK MAP ARE DEFINED HERE.
  
**        MICROS FOR SEGMENT TITLES.
  
 VMT      MICRO  1,,$ --VARIABLE MAP--$ 
 SCMT     MICRO  1,,$ --SYMBOLIC CONSTANTS--$ 
 PMT      MICRO  1,,$ --PROCEDURES--$ 
 LMT      MICRO  1,,$ --STATEMENT LABELS--$ 
 EPMT     MICRO  1,,$ --ENTRY POINTS--$ 
 NLMT     MICRO  1,,$ --NAMELISTS--$
 DLMT     MICRO  1,,$ --DO LOOPS--$ 
 CEMT     MICRO  1,,$ --COMMON+EQUIVALENCE--$ 
 CEMLT    MICRO  1,,$ --LOCAL EQUIVALENCE--$
 IOMT     MICRO  1,,$ --I/O UNITS--$
  
**        MICROS FOR THE REFERENCE SYMBOL USAGE DICTIONARY. 
  
 VUD1     MICRO  1,,$A=ARGLIST, C=CTRL OF DO, I=DATA INIT,$ 
 VUD2     MICRO  1,,$R=READ, S=STORE, U=I/O UNIT, W=WRITE$
 SCUD1    MICRO  1,,$S=SOURCE DEFINITION$ 
 SCUD2    MICRO  1,,$ $ 
 PUD1     MICRO  1,,$D=DEF LINE OF STMT FUNC$ 
 PUD2     MICRO  1,,$A=ACTUAL ARGUMENT$ 
 LUD1     MICRO  1,,$A=ASSIGN STMT, D=DO STMT,$ 
 LUD2     MICRO  1,,$R=READ, W=WRITE, L=LABEL$
 EPUD1    MICRO  1,,$D=DEFINITION, R=RETURN$
 EPUD2    MICRO  1,,$ $ 
 NLUD1    MICRO  1,,$D=DEFINITION, R=READ, W=WRITE$ 
 NLUD2    MICRO  1,,$ $ 
 DLUD1    MICRO  1,,$ $ 
 DLUD2    MICRO  1,,$ $ 
 CEUD1    MICRO  1,,$ $ 
 CEUD2    MICRO  1,,$ $ 
 IOUD1    MICRO  1,,$R=READ, W=WRITE$ 
 IOUD2    MICRO  1,,$ $ 
          EJECT 
          TITLE  PARAMETER DEFINITIONS
**        THE FOLLOWING SYMBOLS DEFINE CONSTANTS USED IN THE DECK MAP 
*         TO CONTROL VARIOUS ASPECTS OF BOTH THE CODE AND THE OUTPUT. 
  
 L        EQU    0           MEANS LEFT JUSTIFICATION 
 MAPCPR   EQU    7           CHARS PER REFERENCE
 MAPDTC   EQU    91          DICTIONARY TAB COLUMN
 MAPLC    EQU    126         USED TO DETERMINE IF IN PW SPLIT MODE
 MAPLFL   EQU    15          LARGEST FORMATTER LENGTH 
 MAPMCPR  EQU    7           MINIMUM CHARS PER REFERENCE
 MAPMRL   EQU    3           MINIMUM ROW LENGTH 
 MAPMRPL  EQU    2           MINIMUM REFERENCES PER LINE
 MAPPML   EQU    4           PROCESSOR MESSAGE LENGTH 
 MAPUDL   EQU    4           USAGE DICTIONARY ENTRY LENGTH (WORDS)
 R        EQU    1           MEANS RIGHT JUSTIFICATION
 STO      SET    -1          INITIAL VALUE OF SEGMENT TABLE OFFSET
 VMTL     MICCNT    VMT         VARIABLE MAP TITLE LENGTH 
 SCMTL    MICCNT    SCMT        SYMBOLIC CONSTANTS TITLE LENGTH 
 PMTL     MICCNT    PMT         PROCEDURE MAP TITLE LENGTH
 LMTL     MICCNT    LMT         LABEL MAP TITLE LENGTH
 EPMTL    MICCNT    EPMT        ENTRY POINT MAP TITLE LENGTH
 NLMTL    MICCNT    NLMT        NAMELIST MAP TITLE LENGTH 
 DLMTL    MICCNT    DLMT        DO-LOOP MAP TITLE LENGTH
 CEMTL    MICCNT    CEMT        COMMON+EQUIV MAP TITLE LENGTH 
 CEMLTL   MICCNT    CEMLT       COMMON+EQUIV MAP LOCAL TITLE LENGTH 
 IOMTL    MICCNT    IOMT        I/O MAP TITLE LENGTH
 TEMP1    MAX  VMTL,SCMTL,PMTL,LMTL,EPMTL,NLMTL,DLMTL,CEMTL,IOMTL,CEMLTL
 TEMP2    EQU    TEMP1+9
 MAPSTL   EQU    TEMP2/10    ROUND UP TO NEXT HIGHEST WORD
  
  
**        THE FORMAT OF T.SCR AS USED BY MAP IS AS FOLLOWS -
  
          DESCRIBE  MT. 
 SYM      DEFINE WA.SYML     DPC OF A SYMBOL (-0L- FORMAT)
          REDEF  SYM
 NMG      DEFINE 18          NUMBER OF MEMBERS IN A GROUP OF ITEMS
 RA       DEFINE 24          RA OF A COMMON+EQUIVALENCE MAP ITEM
 WAI      DEFINE 18          SYMTAB *WA* INDEX
          TITLE  TABLES 
          EJECT 
**        THE FOLLOWING SECTION OF CODE DEFINES ALL TABLES NEEDED 
*         BY THE CONTROLLER.
  
**        FORMATTER TABLE FOR VARIABLES.
  
 TVAR     DTE    0,VARA 
          DTE    0,VARB 
          DTE    0,VARC 
          DTE    0,VARB 
          DTE    0,VARC 
          DTE    0,VARB 
          DTE    0,VARC 
  
**        FORMATTERS FOR VARIABLES. 
  
 VARA     DTE    3,XB 
          DTE    7,NAM
          DTE    3,XA 
          DTE    11,REF 
          DTE    0,0
  
 VARB     DTE    3,XB 
          DTE    7,NAM
          DTE    8,ADR
          DTE    2,XA 
          DTE    9,BLK
          DTE    1,XA 
          DTE    16,PRP 
          DTE    1,XA 
          DTE    10,TYP 
          DTE    7,SZE
          DTE    3,XC 
          DTE   0,0 
  
 VARC     DTE    3,XB 
          DTE    7,NAM
          DTE    8,ADR
          DTE    2,XA 
          DTE    9,BLK
          DTE    1,XA 
          DTE    16,PRP 
          DTE    1,XA 
          DTE    10,TYP 
          DTE    7,SZE
          DTE    3,XA 
          DTE    11,REF 
          DTE    0,0
  
**        FORMATTER TABLE FOR SYMBOLIC CONSTANTS. 
  
 TSC      DTE    0,SCA
          DTE    0,SCB
          DTE    0,SCC
          DTE    0,SCB
          DTE    0,SCC
          DTE    0,SCB
          DTE    0,SCC
  
**        FORMATTERS FOR SYMBOLIC CONSTANTS.
  
 SCA      DTE    3,XB 
          DTE    7,NAM
          DTE    3,XA 
          DTE    11,REF 
          DTE    0,0
  
 SCB      DTE    3,XB 
          DTE    7,NAM
          DTE    1,XA 
          DTE    10,TYP 
          DTE    23,VAL 
          DTE    4,XC 
          DTE    0,0
  
 SCC      DTE    3,XB 
          DTE    7,NAM
          DTE    1,XA 
          DTE    10,TYP 
          DTE    23,VAL 
          DTE    3,XA 
          DTE    11,REF 
          DTE    0,0
  
**        FORMATTER TABLE FOR PROCEDURES. 
  
 TPRO     DTE    0,PROA 
          DTE    0,PROB 
          DTE    0,PROC 
          DTE    0,PROB 
          DTE    0,PROC 
          DTE    0,PROB 
          DTE    0,PROC 
  
**        FORMATTERS FOR PROCEDURES.
  
 PROA     DTE    3,XB 
          DTE    7,NAM
          DTE    3,XA 
          DTE    11,REF 
          DTE    0,0
  
 PROB     DTE    3,XB 
          DTE    7,NAM
          DTE    3,XA 
          DTE    10,TYP 
          DTE    2,XA 
          DTE    7,ARG
          DTE    3,XA 
          DTE    10,CLS 
          DTE    4,XC 
          DTE    0,0
  
 PROC     DTE    3,XB 
          DTE    7,NAM
          DTE    1,XA 
          DTE    10,TYP 
          DTE    7,ARG
          DTE    1,XA 
          DTE    10,CLS 
          DTE    11,REF 
          DTE    0,0
  
**        FORMATTER TABLE FOR LABELS. 
  
 TLAB     DTE    0,LABA 
          DTE    0,LABB 
          DTE    0,LABC 
          DTE    0,LABB 
          DTE    0,LABC 
          DTE    0,LABB 
          DTE    0,LABC 
  
**        FORMATTERS FOR LABELS.
  
 LABA     DTE    3,XB 
          DTE    5,LBL
          DTE    3,XA 
          DTE    7,LDEF 
          DTE    2,XA 
          DTE    11,REF 
          DTE    0,0
  
 LABB     DTE    3,XB 
          DTE    5,LBL
          DTE    1,XA 
          DTE    9,LADR 
          DTE    3,XA 
          DTE    10,PRP 
          DTE    7,LDEF 
          DTE    5,XC 
          DTE    0,0
  
 LABC     DTE    3,XB 
          DTE    5,LBL
          DTE    2,XA 
          DTE    9,LADR 
          DTE    1,XA 
          DTE    10,PRP 
          DTE    1,XA 
          DTE    7,LDEF 
          DTE    2,XA 
          DTE    11,REF 
          DTE    0,0
  
**        FORMATTER TABLE FOR ENTRY POINTS. 
  
 TENT     DTE    0,ENTA 
          DTE    0,ENTB 
          DTE    0,ENTC 
          DTE    0,ENTB 
          DTE    0,ENTC 
          DTE    0,ENTB 
          DTE    0,ENTC 
  
**        FORMATTERS FOR ENTRY POINTS.
  
 ENTA     EQU    VARA        IDENTICAL TO A VARIABLE MAP FORMATTER
  
 ENTB     DTE    3,XB 
          DTE    7,NAM
          DTE    7,ADR
          DTE    2,XA 
          DTE    7,EPA
          DTE    4,XC 
          DTE    0,0
  
 ENTC     DTE    3,XB 
          DTE    7,NAM
          DTE    7,ADR
          DTE    2,XA 
          DTE    7,EPA
          DTE    3,XA 
          DTE    11,REF 
          DTE    0,0
  
**        FORMATTER TABLE FOR NAMELISTS.
  
 TNAM     DTE    0,NAMA 
          DTE    0,NAMB 
          DTE    0,NAMC 
          DTE    0,NAMB 
          DTE    0,NAMC 
          DTE    0,NAMB 
          DTE    0,NAMC 
  
**        FORMATTERS FOR NAMELISTS. 
  
 NAMA     EQU    VARA        IDENTICAL TO A VARIABLE MAP FORMATTER
  
 NAMB     DTE    3,XB 
          DTE    7,NAM
          DTE    7,ADR
          DTE    4,XC 
          DTE    0,0
  
 NAMC     DTE    3,XB 
          DTE    7,NAM
          DTE    7,ADR
          DTE    3,XA 
          DTE    11,REF 
          DTE    0,0
  
**        FORMATTER TABLE FOR DO-LOOPS. 
  
 TDOL     DTE    0,0
          DTE    0,0
          DTE    0,0
          DTE    0,DOLA 
          DTE    0,DOLA 
          DTE    0,DOLA 
          DTE    0,DOLA 
  
**        FORMATTERS FOR DO-LOOPS.
  
 DOLA     DTE    3,XB 
          DTE    5,DOLAB
          DTE    2,XA 
          DTE    9,LADR 
          DTE    2,XA 
          DTE    22,PRP 
          DTE    2,XA 
          DTE    7,DOIN 
          DTE    5,FROM 
          DTE    2,XA 
          DTE    5,TO 
          DTE    0,0
  
**        FORMATTER TABLE FOR I/O UNITS.
  
 TIO      DTE    0,IOA
          DTE    0,IOB
          DTE    0,IOA
          DTE    0,IOB
          DTE    0,IOA
          DTE    0,IOB
          DTE    0,IOA
  
**        FORMATTERS FOR I/O UNITS. 
  
 IOA      DTE    3,XB 
          DTE    7,NAM
          DTE    1,XB 
          DTE    23,PRP 
          DTE    11,REF 
          DTE    0,0
  
 IOB      DTE    3,XB 
          DTE    7,NAM
          DTE    1,XB 
          DTE    23,PRP 
          DTE    3,XC 
          DTE    0,0
          SPACE  4,10 
**        MAP SEGMENT TABLE - ADDRESSES IN THIS TABLE 
*         ARE THOSE OF ROUTINES WHICH GIVE VALUES TO PARAMETERS NEEDED
*         BY MOC TO OUTPUT A MAP. ONLY THOSE MAPS WITH UNIQUE PARAMETER 
*         REQUIREMENTS HAVE UNIQUE INITIALIZING ROUTINES. 
*         SYMBOLS CORRESPONDING TO NON - EXISTENT ROUTINES OR TABLES
*         WILL BE EQU'D TO ZERO.
  
 TCOM     EQU    0
 MST      BSS    0
  
          LOC    0
          DMSTE  TVAR,IRA    VAR MAP FORMATTER, INITIAL ROUTINE 
          DMSTE  TSC,IRA     SYMBOLIC CONSTANTS MAP 
          DMSTE  TPRO,IRA    PROCEDURE MAP
          DMSTE  TLAB,IRA    LABEL MAP
          DMSTE  TENT,IRA    ENTRY POINT MAP
          DMSTE  TNAM,IRA    NAMELIST MAP 
          DMSTE  TDOL,IRA    DO-LOOP MAP
          DMSTE  TCOM,IRB    COMMON+EQUIVALENCE MAP 
          DMSTE  TIO,IRA     I/O UNITS MAP
          CON      0           MARKS END OF TABLE 
          LOC    *O 
          TITLE  MESSAGES AND BUFFERS 
          EJECT 
**        MESSAGES AND BUFFERS OF MAJOR IMPORTANCE ARE LOCATED HERE.
  
  
**        TABLE OF LIST OPTIONS.
  
 MAPLOT   DIS    1,(LO=R) 
          DIS    1,(LO=A) 
          DIS    1,(LO=A/R) 
          DIS    1,(LO=M) 
          DIS    1,(LO=M/R) 
          DIS    1,(LO=M/A) 
          DIS    1,(LO=M/A/R) 
  
  
**        SEGMENT TITLES. 
  
  
 STO      SET    -1 
  
 MAPST    DDTE   TVARP,(CON    VMTL),(DIS    MAPSTL,"VMT")
          DDTE   TSCP,(CON    SCMTL),(DIS    MAPSTL,"SCMT") 
          DDTE   TPROP,(CON    PMTL),(DIS    MAPSTL,"PMT")
          DDTE   TLABP,(CON    LMTL),(DIS    MAPSTL,"LMT")
          DDTE   TENTP,(CON    EPMTL),(DIS    MAPSTL,"EPMT")
          DDTE   TNAMP,(CON    NLMTL),(DIS    MAPSTL,"NLMT")
          DDTE   TDOLP,(CON    DLMTL),(DIS    MAPSTL,"DLMT")
          DDTE   TCOMP,(CON    CEMTL),(DIS    MAPSTL,"CEMT")
          DDTE   TIOP,(CON    IOMTL),(DIS    MAPSTL,"IOMT") 
  
  
**        REFERENCE SYMBOL USAGE DICTIONARY.
  
  
 STO      SET    -1 
  
 MAPUD    DDTE   TVARP,(DIS    MAPUDL,"VUD1"),(DIS    MAPUDL,"VUD2")
          DDTE   TSCP,(DIS    MAPUDL,"SCUD1"),(DIS    MAPUDL,"SCUD2") 
          DDTE   TPROP,(DIS    MAPUDL,"PUD1"),(DIS    MAPUDL,"PUD2")
          DDTE   TLABP,(DIS    MAPUDL,"LUD1"),(DIS    MAPUDL,"LUD2")
          DDTE   TENTP,(DIS    MAPUDL,"EPUD1"),(DIS    MAPUDL,"EPUD2")
          DDTE   TNAMP,(DIS    MAPUDL,"NLUD1"),(DIS    MAPUDL,"NLUD2")
 MAP.XS   DDTE   TDOLP,(DIS    MAPUDL,"DLUD1"),(DIS    MAPUDL,"DLUD2")
          DDTE   TCOMP,(DIS    MAPUDL,"CEUD1"),(DIS    MAPUDL,"CEUD2")
          DDTE   TIOP,(DIS    MAPUDL,"IOUD1"),(DIS    MAPUDL,"IOUD2") 
  
  
**        DPC BUFFER FOR USE OF XOUT MACRO. 
  
  
 MAP.XXS  DIS    3,XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
  
  
**        TO AVOID PROBLEMS CAUSED WHEN *PEM* USES THE BUFFER 
*         *LINEBUF* IN TEST MODE, WE USE THE FOLLOWING **KLUDGE** - 
  
  
 .T       IFEQ   TEST,ON
          BSS    1
 MAPBUFF  BSS    14 
 .T       ELSE
 MAPBUFF  EQU    LINEBUF
 .T       ENDIF 
 MAP      EJECT 
          TITLE  MAIN ROUTINES
**        MAP -  REFERENCE MAP PRODUCTION.
* 
*         M.A. PETERS        SVLOPS  1978.
* 
*         ENTRY  NONE.
* 
*         EXIT   NONE.
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  PRT,MOC,SHRINK,PLINE,EFE,ALLOC.
  
  
 MAP      SUBR   =           ENTRY/EXIT...
          SA1    FAILSFT
          NZ     X1,EXIT.    NO MAP IF TABLES CRUMPED 
          =X6    PASS=MAP 
          SA6    PASS 
          SA2    CO.PS
  
**        IF BL PARAMETER SELECTED, PAGE EJECT. 
  
          SA3    CP.BLF 
          ZR     X3,MAP30    IF BL NOT SELECTED 
          BX6    X2 
          SA6    LCNT 
  
 MAP30    SA1    WO.LOM 
          LX1    3
          SA2    WO.LOA 
          LX2    2
          SA3    WO.LOR 
          LX3    1
          BX6    X1+X2
          BX6    X6+X3
          SA6    MAP.NO       MAP.NO HAS A VALUE BETWEEN 1 AND 7 (INCL) 
  
**        SELECT PROPER LO HEADING AND PUT IT INTO OTH.LO . 
  
          =X5    X6-1        OFFSET INTO MAPLOT TABLE 
          SA1    X5+MAPLOT
          BX6    X1 
          SA6    OTH.LO 
          RJ     PRT         PREPARE REFERENCE TABLE
          RJ     EFE         ENTER FAKE ENTRY POINTS
          RJ     MOC         GO TO CONTROLLER 
          SA2    MAPNEW 
          BX2    -X2
          ALLOC  T.SYM,X2    ELIMINATE FAKE ENTRY POINTS
          =X1    1
          SX6    HDRBL
          LX1    30 
          BX6    X6+X1
          SA6    O.STITL     SUPRESS OLD HEADING
          EQ     EXIT.       RETURN TO REC
  
 MAP.NO   BSS    1           STORAGE FOR MAP NUMBER CALC AT THE START 
 MAPNEW   BSS    1           NUMBER OF WORDS ADDED TO T.SYM 
 MOC      EJECT 
**        MOC -  MAP OUTPUT CONTROLLER. 
* 
*         THIS ROUTINE OVERSEES THE OUTPUT OF EACH MAP SEGMENT. 
*         THE MAIN CONTROLLER LOOP IS DIVIDED INTO 3 SECTIONS:  
* 
*         1)  INITIALIZATION FOR THE CURRENT MAP SEGMENT. 
*         2)  OUTPUT OF TITLE AND HEADING FOR CURRENT MAP SEGMENT . 
*         3)  OUTPUT OF THE  CURRENT MAP SEGMENT. 
* 
*         THE HEART OF THE CONTROLLER IS A 10 WORD TABLE WHICH
*         HAS ONE ENTRY FOR EACH MAP TO BE OUTPUT. EACH TABLE 
*         ENTRY CONTAINS TWO ADDRESSES. IN THE LOWER 30 BITS
*         IS THE ADDRESS OF A ROUTINE WHICH WILL GIVE VALUES TO 
*         PARAMETERS THAT ENABLE THE CONTROLLER TO OUTPUT THE 
*         CURRENT MAP. IN THE UPPER 30 BITS IS THE ADDRESS OF A 
*         TABLE ACCESSED BY THE ABOVE ROUTINE.
* 
*         THE FOLLOWING REGISTER-POINTER ASSOCIATIONS HOLD: 
* 
*         GLOBALLY  - X5 CONTAINS CURRENT OFFSET INTO THE MST TABLE.
* 
*         SECTION 2 - X2 CONTAINS CURRENT *TRIP COUNT*. 
*                     X3 CONTAINS CURRENT FORMATTER OFFSET. 
*                     B5 CONTAINS CURRENT FORMATTER ADDRESS.
* 
*         SECTION 3 - ALL SECTION 2 ASSOCIATIONS. 
* 
*         ENTRY  NONE.
* 
*         EXIT   REFERENCE MAP OUTPUT IS COMPLETE.
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  RNI,PLINE,SETMEM,OTH.
  
  
  
 MOC      SUBR               ENTRY/EXIT 
  
**        MAKE SURE THAT BUFFER DOESNT HAVE GARBAGE IN IT . 
  
          SETMEM MAPBUFF-1,15 
  
**        INITIALIZATION FOR CURRENT MAP. 
  
          =X5    -1 
  
 MOC10    =X5    X5+1 
          SA1    X5+MST      X1 = 30/FORMATTER TABLE,30/INITIAL ROUTINE 
          ZR     X1,EXIT.    IF ALL DONE
          SB5    X1 
          SAVR   (X5),MOCSAV
          JP     B5          JUMP TO INITIALIZER
  
*         INITIALIZER RETURNS HERE (B5= ADDRS OF PROPER FORMATTER). 
  
 MOC.RA   RESR   (X5),MOCSAV
          ZR     B5,MOC10    IF NOTHING TO OUTPUT 
  
*        OUTPUT THE TITLE AND HEADING FOR CURRENT MAP.
  
          SA4    B5          X4 = FIRST WORD OF FORMATTER 
          SA2    MOCTC       X2 = TRIP COUNT
          MX3    0
  
 MOC30    SA1    X4          X1 = PROCESSOR HEADING 
          LX4    30 
          SB6    X4          B6 = LENGTH (IN CHARS) OF HEADING
          SAVR   (X2,X3,B5),MOCSAV
          RJ     PCB         PACK CHARACTERS IN BUFFER
          RESR   (X2,X3,B5),MOCSAV
          =X3    X3+1 
          SA4    X3+B5       X4 = 30/FIELD WIDTH, 30/PROCESSOR ADDRESS
          NZ     X4,MOC30    IF NOT END OF FORMATTER
          MX3    0
          =X2    X2-1 
          SA4    B5          X4 = 1ST WORD OF FORMATTER 
          NZ     X2,MOC30    IF HEADING NOT DONE
          RJ     OTH         OUTPUT TITLE AND HEADING 
          RJ     RNI         RETURN THE 1ST ITEM INDEX
          RESR   (B5,X5),MOCSAV 
          SA2    MOCTC
          SAVR   (X2),MOCSAV
  
**        OUTPUT OF THE CURRENT MAP 
  
 MOC40    MX3    0
          SA4    B5          X4 = 1ST WORD OF FORMATTER 
          SB6    X4          B6 = PROCESSOR ADDRESS 
  
 MOC50    SAVR   (X3),MOCSAV
          SA2    T.SCR
          SA1    RNI.PI 
          SB2    X2 
          =X1    X1-1 
          SA1    B2+X1       X1 = TABLE ENTRY FOR NEXT ITEM 
          BX7    X1 
          JP     B6+MAPPML   PROCESS NEXT FIELD FOR ITEM
  
**        PROCESSORS RETURN HERE
  
 MOC.RB   RESR   (X2,X3,B5,X5),MOCSAV 
          =X3    X3+1 
          SA4    X3+B5
          SB6    X4 
          NZ     B6,MOC50    IF NOT END OF FORMATTER
          RJ     RNI         RETURN NEXT INDEX
          SA1    RNI.PI 
          =X1    X1-1 
          PL     X1,MOC60    IF MORE ITEMS
          SB6    500
          RJ     CBS         FLUSH THE BUFFER 
          RESR   (X5),MOCSAV
          EQ     MOC10       PROCESS NEXT MAP 
  
 MOC60    RESR   (X2),MOCSAV
          =X2    X2-1 
          SAVR   (X2,X3),MOCSAV 
          NZ     X2,MOC40    IF NOT END OF LINE 
          SA5    PCB.WO 
          SX5    X5+2        X5 = NO. OF WORDS TO OUTPUT
          WLINE  MAPBUFF-1,X5,0,0 
          SA2    MOCTC
          SAVR   (X2),MOCSAV
          RESR   (B5),MOCSAV
          EQ     MOC40
          SPACE  4,10 
**        BUFFERS  AND POINTERS.
  
  
 MOCBUF   BSSZ   15          TEMP STORAGE FOR A HEADING 
  
 MOCTC    BSS    1           TRIP COUNT 
 MOCSAV   BSS    0
          LOC    0
 SVB5     BSS    1           TEMP STORAGE FOR B5
 SVX5     BSS    1           TEMP FOR X5
 SVX2     BSS    1           TEMP FOR X2
 SVX3     BSS    1           TEMP FOR X3
          LOC    *O 
          TITLE  INITIALIZING ROUTINES
 IRA      EJECT 
**        THE FOLLOWING ROUTINES ARE THE INITIALIZING ROUTINES
*         CALLED BY THE CONTROLLER. 
 IRA      SPACE  4,10 
**        IRA -  INITIALIZING ROUTINE A.
* 
*         THIS ROUTINE ACCOMPLISHES THE FOLLOWING - 
* 
*         1)  SELECTS THE APPROPRIATE FORMATTER FOR THE CONTROLLER. 
* 
*         2)  CALLS STS TO SEPARATE PROPER SYMBOL TYPE FROM SYMTAB. 
* 
*         3)  CALLS DMF TO DETERMINE HOW THE CURRENT MAP WILL APPEAR ON 
*             THE PAGE. 
* 
*         ENTRY  (X5) = OFFSET INTO MST TABLE.
*                (X1) = 30/ADRS FORMATTER TABLE,30/ADRS IRA.
* 
*         EXIT   (B5) = ADDRESS OF PROPER FORMATTER.
* 
*         USES   X - ALL  A - ALL  B - 2,3,4,5,7. 
* 
*         CALLS  STS,DMF,SST. 
  
 IRA      LX1    5*CHAR 
          SB5    X1          B5 = ADRS FORMATTER TABLE
          SA1    MAP.NO 
          =X2    X1-1 
          SA2    B5+X2       X2 = ADRS OF PROPER FORMATTER
          MX4    0
          SB4    X5          COPY OF MST OFFSET FOR STS AND DMF 
          SB5    X2 
          SX6    B5 
          SA6    IRASAV      PRESERVE FORMATTER ADDRESS 
          ZR     B5,MOC.RA   IF NO OUTPUT FOR THIS MAP
          SA5    IRAJP+B4 
          SB2    X5 
          JP     B2          SELECT PROPER CODE SECTION 
  
  
 STO      SET    -1 
 IRAJP    BSS    0
          LOC    0
  
          DDTE   TVARP,(VFD    60/IRA5)        VARIABLES
          DDTE   TSCP,(VFD    60/IRA10)        SYMBOLIC CONSTANTS 
          DDTE   TPROP,(VFD    60/IRA15)       PROCEDURES 
          DDTE   TLABP,(VFD    60/IRA20)       LABELS 
          DDTE   TENTP,(VFD    60/IRA25)       ENTRY POINTS 
          DDTE   TNAMP,(VFD    60/IRA30)       NAMELISTS
          DDTE   TDOLP,(VFD    60/IRA35)       DO-LOOPS 
          DDTE   TCOMP,(VFD    60/"BLOWUP")    COMMON+EQUIV 
          DDTE   TIOP,(VFD    60/IRA40)        I/O UNITS
          LOC    *O 
  
  
 IRA5     CLAS=  X5,WB,(VAR)
          CLAS=  X4,WB,(PARM,ENT,LAB,NLST,CGS)
          EQ     IRA45
  
 IRA10    CLAS=  X5,WB,(PARM) 
          CLAS=  X4,WB,(LAB,CGS)
          EQ     IRA45
  
 IRA15    CLAS=  X5,WB,(FUN,SUB,DEXT) 
          CLAS=  X4,WB,(LAB,CGS)
          EQ     IRA45
  
 IRA20    CLAS=  X5,WB,(LAB)
          CLAS=  X4,WB,(CGS)
          EQ     IRA45
  
 IRA25    SA5    MOD
          HX5    MO.BLK 
          SB2    B5 
          =B5    0
          MI     X5,MOC.RA   IF BLOCK DATA, SUPPRESS
          SB5    B2 
          CLAS=  X5,WB,(ENT)
          CLAS=  X4,WB,(LAB,CGS)
          EQ     IRA45
  
 IRA30    CLAS=  X5,WB,(NLST) 
          CLAS=  X4,WB,(LAB,CGS)
          EQ     IRA45
  
 IRA35    SB2    B5 
          =B5    0
          SA1    WO.QC
          MI     X1,MOC.RA   SUPPRESS IF FATAL ERRORS OR QC MODE
          SB5    B2 
          CLAS=  X5,WB,(LAB,DOGL) 
          BX5    -X5         COMPLEMENT TO MAKE *AND* OF BITS POSSIBLE
          EQ     IRA45
  
 IRA40    CLAS=  X5,WB,(UDC,NVAR) 
          BX5    -X5         BOTH BITS MUST BE ON 
  
 IRA45    RJ     STS
          SA5    T=SCR
          NZ     X5,IRA60    IF TABLE NOT EMPTY 
          SB5    B0 
          EQ     MOC.RA      RETURN TO CONTROLLER 
  
 IRA60    RJ     DMF         DETERMINE MAP FORMAT 
          SA1    T.SCR
          SB7    X1          FWA OF TABLE 
          SA1    T=SCR
          SX7    B4-TDOLP 
          ZR     X7,IRA70    IF DO-LOOP MAP 
          CALL   SST         SORT THE TABLE 
 IRA70    SA1    IRASAV 
          SB5    X1 
          EQ     MOC.RA 
  
  
 IRASAV   EQU    MOCSAV+SVB5
IRB       SPACE  4,10 
**        IRB -  INITIALIZING ROUTINE B.
* 
*         ACTUALLY PERFORMS INITIALIZATION AND OUTPUT OF THE
*         COMMON+EQUIVALENCE MAP. UPON EXIT, B5 MUST BE SET 
*         TO ZERO TO FORCE MOC TO BYPASS ITS OWN CONTROL LOGIC. 
* 
*         EXIT   (B5) = 0.
*                OUTPUT OF COMMON-EQUIVALENCE MAP COMPLETE. 
* 
*         CALLS  SST,OTH,PCB,OBI,OBM,OLE,SCS. 
* 
*         USES   ALL REGISTERS. 
  
 IRB      SA1    WO.LOM 
          =B5    0
          ZR     X1,MOC.RA   IF THIS MAP NOT SELECTED 
          SA1    WO.QC
          MI     X1,MOC.RA   IF FATAL ERRORS OR QC MODE 
          SA1    T=ECT
          SA2    T=BLKS 
          SX1    X1-3 
          SX2    X2-Z=BLKS-1
          BX3    X1*X2
          MI     X3,MOC.RA   IF NO OUTPUT 
  
**        CHECK IF S$A$V$E BLOCK WOULD BE THE ONLY OUTPUT.
  
          PL     X1,IRB5     IF EQUIVALENCES EXIST
          =X2    X2-1 
          PL     X2,IRB7     IF MORE THAN ONE BLOCK 
          SA2    T.BLKS 
          SA2    X2+Z=BLKS   X2 = *CA*
          SA3    =7RS$A$V$E 
          XTRCT  CA.BNAM,X2,X2     EXTRACT BLOCK NAME 
          BX2    X2-X3
          ZR     X2,MOC.RA   IF IT IS THE ONLY BLOCK
  
 IRB5     SA2    T.ECT
          SB7    X2 
          SA1    T=ECT
          CALL   SST         SORT EQUIVALENCE CLASS TABLE 
  
 IRB7     SA1    MAP.XS 
          =B6    1
          RJ     PCB         BLANK LINE INSTEAD OF HEADING
          =X5    TCOMP
          RJ     OTH         OUTPUT TITLE AND HEADING 
          MX6    0
          SA6    OBI.BI      INITIALIZE BLOCK INDEX 
  
**        OUTPUT OF COMMON BLOCK INFORMATION. 
  
 IRB10    RJ     GNB         GET NEXT BLOCK 
          MI     X3,IRB30    IF NO MORE BLOCKS
          RJ     OBI         OUTPUT BLOCK INFORMATION 
          RJ     OML         OUTPUT BLOCK MEMBERS 
          EQ     IRB10
  
**        OUTPUT OF LOCAL EQUIVALENCE CLASSES.
  
 IRB30    RJ     GLE         GET LOCAL EQUIVALENCE CLASSES
          =B5    0
          SA1    T=SCR
          ZR     X1,MOC.RA   IF NO LOCAL CLASSES
          WLINE  IRBA,MAPSTL,2,1   OUTPUT TITLE 
          SA1    MAP.XS 
          SB6    6
          RJ     PCB         INDENT 6 
          RJ     OML         OUPUT LOCAL EQUIVALENCE
          =B5    0
          EQ     MOC.RA 
  
 IRBA     DIS    3, --LOCAL EQUIVALENCE-- 
          TITLE  GENERAL PURPOSE ROUTINES 
          TITLE  TASK PERFORMERS
**        THE FOLLOWING GROUP OF SUBROUTINES ARE
*         ROUTINES THAT PERFORM VARIOUS TASKS FOR THE CONTROLLER. 
  
**        BNS -  BOUND NAME WITH SLASHES. 
* 
*         THIS ROUTINE IS USED TO FORMAT BLOCK NAMES FOR OUTPUT.
* 
*         ENTRY  (X1) = NAME TO BE BOUNDED, LEFT JUSTIFIED. 
* 
*         EXIT   (X1) = FORMATTED NAME LEFT JUSTIFIED.
* 
*         USES   X - ALL  A - 2,3,4,7  B - 3. 
* 
*         KEEPS  X4.
* 
*         CALLS  NONE.
  
 BNS      SUBR               ENTRY/EXIT...
          BX7    X4 
          SA7    BNSAV       PRESERVE X4
          MX0    -1 
          SA2    =40404040404040404040B 
          SA3    =10H////////// 
          SA4    =1A/ 
          SB3    60-CHAR+1
          IX7    X1+X0       LOCATE LOWEST BIT
          BX5    -X7+X1 
          BX7    X2*X5       40 WHERE CHARACTERS WERE 
          LX5    X7,B3
          IX6    X7-X5
          IX7    X7+X6       77 WHERE CHARACTERS WERE 
          BX6    -X7*X3 
          AX7    CHAR        EXTEND MASK
          BX5    -X7*X4 
          IX6    X1+X6       APPEND TRAILING SLASHES
          BX7    X7*X6       DISCARD SUPERFLUOUS SLASHES
          IX7    X5+X7       SPACE FILL 
          LX7    -CHAR
          BX1    X7 
          SA4    BNSAV       RESTORE X4 
          EQ     EXIT.
  
 BNSAV    BSS    1           CELL TO PRESERVE REGISTER X4 
 CBS      SPACE  4,10 
**        CBS -  CREATE BUFFER SPACE. 
* 
*         WILL FLUSH BUFFER (MAPBUFF) IF THERE ARE LESS THAN
*         (B6) CHARACTERS OF ROOM LEFT. 
* 
*         ENTRY  (B6) = SPACE NEEDED (IN CHARACTERS). 
* 
*         CALLS  GBL,WLINE. 
* 
*         USES   ALL REGISTERS. 
  
 CBS      SUBR               ENTRY/EXIT...
          SA1    CO.PW
          RJ     GBL         GET BUFFER LENGTH
          ZR     X2,EXIT.    IF BUFFER EMPTY
          SX1    X1          STRIP CONNECT BIT
          IX1    X1-X2       ROOM LEFT ON PAGE
          IFEQ   TEST,ON,1
          MI     X1,"BLOWUP" IF BUFFER TOO BIG
          SB3    X1 
          SB3    B3-B6
          PL     B3,EXIT.    IF ENOUGH ROOM 
          SX6    B6 
          SA6    CBSSAV 
          SA1    PCB.WO 
          SX1    X1+2 
          WLINE  MAPBUFF-1,X1,0,0 
          SX6    7
          SA6    OCEI.TAB    INITIALIZE TAB COUNTER 
          SA1    CBSSAV 
          SX1    X1-150 
          PL     X1,EXIT.    IF BUFFER FLUSH FORCED 
          SB6    6
          SA1    MAP.XS 
          RJ     PCB         INDENT 6 
          SB3    -1          INDICATE BUFFER OUTPUT 
          EQ     EXIT.
  
 CBSSAV   BSS    1           CELL TO PRESERVE SPACE NEEDED
 CCBB     SPACE  4,10 
**        CCBB - COUNT CHARS BEFORE BLANK.
* 
*         USED TO DETERMINE LENGTH OF A PROCESSOR OUTPUT TO 
*         FACILITATE LEFT OR RIGHT JUSTIFICATION OF THAT OUTPUT 
*         IN THE FIELD ALOTTED TO THE PROCESSOR.
* 
*         ENTRY  (X1) = PROCESSOR OUTPUT TO CHECK.
*                (X0) = PL FOR INPUT LEFT JUST., MI FOR RIGHT JUST. 
* 
*         EXIT   (B6) = CHARACTER COUNT.
* 
*         USES   X - 2,3,4,7  B - 2,3,6.
* 
*         CALLS  NONE.
  
 CCBB     SUBR               ENTRY/EXIT...
          SX3    1R 
          LX3    -CHAR
          MX4    CHAR 
          SB2    CHAR        SHIFT COUNT FOR LEFT JUST. INPUT 
          PL     X0,CCBB10   IF INPUT LEFT JUST.
          LX3    CHAR 
          LX4    CHAR 
          SB2    -CHAR       SHIFT COUNT FOR RIGHT JUST. INPUT
  
 CCBB10   BX7    X1 
          SB3    10          LOOP LIMIT 
          =B6    0           NON-BLANK CHAR COUNTER 
  
 CCBB20   =B3    B3-1 
          MI     B3,EXIT.    IF NO BLANKS FOUND 
          BX2    X4*X7       ISOLATE A CHAR 
          BX2    X2-X3
          ZR     X2,EXIT.    IF FOUND A BLANK 
          =B6    B6+1 
          LX7    B2,X7
          EQ     CCBB20      CONTINUE 
 DELF     SPACE  4,10 
**        DELF - DELETE FIELDS FROM A FORMATTER.
* 
*         WILL DELETE FIELDS ON THE BASIS OF PRIORITIES DEFINED 
*         IN A TABLE UNIQUE TO THE MAP SEGMENT BEING PROCESSED. 
*         AN OCCURANCE OF THE PROCESSOR CURRENTLY AT THE TOP OF 
*         THE PRIORITY TABLE WILL BE REPLACED BY A NO-OP PROCESSOR. 
*         THIS IS CONTINUED UNTIL THE LENGTH OF THE FORMATTER 
*         BECOMES EQUAL TO OR LESS THAN THE PAGE WIDTH. 
* 
*         ENTRY  (B2) = LENGTH OF FORMATTER.
*                (B5) = ADDRESS OF FORMATTER. 
*                (B4) = MST OFFSET. 
* 
*         EXIT   (X6) = 1.
*                (X7) = X5  (PRESERVED ON ENTRY). 
* 
*         USES   X - 1,2,3,4,5,6,7   A - 1,2,3,5,6  B - 3,6,7.
* 
*         KEEPS  X5.
  
  
 DELF     BX6    X5 
          SA6    DELFA       PRESERVE X5
          SA1    CO.PW
          SB6    X1 
          SX5    B2-B6       NUMBER OF COLUMNS EXCEEDING PW 
          IFEQ   TEST,ON,2
          ZR     X5,"BLOWUP"
          MI     X5,"BLOWUP" IF BAD B2 OR ERROR BY DMF
          =B3    0           OFFSET INTO PRIORITY TABLE 
          SA1    B4+DELFB    X1 = ADRS OF PRIORITY TABLE
          IFEQ   TEST,ON,1
          ZR     X1,"BLOWUP" IF TABLE DOESNT EXIST
          =B7    0           OFFSET INTO FORMATTER
          SX6    NOP
  
 DELF10   SA2    X1+B3       SEARCH FOR THIS PROCESSOR
          IFEQ   TEST,ON,1
          ZR     X2,"BLOWUP" IF ERROR 
          =B3    B3+1 
          MX7    0           COUNTS PASSES THROUGH THE TABLE
  
**        THE FOLLOWING LOOP WILL GO ON TO THE NEXT HIGHEST 
*         PRIORITY PROCESSOR IF IT CANT FIND THE PRESENT ONE
*         WITHIN 2 PASSES THROUGH THE TABLE.
  
 DELF20   SA3    B5+B7       WORD OF FORMATTER
          =B7    B7+1 
          NZ     X3,DELF30   IF NOT AT END OF FORMATTER 
          =X7    X7+1 
          SX3    X7-2 
          PL     X3,DELF10   IF PROCESSOR NOT PRESENT IN FORMATTER
          =B7    0
          EQ     DELF20      CONTINUE 
  
 DELF30   SX4    X3 
          IX4    X2-X4
          NZ     X4,DELF20   IF NO MATCH
          MX7    0           RESET PASS COUNTER 
          LX3    30 
          SX3    X3 
          IX5    X5-X3
          SA6    A3          REPLACE PROCESSOR BY NOP 
          =X3    X5-1 
          PL     X3,DELF10   IF MORE DELETIONS NECESSARY
          =X6    1
          SA5    DELFA       RESTORE X5 
          BX7    X5 
          EQ     DMF.RTN     RETURN TO DMF
 DELF     SPACE  4
 DELFA    BSS    1           TO PRESERVE X5 
  
**        TABLE OF PRIORITY TABLE ADDRESSES, ACCESSED VIA MST OFFSET. 
*         MUST BE IN THE SAME ORDER AS MST. 
  
 STO      SET    -1 
 DELFB    BSS    0
          LOC    0
          DDTE   TVARP,(VFD    60/DELFPT1)     VARIABLE MAP 
          DDTE   TSCP,(VFD    60/DELFPT2)      SYMBOLIC CONSTANTS 
          DDTE   TPROP,(VFD    60/0)
          DDTE   TLABP,(VFD   60/DELFPT4)       LABELS
          DDTE   TENTP,(VFD    60/0)
          DDTE   TNAMP,(VFD    60/0)
          DDTE   TDOLP,(VFD    60/DELFPT3)     DO-LOOPS 
          DDTE   TCOMP,(VFD    60/0)
          DDTE   TIOP,(VFD    60/0) 
          LOC    *O 
  
**        FIELD DELETION PRIORITY TABLES. 
  
 DELFPT1  VFD    60/XC
          VFD    60/ADR 
          VFD    60/BLK 
          VFD    60/XA
          VFD    60/SZE 
          VFD    60/XA
          VFD    60/0 
  
 DELFPT2  VFD    60/VAL 
          VFD    60/0 
  
 DELFPT3  VFD    60/LADR
          VFD    60/XA
          VFD    60/DOIN
          VFD    60/0 
  
 DELFPT4  VFD    60/XA
          VFD    60/0 
 DMF      SPACE  4,10 
**        DMF -  DETERMINE MAP FORMAT.
* 
*         THIS ROUTINE ATTEMPTS TO FIX THE FORMAT OF A MAP OUTPUT 
*         IN SUCH A WAY AS TO MAKE EFFICIENT USE OF PAPER AND TO
*         MAKE IT AESTHETICALLY PLEASING, GIVEN THE LIMITATION
*         ON PAGE WIDTH.
* 
*         ENTRY  (X5)= LENGTH OF T.SCR. 
*                (B5)= ADDRESS OF A FORMATTER.
*                (B4) = MST OFFSET. 
* 
*         EXIT   NONE.
* 
*         CALLS  SRNI,DELF. 
* 
*         USES   X - 1,2,3,4,5,6,7  A - ALL  B - ALL. 
  
 DMF      SUBR               ENTRY/EXIT.
          SB2    B0 
          MX3    0
  
 DMF20    SA2    B5+B2       GRAB WORD OF FORMATTER 
          ZR     X2,DMF30    IF LAST WORD OF FORMATTER
          LX2    5*CHAR 
          SX2    X2          ISOLATE FIELD WIDTH
          IX3    X3+X2       ACCUMULATE SUM 
          =B2    B2+1 
          IFEQ   TEST,ON,2
          SB3    B2-MAPLFL
          PL     B3,"BLOWUP" IF B2 GE LARGEST FORMATTER LENGTH
          EQ     DMF20
  
 DMF30    SA4    CO.PW
          SB2    X3          SAVE COPY OF FORMATTER LENGTH FOR DELF 
          SX4    X4          STRIP CONNECT BIT
          IX6    X4/X3       MAXIMUM NUMBER OF SECTIONS 
          BX2    X5          SAVE COPY OF NUMBER OF ENTRIES IN T.SCR
          =X1    X5-MAPMRL
          PL     X1,DMF40    IF MORE THAN MAPMRL ENTRIES
          ZR     X6,DELF     IF FIELDS NEED TO BE DELETED 
          =X6    1
          BX7    X5 
          EQ     DMF.RTN
  
 DMF40    SA1    MAP.NO      GET MAP.NO 
          LX1    59 
          PL     X1,DMF45    IF REFERENCES NOT SELECTED 
          ZR     X6,DELF     IF FIELDS NEED TO BE DELETED 
          =X6    1           FORCE SECTION COUNT TO 1 
  
 DMF45    BX3    X6          SAVE COPY OF # OF SECTIONS 
          ZR     X3,DELF     IF FIELDS NEED TO BE DELETED 
          IX7    X2/X3
          =X1    X7-MAPMRL
          PL     X1,DMF.RTN  IF THIS IS A GOOD FORMAT 
          =X6    X6-1 
          BX2    X5          REFRESH # OF ENTRIES 
          EQ     DMF45       TRY NEXT VALUE 
  
**        DELF WILL RETURN HERE.
  
 DMF.RTN  SA6    MOCTC       SET TRIP COUNT 
          MX6    0
          SA6    SRNI.LED    INITIALIZE LAST ELEMENT OF DIVISION
          SB2    3
          RJ     SRNI        SET RNI PARAMETERS 
          EQ     EXIT.
 EFE      SPACE  4,10 
**        EFE -  ENTER FAKE ENTRY PTS IN SYMTAB.
* 
*         THIS IS A KLUDGE TO ENABLE FUNCTION ENTRY POINTS TO APPEAR
*         IN BOTH THE VARIABLE MAP AND THE ENTRY POINT MAP. 
* 
*         EXIT   *MAPNEW* = NUMBER OF WORDS ADDED TO SYMBOL TABLE.
* 
*                FAKE ENTRY POINTS ARE IN SYMBOL TABLE. 
* 
*         USES   X - ALL  A - ALL  B - 2,3,4,5,7. 
* 
*         CALLS  STS,SRC,ALLOC. 
  
 EFE      SUBR               ENTRY/EXIT...
          MX6    0
          SA6    MAPNEW 
          SA1    MOD
          SBIT   X1,MO.FUNP 
          PL     X1,EXIT.    IF NOT COMPILING A FUNCTION
          CLAS=  X5,WB,(ENT)
          CLAS=  X4,WB,(CGS,LAB)
          SB4    100         SET UP STS ENTRY CONDITIONS
          RJ     STS         SEPARATE ENTRY POINTS FROM SYMTAB
          SA1    T=SCR       X1 = NUMBER OF ENTRY POINTS
          SB2    X1 
          LX1    1
          SX6    X1+B2       X6 = NUMBER OF WORDS TO ADD TO SYMTAB
          SA6    MAPNEW 
          BX5    X6 
          ALLOC  T.SYM,X6 
          SA1    T.SYM
          SA2    T=SYM
          IX2    X1+X2
          IX2    X2-X5
          SB5    X2          B5 = ADDRESS OF *WA* OF 1ST FAKE ENTRY 
          =B2    0           LOOP COUNTER 
          SB3    X5          LOOP LIMIT 
          SA5    T.SCR
          =A3    X5-1        INITIALIZE FETCH REG 
          SA2    S=VALUE
  
 EFE10    =A3    A3+1 
          CLAS=  X4,WB,(EQV,BASE,BMEM,CGS,1REF,FP,MODE,MDF) 
          XTRCT  MT.WAI,X3,X3     ISOLATE *WA* OFFSET OF REAL ENTRY 
          SB7    X3 
          SA5    X1+B7
          BX6    X5 
          SA6    B2+B5       FIX *WA* OF FAKE ENTRY 
          RJ     SRC         SEARCH REFERENCE CHAIN 
          =B4    X3+WB.W
          SA5    X1+B4       *WB* OF REAL ENTRY 
          XTRCT  WB.MODE,X5,X6     ISOLATE MODE OF REAL ENTRY 
          IX5    X6+X2
          SB7    X5 
          LX5    1
          SX5    X5+B7
          =B7    X5+WB.W     X5 = OFFSET OF PROPER VALUE. 
          SA5    X1+B7       *WB* OF THE VALUE. 
          BX5    -X4*X5      ERASE SOME FIELDS
          LX6    WB.MODEP 
          BX6    X5+X6       ADD IN MODE OF ENTRY POINT 
          SA6    A6-WA.W+WB.W      FIX *WB* OF THE FAKE ENTRY 
          =B4    B4-WB.W+WC.W 
          SA4    X1+B4
          MX0    -WC.CLIFL
          LX0    WC.CLIFP 
          BX4    -X0*X4      ISOLATE CLIF 
          SA5    A5-WB.W+WC.W      X5 = *WC* OF THE VALUE.
          BX6    X5*X0       ERASE CLIF 
          BX6    X6+X4
          SA6    A6-WB.W+WC.W      FIX *WC* OF FAKE ENTRY 
          SB2    B2+Z=SYM 
          GE     B2,B3,EXIT. IF ALL DONE
          EQ     EFE10
 GBL      SPACE  4,10 
**        GBL - GET BUFFER LENGTH (IN CHARS). 
* 
*         EXIT   (X2) = BUFFER LENGTH IN CHARACTERS.
* 
*         CALLS  WC.
* 
*         USES   X - 2,3,4  A - 2  B - 2. 
  
 GBL      SUBR               ENTRY/EXIT...
  
          SA2    PCB.WO 
          SX2    X2+2 
          WC     X3,X2       CONVERT TO CHARACTER COUNT 
          SA2    PCB.SC 
          MX4    0
          SB2    X2-60
          ZR     B2,GBL10    IF AT START OF WORD
          SX3    X3-10
          SX4    6
          IX4    X2/X4
          SX2    10 
          IX4    X2-X4       X4 = CHARS IN LAST WORD
  
 GBL10    IX2    X3+X4       X2 = TOTAL CHARS IN BUFFER 
          EQ     EXIT.
 GLE      SPACE  4,10 
**        GLE - GET LOCAL EQUIVALENCE CLASSES.
* 
*         THIS ROUTINE WILL FIND ALL LOCAL EQUIVALENCE CLASSES
*         IN T.ECT, REFORMATTING EACH ENTRY TO MT. FORMAT, AND
*         PUTTING IT ON T.SCR FOR PROCESSING BY *OML*.
* 
*         ENTRY  T.ECT CONTAINS ALL EQUIVALENCE CLASSES, THE BASE 
*                MEMBER OF ALL NON-LOCAL CLASSES HAVING BIT 59 SET. 
* 
*         EXIT   T.SCR CONTAINS ALL LOCAL EQUIVALENCE CLASSES 
*                IN MT. FORMAT. 
* 
*         CALLS  SCS,ADW. 
* 
*         USES   X - 0,1,2,3,5,6,7  A - 1,2,3,6,7  B - 2,7. 
  
  
 GLE      SUBR               ENTRY/EXIT...
          SHRINK T=SCR
  
**        LOOK FOR A LOCAL EQUIVALENCE CLASS. 
  
 GLE10    MX7    1
          LDBIT  X1,TE.NBP
          BX7    X1+X7
          SA7    SCSA 
          MX6    0
          SCAN   T.ECT,SCS
          MI     B7,EXIT.    IF NO MORE CLASSES 
          MX6    1
          BX6    X6+X2
          SA6    A2          MARK CLASS PROCESSED 
  
 GLE20    =B6    B7+1        PRESERVE INDEX OF 1ST MEMBER 
          =B2    B6 
          SA1    T=ECT
          SB3    X1 
          SA1    T.ECT
  
**        NOW WE REFORMAT EACH MEMBER, ADDING IT TO T.SCR, AND
*         COUNTING THE TOTAL NUMBER OF MEMBERS. 
  
 GLE30    SA1    X1+B2       X1 = NEXT MEMBER (TE. FORMAT)
          HX1    TE.NB
          PL     X1,GLE40    IF END OF CLASS
          LX1    1+TE.NBP-TE.SYMIP
          SX6    X1 
          ERRNZ  TE.SYMIL-18
          LX6    MT.WAIP
          LX1    TE.SYMIP 
          XTRCT  TE.BIAS,X1,X1     X1 = BIAS FROM BASE
          LX1    MT.RAP 
          BX6    X6+X1
          ADDWD  T.SCR       ADD REFORMATTED MEMBER TO T.SCR
          =B2    B2+1 
          SA1    T.ECT       REFRESH FWA OF TABLE 
          LT     B2,B3,GLE30 IF MORE MEMBERS
  
GLE40     SX6    B2-B6       X6 = NUMBER OF CLASS MEMBERS 
          SB2    X6 
          SA1    B7-B2       X1 = 1ST MEMBER OF CLASS (MT. FORMAT)
          LX6    MT.NMGP
          BX6    X6+X1
          SA6    A1          ADD LENGTH TO 1ST MEMBER 
          EQ     GLE10       FIND NEXT CLASS
 GNB      SPACE  4,10 
**        GNB - GET NEXT BLOCK. 
* 
*         THIS ROUTINE WILL FIND THE NEXT COMMON BLOCK, AND COLLECT 
*         ALL MEMBERS OF THAT BLOCK IN T.SCR VIA A CALL TO *STS*. 
* 
*         ENTRY  *OBI.BI* - CONTAINS THE CURRENT BLOCK INDEX. 
* 
*         EXIT   (X3),*OBI.BI* - UPDATED BLOCK INDEX.(MI IF NONE LEFT)
* 
*         CALLS  STS,SST,MEC. 
* 
*         USES   X - ALL  A - 1,2,3,4,5,6  B - 2,3,4,5,6,7. 
  
  
 GNB      SUBR               ENTRY/EXIT...
  
 GNB10    SA1    T=BLKS 
          SA5    OBI.BI 
          =X1    X1-1 
          SX5    X5+Z=BLKS
          IX3    X1-X5
          MI     X3,EXIT.    IF NO MORE BLOCKS
          BX6    X5 
          SA6    A5          UPDATE BLOCK COUNT 
          SA1    T.BLKS 
          SB2    X5 
          SA1    X1+B2
          XTRCT  CA.BNAM,X1,X1     X1 = BLOCK NAME
          SA2    =7RS$A$V$E 
          BX1    X1-X2
          ZR     X1,GNB10    IF S$A$V$E BLOCK, SKIP IT
  
**        NOW WE COLLECT ALL BLOCK MEMBERS, SORT THEM BY RA,
*         AND MARK ALL EQUIVALENCE CLASSES. 
  
          SA6    STS.BI      TELL STS ABOUT BLOCK NUMBER
          CLAS=  X5,WB,(COM)
          CLAS=  X4,WB,(CGS)
          =B4    TCOMP
          RJ     STS         SEPARATE BLOCK MEMBERS 
          SA2    T.SCR
          SA1    T=SCR
          SB7    X2 
          CALL   SST         SORT BY RELATIVE ADDRESS 
          RJ     MEC         MARK EQUIVALENCE CLASSES 
          SA3    OBI.BI 
          EQ     EXIT.
 JIF      SPACE  4,10 
**        JIF -  JUSTIFY ITEM IN A FIELD. 
* 
*         ALLOWS FLEXIBILITY IN JUSTIFYING A PROCESSOR OUTPUT.
*         SHOULD BE USED ONLY WHEN THE OUTPUT OF A COMPLETE 
*         ITEM CAN BE ACCOMPLISHED WITH ONE JIF CALL. 
*         (OTHERWISE THE PURPOSE OF THE ROUTINE IS DEFEATED)
* 
*         ENTRY  (B5) = WIDTH IN CHARS OF FIELD.
*                (B6) = IF PL - WIDTH IN CHARS OF ITEM. 
*                       IF MI - INDICATES WIDTH IS UNKNOWN. 
*                (X0) = BIT 0 INDICATES JUSTIFICATION OF OUTPUT.
*                       BIT 1 INDICATES JUSTIFICATION OF INPUT. 
*                       -  OFF IMPLIES LEFT JUSTIFICATION.
*                       -  ON IMPLIES RIGHT JUSTIFICATION.
*                (A1) = ADRS 1ST WORD OF ITEM. (ONLY IF WIDTH GT 10). 
*                (X1) = 1ST WORD OF ITEM. 
* 
*         USES   X - ALL  A - 1,2,3,6  B - ALL. 
* 
*         CALLS  BC,CCBB,PCB. 
  
 JIF      SUBR               ENTRY/EXIT...
          LX0    58 
          PL     B6,JIF10    IF ITEM WIDTH IS KNOWN 
          RJ     CCBB        DETERMINE WIDTH
  
 JIF10    PL     X0,JIF20    IF ITEM ALREADY LEFT JUSTIFIED 
          SX2    B6 
          BC     X3,X2       CONVERT TO BIT COUNT 
          SB4    X3-10*CHAR 
          AX1    B4,X1       LEFT JUSTIFY 
  
 JIF20    LX0    1
          SB4    B5-B6
          IFEQ   TEST,ON,1
          MI     B4,"BLOWUP" IF FIELD TOO SMALL 
  
          PL     X0,JIF30    IF OUTPUT TO BE LEFT JUSTIFIED 
          SB7    B6          PRESERVE ITEM WIDTH
          SB5    A1          PRESERVE ITEM ADDRESS
          BX5    X1          PRESERVE 1ST WORD OF ITEM
          SB6    B4 
          SA1    MAP.XS 
          RJ     PCB
          SB6    B7          RESTORE ITEM WIDTH 
          SA1    B5          RESTORE ITEM ADDRESS 
          BX1    X5          RESTORE ITEM 
          RJ     PCB
          EQ     EXIT.
  
 JIF30    SB7    B6-10
          PL     B7,JIF40    IF ITEM WIDTH GE 10
          SB7    B5-11
          MI     B7,JIF40    IF FIELD WIDTH LE 10 
          SB6    10 
          RJ     PCB
          SB6    B4 
          SA1    MAP.XS 
          RJ     PCB
          EQ     EXIT.
  
 JIF40    SB6    B5 
          RJ     PCB
          EQ     EXIT.
 MEC      SPACE  4,10 
**        MEC - MARK EQUIVALENCE CLASSES. 
* 
*         THIS ROUTINE WILL MAKE ONE PASS THROUGH A TABLE 
*         OF COMMON BLOCK MEMBERS, AND MARK EACH EQUIVALENCE
*         CLASS BY PLACING A COUNT OF THE NUMBER OF CLASS 
*         MEMBERS IN THE UPPER 18 BITS OF THE 1ST MEMBER
*         OF THAT CLASS ENCOUNTERED. IT WILL ALSO MARK GROUPS 
*         OF NON-EQUIVALENCED ITEMS IN THE SAME MANNER. 
* 
*         NOTE - THIS ROUTINE ASSUMES THAT CLASS MEMBERS WILL 
*                OCCUR CONSECUTIVELY IN THE TABLE.
* 
*         ENTRY  BLOCK MEMBERS ON T.SCR.  (MT. FORMAT)
* 
*         EXIT   EQUIVALENCE CLASSES MARKED. (MT.NMG FILLED IN) 
* 
*         CALLS  SCS. 
* 
*         USES   X - ALL  A - 1,2,3,4,5,6  B - 2,3,4,5,6,7. 
  
  
 MEC      SUBR               ENTRY/EXIT...
          SA4    T.SCR
          SA2    T=SCR
          SA5    T.SYM
          BX7    X5 
          =B3    0
          SB4    X2 
          IFEQ   TEST,ON,1
          ZR     B4,"BLOWUP" IF TABLE EMPTY 
  
 MEC10    SA5    X4+B3       X5 = ENTRY OF T.SCR
          LX5    -MT.WAIP 
          =B6    X5-WA.W+WB.W 
          ERRNZ  MT.WAIL-18 
          LX5    MT.WAIP
          SA1    X7+B6       X1 = *WB* OF ITEM
          HX1    WB.EQV 
          MI     X1,MEC40    IF FOUND AN EQUIVALENCE CLASS
  
**        HERE IF NON-EQUIVALENCED ITEM FOUND.  WE NEED TO
*         COUNT THE NUMBER OF CONSECUTIVE ITEMS OF THIS KIND, 
*         AND CHANGE THE SIGN TO INDICATE *NON-EQUIVALENCED ITEMS*. 
  
          =B2    0
  
 MEC20    =B2    B2+1 
          SA1    A5+B2       X1 = NEXT T.SCR ENTRY
          SB6    B3+B2
          GE     B6,B4,MEC30 IF TABLE EXHAUSTED 
          LX1    -MT.WAIP 
          =B6    X1-WA.W+WB.W 
          ERRNZ  MT.WAIL-18 
          SA1    X7+B6       X1 = *WB* OF ITEM
          HX1    WB.EQV 
          PL     X1,MEC20    IF NOT EQUIVALENCED
  
 MEC30    SX6    -B2
          MX0    -MT.NMGL 
          BX6    -X0*X6 
          EQ     MEC80
  
**        HERE FOR EACH EQUIVALENCE CLASS. WE NEED TO LOCATE
*         THE T.ECT ENTRY CORRESPONDING TO THE ITEM JUST FOUND. 
  
 MEC40    MX6    TE.SYMIL 
          LX6    TE.SYMIL+TE.SYMIP
          SA6    SCSA 
          =X6    B6-WB.W+WA.W 
          SCAN   T.ECT,SCS   FIND ITEM IN T.ECT 
  
**        NEXT WE SEARCH BACKWARDS TO LOCATE THE BASE MEMBER
*         SO IT CAN BE MARKED *PROCESSED*.
*         (A2) _ T.ECT ENTRY OF CLASS MEMBER. 
*         (B7) = MI IF ITEM NOT IN TABLE. INDEX OF ITEM OTHERWISE.
  
          =B2    0
  
 MEC50    =B2    B2+1 
          SA3    A2-B2       X3 = NEXT T.ECT ENTRY
          =B7    B7-1 
          IFEQ   TEST,ON,1
          MI     B7,"BLOWUP" IF *NIT* 
          HX3    TE.NB
          MI     X3,MEC50    IF NOT BASE MEMBER 
  
          LX3    TE.NBP+1 
          MX6    1
          BX6    X6+X3
          SA6    A3          MARK CLASS *PROCESSED* 
  
**        NOW WE SEARCH FORWARD STARTING AT A2+1 TO FIND
*         EITHER THE END OF THE TABLE, OR THE BASE MEMBER OF
*         THE NEXT CLASS, COUNTING AS WE GO.
*         (B2) = NUMBER OF MEMBERS FOUND SO FAR.
  
          SA1    T.ECT
          SA3    T=ECT
          =B6    0
          IX1    X1+X3
          SB5    X1          B5 = LWA + 1 
  
 MEC60    =B6    B6+1 
          SA3    A2+B6       X3 = NEXT T.ECT ENTRY
          SX6    A3-B5
          ZR     X6,MEC70    IF END OF TABLE
          HX3    TE.NB
          MI     X3,MEC60    IF NOT BASE MEMBER 
  
 MEC70    =B6    B6-1 
          SB2    B2+B6       B2 = COUNT OF MEMBERS
          SX6    B2 
  
**        NOW WE PLACE THE COUNT INTO THE TABLE ENTRY OF THE
*         FIRST ITEM OF THE GROUP, AND CHECK FOR END OF PROCESSING. 
*         (A5) _ TABLE ENTRY OF THE FIRST ITEM OF THE GROUP.
*         (X5) = TABLE ENTRY OF THE FIRST ITEM. 
*         (X6) = COUNT OF ITEMS IN THE GROUP. (WITH PROPER SIGN)
*         (B2) = ABSOLUTE VALUE OF X6 ABOVE.
  
 MEC80    LX6    MT.NMGP
          BX6    X5+X6
          SA6    A5          MERGE THE COUNT
          SB3    B3+B2       B3 = NEW T.SCR OFFSET
          LT     B3,B4,MEC10 IF MORE ITEMS
  
          IFEQ   TEST,ON,1
          NE     B3,B4,"BLOWUP"    IF INCONSISTENT INCREMENT
          EQ     EXIT.
 OBI      SPACE  4,10 
**        OBI -  OUTPUT COMMON BLOCK INFORMATION. 
* 
*         ENTRY  *OBI.BI* - CONTAINS THE CURRENT BLOCK INDEX. 
* 
*         EXIT   (X3),*OBI.BI* - UPDATED BLOCK INDEX. (MI IF NONE LEFT).
* 
*                *OCEI.SUP* = 0.
* 
*         CALLS  PCB,WLINE,BNS. 
* 
*         USES   ALL REGISTERS. 
  
 OBI      SUBR               ENTRY/EXIT...
          SA1    MAP.XS 
          SB6    3
          RJ     PCB
          SA5    OBI.BI 
          SA1    T.BLKS 
          SB2    X5 
          SA5    X1+B2       *CA* 
          SA2    BLNKCOM
          SB6    X2 
          SB6    B6-B2
          SA1    =2H//
          ZR     B6,OBI15    IF BLANK COMMON
          XTRCT  CA.BNAM,X5,X1     ISOLATE BLOCK NAME 
          LX1    -CA.BNAML   LEFT JUSTIFY BLOCK NAME
          RJ     BNS         BOUND NAME BY SLASHES
  
 OBI15    SB6    10 
          RJ     PCB         ADD NAME TO LINE 
          SA5    A5          RESTORE X5 
          XTRCT  CA.BLVL,X5,X1     ISOLATE LEVEL NUMBER 
          NZ     X1,OBI17    ** KLUDGE TO AVOID LEV0
          =X1    X1+1 
  
 OBI17    SX1    X1+33B      CONVERT TO DPC 
          LX1    CHAR 
          SA2    =8LLEVEL = 
          BX1    X1+X2       APPEND TO 8LLEVEL =
          SA2    =1R, 
          BX1    X1+X2
          SB6    10 
          RJ     PCB
          SA1    =5H SIZE 
          SB6    5
          RJ     PCB
          =A5    A5+1        *CB* 
          XTRCT  CB.BLEN,X5,X1     ISOLATE BLOCK LENGTH 
          =A3    A5-1 
          =B5    1
          SBIT   X3,CA.CHARP
          PL     X3,OBI20    IF NOT CHARACTER COMMON BLOCK
          BX3    X1 
          LX1    3
          IX1    X1+X3
          IX1    X1+X3       MULTIPLY LENGTH BY 10
          =B5    0
  
 OBI20    CALL   CDD         CONVERT SIZE TO DPC
          BX1    X4 
          =X0    1
          RJ     CCBB 
          BX4    X1 
          LX4    -3*CHAR
          SA1    =3L =
          MX0    3*CHAR 
          BX4    -X0*X4      ERASE BLANKS 
          BX1    X1+X4
          SB6    B6+3 
          RJ     PCB
          SA1    =6L CHARS   ASSUME UNITS ARE CHAR
          ZR     B5,OBI30    IF ASSUMPTION CORRECT
          SA1    =6L WORDS
  
 OBI30    SB6    10 
          SA2    =4R "SCM"   ASSUME SCM 
          HX5    CB.LCM 
          PL     X5,OBI35    IF ASSUMPTION CORRECT
          SA2    =4R "LCM"
  
 OBI35    BX1    X1+X2
          RJ     PCB
          LX5    CB.LCMP-CB.SAVEP+2 
          PL     X5,OBI40    IF NOT SAVED 
          SA1    =4HSAVE
          SB6    4
          RJ     PCB
  
 OBI40    SA5    PCB.WO 
          SX5    X5+2 
          WLINE  MAPBUFF-1,X5,1,0  OUTPUT BLOCK INFO
          SB6    6
          SA1    MAP.XS 
          RJ     PCB         INDENT 6 
          EQ     EXIT.
  
 OBI.BI   BSS    1           BLOCK INDEX
 OCEI     SPACE  4,10 
**        OCEI - OUTPUT COMMON+EQUIVALENCE ITEMS. 
* 
*         THIS ROUTINE WILL OUTPUT EACH ITEM REQUESTED IN 4 PARTS : 
* 
*         1)  THE NAME OF THE ITEM. 
*         2)  THE STORAGE UNIT OCCUPIED BY THE 1ST ELEMENT OF THE ITEM. 
*         3)  THE STORAGE UNIT OCCUPIED BY THE LAST ELEMENT OF THE ITEM.
*         4)  THE TRAILING CHARACTERS *> * .
* 
*         ENTRY  (OCEI.ADR) = ADDRESS OF THE 1ST ITEM.
*                (OCEI.NI)  = THE NUMBER OF ITEMS TO OUTPUT.
* 
*         EXIT   (OCEI.ADR) = ADDRESS OF LAST ITEM OUTPUT + 1.
*                ALL REQUESTED ITEMS OUTPUT.
* 
*         CALLS  NAME,FIRST,LAST,CBS,PCB. 
* 
*         USES   ALL REGISTERS. 
  
  
 OCEI     SUBR               ENTRY/EXIT...
  
 OCEI10   RJ     NAME        DETERMINE NAME 
          RJ     FIRST       DETERMINE FIRST INDEX
          RJ     LAST        DETERMINE LAST INDEX 
  
**        ALL INFO FOR THE CURRENT ITEM HAS BEEN ASSEMBLED. 
*         (B6) = LENGTH OF INFO IN CHARACTERS.
  
          SB6    B6+1        ACCOUNT FOR *>*
          RJ     CBS         CREATE BUFFER SPACE
          SA1    NAMEA       X1 = DPC OF NAME 
          =A2    A1+1        X2 = LENGTH OF NAME
          SB6    X2 
          RJ     PCB         OUTPUT NAME
          SA1    FIRSTA      X1 = FIRST DPC 
          =A2    A1+1        X2 = LENGTH OF FIRST 
          SB6    X2 
          RJ     PCB         OUTPUT FIRST 
          SA1    LASTA       X1 = DPC OF LAST 
          =A2    A1+1        X2 = LENGTH OF LAST
          SB6    X2 
          RJ     PCB         OUTPUT LAST
          SA1    =1L> 
          SB6    1
          RJ     PCB         OUTPUT TRAILING CHARACTERS 
          SA1    OCEI.NI
          SA2    OCEI.ADR 
          =X6    X1-1 
          =X7    X2+1 
          SA6    A1          UPDATE NUMBER OF ITEMS 
          SA7    A2          UPDATE ADDRESS 
          SA1    OCEI.TAB 
          SX0    23 
          IX1    X1+X0       INCREMENT FOR TAB
          BX7    X1 
          SA7    A1          UPDATE 
          ZR     X6,EXIT.    IF ALL ITEMS PROCESSED 
          RJ     TAB         MOVE TO NEXT POSITION
          EQ     OCEI10      CONTINUE 
  
 OCEI.ADR BSS    1           ADDRESS OF COMMON/EQUIVALENCE ITEM 
 OCEI.NI  BSS    1           NUMBER OF ITEMS
 OCEI.TAB BSS    1           TAB POSITION 
 OML      SPACE  4,10 
**        OML - OUTPUT MEMORY LAYOUT. 
* 
*         THIS ROUTINE DIRECTS THE OUTPUT OF COMMON + EQUIVALENCE 
*         MAP ITEMS, DELIMITING ANY AND ALL EQUIVALENCE CLASSES 
*         THAT MAY EXIST. 
* 
*         ENTRY  ALL ITEMS ON T.SCR (MT. FORMAT)
* 
*         EXIT   ALL ITEMS OUTPUT.
* 
*         CALLS  OCEI,CBS,PCB.
* 
*         USES   ALL REGISTERS. 
  
  
 OML      SUBR               ENTRY/EXIT...
          SA1    T.SCR
          BX6    X1 
          SA6    OCEI.ADR    SET FWA OF ITEMS 
          SA2    T=SCR
          IX6    X6+X2
          =X6    X6-1 
          SA6    OMLLWA      SET LWA OF ITEMS 
  
 OML10    SA2    X1          X2 = TABLE ENTRY OF AN ITEM
          LX2    -MT.NMGP 
          SX6    X2          X6 = NO. OF ITEMS IN NEXT GROUP
          ERRNZ  MT.NMGL-18 
          IFEQ   TEST,ON,1
          ZR     X6,"BLOWUP" IF BAD COUNT 
          MI     X6,OML20    IF GROUP OF NON-EQUIV ITEMS
  
**        HERE FOR ALL EQUIVALENCE CLASSES. 
  
          SA6    OCEI.NI     SET NUMBER OF ITEMS
          SA1    OCEI.TAB 
          RJ     TAB         BLANK FILL TO PROPER POSITION
          =B6    1
          RJ     CBS         CREATE BUFFER SPACE
          SA1    =1L( 
          =B6    1
          RJ     PCB         OUTPUT LEFT PAREN
          RJ     OCEI        OUTPUT EQUIVALENCE CLASS 
          =B6    1
          RJ     CBS         CREATE BUFFER SPACE
          SA1    =1L) 
          =B6    1
          RJ     PCB         OUTPUT RIGHT PAREN 
          EQ     OML30
  
**        HERE FOR ALL NON-EQUIVALENCED ITEMS.
  
 OML20    BX6    -X6
          SA6    OCEI.NI     SET NUMBER OF ITEMS
          SA1    OCEI.TAB 
          RJ     TAB         BLANK FILL TO PROPER POSITION
          RJ     OCEI        OUTPUT ITEMS 
  
**        TEST FOR EXHAUSTED TABLE. 
  
 OML30    SA1    OCEI.ADR 
          SA2    OMLLWA 
          IX2    X2-X1
          PL     X2,OML10    IF MORE ITEMS
          SB6    500
          RJ     CBS         FORCE BUFFER FLUSH 
          EQ     EXIT.
  
OMLLWA    BSS    1
 OTH      SPACE  4,10 
**        OTH -  OUTPUT TITLE AND HEADING.
* 
*         WILL OUTPUT TITLE AND HEADING WITHOUT PAGE EJECT, 
*         (UNLESS THERE ARE LESS THAN 10 LINES LEFT ON PAGE)
*         AND SET O.STITL CELL TO ALLOW WOF TO TAKE CARE OF 
*         FUTURE OUTPUT OF HEADING FOR THE CURRENT MAP. 
* 
*         ENTRY  *PCB.WO* = NO. WORDS IN HEADING - 2. 
*                (X5) = MST OFFSET. 
* 
*         EXIT   TITLE AND HEADING OUTPUT.
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  WLINE,PCB,MOVE,SETMEM,TAB. 
  
 OTH      SUBR               ENTRY/EXIT...
          SA1    LCNT 
          SA2    CO.PS
          IX6    X2-X1
          SX6    X6-10
          LX5    2           MULTIPLY MST OFFSET BY 4 
          PL     X6,OTH10    IF 10 OR MORE LINES LEFT 
          BX6    X2 
          SA6    LCNT        FORCE EJECT WITH NEXT LINE 
          =X1    1
          SX6    HDRBL
          LX1    30 
          BX6    X6+X1
          SA6    O.STITL     SUPRESS OLD HEADING
  
 OTH10    SA1    WO.LOR 
          PL     X1,OTH20    IF REFERENCES NOT SELECTED 
          SA1    CO.PW
          SX1    X1-MAPLC 
          MI     X1,OTH20    IF IN PW MODE
          SX1    MAPDTC 
          RJ     TAB         BLANK FILL TO DICTIONARY TAB COLUMN
          BX7    X5 
          LX7    1           MST OFFSET * 8 
          SA1    X7+MAPUD+4 
          SB6    MAPUDL*10
          RJ     PCB         OUTPUT PIECE OF USAGE DICTIONARY 
  
 OTH20    SA1    PCB.WO 
          =X0    X1+2        NO. WORDS IN HEADING 
          MOVE   X0,MAPBUFF-1,MOCBUF   MOVE HEADING TO DIFFERENT BUFFER 
          SETMEM MAPBUFF-1,X0,0    ZERO THE BUFFER
          SX6    60 
          SA6    PCB.SC      RESET SHIFT COUNT
          =X6    -2 
          SA6    PCB.WO      RESET WORD OFFSET
          SA1    X5+MAPST    FETCH LENGTH OF TITLE
          SB4    X0          SAVE HEADING LENGTH
          SB6    X1 
          =A1    A1+1        GET READY FOR PCB
          SB4    X0          SAVE HEADING LENGTH
          RJ     PCB
          SA1    OTH.LO       FETCH LIST OPTIONS
          SB6    10 
          RJ     PCB         APPEND THEM TO TITLE 
          SA1    WO.LOR 
          PL     X1,OTH30    IF REFERENCES NOT SELECTED 
          SA1    CO.PW
          SX1    X1-MAPLC 
          MI     X1,OTH30    IF IN PW MODE
          SX1    MAPDTC 
          RJ     TAB         BLANK FILL TO DICTIONARY TAB COLUMN
          BX7    X5 
          LX7    1           MST OFFSET * 8 
          SA1    X7+MAPUD 
          SB6    MAPUDL*10
          RJ     PCB         OUTPUT PART OF USAGE DICTIONARY
  
 OTH30    SA1    PCB.WO 
          =X1    X1+2        NO. OF WORDS TO OUTPUT 
          SX0    B4 
          WLINE  MAPBUFF-1,X1,2,0  OUTPUT THE TITLE 
          WLINE  MOCBUF,X0,0,1     OUTPUT THE HEADING 
          SX6    MOCBUF 
          SA1    WO.LOR 
          PL     X1,OTH40    IF REFERENCES NOT SELECTED 
          SA1    CO.PW
          SX1    X1-MAPLC 
          MI     X1,OTH40    IF IN PW MODE
          SX0    X0-MAPUDL   TRICK WOF INTO SUPPRESSING DICT. 
  
 OTH40    LX0    30 
          BX6    X6+X0       30/LEN,30/FWA
          SA6    O.STITL     SET CELL FOR USE BY WOF
          EQ     EXIT.
  
 OTH.LO    BSS    1           LIST OPTIONS PUT HERE BY MAP
 PCB      SPACE  4,10 
**        PCB -  PLACE CHARACTERS IN BUFFER.
* 
*         BEGINING AT LEFT, PCB REMOVES CHARACTERS FROM A STRING
*         AND STARTING AT WORD AND CHARACTER POSITION SPECIFIED 
*         BY *PCB.WO* AND *PCB.SC* RESPECTIVELY, PLACES THEM IN 
*         THE BUFFER. 
* 
*         ENTRY  (A1) = ADRS 1ST WORD OF STRING.
*                (X1) = 1ST WORD OF STRING. 
*                (B6) = LENGTH OF STRING. 
* 
*         EXIT   NONE.
* 
*         USES    X - ALL EXCEPT X5  A - 1,2,3,6  B - 2,3,6.
* 
*         CALLS  NONE.
  
 PCB10    BX6    X2 
          SX4    B2-60
          NZ     X4,PCB15    IF NOT AT START OF NEW WORD
          =X6    X6-1 
  
 PCB15    SA6    PCB.WO       STORE WORD OFFSET 
          SX6    B2 
          SA6    PCB.SC 
          BX6    X3 
          SA6    X2+MAPBUFF  REPLACE MAPBUFF WORD 
  
 PCB      SUBR               ENTRY/EXIT...
          SB3    B0 
          MX0    CHAR 
          SA2    PCB.WO       CURRENT MAPBUFF OFFSET
          SA3    PCB.SC       CURRENT SHIFT COUNT 
          SB2    X3-60
          NZ     B2,PCB17    IF NOT AT START OF NEW WORD
          =X2    X2+1 
  
 PCB17    SB2    X3 
          SA3    X2+MAPBUFF  CURRENT MAPBUFF WORD 
  
 PCB20    =B6    B6-1 
          MI     B6,PCB10    IF STRING EXHAUSTED
          BX4    X0*X1       GRAB LEFTMOST CHARACTER
          LX4    B2,X4       SHIFT INTO POSITION
          BX3    X4+X3       ADD IT TO MAPBUFF WORD 
          SB2    B2-6 
          GT     B2,B0,PCB30 IF MAPBUFF WORD NOT FILLED 
          BX6    X3          OTHERWISE... 
          IFEQ   TEST,ON,2
          SX7    X2-14
          PL     X7,"BLOWUP" IF BAD OFFSET
          SA6    X2+MAPBUFF  STORE FILLED WORD
          =X2    X2+1 
          SA3    X2+MAPBUFF  GET NEXT ONE 
          SB2    60          RESET SHIFT COUNT
  
 PCB30    LX1    CHAR 
          =B3    B3+1 
          SX4    B3-10
          MI     X4,PCB20    IF WORD OF STRING NOT EMPTY
          =A1    A1+1        GET NEXT ONE OTHERWISE 
          SB3    B0          RESET CHARACTER COUNT
          EQ     PCB20       CONTINUE 
  
  
 PCB.WO    CON    -2          MAPBUFF WORD OFFSET 
 PCB.SC    CON    60          MAPBUFF SHIFT COUNT (CHAR POSITION) 
 PRT      SPACE  4,10 
**        PRT -  PREPARE REFERENCE TABLE. 
* 
* 
*         EXIT   REFERENCE LINKS SET UP (IF SELECTED).
*                TABLES SQUEEZED AND SORTED.
* 
*         USES   ALL BUT A0.
*         CALLS  PST. 
  
  
 PRT      SUBR               ENTRY/EXIT...
          SA1    WO.LOR 
          PL     X1,PRT2     IF REF-MAP NOT SELECTED
          SA3    REFIO
          ZR     X3,PRT2     IF TABLE IN CORE 
  
**        READ REFERENCE TABLE BACK INTO CORE.
  
          SX0    B4          SAVE (B4)
          WRITER F.REF
          REWIND F.REF
          SB4    X0          RESTORE (B4) 
          SA2    LOSTREF
          ALLOC  T.REF,X2 
  
          IFNE   CP#RM,7,1
          READ   F.REF
  
          SA1    T.REF
          SA3    T=REF
          SX0    B4          SAVE (B4)
          READW  F.REF,X1,X3
          SB4    X0          RESTORE (B4) 
  
**        PRE-LOAD REGISTERS, AND CLEAR LINKS FROM SYMBOL AND LABEL 
*         TABLES. 
  
 PRT2     SA1    T.SYM
          SA4    T=SYM
          SA3    X1 
          SB5    X1          (B5) = FWA SYMBOL TABLE
          MX0    WA.SYML
          =B2    Z=SYM
          SB7    X4-Z=SYM 
          BX6    X0*X3
  
 PRT23    SA6    A3          CLEAR LINKS FROM SYM TAB 
          SA3    A3+B2
          SB7    B7-B2
          BX6    X0*X3
          PL     B7,PRT23 
  
**        LINK SYMBOLS AND LABELS INTO  THE REFERENCES. 
  
          SA1    T=REF       (X1) = LEN REF TABLE 
          SA4    T.REF
          ZR     X1,PRT5     IF REF TABLE EMPTY 
          =X6    X1+1 
          =X7    X4-1 
          ERRMI  FUDGE-1     CODE REQUIRES AT LEAST 1 SLOP WORD 
          SB4    X7 
          MX0    XR.TAGL
          SA6    A1 
          SA7    A4          FAKE UP INITIAL ENTRY, TO PREVENT ZERO LINK
          SA5    B4+X1
  
 SNAP=R   IFNE   TEST        DMP REFERENCE TABLE
          SA3    CO.SNAP
          LX3    1RR
          PL     X3,PRT3S    IF REFERENCE SNAP NOT SELECTED 
          DUMPT  REF
 PRT3S    BSS    0
 SNAP=R   ENDIF 
  
 PRT4     BX6    -X0*X5 
          LX5    -XR.TAGP 
          SX2    X5 
          LX7    X2,B1
          IX2    X2+X7       (X2) = SYMTAB INDEX
          ERRNZ  3-Z=SYM     CODE ASSUMES Z=SYM = 3 
          SA2    X2+B5       FETCH SYMBOL 
          SX4    X2          ISOLATE SYM LINK 
          BX3    X2-X4
          LX4    XR.TAGP
          =A5    A5-1 
          IX6    X6+X4       LINK THIS REF TO PREVIOUS CHAIN
          BX7    X3+X1       SYM/LAB LINKS TO THIS REF
          SA6    B4+X1
          SX1    A5-B4       (X1) = (X1) - 1
          SA7    A2 
          NZ     X1,PRT4     IF MORE REFERENCES 
  
 PRT5     BSS    0
 SNAP=R   IFNE   TEST        DUMP REFERENCE TABLE 
          SA3    CO.SNAP
          LX3    1RR
          PL     X3,PRT5S    IF REFERENCE SNAP NOT SELECTED 
          DUMPT  SYM
 PRT5S    BSS    0
 SNAP=R   ENDIF 
          EQ     EXIT.
 RNI      SPACE  4,10 
**        RNI -  RETURN NEXT INDEX
* 
*         RETURNS INDEX OF NEXT TABLE MEMBER TO BE PROCESSED
*         BY THE CALLING ROUTINE
* 
*         ENTRY  NONE 
* 
*         EXIT   *RNI.PI* = INDEX OF NEXT MEMBER
* 
*         CALLS  SRNI 
*         USES   X - 1,2,3,4,5,6,7  A - ALL  B - 2,3,4,5
  
 RNI      SUBR               ENTRY/EXIT...
 RNI5     SA3    RNI.PI      PREVIOUS INDEX RETURNED
          SA4    SRNI.BDF 
          PL     X4,RNI10    IF NOT FIRST TIME FOR THIS TABLE DIVISION
          BX7    X3 
          SA7    A4 
          =X6    1
          SA6    RNI.CC 
          =X6    -1 
          SA6    RNI.SC 
          EQ     EXIT.
  
 RNI10    SA1    RNI.CC      COUNTS NO. OF TIMES CALLED FOR THIS TABLE
          =X7    X1+1 
          SA7    RNI.CC      UPDATE IT
          SA2    RNI.CL      CALL LIMIT 
          IX1    X2-X7
          PL     X1,RNI20    IF TABLE DIVISION NOT EMPTY
          SB2    0
          RJ     SRNI        RESET RNI PARAMETERS 
          PL     B3,RNI5     IF TABLE NOT EMPTY 
          MX7    0           SIGNAL EMPTY TABLE 
          SA7    RNI.PI 
          EQ     EXIT.       RETURN 
  
 RNI20    SA1    RNI.SC      SECTION COUNTER
          =X6    X1+1 
          SA1    RNI.SL+X6   FETCH LENGTH PREVIOUS SECTION
          IX7    X3+X1       COMPUTE NEW INDEX
          SA2    SRNI.LED 
          IX3    X2-X7
          MI     X3,RNI30    IF TIME TO BACK UP TO 1ST SECTION
          SA6    RNI.SC 
          SA7    RNI.PI 
          EQ     EXIT.
  
 RNI30    SA1    SRNI.FED 
          IX1    X2-X1
          IX7    X7-X1
          =X6    -1 
          SA6    RNI.SC      UPDATE SECTION COUNTER 
          SA7    RNI.PI      UPDATE PREVIOUS INDEX
          EQ     EXIT.       RETURN 
  
 RNI.SL   BSS    6           STORAGE FOR SECTION LENGTHS
 RNI.CC   BSS    1           CALL COUNTER 
 RNI.CL   BSS    1           CALL LIMIT 
 RNI.SC   BSS    1           SECTION COUNTER
 RNI.PI   BSS    1           PREVIOUS INDEX 
 SRC      SPACE  4,10 
**        SRC -  SEARCH REFERENCE CHAIN.
* 
*         WILL SEARCH REF CHAIN FOR A *D* USAGE LETTER, SETTING XR.MEDF 
*         IN THAT ENTRY SO THAT REF PROCESSOR CAN SKIP IT.
* 
*         ENTRY  (X6) = *WA* OF A SYMBOL. 
* 
*         USES   X - 0,5,6,7  A - 5,7  B - 4. 
  
  
 SRC      SUBR               ENTRY/EXIT...
          SA5    WO.LOR 
          PL     X5,EXIT.    IF REFERENCES NOT SELECTED 
          SA5    T.REF
          SB4    X5          FWA T.REF
          XTRCT  WA.HASH,X6,X6     ISOLATE LINK TO HEAD OF REF CHAIN
          ZR     X6,EXIT.    IF NO REFS 
  
 SRC10    SA5    B4+X6
          XTRCT  XR.TAG,X5,X6      ISOLATE LINK TO NEXT REF 
          LX5    XR.TAGP-XR.USEP
          MX0    -XR.USEL 
          BX7    -X0*X5      ISOLATE USAGE LETTER 
          SX0    X7-CR.DEF
          ZR     X0,SRC20    IF FOUND *D* USAGE LETTER
          SX7    X7-CR.RET
          NZ     X7,SRC30    IF NOT FOUND *R* USAGE LETTER
  
 SRC20    LX5    XR.USEP
          LDBIT  X7,XR.MEDFP
          BX7    X5+X7
          SA7    A5 
  
 SRC30    NZ     X6,SRC10    IF MORE REFS 
          EQ     EXIT.
 SRNI     SPACE  4,10 
**        SRNI - SET RNI PARAMETERS.
* 
*         ENTRY  *SRNI.LED* = INDEX OF LAST ELEMENT IN T.SCR DIVISION.
* 
*                *T=SCR* = LENGTH OF T.SCR. 
* 
*                *MOCTC* = NUMBER OF SECTIONS TO APPEAR ACROSS PAGE.
* 
*                (B2) = NUMBER OF LINES NEEDED BY HEADINGS. 
* 
*         EXIT   (B3) = -1 IF TABLE EMPTY.
* 
*         USES   X - 1,2,3,4,5,6,7  A - 2,3,4,5,6,7  B - 2,3,5,6. 
  
 SRNI     SUBR               ENTRY/EXIT...
          =X6    -1 
          SA6    SRNI.BDF    SET BEGINING OF DIVISION FLAG
          SA2    SRNI.LED    LAST ELEMENT IN THIS DIVISION
          SA3    T=SCR
          =X6    X2+1 
          SA6    SRNI.FED    RESET FIRST ELEMENT OF DIVISION
          IX7    X3-X6
          =B3    -1 
          MI     X7,EXIT.    IF TABLE EMPTY 
          SA4    LCNT 
          SA5    CO.PS
          IX2    X5-X4
          SB3    X2-2 
          SX4    B3-B2       X4 = NUMBER OF USABLE LINES
          SX7    X2-10
          PL     X7,SRNI10   IF *OTH* WONT PAGE EJECT 
          SB3    X5 
          SX4    B3-B2
  
 SRNI10   SA5    MAP.NO 
          LX5    -1 
          BX1    X3          X1 = DEFAULT NUMBER OF ENTRIES ON PAGE 
          SA2    MOCTC
          MI     X5,SRNI20   IF REFERENCES SELECTED 
          IX5    X4*X2       X5 = NO. OF ENTRIES THAT COULD FIT ON PAGE 
          IX7    X3-X6
          =X1    X7+1        X1 = NUMBER OF ENTRIES LEFT
          IX7    X5-X1
          PL     X7,SRNI20   IF ALL ENTRIES WILL FIT ON PAGE
          BX1    X5 
  
 SRNI20   IX7    X6+X1
          =X7    X7-1 
          SA7    SRNI.LED    RESET LAST 
          SA6    RNI.PI      INITIALIZE INDEX 
          =B5    X2-1        LOOP LIMIT 
          =B6    0
          =B2    1           EXTRA LENGTH 
          BX4    X1 
          BX5    X2 
          IX7    X4/X5
          IX6    X7*X2
          IX6    X1-X6
          SB3    X6          B3 = REMAINDER 
  
 SRNI30   =B3    B3-1 
          PL     B3,SRNI40   IF NEED TO ADD EXTRA LENGTH
          =B2    0
          SB3    10          PREVENTS EXECUTION OF THIS SEQUENCE
  
 SRNI40   SX6    X7+B2       COMPUTE LENGTH OF A SECTION
          SA6    RNI.SL+B6
          =B6    B6+1 
          LE     B6,B5,SRNI30      IF NOT DONE
          BX6    X1 
          SA6    RNI.CL      CALL LIMIT 
          EQ     EXIT.
 SRNI     SPACE  4
 SRNI.BDF BSS    1           FLAG 
 SRNI.FED BSS    1           FIRST ELEMENT OF TABLE DIVISION
 SRNI.LED BSS    1           LAST ELEMENT OF TABLE DIVISION 
 STS      SPACE  4,10 
**        STS -  SYMBOL TABLE SEPARATION. 
* 
*         WILL SELECT ONE OF THE FOLLOWING SYMBOL TYPES 
*         FROM THE SYMBOL TABLE - 
*         VARIABLES,PROCEDURES,LABELS,NAMELIST,STRAY NAMES,DO LOOPS,
*         ENTRY POINTS,SYMBOLIC CONSTANTS,COMMON BLOCK MEMBERS. 
*         FOR EACH ENTRY SELECTED, AN INDIRECT SORT KEY IS
*         ADDED TO T.SCR. 
* 
*         ENTRY  (X5) = BIT MASK TO SELECT A SYMBOL TYPE. 
*                (X4) = BIT MASK TO REJECT SUBSET OF SELECTED SYM TYPE. 
*                (B4) = MST OFFSET. 
*                (STS.BI) = BLOCK INDEX (COM-EQV MAP ONLY)  . 
* 
*         EXIT   PROPER SYMBOLS ON T.SCR. 
* 
*         USES   X - 0,1,2,3,6,7  A - 1,2,3  B - 2,3,7. 
* 
*         CALLS  ADDWD,SHRINK.
  
 STS      SUBR               ENTRY/EXIT.
          SHRINK T=SCR,0
          SA1    T.SYM
          SA2    T=SYM
**
*         WILL ALWAYS SKIP OVER ZERO-TH ORDINAL.
**
          =B2    WB.W 
          SB3    X2 
  
 STS10    SB2    B2+Z=SYM 
          SB3    B3-Z=SYM 
          ZR     B3,EXIT.    IF TABLE EXHAUSTED 
          IFEQ   TEST,ON,1
          MI     B3,"BLOWUP" IF TABLE LENGTH NOT MULTIPLE OF Z=SYM
          SA3    X1+B2
          SX7    B4-TVARP 
          NZ     X7,STS20    IF NOT VARIABLE MAP
          CLAS=  X7,WB,(VAR,NVAR,LAB) 
          BX7    X7*X3
          ZR     X7,STS30    IF STRAY NAME, LET IT THROUGH
          EQ     STS25
  
 STS20    SX7    B4-TDOLP 
          ZR     X7,STS22    IF DO-LOOP MAP 
          SX7    B4-TIOP
          NZ     X7,STS25    IF NOT I/O MAP 
  
 STS22    BX7    X5+X3
          NZ     X7,STS10    IF ALL REQUESTED BITS ARE ZERO 
          EQ     STS35
  
 STS25    BX7    X5*X3
          ZR     X7,STS10    IF SELECT CRITERIA NOT SATISFIED 
          BX7    X4*X3
          NZ     X7,STS10    IF REJECT SUBSET CRITERIA SATISFIED
          SX7    B4-TCOMP 
          NZ     X7,STS30    IF NOT COMMON-EQUIVALENCE MAP
          SA2    A3-WB.W+WC.W 
          SA3    STS.BI 
          XTRCT  WC.RB,X2,X7 ISOLATE BLOCK INDEX
          IX7    X3-X7
          NZ     X7,STS10    IF BLOCK INDEXES DONT MATCH
          LX2    WC.RBP 
          XTRCT  WC.RA,X2,X6    X6 = RA 
          =A3    A2-WC.W+WB.W      *WB* 
          XTRCT  WB.MODE,X3,X3
          SX3    X3-M.CHAR
          LX6    MT.RAP 
          NZ     X3,STS40    IF NOT TYPE CHAR 
          LX6    -MT.RAP
          LX2    WC.RAP 
          WC     X3,X6       CONVERT RA TO CHARACTERS 
          XTRCT  WC.BCP,X2,X6      ISOLATE BEGINING CHARACTER POSITION
          IX6    X6+X3
          LX6    MT.RAP 
          SA3    A3          RESTORE *WB* 
          HX3    WB.EQV 
          PL     X3,STS40    IF NOT EQUIVALENCED
          LX6    -MT.RAP
          LX3    1+WB.EQVP-WB.BASEP 
          MX0    -WB.BASEL
          BX3    -X0*X3      X3 = SYMORD OF BASE MEMBER 
          BX2    X3 
          LX3    1
          IX3    X3+X2       CONVERT TO *WA* INDEX
          IX3    X1+X3       X3 = *WA* ADDRESS
          =A3    X3+WC.W     X3 = *WC*
          XTRCT  WC.BCP,X3,X3      X3 = BCP OF BASE 
          IX6    X6+X3       X6 = COMPLETE RA OF MEMBER 
          LX6    MT.RAP 
          EQ     STS40
  
 STS30    SA2    MAP.NO 
          =A1    A3-WB.W+WA.W 
          LX2    -1 
          PL     X2,STS35    IF LO=-R 
          SX1    X1          EXTRACT REFERENCE LINK 
          ZR     X1,STS50    IF NO REFERENCES COLLECTED FOR SYMBOL
  
 STS35    =A2    A3-WB.W+WA.W 
          MX7    -WA.SYML 
          LX2    -WA.SYMP 
          BX6    -X7*X2       ISOLATE SYMBOL
          LX6    MT.SYMP
          SX7    B4-TIOP
          NZ     X7,STS40    IF NOT I/O MAP 
          PL     X6,STS10    IF BIT 59 NOT SET
          MX7    1
          BX6    X6-X7       TURN OFF BIT 59
  
 STS40    =X1    B2-WB.W     OFFSET OF THIS ENTRY 
          LX1    MT.WAIP
          BX6    X6+X1       FORM INDIRECT KEY
          ADDWD  T.SCR
  
 STS50    SA1    T.SYM
          EQ     STS10
  
 STS.BI   BSS    1           BLOCK INDEX. USED ONLY DURING COM-EQV MAP
 TAB      SPACE  4,10 
**        TAB -  TAB OUT TO GIVEN COLUMN IN MAPBUFF.
* 
*         ENTRY  (X1) = COLUMN TO TAB TO. 
* 
*         USES   X - 0,1,2,3,4,6,7  A - 1,2,3,6  B - 2,3,6. 
* 
*         CALLS  CBS, GBL, PCB. 
  
 TAB      SUBR               ENTRY/EXIT...
          RJ     GBL         GET BUFFER LENGTH
          IX4    X1-X2
          =B6    X4-1        NUMBER OF BLANKS TO OUTPUT 
          IFEQ   TEST,ON,1
          MI     B6,"BLOWUP" IF BAD X1
          ZR     B6,EXIT.    IF POSITIONED CORRECTLY
          RJ     CBS         MAKE SURE ENOUGH BUFFER SPACE
          MI     B3,EXIT.    IF NOT ENOUGH BUFFER SPACE, NO TAB 
          SA1    MAP.XS 
          RJ     PCB         TAB TO REQUESTED COLUMN
          EQ     EXIT.
          TITLE  FIELD PROCESSORS 
 ADR      SPACE  4,10 
**        ADR -  OUTPUT RELATIVE ADDRESS OF A SYMBOL. 
* 
*         ACCESSES SYMBOL TABLE VIA OFFSET STORED IN X7 TO GET
*         RELATIVE ADDRESS OF A SYMBOL. 
* 
*         ENTRY  (X4) = 30/WIDTH OF FIELD,30/ADR. 
*                (X7) = ENTRY OF T.SCR (CONTAINS INDEX).
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - ALL. 
* 
*         CALLS  JIF,PIA,CDD,CCBB,PCB.
  
 ADR      DIS    MAPPML,ADDRESS 
  
          SA2    T.SYM
          XTRCT  MT.WAI,X7,X7      ISOLATE T.SYM WORD A INDEX 
          =B6    X7+WB.W     OFFSET TO WORD B 
          SA1    X2+B6       FETCH WORD B 
          LX4    30 
          SB5    X4          ISOLATE FIELD WIDTH
          SBIT   X1,WB.FPP
          PL     X1,ADR10    IF NOT DUMMY ARGUMENT
          LX1    WB.FPP+1    RESTORE X1 TO NOMINAL POSITION 
          XTRCT  WB.FPNO,X1,X1     ISOLATE FPNO 
          CALL   CDD         CONVERT TO DPC 
          BX1    X6 
          =B5    B5-1 
          =B6    -1          INDICATE UNKNOWN ITEM WIDTH
          SX0    3           BOTH INPUT AND OUTPUT RIGHT JUSTIFY
          RJ     JIF
          =B6    1
          SA1    MAP.XS 
          RJ     PCB
          EQ     MOC.RB 
  
 ADR10    SBIT   X1,WB.MATP/WB.FPP
          MI     X1,ADR20    IF MATERIALIZED
          SBIT   X1,WB.EQVP/WB.MATP 
          PL     X1,ADR15    IF NOT EQUIVALENCED
          LX1    WB.EQVP+1   RESTORE X1 TO NOMINAL POSITION 
          XTRCT  WB.BASE,X1,X4     X4 = SYMORD OF BASE MEMBER 
          SB6    X4 
          LX4    1
          SB6    X4+B6
          =B6    B6+WB.W     CONVERT TO *WB* INDEX
          SA4    X2+B6       *WB* OF BASE MEMBER
          SBIT   X4,WB.MATP 
          MI     X4,ADR20    IF BASE MEMBER MATERIALIZED
  
 ADR15    SA1    =5HNONE
          SB6    5
          =X0    1
          RJ     JIF
          EQ     MOC.RB 
  
 ADR20    =A1    A1-WB.W+WC.W   FETCH WORD C
          XTRCT  WC.RA,X1,X1 ISOLATE RELATIVE ADDRESS 
          SA2    WO.QC
          PL     X2,ADR30    IF NO FATAL ERRORS 
          MX1    0
          MX6    0
  
 ADR30    PIA                CONVERT TO OCTAL DPC 
          LX6    8*CHAR 
          BX1    X6 
          =B6    -1 
          SX0    3
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 ARG      SPACE  4,10 
**        ARG -  OUTPUT THE NUMBER OF ARGUMENTS OF A PROCEDURE. 
* 
*         WILL OUTPUT EITHER VAR, UNKNOWN, OR AN ARGUMENT COUNT 
*         DEPENDING ON THE NATURE OF THE PROCEDURE BEING PROCESSED. 
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/ARG.
*                (X7) = ENTRY OF T.SCR. 
*                (X5) = MST OFFSET. 
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - ALL. 
* 
*         CALLS  JIF,CDD,PCB. 
  
 ARG      DIS    MAPPML,ARGS--- 
  
          SA2    T.SYM
          XTRCT  MT.WAI,X7,X7      ISOLATE T.SYM OFFSET 
          =B6    X7+WB.W     OFFSET TO WORD B 
          SA1    X2+B6       FETCH WORD B 
          LX4    30 
          SB5    X4 
          =A2    A1-WB.W+WC.W   FETCH WORD C
          SBIT   X1,WB.DEFP 
          PL     X1,ARG10    IF ARGUMENT COUNT NOT DETERMINED 
          LX3    X2          ANOTHER COPY OF *WC* 
          XTRCT  WC.ARGC,X2,X1      ISOLATE ARG COUNT 
          XTRCT  WC.FUNT,X3,X3     FUNCTION TYPE
          =X3    X3-MF.LIB
          NZ     X3,ARG5     IF NOT INTRINSIC 
          SX0    X1-7 
          ZR     X0,ARG20    IF VARIABLE ARGUMENT INTRINSIC 
  
 ARG5     CALL   CDD         CONVERT ARGUMENT COUNT TO DISPLAY
          SB6    B5 
          BX1    X6 
          LX1    -4*CHAR
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 ARG10    XTRCT  WC.FUNT,X2,X2     ISOLATE FUNCTION TYPE
          =X3    X2-MF.LIB
          ZR     X3,ARG20    IF INTRINSIC FUNCTION
          =X3    X2-MF.INL
          ZR     X3,ARG20    IF INTRINSIC FUNCTION
          SA1    =7HUNKNOWN 
          SB6    7
          MX0    0           INPUT AND OUTPUT LEFT JUSTIFY
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 ARG20    SA1    =3HVAR 
          SB6    3
          MX0    0
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 BLK      SPACE  4,10 
**        BLK -  OUTPUT NAME OF BLOCK FOR A SYMBOL. 
* 
*         OUTPUTS THE NAME OF THE COMMON BLOCK THAT THE CURRENT 
*         SYMBOL IS A MEMBER OF, IF ANY.
* 
*         ENTRY  (X7) = ENTRY OF T.SCR (CONTAINING OFFSET). 
*                (X4) = 30/FIELD WIDTH,30/BLK.
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  JIF,BNS,PCB. 
  
 BLK      DIS    MAPPML,BLOCK---------------
  
          SA2    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM WORD A OFFSET 
          =B6    X1+WB.W     OFFSET TO WORD B 
          SA1    B6+X2       FETCH WORD B 
          LX4    30 
          SB5    X4 
          SBIT   X1,WB.COMP 
          MI     X1,BLK10    IF SYMBOL IS IN COMMON 
          SBIT   X1,WB.FPP/WB.COMP
          PL     X1,BLK4     IF SYMBOL IS NOT FORMAL PARAMETER
          SA1    =9HDUMMY-ARG 
          MX0    0
          SB6    9
          RJ     JIF
          EQ     MOC.RB      RETURN 
  
 BLK4     SBIT   X1,WB.SFAP/WB.FPP
          PL     X1,BLK5     IF SMYBOL IS NOT STF DUMMY ARGUMENT
          SA1    =8HSTF-DARG
          MX0    0
          SB6    8
          RJ     JIF
          EQ     MOC.RB      RETURN 
  
 BLK5     SA1    MAP.XS     GET READY FOR PCB 
          SB6    B5 
          RJ     PCB
          EQ     MOC.RB 
  
 BLK10    =A1    A1-WB.W+WC.W   FETCH WORD C
          XTRCT  WC.RB,X1,X1 ISOLATE BLOCK OFFSET 
          SA5    T.BLKS 
          SB4    X1 
          SA1    B4+X5       FETCH WORD A OF T.BLKS 
          XTRCT  CA.BNAM,X1,X1     ISOLATE BLOCK NAME 
          LX1    -CA.BNAML   LEFT JUSTIFY IT
          SA2    BLNKCOM
          SB7    X2 
          SB7    B7-B4
          ZR     B7,BLK20    IF BLANK COMMON
          RJ     BNS         BOUND NAME BY SLASHES
          EQ     BLK30
  
 BLK20    SA1    =10H// 
  
 BLK30    MX0    0
          =B6    -1 
          RJ     JIF
  
          EQ     MOC.RB      RETURN TO CONTROLLER 
 CLS      SPACE  4,10 
**        CLS -  OUTPUT THE CLASS OF A PROCEDURE. 
* 
*         WILL OUTPUT EXTERNAL, SUBROUTINE, INTRINSIC, FUNCTION OR
*         STAT FUNC DEPENDING ON THE NATURE OF THE PROCEDURE
*         BEING PROCESSED.
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/CLS.
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES   X - ALL  A - 1,2,3,6  B - ALL. 
* 
*         CALLS  JIF. 
  
 CLS      DIS    MAPPML,CLASS---------------
  
          LX4    30 
          SB5    X4 
          SA2    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM WORD A OFFSET 
          =B2    X7+WB.W     OFFSET TO WORD B 
          SA2    X2+B2       FETCH WORD B 
          SBIT   X2,WB.SUBP 
          PL     X2,CLS10    IF NOT A SUBROUTINE
          SA1    =10HSUBROUTINE 
          SBIT   X2,WB.FPP/WB.SUBP
          PL     X2,CLS5     IF NOT DUMMY ARGUMENT SUBROUTINE 
          SA1    =10HDUMMY-SUBR 
  
 CLS5     MX0    0
          SB6    10 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 CLS10    SBIT   X2,WB.FUNP/WB.SUBP 
          MI     X2,CLS20    IF FUNCTION
          SA1    =8HEXTERNAL
          MX0    0
          SB6    8
          RJ     JIF
          EQ     MOC.RB      RETURN 
  
 CLS20    =A1    A2-WB.W+WC.W   FETCH WORD C
          XTRCT  WC.FUNT,X1,X1     ISOLATE FUNCTION TYPE
          SA1    X1+CLSM     FETCH PROPER FUNCTION TYPE MESSAGE 
          SBIT   X2,WB.FPP/WB.FUNP
          PL     X2,CLS30    IF NOT DUMMY ARGUMENT FUNCTION 
          SA1    =10HDUMMY-FUNC 
  
 CLS30    MX0    0
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN 
 CLS      SPACE  4,10 
 CLSM     BSS 
          LOC    0
 MF.USER  DIS    1,FUNCTION 
 MF.STF   DIS    1,STAT FUNC
 MF.LIB   DIS    1,INTRINSIC
 .T       IFEQ   TEST,ON
 MF.BEF   DIS    1,**ERR**3  ALWAYS CGS 
 MF.INL   DIS    1,**ERR**4  ALWAYS CGS 
 .T       ENDIF 
          LOC    *O 
 DOIN     SPACE  4,10 
**        DOIN - OUTPUT VARIABLE USED AS LOOP CONTROL INDEX.
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/DOIN. 
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES   X - ALL  A - 1,2,3,6  B - ALL. 
* 
*         CALLS  JIF,SFN. 
  
 DOIN     DIS    MAPPML,INDEX-----
  
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B2    X7+WB.W
          SA2    X1+B2       FETCH SYMTAB (WB.) OF DOGL 
          XTRCT  WB.DI,X2,X2
          LX7    X2,B1
          IX3    X2+X7       (X3) = INDEX OF SYMTAB ENTRY OF DO-INDEX 
          ERRNZ  3-Z=SYM
          =B2    X1+WA.W
          SA2    X3+B2
          XTRCT  WA.SYM,X2,X1      ISOLATE NAME OF DO-INDEX 
          LX1    WA.SYMP     LEFT JUSTIFY IT
          CALL   SFN         SPACE FILL 
          LX4    30 
          SB5    X4 
          BX1    X6 
          MX0    0
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 DOLAB    SPACE  4,10 
**        DOLAB - OUTPUT LABEL DEFINED AS END OF LOOP.
* 
*         IF LOOP IS AN IMPLIED DO IN AN I/O STATEMENT, THIS
*         FIELD WILL BE BLANK.
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/DOLAB.
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES   X - ALL  A - 1,2,3,6  B - ALL. 
* 
*         CALLS  JIF,ZTB,PCB. 
  
 DOLAB    DIS    MAPPML,LABEL 
  
          LX4    30 
          SB5    X4 
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM WORD A OFFSET 
          =B2    X7+WB.W     OFFSET TO WORD B 
          SA2    X1+B2
          XTRCT  WB.TL,X2,X2 ISOLATE SYMORD OF TERMINAL LABEL 
          NZ     X2,DOLAB10  IF NOT AN I/O LOOP 
          SA1    =3HI/O 
          SB6    B5 
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 DOLAB10  LX7    X2,B1
          =B2    X1+WA.W
          IX3    X2+X7       (X3) = INDEX OF SYMTAB ENTRY OF TERMINAL 
          ERRNZ  3-Z=SYM
          SA2    X3+B2
          XTRCT  WA.STL,X2,X1      ISOLATE THE LABEL
          CALL   ZTB         CONVERT 00 CHARS TO BLANKS 
          BX1    X6 
          SX0    3
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 EPA      SPACE  4,10 
**        EPA -  OUTPUT THE NUMBER OF ARGS FOR AN ENTRY POINT.
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/EPA.
*                (X7) = ENTRY OF T.SCR. 
* 
*         CALLS  CDD,PCB. 
* 
*         USES   X - 1,2,3,4,6,7  A - 1,2,3,4,6  B - 2,3,4,5,6. 
  
 EPA      DIS    MAPPML,ARGS--- 
  
          LX4    30 
          SB5    X4          PRESERVE FIELD WIDTH 
          SA2    T.SYM
          XTRCT  MT.WAI,X7,X7      X7 = *WA* INDEX
          =B2    X7-WA.W+WB.W 
          SA2    X2+B2       *WB* 
          SA3    T.ENTP 
          XTRCT  WB.PNT,X2,X2      X2 = T.ENTP INDEX + 1
          MX1    0
          ZR     X2,EPA10    IF NO ARGS 
          =B2    X2-1 
          SA3    X3+B2       T.ENTP HEADER WORD (EH.) 
          XTRCT  EH.FPC,X3,X1      X1 = FP COUNT
 EPA10    CALL   CDD
          SB6    B5 
          BX1    X6 
          LX1    -4*CHAR
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
 FIRST    SPACE  4,10 
**        FIRST - DETERMINE STORAGE UNIT OCCUPIED BY FIRST
*                 ELEMENT OF COMMON-EQUIVALENCE MAP ITEM. 
* 
*         ENTRY  (OCEI.ADR) = ADDRESS OF TABLE ENTRY FOR ITEM.
*                (B6) = CHAR COUNT FOR ITEM.
* 
*         EXIT   (B6) = UPDATED BY LENGTH OF FIRST DPC. 
*                (FIRSTA) = DPC OF FIRST. 
*                (FIRSTA+1) = LENGTH OF FIRST IN CHARS. 
* 
*         CALLS  CCBB,CDD.
* 
*         USES   X - 0,1,2,3,4,6,7  A - 1,2,3,4,6  B - 2,3,4,6. 
  
  
 FIRST    SUBR               ENTRY/EXIT...
          SA1    OCEI.ADR 
          SA1    X1          X1 = TABLE ENTRY FOR ITEM
          XTRCT  MT.RA,X1,X6    X6 = RA OF ITEM 
          =X1    1
          IX6    X1+X6       CONVERT FROM RA TO INDEX 
          SA6    LASTA       SAVE FOR USE BY *LAST* 
          BX1    X6 
          SB5    B6 
          CALL   CDD         CONVERT TO DPC 
          MX0    CHAR 
          LX4    -CHAR
          BX4    -X0*X4      ERASE UPPER BLANK
          SA1    =1L< 
          BX1    X4+X1       PREFIX WITH <
          =X0    1
          RJ     CCBB        DETERMINE LENGTH 
          BX6    X1 
          SA6    FIRSTA 
          SX6    B6 
          =A6    A6+1 
          SB6    B6+B5       UPDATE CHARACTER COUNT 
          EQ     EXIT.
  
 FIRSTA   BSS    2
 FROM     SPACE  4,10 
**        FROM - OUTPUT THE LINE NUMBER OF 1ST STATEMENT OF A LOOP. 
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/FROM. 
*                (X7) = T.SCR ENTRY.
* 
*         USES   X - ALL  A - 1,2,3,6  B - ALL. 
* 
*         CALLS  JIF,CDD. 
  
 FROM     DIS    MAPPML,-FROM 
  
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B2    X7+WC.W
          SA1    X1+B2
          XTRCT  WC.LINE,X1,X1     ISOLATE LINE NUMBER
          LX4    30 
          SB5    X4 
          CALL   CDD         CONVERT TO DPC 
          BX1    X6 
          SX0    3
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 LADR     SPACE  4,10 
**        LADR - OUTPUT THE PROGRAM RELATIVE ADDRESS OF A LABEL.
* 
*         IF NO MEANINGFULL ADDRESS CAN BE ASSIGNED TO A LABEL, 
*         ONE OF THE FOLLOWING FLAGS WILL BE OUTPUT : 
*         *UNDEF*, *NO REFS*, INACTIVE, OR BLANK. 
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/LADR. 
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES  X - ALL  A - 1,2,3,6  B - ALL.
* 
*         CALLS  JIF,PIA. 
  
 LADR     DIS    MAPPML,ADDRESS---
  
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B6    X7+WB.W     OFFSET TO WORD B 
          SA1    X1+B6       FETCH WORD B 
          LX4    30 
          SB5    X4 
          CLAS=  X4,WB,(SDEF,NDEF,FDEF) 
          BX4    X1*X4
          NZ     X4,LADR10   IF DEFINED 
          SA1    =7H*UNDEF* 
          =X0    1
          SB6    7
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 LADR10   CLAS=  X4,WB,(CGS,DOGL) 
          BX2    X4*X1
          BX4    X2-X4
          ZR     X4,LADR30   IF DO-TOP LABEL
          SBIT   X1,WB.1REFP
          PL     X1,LADR20   IF REFERENCED
          SA1    =9H*NO REFS* 
          =X0    1
          SB6    9
          RJ     JIF
          EQ     MOC.RB      RETURN 
  
 LADR20   SBIT   X1,WB.ACTP/WB.1REFP
          MI     X1,LADR30   IF ACTIVE
          SBIT   X1,WB.SDEFP/WB.ACTP
          PL     X1,LADR30   IF NOT EXECUTABLE LABEL
          SA1    =8HINACTIVE
          =X0    1
          SB6    8
          RJ     JIF
          EQ     MOC.RB      RETURN 
  
 LADR30   SA1    A1-WB.W+WC.W      FETCH WORD C 
          XTRCT  WC.RA,X1,X1 ISOLATE RELATIVE ADDRESS 
          SA2    WO.QC
          PL     X2,LADR40   IF NO FATAL ERRORS 
          MX1    0
  
 LADR40   PIA                CONVERT TO OCTAL DPC 
          LX6    8*CHAR 
          BX1    X6 
          SB5    B5-2 
          =X0    3
          =B6    -1 
          RJ     JIF
          SA1    MAP.XS 
          SB6    2
          RJ     PCB
          EQ     MOC.RB      RETURN 
 LAST     SPACE  4,10 
**        LAST - DETERMINE STORAGE UNIT OCCUPIED BY LAST ELEMENT
*                OF COMMON-EQUIVALENCE ITEM.
* 
*         ENTRY  (OCEI.ADR) = ADDRESS OF TABLE ENTRY FOR ITEM.
*                (LASTA) = FIRST INDEX FOR THIS ITEM. (BINARY)
*                (B6) = CHARACTER COUNT.
* 
*         EXIT   (B6) = UPDATED BY LENGTH OF LAST DPC.
*                (LASTA) = DPC OF LAST. 
*                (LASTA+1) = LENGTH OF LAST INDEX.
* 
*         CALLS  CDD,CCBB.
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - 2,3,4,6. 
  
  
 LAST     SUBR               ENTRY/EXIT...
          SA3    T.SYM
          SA1    OCEI.ADR 
          SA1    X1 
          LX1    -MT.WAIP 
          SB2    X1-WA.W+WB.W 
          ERRNZ  MT.WAIL-18 
          SA3    X3+B2       X3 = *WB*
          XTRCT  WB.MODE,X3,X6     X6 = MODE OF ITEM
          LX3    WB.MODEP-WB.ARYP-1 
          =X1    1
          PL     X3,LAST10   IF NOT AN ARRAY
          LX3    WB.ARYP+1
          XTRCT  WB.PNT,X3,X3      X3 = T.DIM INDEX 
          SA2    T.DIM
          SB2    X3 
          SA2    X2+B2       X2 = *DH*
          XTRCT  DH.PS,X2,X1 X1 = LENGTH
  
 LAST10   SX7    1R-
          SA7    LASTA+1     STORE SEPARATOR FOR NON-CHAR ITEM
          =X2    X6-M.DBL 
          =X3    2
          ZR     X2,LAST20   IF DOUBLE PRECISION
          =X2    X6-M.CPLX
          ZR     X2,LAST20   IF COMPLEX 
          =X2    X6-M.CHAR
          =X3    1
          NZ     X2,LAST20   IF NOT CHARACTER 
          =A3    A3-WB.W+WC.W 
          XTRCT  WC.CLEN,X3,X3     X3 = CHARACTER LENGTH
          =X7    1R:  
          SA7    LASTA+1     STORE SEPARATOR FOR CHAR ITEM
  
 LAST20   IX5    X1*X3       X5 = TOTAL LENGTH OF ITEM
          SA3    LASTA
          IX2    X3+X5
          =X5    1
          IX1    X2-X5       X1 = LAST
          SB5    B6          SAVE B6
          =B6    0
          IX3    X3-X1
          ZR     X3,LAST30   IF LAST .EQ. FIRST 
          CALL   CDD         CONVERT TO DPC 
          MX0    CHAR 
          LX4    -CHAR
          BX4    -X0*X4      ERASE UPPER BLANK
          SA1    LASTA+1     X1 = SEPARATOR 
          LX1    -CHAR
          BX1    X4+X1       PREFIX WITH - (OR :) 
          =X0    1
          RJ     CCBB        DETERMINE LENGTH 
          BX6    X1 
  
 LAST30   SA6    LASTA
          SX6    B6 
          =A6    A6+1 
          SB6    B6+B5       UPDATE TOTAL CHARACTER COUNT 
          EQ     EXIT.
  
 LASTA    BSS    2
 LBL      SPACE  4,10 
**        LBL -  OUTPUT A LABEL NUMBER. 
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/LBL.
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - ALL. 
* 
*         CALLS  JIF,ZTB. 
  
 LBL      DIS    MAPPML,LABEL 
  
          LX4    30 
          SB5    X4 
          XTRCT  WA.STL,X7,X1      ISOLATE THE LABEL
          CALL   ZTB         CONVERT 00 CHARS TO BLANKS 
          BX1    X6 
          SX0    3
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 LDEF     SPACE  4,10 
**        LDEF - OUTPUT SOURCE LINE NUMBER WHERE A LABEL WAS DEFINED. 
* 
*         IF LABEL WAS NOT DEFINED, *UNDEF* WILL BE OUTPUT. 
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/LDEF. 
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - ALL. 
* 
*         CALLS  JIF,CDD. 
  
 LDEF     DIS    MAPPML,----DEF 
  
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B6    X7+WB.W     OFFSET TO WORD B 
          SA1    X1+B6       FETCH WORD B 
          LX4    30 
          SB5    X4          FIELD WIDTH
          CLAS=  X4,WB,(SDEF,NDEF,FDEF) 
          BX4    X1*X4
          NZ     X4,LDEF10   IF DEFINED 
          SA1    =7H*UNDEF* 
          =X0    1
          SB6    7
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 LDEF10   SA1    A1-WB.W+WC.W      FETCH WORD C 
          XTRCT  WC.LINE,X1,X1     ISOLATE LINE NUMBER
          CALL   CDD         CONVERT TO DPC 
          BX1    X6 
          SX0    3
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 NAM      SPACE  4,10 
**        NAM -  OUTPUT THE NAME OF A SYMBOL. 
* 
*         THIS ROUTINE WILL TAKE THE SYMBOL IN UPPER 42 BITS
*         OF X7 AND FORMAT IT FOR PCB.
* 
*         ENTRY  (X4) = 30/WIDTH OF FIELD,30/NAM. 
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES   X - ALL  A - 1,2,3,6  B - ALL. 
* 
*         CALLS  JIF,SFN. 
  
 NAM      DIS    MAPPML,NAME------
  
          XTRCT  MT.SYM,X7,X1      ISOLATE NAME 
          LX1    -MT.SYML    LEFT JUSTIFY IT
          CALL   SFN         SPACE FILL 
          BX1    X6 
          LX4    30 
          SB5    X4 
          MX0    0
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 NAME     SPACE  4,10 
**        NAME - DETERMINE NAME OF COMMON-EQUIVALENCE ITEM. 
* 
*         ENTRY  (OCEI.ADR) = ADDRESS OF TABLE ENTRY FOR ITEM.
* 
*         EXIT   (B6) = LENGTH OF NAME IN CHARS.
*                (NAMEA) = DPC OF NAME. 
*                (NAMEA+1) = B6 
* 
*         CALLS  SFN,CCBB.
* 
*         USES   X - 0,1,2,3,4,6,7  A - 1,2,6  B - 2,3,6. 
  
  
 NAME     SUBR               ENTRY/EXIT...
          SA1    OCEI.ADR 
          SA2    T.SYM
          SA1    X1          X1 = TABLE ENTRY OF ITEM 
          LX1    -MT.WAIP 
          SB2    X1 
          ERRNZ  MT.WAIL-18 
          SA2    X2+B2       X2 = *WA*
          MX1    WA.SYML
          HX2    WA.SYM 
          BX1    X1*X2       EXTRACT DPC OF NAME
          CALL   SFN         SPACE FILL 
          =X0    1
          BX1    X6 
          RJ     CCBB        DETERMINE LENGTH 
          SA6    NAMEA
          SX6    B6 
          =A6    A6+1 
          EQ     EXIT.
  
 NAMEA    BSS    2
 NOP      SPACE  4,10 
**        NOP -  DO NOTHING AT ALL. 
* 
*         USED TO EFFECTIVELY DELETE A FIELD FROM A MAP 
*         WHEN PAGE WIDTH LIMITATIONS WONT ALLOW ENTIRE 
*         MAP TO BE PRINTED.
* 
 NOP      DIS    MAPPML,THIS SHOULD NEVER BE PRINTED
  
          EQ     MOC.RB 
 PRP      SPACE  4,10 
**        PRP -  OUTPUT PROPERTIES OF DO LOOPS, VARIABLES, OR LABELS. 
* 
*         THIS ROUTINE MAKES ONE PASS THROUGH A TABLE UNIQUE TO 
*         THE MAP SEGMENT BEING PROCESSED TO OUTPUT PROPERTIES. 
*         THE ACTION OF THE PROCESSOR IS DETERMINED BY FIELDS IN
*         THE 1ST WORD OF EACH 2-WORD TABLE ENTRY.  A MAXIMUM OF
*         TWO BITS MUST BE TESTED TO DETERMINE WHETHER A PROPERTY 
*         IS TO BE PRINTED OR NOT.  IN ADDITION, CERTAIN ACTIONS
*         MAY NEED TO BE TAKEN BEFORE PRINTING.  THIS INFORMATION 
*         (ALONG WITH THE LENGTH IN CHARS OF THE PROPERTY) IS 
*         CONTAINED IN THE 1ST WORD OF EACH TABLE ENTRY AS FOLLOWS :  
* 
*         18/BIT1,1/VAL1,18/BIT2,1/VAL2,18/LABEL,4/LENGTH.
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/PRP.
*                (X7) = ENTRY OF T.SCR. 
*                (X5) = CURRENT MST OFFSET. 
* 
*         USES   ALL EXCEPT A5. 
* 
*         CALLS  JIF,PCB. 
  
 PRP      DIS    MAPPML,PROPERTIES--------------------
  
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B2    X7+WB.W
          SA1    X1+B2
          LX4    30 
          SB4    X4          SAVE COPY OF THE FIELD WIDTH 
          =B7    0           FLAG 
          =B5    0           CHARACTER COUNTER
          SA4    PRPPTA+X5   X4 = PROPER TABLE ADDRESS
          IFEQ   TEST,ON,1
          ZR     X4,"BLOWUP" IF BAD X5
          SA4    X4-2        INITIALIZE A4
          BX5    X1 
  
 PRP30    SA4    A4+2 
          ZR     X4,PRP50    IF AT END OF TABLE 
          LX4    18 
          SB2    X4          ISOLATE 1ST BIT NUMBER 
          LX4    1
          =X0    1
          BX2    X0*X4       ISOLATE BIT VALUE THAT TRIGGERS SUPPRESS 
          LX2    B2,X2       POSITION IT
          LX0    B2,X0
          BX1    X0*X5       ISOLATE ACTUAL BIT VALUE 
          BX1    X1-X2
          ZR     X1,PRP30    IF SATISFIES SUPPRESS CRITERION
          LX4    18 
          SB2    X4          ISOLATE 2ND BIT NUMBER 
          LX4    1
          =X0    1
          BX2    X0*X4       ISOLATE BIT VALUE THAT TRIGGERS SUPPRESS 
          LX2    B2,X2       POSITION IT
          LX0    B2,X0
          BX1    X0*X5       ISOLATE ACTUAL BIT VALUE 
          BX1    X1-X2
          ZR     X1,PRP30    IF SATISFIES SUPPRESS CRITERION
          LX4    18 
          SB2    X4          ADDRESS OF CODE TO EXECUTE 
          JP     B2 
  
 PRP40    MX0    4
          BX1    X0*X4       ISOLATE PROPERTY LENGTH
          LX1    4
          SB6    X1+B7       ADD LENGTH OF / (IF ANY) 
          SB5    B5+B6       ACCUMULATE SUM 
          IFEQ   TEST,ON,2
          SB2    B4-B5
          MI     B2,"BLOWUP" IF EXCEEDING FIELD WIDTH 
          SA1    A4+1 
          ZR     B7,PRP45    IF NOTHING PREVIOUSLY OUTPUT 
          SX0    5
          BX1    X1-X0       CHANGE BLANK TO /
          LX1    -CHAR
  
 PRP45    RJ     PCB
          =B7    1           SET THE FLAG 
          EQ     PRP30       CONTINUE 
  
 PRP50    SB6    B4-B5       NUMBER OF UNUSED COLUMNS 
          SA1    MAP.XS 
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
 PRP      SPACE  4,10 
**        THE FOLLOWING CODE IS EXECUTED ONLY IF WB.LEV IS
*         SET. (WHEN PROCESSING VARIABLE MAP) 
  
 PRP60    BX1    X5 
          XTRCT  WB.LEVN,X1,X1      ISOLATE THE LEVEL NUMBER
          SX1    X1+33B      CONVERT TO DPC 
          =A2    A4+1 
          MX0    CHAR 
          LX0    -3*CHAR
          BX2    -X0*X2      ERASE OLD LEVEL NUMBER 
          LX1    6*CHAR 
          BX7    X1+X2       APPEND NEW LEVEL NUMBER
          SA7    A2 
          EQ     PRP40
 PRP      SPACE  4,10 
**        THE FOLLOWING CODE IS EXECUTED ONLY IF THE
*         LABEL MAP IS BEING PROCESSED. 
  
 PRP70    MX0    4
          BX1    X0*X4       ISOLATE LENGTH 
          LX1    4
          SB6    X1 
          SA1    A4+1 
          SB5    B4 
          MX0    0
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
**        THE FOLLOWING CODE IS EXECUTED ONLY DURING VARIABLE MAP OUTPUT
*         IF A SYMBOL IS UNUSED.
  
 PRP80    CLAS=  X1,WB,(DEF)
          BX5    X1+X5       TURN ON THE *DEF* BIT
          EQ     PRP40
 PRP      SPACE  4
**        TABLE OF PRIORITY TABLE ADDRESSES.
  
 STO      SET    -1 
 PRPPTA   BSS    0
          LOC    0
          DDTE   TVARP,(VFD    60/PRPA)        VARIABLES
          DDTE   TSCP,(VFD    60/0) 
          DDTE   TPROP,(VFD    60/0)
          DDTE   TLABP,(VFD    60/PRPC)        LABELS 
          DDTE   TENTP,(VFD    60/0)
          DDTE   TNAMP,(VFD    60/0)
          DDTE   TDOLP,(VFD    60/PRPB)        DO-LOOPS 
          DDTE   TCOMP,(VFD    60/0)
          DDTE   TIOP,(VFD    60/PRPD)         I/O UNITS
          LOC    *O 
 PRP      SPACE  4,10 
**        THE FOLLOWING CODE DEFINES ONE TABLE FOR EACH MAP 
*         SEGMENT THAT USES THIS PROCESSOR. 
  
 PRPA     VFD    18/WB.SFAP,1/0,18/WB.SFAP,1/0,18/PRP50,4/0 
          DATA   10H
          VFD    18/WB.VARP,1/1,18/WB.NVARP,1/1,18/PRP80,4/6
          DATA   10HUNUSED
  
          VFD    18/WB.DEFP,1/1,18/WB.FPP,1/1,18/PRP40,4/3
          DATA   10HUND 
  
          VFD    18/WB.EQVP,1/0,18/WB.EQVP,1/0,18/PRP40,4/3 
          DATA   10HEQV 
  
          VFD    18/WB.1REFP,1/0,18/WB.COMP,1/1,18/PRP40,4/3
          DATA   10H*S* 
  
          VFD    18/WB.LEVP,1/0,18/WB.LEVP,1/0,18/PRP60,4/4 
          DATA   10HLEV 
  
          VFD    18/WB.SAVEP,1/0,18/WB.SAVEP,1/0,18/PRP40,4/3 
          DATA   10HSAV 
  
          DATA   0
 PRP      SPACE  4,10 
 PRPB     VFD    18/WB.DLERP,1/0,18/WB.DLERP,1/0,18/PRP40,4/4 
          DATA   10HXREF
  
          VFD    18/WB.DLENP,1/0,18/WB.DLENP,1/0,18/PRP40,4/5 
          DATA   10HENTRY 
  
          VFD    18/WB.DLNIP,1/0,18/WB.DLNIP,1/0,18/PRP40,4/5 
          DATA   10HOUTER 
  
          VFD    18/WB.DLEXP,1/0,18/WB.DLEXP,1/0,18/PRP40,4/4 
          DATA   10HEXIT
  
          DATA   0
 PRP      SPACE  4,10 
PRPC      VFD    18/WB.FDEFP,1/0,18/WB.FDEFP,1/0,18/PRP70,4/6 
          DATA   10HFORMAT
  
          VFD    18/WB.NDEFP,1/0,18/WB.NDEFP,1/0,18/PRP70,4/6 
          DATA   10HNON-EX
  
          VFD    18/WB.DOTP,1/0,18/WB.DOTP,1/0,18/PRP70,4/7 
          DATA   10HDO-TERM 
  
          DATA   0
  
 PRPD     VFD    18/WB.AUXP,1/0,18/WB.AUXP,1/0,18/PRP40,4/3 
          DATA   10HAUX 
  
          VFD    18/WB.FMTP,1/0,18/WB.FMTP,1/0,18/PRP40,4/3 
          DATA   10HFMT 
  
          VFD    18/WB.BINP,1/0,18/WB.BINP,1/0,18/PRP40,4/3 
          DATA   10HBIN 
  
          VFD    18/WB.DIRP,1/0,18/WB.DIRP,1/0,18/PRP40,4/3 
          DATA   10HDIR 
  
          VFD    18/WB.SEQP,1/0,18/WB.SEQP,1/0,18/PRP40,4/3 
          DATA   10HSEQ 
  
          VFD    18/WB.BUFP,1/0,18/WB.BUFP,1/0,18/PRP40,4/3 
          DATA   10HBUF 
  
          DATA   0
 REF      SPACE  4,10 
**        REF -  OUTPUT REFERENCES TO A SYMBOL. 
* 
*         EACH REFERENCE TAKES UP MAPCPR COLUMNS. CODE WILL WORK
*         PROPERLY ONLY IF MAPCPR IS BETWEEN 7 AND 10 INCL. 
* 
*         ENTRY  (X7) = ENTRY OF T.SCR. 
*                (X5) = CURRENT MST OFFSET. 
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  PCB,CDD,WLINE,GBL. 
  
 REF      DIS    MAPPML,REFERENCES------
  
          PLUG   AT=REFP1,TO=REF15,,VOID=NO 
          SA1    MOD
          SBIT   X1,MO.FUNP 
          PL     X1,REF3     IF NOT FUNCTION
          =X6    X5-TVARP 
          NZ     X6,REF1     IF NOT PROCESSING VARIABLE MAP 
          PLUG   AT=REFP2,FROM=REFPL,,,VOID=NO
          EQ     REF2 
  
 REF1     =X6    X5-TENTP 
          NZ     X6,REF3     IF NOT PROCESSING ENTRY MAP
          PLUG   AT=REFP2,FROM=REFMI,,,VOID=NO
  
 REF2     PLUG   AT=REFP1,FROM=REFNOP,,,VOID=NO 
  
 REF3     RJ     GBL         GET BUFFER LENGTH
          BX6    X2 
          SA6    REFICC      SAVE INITIAL CHARACTER COUNT 
          SA3    CO.PW
          SX3    X3          STRIP CONNECT BIT
          IX3    X3-X2       # COLUMNS REF CAN USE
          SX1    MAPCPR 
          IX3    X3/X1       X3 = # OF REFERENCES PER LINE
          SX1    X3-MAPMRPL 
          PL     X1,REF5     IF ROOM FOR 2 OR MORE REFERENCES PER LINE
          SA7    REFSAV+2    PRESERVE T.SCR ENTRY 
          SA1    PCB.WO 
          SX1    X1+2 
          WLINE  MAPBUFF-1,X1,0,0    FLUSH THE BUFFER 
          SA1    MAP.XS 
          SB6    10 
          RJ     PCB
          SA3    CO.PW
          SX3    X3-10
          SX1    MAPCPR 
          IX3    X3/X1
          SX6    10 
          SA6    REFICC 
          SA1    REFSAV+2 
          BX7    X1          RESTORE T.SCR ENTRY
  
 REF5     BX6    X3 
          SA6    REFRPL      SAVE IT
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B2    X7+WA.W
          SA1    X1+B2       FETCH WORD A 
          LX1    -WA.HASHP
          BX5    -X0*X1      ISOLATE LINK TO HEAD OF REF CHAIN
          ZR     X5,MOC.RB   IF NO REFERENCES 
          SB5    X3          COUNTER
  
 REF10    SA1    MAP.XS 
          SB6    MAPCPR-MAPMCPR 
          IFEQ   TEST,ON,1
          MI     B6,"BLOWUP" IF MAPCPR BAD
          RJ     PCB
          MX0    -XR.LINEL
          SA1    T.REF
          SB2    X5 
          SA1    X1+B2       FETCH T.REF ENTRY
          LX1    -XR.LINEP
          BX1    -X0*X1      ISOLATE LINE NUMBER OF REFERENCE 
          CALL   CDD         CONVERT TO DPC 
          LX6    2*CHAR 
          SA1    A1          RESTORE T.REF ENTRY
          BX3    X1 
          MX2    -XR.TAGL 
          LX3    -XR.TAGP 
          BX5    -X2*X3      ISOLATE LINK TO NEXT REFERENCE 
  
 REFP1    EQ     REF15
+         LX3    XR.TAGP-XR.MEDFP-1 
  
 REFP2    PL     X3,REF15 
+         ZR     X5,MOC.RB
          EQ     REF10
  
 REF15    MX2    -XR.USEL 
          LX1    -XR.USEP 
          BX1    -X2*X1      ISOLATE USAGE LETTER 
          SX2    X1-55B 
          ZR     X2,REF20    IF BLANK USAGE LETTER
          MX2    -2*CHAR
          BX6    X2*X6       ERASE LOWER BLANKS OF LINE NUMBER
          SX2    1R/
          LX2    CHAR 
          BX1    X1+X2       COMBINE / AND USAGE LETTER 
          BX6    X1+X6       APPEND TO LINE NUMBER
  
 REF20    SB6    MAPMCPR
          BX1    X6 
          LX1    60-6*MAPMCPR 
          RJ     PCB
          ZR     X5,MOC.RB   IF LINK IS ZERO
          =B5    B5-1 
          NZ     B5,REF10    IF LINE NOT FINISHED 
          SA2    PCB.WO 
          =X2    X2+2        # OF WORDS TO OUTPUT 
          SAVR   (X5,B5),REFSAV 
          WLINE  MAPBUFF-1,X2,0,0  OUTPUT THE LINE
          RESR   (X5,B5),REFSAV 
          SA2    REFICC      # OF BLANKS TO OUTPUT
          SB6    X2 
          SA1    MAP.XS 
          RJ     PCB
          SA1    REFRPL 
          SB5    X1 
          EQ     REF10       CONTINUE 
  
 REF      SPACE  4,10 
 REFSAV   BSS    3           STORAGE FOR POINTERS 
  
 REFICC   BSS    1           INITIAL CHARACTER COUNT
 REFPF    BSS    1           PRINT FLAG CELL
 REFRPL   BSS    1           REFERENCES PER LINE
 REFNOP   NO
 REFPL    PL     X3,REF15 
 REFMI    MI     X3,REF15 
 SZE      SPACE  4,10 
**        SZE -  OUTPUT THE SIZE OF A VARIABLE. 
* 
*         THIS ROUTINE ACCESSES T.DIM (IF VAR IS AN ARRAY)
*         TO GET THE LINEAR LENGTH OF A VARIABLE. 
* 
*         ENTRY  (X4) = 30/WIDTH OF FIELD,30/SZE. 
*                (X7) = ENTRY OF T.SCR. 
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - ALL. 
* 
*         CALLS  JIF,CDD,PCB. 
  
 SZE      DIS    MAPPML,---SIZE 
  
          SA2    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B6    X7+WB.W     OFFSET TO WORD B 
          SA1    B6+X2       FETCH WORD B 
          BX2    X1 
          LX4    30 
          SB5    X4 
          SBIT   X2,WB.ARYP 
          MI     X2,SZE10    IF ARRAY 
          SA1    MAP.XS 
          SB6    B5 
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 SZE10    SA2    T.DIM
          XTRCT  WB.PNT,X1,X1      ISOLATE T.DIM OFFSET 
          SB6    X2 
          SA1    B6+X1       FETCH HEADER WORD
          CLAS=  X5,DH,(VD,AS)
          BX2    X5*X1
          ZR     X2,SZE40    IF NOT VARIABLE LENGTH OR ASSUMED SIZE 
          LX4    30 
          SB6    X4 
          SA1    =7HADJ-ARY 
          MX0    0
          SB6    7
          RJ     JIF
          EQ     MOC.RB 
  
 SZE40    MX0    -DH.PSL
          LX1    -DH.PSP
          BX1    -X0*X1      ISOLATE PRODUCT OF SPANS 
          BX5    X4 
          CALL   CDD
          BX1    X6 
          SX0    3
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 TO       SPACE  4,10 
**        TO -   OUTPUT LINE NUMBER OF LAST STATEMENT OF A LOOP.
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/TO. 
*                (X7) = T.SCR ENTRY.
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - ALL. 
* 
*         CALLS  JIF,CDD
  
 TO       DIS    MAPPML,---TO 
  
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B2    X7+WB.W
          SA3    X1+B2       X3 = *WB*
          =A2    A3-WB.W+WC.W      X2 = *WC*
          XTRCT  WB.TL,X3,X3 ISOLATE SYMORD OF TERMINAL LABEL 
          ZR     X3,TO10     IF I/O LOOP
          LX7    X3,B1
          =B2    X1+WC.W
          IX3    X3+X7       (X3) = INDEX OF SYMTAB ENTRY OF TERMINAL 
          ERRNZ  3-Z=SYM
          SA2    X3+B2       X2 = *WC*
 TO10     XTRCT  WC.LINE,X2,X1     ISOLATE LINE NUMBER
          LX4    30 
          SB5    X4 
          CALL   CDD
          BX1    X6 
          SX0    3
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 TYP      SPACE  4,10 
**        TYP -  OUTPUT THE TYPE OF A SYMBOL. 
* 
*         THIS ROUTINE WILL OUTPUT THE TYPE OF A PROCEDURE,PAR, 
*         OR A VARIABLE, DEPENDING ON WHICH MAP IS BEING PROCESSED. 
* 
*         ENTRY  (X4) = 30/WIDTH OF FIELD,30/TYP. 
*                (X7) = ENTRY OF T.SCR. 
*                (X5) = CURRENT MST OFFSET. 
* 
*         USES   X - ALL  A - 1,2,3,4,6  B - ALL. 
* 
*         CALLS  JIF,CDD. 
  
 TYP      DIS    MAPPML,TYPE----------------
  
          LX4    30 
          SB5    X4 
          SA2    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B6    X7+WB.W     OFFSET TO WORD B 
          SA1    B6+X2       FETCH WORD B 
          BX2    X1 
          XTRCT  WB.MODE,X2,X2     ISOLATE MODE BITS
          SX7    X5-TPROP 
          NZ     X7,TYP110   IF NOT PROCEDURE MAP 
          SBIT   X1,WB.FUNP 
          MI     X1,TYP105   IF FUNCTION
          SA1    MAP.XS 
          SB6    B5 
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 TYP105   SBIT   X1,WB.GENFP/WB.FUNP
          PL     X1,TYP110   IF NOT GENERIC FUNCTION
          SA1    =7HGENERIC 
          MX0    0
          SB6    7
          RJ     JIF
          EQ     MOC.RB      RETURN 
  
 TYP110   =X3    X2-M.CHAR
          NZ     X3,TYP130   IF NOT TYPE CHARACTER
          =A4    A1-WB.W+WC.W   FETCH WORD C
          BX3    X4 
          SBIT   X3,WC.CTYPP
          MI     X3,TYP120   IF PASSED LENGTH CHARACTER 
          MX0    -WC.CLENL
          BX1    X4 
          LX1    -WC.CLENP
          BX1    -X0*X1      ISOLATE CHARACTER LENGTH 
          CALL   CDD         CONVERT TO DPC 
          SA1    =5LCHAR* 
          LX4    -5*CHAR
          MX0    -5*CHAR
          BX4    -X0*X4       ERASE UPPER BLANKS
          BX1    X1+X4       CONCATENATE THE LENGTH 
          EQ     TYP150 
  
 TYP120   SA1    =8HCHAR*(*)
          EQ     TYP150 
  
 TYP130   SA1    X2+TYPM     FETCH PROPER TYPE MESSAGE
  
 TYP150   MX0    0
          =B6    -1 
          RJ     JIF
          EQ     MOC.RB      RETURN TO CONTROLLER 
 TYP      SPACE  4,10 
 TYPM     BSS    0
          LOC    0
          DATA   7HBOOLEAN
          DATA   7HLOGICAL
          DATA   7HINTEGER
          DATA   4HREAL 
          DATA   6HDOUBLE 
          DATA   7HCOMPLEX
          LOC    *O 
 VAL      SPACE  4,10 
**        VAL -  OUTPUT THE VALUE OF A SYMBOLIC CONSTANT. 
* 
*         ENTRY  (X4) = 30/FIELD WIDTH,30/VAL.
*                (X7) = T.SCR ENTRY.
* 
*         USES   ALL EXCEPT A7. 
* 
*         CALLS  PCB,WOD,CDD,JIF. 
  
 VAL      DIS    MAPPML,------------------VALUE 
  
          LX4    30 
          SX5    X4 
          SA1    T.SYM
          XTRCT  MT.WAI,X7,X7     ISOLATE T.SYM OFFSET
          =B2    X7+WB.W     OFFSET TO WORD B 
          SA1    X1+B2       FETCH WORD B 
          =A2    A1-WB.W+WC.W      FETCH WORD C 
          BX3    X2 
          XTRCT  WC.RA,X2,X2 ISOLATE OFFSET INTO T.CHAR OR T.CON
          SB4    X2          KEEP EXTRA COPY
          XTRCT  WB.MODE,X1,X1     ISOLATE MODE BITS
          SX7    X1-M.CHAR
          NZ     X7,VAL20    IF NOT TYPE CHARACTER
          XTRCT  WC.CLEN,X3,X3     ISOLATE CHARACTER LENGTH 
          SB7    X3+2        ADD SPACE USED BY THE QUOTES 
          SB2    X5 
          SX7    B2-B7
          SA1    T.CON
          SB5    X1 
          PL     X7,VAL10    IF IT FITS 
          =B6    1
          SA1    =1H' 
          RJ     PCB
          SB6    X5-4 
          SA1    B5+B4
          RJ     PCB
          SB6    3
          SA1    =3H... 
          RJ     PCB
          EQ     MOC.RB 
  
 VAL10    SB6    X7 
          SA1    MAP.XS 
          RJ     PCB
          =B6    1
          SA1    =1H' 
          RJ     PCB
          SB6    B7-2 
          SA1    B5+B4
          RJ     PCB
          SA1    =1H' 
          =B6    1
          RJ     PCB
          EQ     MOC.RB 
  
 VAL20    SX7    X1-M.LOG 
          NZ     X7,VAL40    IF NOT TYPE LOGICAL
          SA1    T.CON
          SA1    X1+B4       FETCH LOGICAL CONSTANT 
          PL     X1,VAL30    IF VALUE FALSE 
          SA1    =6H.TRUE.
          =X0    1
          SB6    6
          SB5    X5 
          RJ     JIF
          EQ     MOC.RB 
  
 VAL30    SA1    =7H.FALSE. 
          =X0    1
          SB6    7
          SB5    X5 
          RJ     JIF
          EQ     MOC.RB 
  
 VAL40    SX7    X1-M.INT 
          NZ     X7,VAL60    IF NOT INTEGER 
          SA1    T.CON
          SA1    X1+B4       FETCH INTEGER CONSTANT 
          BX3    X1          PRESERVE ORIGINAL NUMBER 
          =B7    0
          PL     X1,VAL45    IF NO NEED TO COMPLEMENT IT
          =B7    1
          BX1    -X1
  
 VAL45    SA2    =9999999999
          IX2    X2-X1
          SB5    X5          SAVE THE FIELD WIDTH 
          PL     X2,VAL50    IF .LT. 9999999999 
          BX1    X3          X1 = ORIGINAL NUMBER 
          CALL   WOD
          SA6    VALA 
          =A7    A6+1 
          =B6    2
          SA1    =2HO"
          RJ     PCB
          =B6    B5-3 
          SA1    VALA 
          RJ     PCB
          =B6    1
          SA1    =1H" 
          RJ     PCB
          EQ     MOC.RB 
  
 VAL50    CALL   CDD
          BX1    X6 
          =B4    1
          RJ     CCBB        DETERMINE THE LENGTH 
          SX5    B6 
          BC     X2,X5       CONVERT TO BIT COUNT 
          SB4    X2-10*CHAR 
          AX5    B4,X1       LEFT JUSTIFY CONVERSION
          SB4    B6          PRESERVE ITS LENGTH
          SB6    B6+B7       ADD LENGTH OF -
          SB6    B5-B6       = NUMBER OF BLANKS TO OUTPUT 
          IFEQ   TEST,ON,1
          MI     B6,"BLOWUP" IF BAD B5
          SA1    MAP.XS 
          RJ     PCB
          ZR     B7,VAL55    IF NO NEED TO PRINT
          =B6    1
          SA1    =1H- 
          RJ     PCB
  
 VAL55    SB6    B4          RESTORE INTEGER LENGTH 
          BX1    X5 
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
  
 VAL60    SA1    T.CON
          SA1    X1+B4       FETCH THE CONSTANT 
          SB4    X5          SAVE THE FIELD WIDTH 
          CALL   WOD
          SA6    VALA 
          =A7    A6+1 
          =B6    2
          SA1    =2HO"
          RJ     PCB
          =B6    B4-3 
          SA1    VALA 
          RJ     PCB
          =B6    1
          SA1    =1H" 
          RJ     PCB
          EQ     MOC.RB 
  
  
 VALA     BSS    2           STORAGE FOR 20 OCTAL DIGITS
 XA       SPACE  4,10 
**        XA -   OUTPUT VARIABLE NUMBER OF BLANKS.
* 
*         IN *HEADER* MODE THE DATA IN THE FIRST FEW WORDS
*         IS USED TO ACCOMPLISH SPACING BETWEEN FIELD HEADERS.
*         IN *PROCESSING* MODE IT WILL OUTPUT A GIVEN NUMBER
*         OF BLANKS TO TAKE CARE OF SPACING BETWEEN FIELD OUTPUTS.
* 
*         ENTRY  (X4) = 30/# OF BLANKS,30/XA. 
* 
*         USES   X - 0,1,2,3,4,6,7  A - 1,2,3,6,7  B - 2,3,6. 
* 
*         CALLS  PCB. 
  
 XA       DIS    MAPPML,------------------------------
  
          SA1    MAP.XS 
          LX4    30 
          SB6    X4 
          RJ     PCB
          EQ     MOC.RB      RETURN TO CONTROLLER 
 XB       SPACE  4,10 
**        XB -   OUTPUT VARIABLE NUMBER OF BLANKS.
* 
*         FUNCTIONS IDENTICALLY TO XA EXCEPT THAT IN *HEADER* 
*         MODE THE DATA IS USED TO SPACE BETWEEN THE 1ST COLUMN 
*         OF A PAGE AND THE 1ST FIELD HEADER. 
* 
*         ENTRY  (X4) = 30/# OF BLANKS,30/XB. 
* 
*         USES   X - 0,1,2,3,4,6,7  A - 1,2,3,6,7  B - 2,3,6. 
* 
*         CALLS  PCB. 
  
 XB       DIS    MAPPML,  - 
  
          SA1    MAP.XS 
          LX4    30 
          SB6    X4 
          RJ     PCB
          EQ     MOC.RB 
 XC       SPACE  4,10 
**        XC -   OUTPUT VARIABLE NUMBER OF BLANKS.
* 
*         FUNCTIONS IDENTICALLY TO XA EXCEPT THAT IN *HEADER* 
*         MODE THE DATA IS USED TO ACCOMPLISH SPACING BETWEEN 
*         REPEATED HEADERS. (I.E. CASES WHERE A MAP IS WRITTEN
*         ACROSS THE PAGE IN MORE THAN ONE BLOCK) 
* 
*         ENTRY  (X4) = 30/# BLANKS,30/XC.
* 
*         USES   X - 0,1,2,3,4,6,7  A - 1,2,3,6,7  B - 2,3,6. 
* 
*         CALLS  PCB. 
  
 XC       DIS    MAPPML,
  
          SA1    MAP.XS 
          LX4    30 
          SB6    X4 
          RJ     PCB
          EQ     MOC.RB 
          SPACE  4,10 
          LIST   D
          ENTRY  FIN.MAP
 FIN.MAP  END                END OF (1,0) OVERLAY WHEN NO OLIST 
