*DECK     FTNTEXT 
          IDENT  FTNTEXT
          STEXT 
 FTNTEXT  TITLE  F T N T E X T  -  FORTRAN EXTENDED ASSEMBLY TEXT 
          LIST   F,X
 FTNTEXT  SPACE  4,8
***       FTNTEXT - FORTRAN EXTENDED ASSEMBLY/INSTALLATION TEXT.
* 
*                *FTNTEXT* IS THE GLOBAL TEXT FOR ASSEMBLY/INSTALLATION 
*         OF THE FORTRAN EXTENDED COMPILER.  IT CONTAINS DEFINITIONS
*         OF MACROS, MICROS, SYMBOLS AND OPDEFS, ORGANIZED AS FOLLOWS...
* 
*         COMPILER INSTALLATION OPTIONS.
*         GENERAL MACROS ( USED BY ALL PARTS OF THE COMPILER ). 
*         I/O MACROS. 
*         SYMBOL TABLE / REFMAP MACROS ( PASS 1 ).
*         MACROS FOR DEBUGGING. 
*         PASS 1 TABLE MANAGER MACROS.
*         SYMBOL TABLE BIT AND FIELD DEFINTIONS.
*         MISCELLANEOUS PASS 1 MACROS.
*         PASS 2 FIELD DEFINITIONS AND TABLE FORMATS. 
 PLI      SPACE  3
**        DEFINE SYMBOL TO CONTROL CONDITIONAL ASSEMBLY OF CODE FOR 
*         *PL/I* IN PASS 2.  *DEFINE PLI  TO ACTIVATE ASSEMBLY .
  
*IF DEF,PLI,1 
 .PLI     EQU    1           ASSEMBLE CODE FOR PL/I 
*IF -DEF,PLI,1
 .PLI     EQU    0           DO NOT ASSEMBLE CODE FOR PL/I
*CALL OPTIONS 
*         SELECT SYSTEM - OR TEST-MODE COMPILER CONFIGURATION.
  
*IF -DEF,TEST,1 
 TEST     =      0           ASSEMBLE COMPILER IN NORMAL (SYSTEM) MODE
*IF DEF,TEST,1
 TEST     =      1           ASSEMBLE COMPILER IN TEST MODE 
  
* 
 STACK    SPACE  3
          TITLE  INTEGER ARITHMETIC MACROS AND OPDEFS 
 CW       SPACE  4,8
**        CW - CONVERT CHARACTER COUNT TO WORD COUNT. 
* 
*         COMPUTES--  WORD COUNT = (CHAR COUNT + 9) / 10
*         VALIDITY- *RESULT* IS GOOD FOR 0.LE.*OPERAND*.LE.262133D
*         RESULT IS WRONG OUTSIDE OF THIS RANGE.
* 
*         CW        X.RESULT,X.OPERAND
* 
*         ENTRY  *X.RESULT*  = X-REG TO RECEIVE INTEGER WORD COUNT
*                *X.OPERAND* = X-REG CONTAINING INTEGER CHARACTER COUNT 
* 
*         USES   X.OPERAND, X.RESULT
  
          PURGDEF   CW,X,X
  
 CW,X,X   OPDEF  R,P
  MX.R -18D 
  SX.P X.P+9D 
  BX.R -X.R*X.P 
*                            52429 = (2**19) / 10 + 1 
  SX.P 52429D 
  IX.R X.R*X.P
  AX.R 19D
  ENDM
 IXI      SPACE  4,8
          PURGDEF  IXX*X
 IXX*X    CPSYN  DXX*X
 LXQ      SPACE  4,8
**        LXQ - REDEFINE THE LEFT SHIFT INSTRUCTION.
* 
*         THIS OPDEF REDEFINES THE LEFT SHIFT INSTRUCTION TO SUPPRESS 
*         CODE GENERATION WHEN THE SHIFT COUNT IS 0, +60D OR -60D.
*         THE INSTRUCTION IS OTHERWISE UNCHANGED. 
* 
*         LXI       JK
* 
*         ENTRY  *XI* = X-REG TO BE SHIFTED 
*                *JK* = SHIFT COUNT EXPRESSION
* 
*         USES   XI 
  
 ^XQ      CPSYN     LXQ 
          PURGDEF   LXQ 
  
 LXQ      OPDEF     I,JK
  IFNE JK,0,2 
  IFNE JK_&60D,0,1
  ^X.I JK 
  ENDM
*CALL TEXTCOM 
 WC       SPACE  4,8
**        WC - CONVERT WORD COUNT TO CHARACTER COUNT. 
* 
*         COMPUTES-- CHAR COUNT = WORD COUNT * 10 
* 
* 
*         WC        X.RESULT,X.OPERAND
* 
*         ENTRY  *X.RESULT*  = X-REG TO RECEIVE INTEGER CHARACTER COUNT 
*                *X.OPERAND* = X-REG CONTAINING INTEGER WORD COUNT
* 
*         USES   X.OPERAND, X.RESULT
  
  
          PURGDEF   WC,X,X
  
 WC,X,X   OPDEF  R,O
  IX.R X.O+X.O
  LX.O 3
  IX.R X.O+X.R
  ENDM
 LXQ      SPACE  3
          TITLE  GENERAL MACROS 
 BIT      SPACE  4,8
**        BIT - SET SYMBOL TO 2**N. 
* 
* 
*  SYM    BIT       PWR 
* 
*         ENTRY  [SYM] = SYMBOL TO BE SET 
*                [PWR] = DESIRED POWER OF 2 
* 
*         EXIT   [SYM] = 2**[PWR] 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC   BIT 
  
          MACRO  BIT,SYM,PWR
 P        DECMIC PWR
 SYM      SET    1S"P"
 BIT      ENDM
 CALL     SPACE  4,8
**        CALL - CALL A ROUTINE.
* 
*         GENERATES--    RJ  =X*ROUTINE*. 
* 
* 
*         CALL      ROUTINE 
* 
*         ENTRY  *ROUTINE* = NAME OF CALLED ROUTINE 
* 
*         USES   NONE 
  
  
          PURGMAC   CALL
  
 CALL     MACRO  R
  RJ =X_R 
  ENDM
 ENTRY.   SPACE  4,8
**        ENTRY. - DEFINE ENTRY POINT AND ITS CONTENTS. 
* 
*         REGISTER SNAPS MAY BE OBTAINED AT ENTRY POINTS DEFINED WITH 
*         THIS MACRO BY USING THE -REGSNAP- DEBUGGING MACRO.
* 
* 
* NAME    ENTRY.    VALUE 
* 
*                *NAME*  = ENTRY POINT NAME 
* 
*                *VALUE* = * OR ** OR ANY OTHER LEGAL COMPASS EXPRESSION
* 
*                          *     (FOR LOCAL SUBROUTINES)    EXPANDS TO--
*                                 NAME  EQ     *+1S17 
* 
*                          **    (FOR GLOBAL SUBROUTINES)   EXPANDS TO--
*                                       ENTRY  NAME 
*                                 NAME  EQ     *+1S17 
* 
*                          ELSE  (FOR GLOBAL STORAGE LOCN)  EXPANDS TO--
*                                       ENTRY  NAME 
*                                 NAME  CON    VALUE
* 
*         CALLS  NONE 
* 
*         USES   NONE 
  
  
          PURGMAC   ENTRY.
  
          MACRO  ENTRY.,NAME,VALUE
  IFC NE,$VALUE$*$,2
  ENTRY NAME
  IFC EQ,$VALUE$**$,2 
NAME EQ *+1S17
  SKIP 1
NAME CON VALUE
*                            REGISTER SNAP FACILITY.
  IF DEF,)NAME,1
 NAME REGS
ENTRY. ENDM 
          SPACE  3
**        EQENT - EQUATE SYMBOL, DECLARE ENTRY POINT. 
* 
*SYM      EQENT  LAB
* 
*         ENTRY - "SYM" = SYMBOL TO BE MADE AN ENTRY POINT
*                "LAB" = VALUE OF ENTRY POINT 
* 
*         GENERATES - 
*         ENTRY  SYM
*SYM      EQU    LAB
* 
*         CALLS  NONE 
  
          PURGMAC EQENT 
  
          MACRO  EQENT,SYM,LAB
          ENTRY  SYM
 SYM      EQU    LAB
 EQENT    ENDM
 LOVER    SPACE  4,8
**        LOVER - LOAD FTN OVERLAY. 
* 
*         FORMS 3-WORD LOADER CALL AND EXITS TO LOAD REQUEST ROUTINE. 
* 
* 
*         LOVER     OVL*P**S* 
* 
*         ENTRY  *P* = OVERLAY PRIMARY LEVEL NUMBER 
*                *S* = OVERLAY SECONDARY LEVEL NUMBER 
* 
*         EXIT   TO *LOVER*.
*                (X4) = LIBRARY NAME, 0L FORMAT 
*                (X6) = OVERLAY NAME, 0L FORMAT 
*                (X7) = 12/OVERLAY LEVEL (0P0S),
*                        9/LOADER REQUEST FLAGS,
*                        3/0, 
*                       18/LWA SPACE AVAILABLE TO LOADER, 
*                       18/FWA LOAD 
* 
*         CALLS  NONE 
* 
*         USES   X - ALL BUT 0
*                A - 1, 3, 4, 5 
*                B - NONE 
  
  
          PURGMAC   LOVER 
  
 LOVER    MACRO  NAME 
          LOCAL  P,S
 P        MICRO  4,1,/NAME/ 
 S        MICRO  5,1,/NAME/ 
*                            FWA, LWA+1 OF LOAD.
          IFEQ   "S",0,3
*                            PRIMARY OVERLAY
          SA5    CP.NFLS
          SX7    CP.ORG 
          SKIP   2
*                                  SECONDARY OVERLAYS.
          SA5    =XLWAWORK
          SX7    =XLWA2.0+1 
*                            OVERLAY NAME.
          SA1    =X_NAME
*                            LIBRARY OR FILE NAME.
          IFEQ   LDRCALL,2,1
          IFNE   TEST,0,1 
          SA4    =XOVLA 
*                            OVERLAY LEVEL, LOADER REQUEST FLAGS. 
          IFEQ   LDRCALL,2,2
          SX2    0"P"0"S"014B-10B*TEST/TEST 
          SKIP   1
          SX2    0"P"0"S"000B 
*                            COMBINE LEVEL, FLAGS, FWA, LWA+1.
          BX6    X1 
          LX2    39D
* 
          IFEQ   LDRCALL,3,2
          SA3    =XOVLB      (X3) = LOADER REQUEST FLAGS
          BX2    X2+X3
* 
          BX7    X2+X7
          LX5    18D
          BX7    X7+X5
          EQ     =XLOVER
 LOVER    ENDM
 MOVE     SPACE  4,8
**        MOVE - MOVE DATA BLOCK. 
* 
* 
*         MOVE      COUNT,FROM,TO 
* 
*         ENTRY  *COUNT* = WORD COUNT OF BLOCK TO BE MOVED
*                *FROM*  = ADDRESS OF FIRST WORD OF BLOCK 
*                *TO*    = ADDRESS OF FIRST WORD OF DESTINATION 
* 
*         USES   X - 1, 2, 3
*                A - NONE 
*                B - 1
* 
*         CALLS  MVE= (COMCMVE) 
  
  
          PURGMAC   MOVE
 MOVE     MACRO  C,F,T
          R=     X1,C 
          R=     X2,F 
          R=     X3,T 
          IF     -DEF,B1=1,1
          SB1    1
          RJ     =XMVE= 
 MOVE     ENDM
 PLUG     SPACE  4,40 
**        PLUG - MODIFY COMPILER CODE DURING EXECUTION. 
* 
*         SELF-MODIFYING (PLUGGING) CODE MAY SEEMINGLY FAIL ON CYBER
*         74 / 6600 AND LARGER MODELS, DUE TO THE HARDWARE INSTRUCTION
*         STACK AND 1- OR 2-WORD INSTRUCTION LOOKAHEAD.  BECAUSE OF THIS
*         PROBLEM, AND THE UNREADABILITY OF PLUGGED CODE, THE TECHNIQUE 
*         IS NOT DESIRABLE FOR WIDE USAGE.  EFFICIENCY CONSIDERATIONS 
*         ARE OCCASIONALLY MORE IMPORTANT, HOWEVER, SO WE FORMALIZE 
*         PLUGGING WITH THE FOLLOWING MACRO.  IT INCLUDES A SAFEGUARD 
*         AGAINST THE STACK/LOOKAHEAD PROBLEM, AND IS PREFERABLE TO 
*         DIRECT CODE FOR READABILITY AND DEBUGGING EASE. 
* 
*         TWO FORMS OF *PLUG* ARE AVAILABLE ... 
* 
* 
*         FORM 1 - PLUGS A CALLER-PROVIDED WORD OF CODE.
* 
*         PLUG      AT=,FROM=,FREG=,SREG=,VOID= 
* 
* 
*         FORM 2 - FABRICATES AND PLUGS AN -EQ- JUMP. 
*         RESTRICTION - THE 1-REGISTER METHOD USED FOR FORMING THE -EQ- 
*         JUMP IS NOT VALID IF *TO* IS .GT. 177777B ABSOLUTE.  THIS IS
*         NOT A PROBLEM IN FTN, SINCE ALL ADDRESSES ARE .LT. 100000B. 
* 
*         PLUG      AT=,TO=,SREG=,VOID= 
* 
* 
*         ENTRY  *AT*   = ADDRESS WHERE PLUG TO BE STORED.
*                *FREG* = (FORM 1 ONLY) (OPTIONAL)  NUMBER OF A,X REG 
*                         TO USE FOR FETCHING CODE WORD.  MUST BE 1-5.
*                         USES A1 AND X1 IF OMITTED.  IGNORED IF *FROM* 
*                         SPECIFIES AN X-REGISTER.
*                *FROM* = (FORM 1 ONLY)  SOURCE OF CODE WORD TO PLUG. 
*                         MAY BE AN X-REGISTER CONTAINING THE CODE WORD 
*                         ( E.G., FROM=X3 ), OR AN ADDRESS EXPRESSION.
*                *SREG* = (OPTIONAL)  NUMBER OF A,X REG TO USE FOR
*                         STORING PLUG.  MUST BE 6 OR 7.  USES X6 AND A6
*                         IF OMITTED. 
*                *TO*   = (FORM 2 ONLY)  -EQ- JUMP ADDRESS. 
*                *VOID* = (OPTIONAL)
*                         *NO* = DO NOT GENERATE STACK-VOIDING CODE.
*                         ELSE OR OMITTED = GENERATE STACK-VOIDING CODE.
* 
*         CALLS  NONE 
* 
*         USES   AS ABOVE 
  
  
          PURGMAC   PLUG
  
 PLUG     MACROE AT,TO,FROM,FREG,SREG,VOID
          LOCAL  FN,SN
 SN       SET    SREG  6
          IFLT   SN,6,1 
          ERR    *PLUG* STORE REG MUST BE 6 OR 7 AT ["SEQUENCE"]. 
 .F1      IFC    EQ, TO 
 .F1A     IF     REG,FROM 
*                            FORM 1A - CODE WORD IN AN X-REGISTER.
 SN       OCTMIC SN,1 
 SN       MICRO  1,, X"SN"
          IFC    NE, FROM "SN" ,1 
          BX.SN  FROM 
 .F1A     ELSE
*                            FORM 1B - FETCH CODE WORD FROM *FROM*. 
 FN       SET    FREG  1
          IFGE   FN,1,2 
          IFLE   FN,5,1 
          SKIP   1
          ERR    FETCH REG NOT 1-5 "SEQUENCE" 
          SA.FN  FROM 
          BX.SN  X.FN 
 .F1A     ENDIF 
 .F1      ELSE
*                            FORM 2 - FABRICATE -EQ- JUMP TO *TO*.
          SX.SN  TO 
          LX.SN  2+30D
*                            2000BS48+*JPADR*S32
          PX.SN  X.SN,B0
*                            0400BS48+*JPADR*S30
          LX.SN  -2 
 .F1      ENDIF 
*                            STORE THE PLUG.
          SA.SN  AT 
*                            GENERATE STACK-VOIDING CODE. 
          IFC    NE, VOID NO ,3 
          RJ     *+1
          EQ     *+1S17 
          BSS    0
 PLUG     ENDM
 ROUTINE  SPACE  4,8
**        ROUTINE - DEFINE LOCAL SUBROUTINE ENTRY POINT.
* 
* 
* NAME    ROUTINE 
* 
*         ENTRY  *NAME* = NAME OF SUBROUTINE. 
  
  
          PURGMAC   ROUTINE 
  
          MACRO  ROUTINE,NAME 
 NAME     JP     *+1S17 
          NOREF  )NAME
          IF     DEF,)NAME,1
          PRINT  NAME,(* ENTERED*)
 ROUTINE  ENDM
 RPVDEF   SPACE  4,8
**        RPVDEF - DEFINE FWA OF ROUTINE FOR REPRIEVE UTILITY.
* 
*         DEFINES THE FIRST WORD ADDRESS OF A ROUTINE AND DECLARES
*         IT AS AN ENTRY POINT, FOR FORMING THE NAME/ADDRESS TABLES 
*         USED BY THE UTILITY ROUTINE *RPV* (LOCATED IN *LSTPRO*).
*         FOR PROPER OPERATION, THIS MACRO MUST BE CALLED AT THE
*         BEGINNING OF EACH ROUTINE, BEFORE ANY OTHER INSTRUCTION OR
*         PSEUDO-OP THAT WOULD CAUSE *COMPASS-S* LOCATION COUNTER TO BE 
*         ADVANCED. 
* 
* 
*  *TAG*  RPVDEF
* 
*         ENTRY  *TAG* = SYMBOLIC NAME OF ROUTINE FWA.
  
  
          PURGMAC   RPVDEF
  
          MACRO  RPVDEF,T 
          NOREF  T
          ENTRY  T
 T        BSS    0
 RPVDEF   ENDM
          SPACE  4,8
**        FWA - DEFINE ENTRY FOR *RPV* FWA TABLE. 
* 
*         FWA    NAM,EPN
* 
*         ENTRY  *NAM* = NAME OF SUBROUTINE 
*                *EPN* = FWA NAME 
  
          PURGMAC FWA 
  
 FWA      MACRO  NAM,EPN
          VFD    42/0L_NAM
          VFD    18/=XB=_EPN
          NOREF  B=_EPN 
          ENDM
 SETCORE  SPACE  4,8
**        SETCORE - SET BLOCK OF MEMORY TO A GIVEN VALUE. 
* 
* 
*         SETCORE   FWA,LEN 
* 
*         ENTRY  *FWA* = BLOCK ADDRESS
*                *LEN* = BLOCK LENGTH 
*                (X6)  = VALUE TO SET 
* 
*         USES   X1, A6 
* 
*         CALLS  SETCORE
  
  
          PURGMAC   SETCORE 
  
 SETCORE  MACRO  F,L
          R=     X1,L 
          SA6    F
          RJ     =XSETCORE
 SETCORE  ENDM
 SETZERO  SPACE  4,8
**        SETZERO - SET BLOCK OF MEMORY TO ZERO.
* 
* 
*         SETZERO   FWA,LEN 
* 
*         ENTRY  *FWA* = BLOCK ADDRESS
*                *LEN* = BLOCK LENGTH 
* 
*         USES   X1, X6, A6 
* 
  
  
          PURGMAC   SETZERO 
  
 SETZERO  MACRO  F,L
          BX6    X6-X6
          SA6    F
 .1       IF     DEF,L
 .1       IF     ABS,L
 .1       IF     -REG,L 
 .1       IFLT   L,60 
 .2       IFNE   L,1
          MX1    L-1
          IF     -DEF,B1=1,1
          SB1    1
+         LX1    1
          SA6    A6+B1
          MI     X1,* 
 .1       ELSE
          R=     X1,L 
          RJ     =XSETCORE
 .2       ENDIF 
 .1       ENDIF 
 SETZERO  ENDM
 XR=      SPACE  4,8
**        XR= - X-REGISTER VERSION OF R= PSEUDO INSTRUCTION.
* 
*         IF *EXPR* = *LDREG*, GENERATES NOTHING. 
*         IF *EXPR* = OTHER X-REG, GENERATES BOOLEAN XMIT TO *LDREG*. 
*         IF *EXPR* = ELSE, GENERATES INCREMENT INSTR TO LOAD *LDREG*.
* 
* 
*         XR=       LDREG,EXPR
* 
*         ENTRY  *LDREG* = X-REGISTER TO BE LOADED.  MUST BE X1 THRU X5.
*                *EXPR*  = ADDRESS EXPRESSION FOR VALUE TO BE LOADED. 
* 
*         USES   *LDREG* AND ITS A-REGISTER.
* 
*         CALLS  NONE 
  
  
          PURGMAC   XR= 
  
 XR=      MACRO  R,E
  LOCAL A 
A MICRO 1,, E 
A MICCNT A
  IFEQ A,2,5
A MICRO 1,1, E
  IFC EQ, "A" X ,3
  IFC NE, R E ,1
  B_R E 
  SKIP 6
A MICRO 2,1, R
  IFC GE, "A" 1 ,3
  IFC LT, "A" 6 ,2
  SA"A" E 
  SKIP 1
  ERR (R) NOT X1-X5 "SEQUENCE"
 XR=      ENDM
 CODING   TITLE  I/O MACRO CODING CONVENTIONS 
*CALL     FA=DEFS 
          TITLE  I/O DATA TRANSFER MACROS 
*CALL COMAREG 
 LISTL    SPACE  4,8
**        LISTL - LIST ONE LINE.
* 
*         WRITE ONE CODED LINE FROM *BUF* TO THE OUTPUT FILE.  IF PAGE
*         IS FULL, EJECT AND WRITE TITLE LINE(S) FIRST. 
* 
* 
*         LISTL     BUF,WORDS 
* 
*         ENTRY  *BUF*   = FIRST WORD ADDRESS OF LINE BUFFER
*                *WORDS* = LINE LENGTH (WORDS)
* 
*         USES   B6, B7 
* 
*         CALLS  FA=LOL 
  
  
          PURGMAC   LISTL 
  
 LISTL    MACRO  S,N
          R=     B6,S 
* 
          IFC    EQ, N  ,1
          ERR    NO LENGTH "SEQUENCE" 
* 
          IFGE   CP#RM,6,1
          R=     B7,N 
* 
          RJ     =XFA=LOL 
 LISTL    ENDM
 NUPAGE   SPACE  4,8
**        NUPAGE - EJECT AND TITLE NEW PAGE.
* 
*         EJECTS PAGE.  WRITES TITLE AND SUBTITLE LINES ON NEW PAGE.
*         RESETS LINES-PER-PAGE COUNTER.
* 
* 
*         NUPAGE    (NO CALLING PARAMETERS) 
* 
*         ENTRY  NO REQUIREMENTS. 
* 
*         EXIT   PAGE EJECTED, NEW PAGE TITLED. 
*                *N.LINES* RESET TO FULL PAGE LINE COUNT. 
* 
*         USES   NONE 
* 
*         CALLS  FA=NPG 
  
  
          PURGMAC   NUPAGE
  
 NUPAGE   MACRO 
          RJ     =XFA=NPG 
 NUPAGE   ENDM
  
          TITLE  LABEL/NAME PROCESSING REQUEST MACROS 
 ADEXTS   SPACE  4,8
**        ADEXTS - GET ORDINAL OF EXTERNAL SYMBOL.
* 
*         ARG:   SAME AS "SYMBOL" 
* 
 ADEXTS   MACRO  NAME 
          SYMBOL NAME 
          MX0    1
          LX0    1+P.EXT
          BX7    X0+X2
          SA7    A2 
 ADEXTS   ENDM
 ADDREF   SPACE  4,8
**        ADDREF - ADD REFERENCE TO REF TABLE FOR VARIABLE ORDINAL. 
* 
*                ORD - ORDINAL OF THE VARIABLE ( RIGHT JUSTIFIED )
*                TYPE - REF, DEF OR FREF FOR REFERENCE, DEFINITION
*                OR FILE REFERENCE
* 
  
 REF=     MICRO  1,,/MX2    0/
 DEF=     MICRO  1,,/MX2    1/
 FREF=    MICRO  1,,/SX2    1/
  
 ADDREF   MACRO  ORD,TYPE 
          IF     -REG,ORD 
          SA1    ORD
          SB1    X1 
          ELSE
          IFC    NE,/ORD/B1/,1
          SB1    ORD
          ENDIF 
* 
 X        IFC    EQ,//TYPE/ 
          "REF="             ASSUME A REFERENCE 
 X        ELSE
          IFC    NE,/TYPE/REF/,2
          IFC    NE,/TYPE/DEF/,1
          IFC    EQ,/TYPE/FREF/,2 
          "TYPE=" 
 Y        IFEQ   0,1
 Z        IF     -REG,TYPE
          SA2    TYPE 
 Z        ELSE
          IFC    NE,/X2/TYPE/ 
          BX2    TYPE 
          ENDIF 
* 
          RJ     =XADDREF 
 ADDREF   ENDM
 CFO      SPACE  4,8
 WRM      SPACE  4,8
**        WRM - WRITE R-MACRO TO *RLIST* FILE.
* 
*         WRM       FWA 
* 
*                *FWA* = FWA OF R-MACRO  ( ONLY 1 MACRO, PLEASE ).
* 
*         CALLS  WRITEW 
* 
*         USES   B7 
  
 WRM      MACRO  F
          R=     B7,F 
          RJ     =XWRM
 WRM      ENDM
 CFO      SPACE  3
**        CFO - CHECK FIRST OCCURRENCE OF NAME IN STATEMENT.
* 
* 
*         CFO       CONTEXT 
* 
*         ENTRY  *CONTEXT* = CONTEXT THAT NAME APPEARED IN;  VALUES --
*                    *VAR* - VARIABLE OR ARRAY
*                    *EXT* - FUNCTION OR SUBROUTINE 
* 
*         USES   X0 
* 
*         CALLS  CFO
  
  
          PURGMAC   CFO 
  
 CFO      MACRO  C
          IFC    EQ, C EXT ,2 
          R=     X0,1 
          SKIP   2
          IFC    EQ, C VAR ,3 
          MX0    0
          RJ     =XCFO
          SKIP   1
          ERR    (C) BAD *CONTEXT* "SEQUENCE" 
 CFO      ENDM
 SYMBOL   SPACE  3,18 
**        SYMBOL - SEARCH SYMBOL TABLE FOR A SYMBOL.
* 
* 
*         SYMBOL    NAME,NOFIND 
* 
*         ENTRY  *NAME*   = ADDRESS OF CELL CONTAINING THE SYMBOL.
*                *NOFIND* = EXIT ADDRESS IF SYMBOL NOT FOUND; IF BLANK, 
*                           CONTINUES AT CURRENT CODE SEQUENCE. 
* 
*         EXIT   TO *NOFIND*   IF NOT FOUND (FIRST OCCURRENCE)
*                TO *NOFIND*+1 IF FOUND (NOT FIRST OCCURRENCE)
* 
*         USES   A1, X1, B7 
* 
*         CALLS  SYMBOL 
  
  
          PURGMAC   SYMBOL
  
 SYMBOL   MACRO  N,F
          IFC    NE, N  ,1
          SA1    N
          SB7    F  *+2-*P/60D
          EQ     =XSYMBOL 
 SYMBOL   ENDM
          TITLE              MACROS FOR DEBUGGING 
 REGSNAP  SPACE  4,8
**        REGSNAP - SNAP REGISTERS AT ENTRY POINTS. 
* 
*         ACTIVATES REGISTER SNAP AT EACH ENTRY POINT DEFINED WITH THE
*         -ENTRY.- MACRO AND NAMED ON THE -REGSNAP- CALL CARD.
*         THE SNAP COUNT IS LIMITED TO 100D PER ENTRY POINT BY THE
*         -REGS- DEBUG MACRO. 
* 
* 
*         REGSNAP   (NAME1,NAME2,...,NAMEN) 
* 
*         ENTRY  *NAMEK* = NAME OF ENTRY POINT TO BE SNAPPED
* 
*         EXIT   SNAP ACTIVATED 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC   REGSNAP 
  
 REGSNAP  MACRO  P
          IF     -DEF,DEBUG,1 
 DEBUG    SET    1
          IRP    P
 )P       =      1           DEFINE SYMBOL
          IRP 
 REGSNAP  ENDM
          SPACE  4
 BREAK    OPSYN  NIL
 ELIST    OPSYN  NIL
 REGS     OPSYN  NIL
 SNAP     OPSYN  NIL
 SNAPT    OPSYN  NIL
 TABDMP   OPSYN  NIL
  
  
 .T       IFNE   TEST,0 
*CALL     DBG=MAC 
**        DUMP OF E-LIST ( PASS 1 ).
  
          PURGMAC   ELIST 
  
 ELIST    MACRO  BCD
          RJ     =XSEL
          DATA   10H_BCD
 ELIST    ENDM
  
**        SNAPT - SNAP A TABLE WITH POINTERS O.TBL AND L.TBL. 
  
          PURGMAC   SNAPT 
  
 SNAPT    MACRO  TBL,BCD
 BCD      SNAP   *O.TBL,,*L.TBL 
 SNAPT    ENDM
  
 .T       ENDIF 
 PRINT    SPACE  4
**        PRINT - PRINT THE CONTENTS OF A LIST OF LOCATIONS.
* 
* 
*         PRINT  LAB,FMT,(LIST) 
* 
*         LAB - STATEMENT PRINTED IF *LAB* MENTIONED ON A *TRACER* LIST 
*                IF BLANK, THEN UNCONDITIONALLY PRINT.
*         FMT - PARENTHESIED FORTRAN FORMAT 
*         LIST - PARENTHESIZED LIST OF NAMES AND OR REGISTERS TO BE 
*                PRINTED. 
* 
*         SAMPLE CALL --
*         PRINT XXX,(* SIP,IIP =*,2I6),(SIP,IIP)   WILL PRODUCE - 
*         XXX SIP,IIP = NNNNNN NNNNNN 
* 
*         THIS MACRO IS FOR INTERNAL DEBUGGING ONLY ( TEST MODE ).
  
  
          PURGMAC   PRINT 
  
 PRINT    MACRO  LAB,FMT,LIST 
          LOCAL  APL,LFMT 
 .P       IFC    NE,/LAB//,2
 .P       IF     -DEF,)LAB,1
 .P       IF     DEF,/DEBUG/LAB 
          USE    DEBUG
 APL      CON    =XOUTPUT#
          CON    LFMT 
          IRP    LIST 
          IF     REG,LIST,4 
 L        MICRO  1,1,/LIST/ 
 N        MICRO  2,1,/LIST/ 
          VFD    12/2,30/1S6,18/=XSV="L"+"N"
          SKIP   1
          VFD    12/2,30/1S6,18/LIST
          IRP 
 LFMT     CON    0
          DIS    ,$(* LAB *,FMT)$ 
          USE    *
          RJ     =XSAVE=
          SA1    APL
          RJ     =XOUTCI. 
          RJ     =XRESET= 
 .P       ENDIF 
 PRINT    ENDM
 TRACER   SPACE  3,14 
**        TRACER - DEFINE ROUTINES/PHASES TO BE TRACED. 
* 
*         TRACER (RTN1,...,RTNI)
  
 TRACER   MACRO  P
          QUAL   DEBUG
          IRP    P
 P        EQU    1
          IRP 
          QUAL   *
          ENDM
 TRACE    SPACE  3
**        TRACE - CONDITIONALLY SNAP CONTENTS OF SPECIFIED TABLE. 
*         CALL -
*         TRACE  LAB,TBL,BLK
* 
*         LAB - SNAP LABEL THAT IS TO BE SPECIFIED ON *TRACER* LIST 
*                TO ACTIVATE THE PRINTOUT.
*         TBL -  IF NOT = RLIST, THEN NAME OF TABLE ( FWA,LEN = O.TBL,
*                L.TBL ) TO BE PRINTED IN OCTAL FORMAT. 
*                IF = RLIST , THEN CALL *DMPRLST* TO PRINT THE TABLE. 
*                TABLE PRINTED OUT IS *TXT* IF *BLK* IS NOT SPECIFIED,
*                ELSE *BLK*.
  
 TRACE    MACRO  RTN,TBL,BLK
 T        IF     DEF,/DEBUG/RTN 
          IRP    TBL
 TB       IFC    NE,/TBL/RLIST/,2 
 TBL-RTN  SNAP   *O.TBL,,*L.TBL,NR
 TB       ELSE   1
 BLK      SNAPRL RTN
          IRP 
 T        ENDIF 
          ENDM
 SNAPRL   SPACE  3,14 
**        SNAPRL - INTERPRETIVE DUMP OF AN *RLIST* SEQUENCE.
  
          PURGMAC  SNAPRL 
          MACRO  SNAPRL,BLK,L,LL,UL,INC 
          LOCAL  X,Y
          CALL   SAVE=
          SA1    X
          IFC    EQ,//BLK/,2
          SA2    =XO.TXT
          ELSE   1
          SA2    =XO.BLK
          BX6    X2 
          SA6    X+1
          CALL   DMPRLST
          CALL   RESET= 
          USE    DEBUG
 X        CON    Y
          IFC    EQ,//BLK/,2
          CON    0,=XL.TXT,0
          ELSE   1
          CON    0,=XL.BLK,0
 Y        SNAPCTRS (L BLK),LL,UL,INC
          USE    *
 SNAPRL   ENDM
  
 SNAPCTRS MACRO  L,LL,UL,INC
          CON    0,10H L
          CON    LL 1 
          CON    UL 200 
          CON    INC 1
 SNAPCTRS ENDM
 DCALL    SPACE  3,24 
**        DCALL - CALL TO DEBUGGING FORTRAN ROUTINE ( PASS 2 ). 
* 
*         DCALL ROUTINE,(PARAMLIST) 
* 
*         [X] IS THE CONTENTS OF X. 
*         CONSTANTS MUST BE WRITTEN AS =X  ( =3 ).
  
 DCALL    MACRO  RTN,P
          LOCAL  APL
          RJ     =XSAVE=
          USE    DEBUG
 APL      BSS    0
          NOREF  .N 
 .N       SET    0
* 
          IRP    P
 .1       MICRO  1,1,/P/
          IFC    EQ,/".1"/[/
 .1       MICRO  2,,]_P_] 
          USE    *
          SA2    =X".1" 
          SX6    X2+
          SA6    APL+.N 
          USE    DEBUG
          BSS    1
          ELSE   4
          IFC    EQ,/".1"/=/,2
          VFD    42/,18/P 
          SKIP   1
          VFD    42/,18/=X_P
 .N       SET    .N+1 
          IRP 
* 
          DATA   0
          USE    *
* 
          SA1    APL
          RJ     =X_RTN 
          RJ     =XRESET= 
 DCALL    ENDM
          TITLE              MACROS TO CALL THE TABLE MANAGER ROUTINES
**        PASS 1 TABLE MANAGER MACROS.
  
**        ADDWD - ADD A SINGLE WORD TO THE END OF A MANAGED TABLE.
* 
*         ARGUMENTS:  
*                TNAM - TABLE NAME
*                WORD - WORD TO BE ADDED
*                MAY BE A REGISTER EXPRESSION OR MEMORY LOCATION
* 
 ADDWD    MACRO  TNAM,WORD
          LOADX  1,WORD 
          IFC    NE,/TNAM//,2 
          IFC    NE,/TNAM/A0/,1 
          SA0    =XZ.TNAM 
          RJ     =XADDWD
 ADDWD    ENDM
 ALLOC    SPACE  4,8
**        ALLOC - CALL *ALLOC* TO ALLOCATE +-N EXTRA WORDS. 
* 
*         ARGUMENTS:  
*                TNAM - TABLE NAME
*                NWDS - TABLE INCREMENT OR DECREMENT
* 
 ALLOC    MACRO  TNAM,NWDS
          IF     -REG,NWDS,2
          IF     ABS,NWDS,1 
 P        ERR                ABSOLUTE VALUE NFG 
          LOADX  5,NWDS 
          IFC    NE,/TNAM//,2 
          IFC    NE,/TNAM/A0/,1 
          SA0    =XZ.TNAM 
          RJ     =XALLOC
 ALLOC    ENDM
 ALLAE    SPACE  4,8
**        ALLAE - ALLOCATE ALMOST ALL OF AVAILABLE CORE FOR TABLE N.
* 
*         ARGUMENTS:  
*                TNAM - TABLE NAME
* 
 ALLAE    MACRO  TNAM 
          SA0    =XZ.TNAM 
          RJ     =XALLAE
 ALLAE    ENDM
 TABLES   SPACE  4,5
 TABLES   MACRO  A,B,C,D,E,F,G,H,I,J
          EXT    O.A,L.A
          IFC    NE,/B//,1
          TABLES B,C,D,E,F,G,H,I,J
 TABLES   ENDM
 LOADX    SPACE  4,8
 LOADX    MACRO  N,WORD            LOAD XN WITH WORD
          LOCAL  L
O         IFC    NE,/WORD// 
* 
 R        IF     REG,WORD 
* 
 L        MICRO  1,1,/WORD/ 
 RR       IFC    NE,/"L"/X/ 
          SX.N   WORD 
 RR       ELSE
 L        MICRO  2,1,/WORD/ 
          IFC    NE,/"L"/N/,1 
          BX.N   WORD 
 RR       ENDIF 
* 
 R        ELSE
          SA.N   WORD 
 R        ENDIF 
* 
O         ENDIF 
 LOADX    ENDM
 DBGERR   SPACE  4,8
**        DBGERR - SEND A MESSAGE FROM *DEBUG* OPTION PROCESSOR TO THE
*                LIST FILE. 
* 
*         ARGUMENT: 
*                TEXT = TEXT OF THE MESSAGE 
* 
 DBGERR   MACRO  TEXT 
          SA5    =C/TEXT/ 
          RJ     =XDBGERR 
 DBGERR   ENDM
 CALLF    SPACE  4,8
**        CALLF - CALL A FORTRAN ROUTINE FROM A COMPASS ROUTINE.
* 
  
 CALLF    MACRO  NAME,RESET 
          SA1    =0                NO ARG LIST
          RJ     =XNAME 
          IFC    NE,//RESET/,1
          SB5    1                 RESET B5 FOR COMPASS ROUTINES
 CALLF    ENDM
          TITLE              SYSTEM SYMBOL DEFINITIONS
*** 
*         SYSTEM SYMBOL DEFINITIONS FOR THE *FTN* COMPILER. 
* 
*         THE FOLLOWING SET OF EQU-S DEFINES THE VALUES, BIT
*         POSITIONS AND LENGTHS OF VARIOUS FIELDS IN THE INTERNAL 
*         TABLES OF THE COMPILER. 
* 
*         THE FIRST TABLE OF INTEREST IS THE 2 WORD/ENTRY SYMBOL
*         TABLE. FOR EACH ENTRY THE WORDS ARE CALLED WORD A AND WORD B. 
* 
*         THE ADDRESS FUNCTION TO FETCH WORDS A AND B OF OF THE 
*         SYMBOL WITH ORDINAL *N* IS: 
* 
*         WORD A = CONT( CONT(SYM1)-2*N ) 
*         WORD B = CONT( CONT(SYM1)-2*N-1 ) 
* 
*         ONE SHOULD NOTE THE FOLLOWING FACTS:  
* 
*         ORDINAL 0 IS UNUSED.
*         ORDINAL 1 WILL ALWAYS BE THE SUBPROGRAM NAME. 
*         ORDINALS 2 - K+1 WILL BE THE FORMAL PARAMETERS ( OR FILE
*         NAMES ) ORDERED AS THEY APPEARED ON THE SUBPROGRAM CARD.
*         IF THE SUBPROGRAM IS A SUBROUTINE WITH *RETURNS* PARAMETERS,
*         THEN THEY WILL COME NEXT. 
*         AFTER THIS, CERTAIN SPECIAL SYMBOLS SUCH AS *VALUE.*, 
*         *TEMPA0.* AND *TRACE.*. 
* 
*         THE REST OF THE SYMBOLS IN THE TABLE WILL HAVE NO SPECIAL 
*         ORDER AND WILL BE PLACED IN THE TABLE AS THEY APPEAR. 
* 
          SPACE  3
*** 
*         THE FORMAT OF THE SYMBOLS IS X.NAME WHERE : 
*         X IS A 1 OR 2 CHARACTER PREFIX AND NAME IS THE NAME 
*         ASSOCIATED WITH THE SYMBOL. 
* 
*         THE PREFIXES USED ARE:  
* 
*         *P*  FOR THE POSITION OF THE BASE OF A BIT FIELD IN A WORD. 
*         *L*  FOR THE LENGTH OF THE BIT FIELD. 
*              *L.* SYMBOLS WILL BE DEFINED ONLY IF *L.NAM* .NE. 1. 
*         *T*  FOR VALUES IN THE TYPE FIELD.
*         *V*  FOR THE VALUES OF BITS WHERE *P.NAME* IS .LT. 17.
          TITLE              SYMBOL TABLE BIT DEFINITIONS 
**        SYMBOL TABLE BIT AND FIELD DESCRIPTIONS.
  
*         WORD A. 
  
 P.NAME   EQU    18                SYMBOL NAME
 L.NAME   EQU    42                7 CHARACTERS FOR THE NAME
  
 P.FP     EQU    17                FORMAL PARAMETER 
  
 P.DEF    EQU    16                DEFINITION BIT ( SYMBOL STORED INTO )
 V.DEF    EQU    1S16              VALUE OF THE BIT 
  
 P.FUN    EQU    15                NAME USED AS A FUNCTION
 V.FUN    EQU    1S15 
  
 P.COM    EQU    14                SYMBOL IS IN COMMON
 V.COM    EQU    1S14 
  
 P.DIM    EQU    13                SYMBOL IS A DIMENTIONED VARIABLE 
 V.DIM    EQU    1S13 
  
 P.EQU    EQU    12                NON BASE MEMBER OF AN EQUIVALENCE
 V.EQU    EQU    1S12              CLASS
  
 P.LC     EQU    15          LABEL CHANGE BIT ( TRANSFER LABELS ONLY )
 L.LCO    EQU    12          LAB CHANGE TABLE ORDINAL ( IN WORD B ) 
  
*         WORD B. 
  
 P.TYP    EQU    56                BASE OF THE TYPE FIELD 
 L.TYP    EQU    4                 LENGTH OF THE TYPE FIELD 
  
 T.LOG    EQU    0                 TYPE LOGICAL 
 T.INT    EQU    1                 TYPE INTEGER 
 T.REAL   EQU    2                 TYPE REAL
 T.DBL    EQU    3                 DOUBLE PRECISION 
 T.CPLX   EQU    4                 TYPE COMPLEX 
 T.OCT    EQU    5                 TYPE OCTAL ( IN E LIST CONSTANTS ONLY
 T.ILL    EQU    5                 TYPES \ TO THIS ARE ILLEGAL IN 
*                                  EXPRESSIONS
 T.HOL    EQU    6                 TYPE HOL ( IN ELIST CONSTANTS ONLY ) 
 T.ECS    EQU    5                 ECS VARIABLE OR ARRAY
 T.LAB    EQU    6                 STMT NUMBERS, FORMAT OR GENERATED LAB
 T.RTN    EQU    7                 RETURN S FORMAL PARAMETER
 T.NML    EQU    10B               NAMELIST GROUP NAME
 T.ENT    EQU    12B               ENTRY POINT NAME 
 T.LFN    EQU    13B               LOGICAL FILE NAME
 T.CGS    EQU    14B               COMPILER GENERATED SYMBOL
 T.DBG    EQU    17B               UNREFERENCED NAME PLACED IN THE
*                                  SYMBOL TABLE BY THE DEBUG PROCESSOR
  
 P.ASF    EQU    55                ARITHMETIC STMT FUNCTION 
 P.EXT    EQU    54                EXTERNAL REFERENCE 
 P.EST    EQU    53          IN EXTERNAL STATEMENT
  
 P.DIMP   EQU    41                ORDINAL TO DIMTAB (1,2,3,...)
 L.DIMP   EQU    12 
  
 P.SCA    EQU    11          DIMP = SCAP BIT IN WORD B. 
 V.SCA    EQU    1S11 
  
 P.SUB    EQU    10          SET BY PASS 2 IXFN PROCESSOR IF USED AS
 V.SUB    EQU    1S10        A SUBSCRIPT
  
 P.LDO    EQU    9           =1 IF VAR IS LD ONLY ( CON. , HOL. , ETC ) 
 V.LDO    EQU    1S9
  
 P.VAR    EQU    40                NAME USED AS A VARIABLE
  
 P.FMODE  EQU    P.DIMP            FILE MODE ( SET BY LISTIO )
 L.FMODE  EQU    5
  
 P.NFU    EQU    5B                NOT FIRST USE BIT, USED BY *FAX* 
  
 P.LOCF   EQU    4           =1 IF VAR IS ARG TO *LOCF* FUNCTION
  
 P.LCM    EQU    1           LCM RESIDENT BIT 
 P.FPB    EQU    0           FP BIT IN WORD B 
  
 P.LVL    EQU    2
 L.LVL    EQU    2
  
*         FIELDS USED FOR ADDRESS DEFINITION. 
  
 P.RL     EQU    37                RELOCATION TYPE
 L.RL     EQU    2                 ABS , PROGRAM , COMMON AND EXTERNAL
 P.RL     MICRO  1,,/37/
  
 P.RA     EQU    19          RELATIVE ADDRESS / F.P. BLOCK LENGTH 
 L.RA     EQU    18 
  
 P.RB     EQU    12                RELOCATION BASE ORDINAL
 L.RB     EQU    7                 1 - 61 FOR COMMON BLOCKS 
 P.RB     MICRO  1,,/12/           0 - 6 FOR LOCAL BLOCKS 
*                                  AND 7 - 70 FOR FORMAL PARAMETERS 
 M.NCB    EQU    127               MAXIMUM NUMBER OF COMMON BLOCKS
  
 P.ADF    EQU    P.RB              ADDRESS DEFINITION FIELD 
 L.ADF    EQU    L.RL+L.RA+L.RB 
  
*         BITS FOR THE DEBUG PROCESSOR ( PASS 1 ONLY ). 
  
 P.SNT    EQU    35                SAVED NATURAL TYPE 
 L.SNT    EQU    3
  
 P.DIF    EQU    31                BASE OF 4 BIT DEBUG FLAG FIELD 
 L.DIF    EQU    4
  
 P.NOT    EQU    P.DIF
 P.IF     EQU    P.DIF+1
 P.SF     EQU    P.DIF+2           STORES OR FUNC 
 P.AC     EQU    P.DIF+3           ARRAYS OR CALLS
  
 P.DTO    EQU    19                DEBUG TABLE ORDINAL
 L.DTO    EQU    12 
  
 P.DBGI   EQU    P.DTO             BASE OF DEBUG FIELD
 L.DBGI   EQU    L.DTO+L.DIF       LENGTH 
  
*         BITS SET FOR A FUNCTION OR SUBROUTINE.
  
 P.FARG   EQU    46                NUMBER OF ARGUMENTS
 L.FARG   EQU    6
  
 P.LIB    EQU    45                LIBRARY FUNCTION 
 P.IOF    EQU    43          I/O FUNCTION 
 P.BEF    EQU    42                BEF CALL BY VALUE
 P.INF    EQU    41          INTRINSIC FUNCTION 
 P.FCALL  EQU    39          = 1 AFTER FIRST CALL 
  
 P.FTYP   EQU    P.BEF       BASE OF FUNCTION TYPE FIELD
 L.FTYP   EQU    2
  
*         WORD B ( FOR LABELS ).
  
 P.GEN    EQU    55                DO GENERATED LABELS
  
*         FOR LABELS NOT GENERATED BY THE COMPILER THE BITS OF WORD B 
*         HAVE THE FOLLOWING MEANINGS --
  
 P.RZ     EQU    54                FOR DO LOOPS 
 P.RSN    EQU    53                REFERENCED AS STMT NO - ACTIVE LABEL 
*                                  BIT MAY BE CLEARED BY OPTIMIZERS 
 P.DSN    EQU    52                LABEL DEFINED AS A STMT NUMBER 
 P.DFN    EQU    51                LABEL DEFINED AS A FORMAT NUMBER 
 P.RFN    EQU    50                LABEL REFERENCED AS A FORMAT NUMBER
 P.RAS    EQU    49                REFERENCED IN CONTEXT AS A STMT NO 
*                                  THIS BIT IS USED FOR ERROR CHECKING
 P.DLT    EQU    48                USED AS A DO LOOP TERMINATOR 
  
 P.SLD    EQU    P.DFN             STMT LABEL DEFINITION FIELD
 L.SLD    EQU    2
  
*         BITS SET FOR A STMT NUMBER THAT ARE USED TO CHECK FOR 
*         CONFLICTING USE OF A LABEL BY FORMAT LABEL PROCESSORS.
  
 )ZZ      BIT    P.DSN-P.DLT
 )ZZ1     BIT    P.RAS-P.DLT
 M.FNCHK  EQU    )ZZ+)ZZ1+1        BIT MASK TO CHECK FOR FMT NO USED AS 
 P.FNCHK  EQU    P.DLT             STMT LABEL 
  
*         WORD B FIELDS FOR STATEMENT NUMBERS.
  
 P.LOR    EQU    12                LOOP ORDINAL IN WHICH LABEL IS 
*                                  REFERENCED 
 L.LOR    EQU    12 
  
 P.TRO    EQU    24                LABEL TRACE ORDINAL ( D OPTION ) 
 L.TRO    EQU    12 
  
 P.DLN    EQU    36                LINE NO LABEL IS DEFINED ON ( DUKE ) 
 L.DLN    EQU    12 
  
 V.OPT    EQU    127B              BITS INHIBITING LOOP OPTIMIZATION
  
*         WORD B FIELDS FOR DO-GENERATED LABELS.
  
 P.FLG    =      48 
 L.FLG    =      7
  
 P.TTLN   =      24                DO-BEGIN LINE NUMBER 
 L.TTLN   =      L.DLN
          SPACE  4
***       OUTSYM - MACRO TO DUMP A TABLE TO FILE ZZZZZSY
* 
 OUTSYM   MACRO  TABTYPE,FWA,LENGTH 
          IFC    NE,*X2*FWA*,1
          SX2    FWA
          IFC    NE,*X3*LENGTH*,1 
          SX3    LENGTH 
          SX6    TABTYPE
          IFEQ   TABTYPE,ZZ.SYM 
          SA1    =XCO.ER     ER FLAG
          SA5    =XCO.OLVL   OPT LEVEL
          LX1    1+2
          BX5    X5+X1       1/ER,2/OPT 
          ELSE   1
          MX5    0           ONLY PASS OPT INFO FOR SYMBOL TABLES 
          RJ     =XPUTTAB 
          ENDM
          TITLE  MACROS AND EQUS FOR PASS 1 
*         LENGTHS OF THE VARIOUS FIELDS IN THE R-MACRO WORDS. 
  
 RM.IHL   EQU    30          IH 
 RM.RIL   EQU    16          RI ( R-NUMBER )
 RM.CAL   EQU    18          CA ( CONSTANTS ) 
 EREXIT   SPACE  4,8
          MACRO  EREXIT,LOC,ERNUM  ERROR EXIT MACRO 
 LOC      BSS    0
          SB6    ERNUM
(LOC      EQU    *
 EREXIT   ENDM
 RMHDR    SPACE  4,8
**        RMHDR - FORM AN R-LIST MACRO HEADER WORD. 
*                MACNUM = RLIST MACRO ORDINAL 
*                IN = WORD COUNT FOR THE REST OF THE MACRO
* 
 RMHDR    MACRO  MACNUM,IN
          VFD    12/1777B-MACNUM,18/IN,30/0 
          ENDM
 RMEQU    SPACE  4,8
**        RMEQU - DEFINE AN R-MACRO MACRO ORDINAL 
* 
* A       RMEQU  B
* 
*                A = SYMBOL TO BE DEFINED 
*                B = NUMERIC VALUE OF SYMBOL OR BLANK 
*                IF B IS BLANK THEN A = MACNUM
  
          MACRO  RMEQU,A,B
 A = B MACNUM 
 MACNUM SET A+1 
 RMEQU    ENDM
 OUTUSE   SPACE  4,8
**        OUTUSE - OUTPUT A *  USE NAME* STATEMENT FOR A LOCAL RB.
* 
 OUTUSE   MACRO  NAME 
          LOCAL  N
 N        MICRO  1,6,/NAME/ 
          SX6    =XU"N" 
          RJ     =XOUTUSE 
 OUTUSE   ENDM
 POSTER   SPACE  4,40 
**        POSTER - POST ERROR MESSAGE TO ERROR TABLE. 
* 
*         *POSTER* MAY BE CALLED DURING PASS 1 ONLY.
*         POSTS ERROR MESSAGE NUMBER, SOURCE LINE NUMBER AND 10-CHARAC
*         CALLER TEXT TO THE PASS 1 ERROR TABLE.  AT THE END OF PASS 1, 
*         *FTNMSG* (2,3 OVERLAY) IS LOADED TO LIST THE CORRESPONDING
*         ERROR MESSAGE, INCLUDING LINE NUMBER AND TEXT.
* 
* 
*         POSTER    NR=,SEV=,FMT=,TXT=,RETURN=
* 
*         ENTRY  *NR*     = ERROR MESSAGE NUMBER (AS IN -FTNMSG-).
*                           MAY BE SET TO /**/.  CALLER THEN ACCEPTS
*                           RESPONSIBILITY FOR (X3), (X4) AND (B6). 
*                           *RETURN* AND *SEV* WILL STILL BE ACCEPTED.
*                *SEV*    = SEVERITY CODE, AS FOLLOWS --
*                           *ANSI* = NON-ANSI INFORMATIVE MESSAGE, TO BE
*                                    LISTED ONLY IF -X- LIST OPTION ON. 
*                           *FC*   = FATAL-TO-COMPILATION ERROR.
*                           *FE*   = FATAL-TO-EXECUTION ERROR.
*                           *INF*  = INFORMATIVE ERROR MESSAGE. 
*                *FMT*    = FORMAT OF TEXT WORD TO BE INSERTED IN THE 
*                           ERROR MESSAGE LISTING LINE.  VALUES ARE --
*                          *DPC*   = 8 DISPLAY-CODED CHARAC, -R- FORMAT 
*                          *ELIST* = E-LIST ENTRY (12/OP CODE, 48/MISC )
*                           IF OMITTED, NO TEXT IS INSERTED.
*                *TXT*    = X-REGISTER CONTAINING TEXT WORD, OR ADDRESS 
*                           EXPRESSION FOR TEXT WORD LOCATION.
*                           MAY NOT BE BLANK IF *FMT* SPECIFIED.
*                *RETURN* = RETURN ADDRESS EXPRESSION, OR BLANK.
*                           IF BLANK, RETURNS TO PRESENT CODE SEQUENCE. 
*                           IGNORED IF *SEV=FC*.
* 
*         EXIT   IF *SEV=FC*, CALLER SURRENDERS CONTROL TO ERROR
*                PROCESSING.  REST OF CURRENT STATEMENT WILL BE IGNORED,
*                AND COMPILER BEGINS AN ERROR-SCAN-ONLY MODE.  NO OBJECT
*                CODE WILL BE GENERATED.
*                IF *SEV* = ELSE, *RETURN* PARAMETER IS HONORED.
* 
*         USES   X - 3, 4 
*                A - 3, 4 
*                B - 4, 6, 7
* 
*         CALLS  ERPRO, XR= 
  
  
          PURGMAC   POSTER
  
 POSTER   MACROE NR,SEV,TXT,FMT,RETURN
          IFC    NE, NR ** ,10
*                            SET DISPLAY-CODED TEXT FORMAT. 
          IFC    EQ, FMT DPC ,4 
          XR=    X3,TXT 
          BX4    X4-X4
          R=     B6,NR
          SKIP   5
*                            SET E-LIST TEXT FORMAT.
          IFC    EQ, FMT ELIST ,3 
          XR=    X4,TXT 
          R=     B6,NR
          SKIP   1
*                            SET ERROR NUMBER (NO TEXT).
          R=     B6,-NR 
*                            SET RETURN ADDRESS.
          IFC    NE, SEV FC ,5
          IFC    NE, RETURN B7 ,4 
          IFEQ   TEST,0,2 
          SB7    RETURN  *+2-*P/60D 
          SKIP   1
          SB7    RETURN  *+2
*                            SET -ERPRO- ENTRY ADDRESS. 
          ECHO   8,A=(FE,INF,ANSI,FC),B=(ERPRO,ERPROI,ASAER,FATALER)
          IFC    EQ, SEV A ,7 
          STOPDUP 
          IFEQ   TEST,0,2 
          EQ     =X_B 
          SKIP   2
          SB4    =X_B 
          RJ     =XTEM
          SKIP   1
          ERR    (SEV) BAD SEV# "SEQUENCE"
 POSTER   ENDM
  
  
          PURGMAC   POSTERR 
 POSTERR  OPSYN  POSTER      OBSOLETE MACRO NAME
          SPACE  3
**        E-LIST TYPE CODE VALUES.
  
 EL.CON   EQU    0                 CONSTANT 
 EL.ID    EQU    1                 NAME 
 EL.)     EQU    2                 RIGHT PAREN
 EL.COMMA EQU    3                 COMMA
 EL.EOS   EQU    4                 END OF STATEMENT 
 EL.=     EQU    5                 EQUALS SIGN
 EL.(     EQU    6                 LEFT PAREN 
 EL.OR    EQU    7                 .OR. 
 EL.AND   EQU    10B               .AND.
 EL.NOT   EQU    11B               .NOT.
 EL.LE    EQU    12B               .LE. 
 EL.LT    EQU    13B               .LT. 
 EL.GE    EQU    14B               .GE. 
 EL.GT    EQU    15B               .GT. 
 EL.NE    EQU    16B               .NE. 
 EL.EQ    EQU    17B               .EQ. 
 EL.MINUS EQU    20B               -
 EL.PLUS  EQU    21B               +
 EL.STAR  EQU    22B               *
 EL.SLASH EQU    23B               /
 EL.DSTR  EQU    24B               ** 
 EL.S)    EQU    25B               SPECIAL PAREN FOR DO-S AND REDUNDANT 
*                                  PARENTHESIS
 DESCRIBE TITLE  FIELD DEFINITION MACROS
**        DESCRIBE, DEFINE - FIELD DEFINITION MACROS. 
* 
*         MACROS TO FACILITATE FIELD DESCRIPTION, WHERE FIELDS ARE
*         SUB-WORD ENTITIES.  THE 'DESCRIBE' MACRO IS USED TO PROVIDE 
*         A PREFIX FOR NAMES SUPPLIED IN SUBSEQUENT 'DEFINE' REFERENCES.
*         FOR EACH NAME SPECIFIED, THE FOLLOWING SYMBOLS WILL BE
*         DEFINED0
* 
*                PFX_NAME_P -- THE BIT POSITION OF THE RIGHT MOST BIT 
*                              WHICH COMPRISES THE NAMED FIELD (WITHIN
*                              A WORD BITS ARE NUMBERED ACCORDING TO
*                              THE POWER OF TWO WHICH THEY REPRESENT) 
*                PFX_NAME_L -- THE LENGTH IN BITS OF THE FIELD
* 
*         FIELDS ARE NOT PERMITTED TO SPAN WORD BOUNDARIES (A FATAL-TO- 
*         ASSEMBLY ERROR WILL RESULT) OR TO GO BEYOND THE TOTAL NUMBER
*         OF BITS WHICH THE ENTIRE SET OF FIELDS IS SUPPOSED TO OCCUPY. 
* 
*         'DESCRIBE' REFERENCE -- 
* 
*                DESCRIBE PFX,BITSLONG,TOPBIT 
* 
*         WHERE  PFX  IS THE PREFIX MENTIONED ABOVE,
*           BITSLONG  IS THE TOTAL LENGTH IN BITS OF THE STRUCTURE, 
*                     IF NOT PRESENT A VALUE OF 60 IS ASSUMED,
*             TOPBIT  THE BEGINNING (I.E. LEFTMOST) BIT OF THE STRUCTURE
*                     IF ABSENT "BITSLONG-1" IS THE DEFAULT VALUE 
* 
*         'DEFINE' REFERENCE -- 
*         NAME   DEFINE  LENGTH,RESET 
* 
*         WHERE NAME IS THE NAME OF THE FIELD MENTIONED ABOVE, IF NOT 
*                    PRESENT THEN THE REFERENCE WILL ACT AS FILLER. 
*             LENGTH IS THE BIT LENGTH OF THE FIELD (OR FILLER), A VALUE
*                    ONE IS ASSUMED IF THIS PARAMETER IS OMITTED
*              RESET IF PRESENT, WILL CAUSE THE NAMED FIELD TO BE 
*                    DEFINED RELATIVE TO BIT POSITION 'RESET' AS THE
*                    TOPMOST (LEFTMOST) BIT.
* 
*         UNLESS THE 'RESET' PARAMETER OCCURS, EACH 'DEFINE' IS 
*         CONSIDERED TO REFERENCE A FIELD BEGINNING TO THE IMMEDIATE
*         RIGHT OF THE PRECEDING FIELD. 
* 
*         CONSIDER THE FOLLOWING EXAMPLE
* 
*         TABLE X      .------.-------.------.
*                      . TYPE   VALUE . SUBV .  (SAY FOR TYPE @ 100)
*                      .------.-------.------.
*                       '      '       '     '
*                      59     47      17     0
* 
*                 OR   .------.--------------.
*                      . TYPE . MESSAGE      .  (FOR TYPE > 100)
*                      .------.--------------.
*                       '      '             '
*                      59     47             0
* 
*                DESCRIBE X.,60    TABLE X, THE PREFIX TO BE USED IS THE
*                                  TWO CHARACTERS 'X.'
*         TYPE   DEFINE  12 
*         MSG    DEFINE  48 
*         VALUE  DEFINE  X.MSGP+47
*         SUBV   DEFINE  18 
* 
*       THE SYMBOLS DEFINED WOULD BE
* 
*                X.TYPEP   EQU  48
*                X.TYPEL   EQU  12
*                X.MSGP    EQU   0
*                X.MSGL    EQU  48
*                X.VALUEP  EQU  18
*                X.VALUEL  EQU  30
*                X.SUBVP   EQU   0
*                X.SUBVL   EQU  18
  
 DESCRIBE MACRO  PREFIX,BITSLONG,TOPBIT 
          NOREF  /"QUAL"/.B,/"QUAL"/.L,/"QUAL"/.1 
 .P       MICRO  1,,/PREFIX/
 .L       SET    BITSLONG 60
 .B       SET    TOPBIT .L-1
 DESCRIBE ENDM
  
          MACRO  DEFINE,N,LONG,RESET
 .1       SET    LONG 1 
          IFC    NE,//RESET/,2
 .B       SET    RESET
 .L       SET    1000 
          IFC    NE,//N/,4
 ".P"N_P  EQU    .B-.1+1
 ".P"N_L  EQU    .1 
          IFEQ   .1,1,1 
          NOREF  ".P"N_L
 .L       SET    .L-.1
 .B       SET    .B-.1
          IFLT   .L,0,1 
           ERR    TOTAL FIELD LENGTHS ARE LONGER THAN SPECIFIED 
          IFLT   .B,0,3 
          IFNE   .B,-1,1
           ERR    FIELD SPANS A WORD BOUNDARY 
 .B       SET    59 
 DEFINE   ENDM
  
**        DEQU - DEFINE EQUIVALENCED FIELDS 
  
          MACRO  DEQU,N,B,LEN 
 ".P"N_P  EQU    ".P"B_P
 ".P"N_L  EQU    LEN ".P"B_L
          IFEQ   ".P"N_L,1,1
          NOREF  ".P"N_L
          ENDM
 BMFW     SPACE  3,14 
**        BFMW - CREATE A BIT FIELD MASK WORD.
* 
* LAB     BFMW   PREFIX,(BITLIST),SHFT
* 
*         PREFIX = BIT FIELD PREFIX CHARACTERS WITH NO PERIOD.
*         BITLIST = LIST OF BIT FIELDS TO APPEAR IN MASK
*         SHFT = AMOUNT BY WHICH WORD IN REGISTERS HAS BEEN SHIFTED 
  
          MACRO  BFMW,LAB,PR,BIT,SHFT 
          IFC    NE,/"QUAL"//,1 
          NOREF  /"QUAL"/.P,/"QUAL"/.Z
* 
 LAB      BSS    0
 .Z       SET    0
  
          IRP    BIT
 .P       SET    PR.BIT_P+PR.BIT_L+SHFT 
          IFGT   .P,60,1
 .P       SET    .P-60
          IFNE   .P,PR.BIT_L,3
          POS    .P 
          VFD    PR.BIT_L/-0
          ELSE   1
 .Z       SET    .P 
          IRP 
* 
          IFNE   .Z,0,3 
          POS    .Z 
          VFD    .Z/-0
          ELSE   1
          VFD    *P/0 
* 
          ENDM
 DESCR    TITLE  PASS 2 DEFINITIONS AND TABLE FORMATS 
**        *IL* INSTRUCTION DESCRIPTOR FIELDS ( ALL INSTRUCTION TYPES )
*         INSTRUCTION ATTRIBUTES ( PROPERTY BITS ). 
  
          DESCRIBE D.,60
 TY       DEFINE 2           RLIST TYPE - 1 ( = 0-3 ) 
 FT       DEFINE 5           FUNCTIONAL UNIT TIME IN MINOR CYCLES 
 NR       DEFINE 1           D.RJRSP+12 ( BIT SHIFT FOR *MCG* IN *DRR* )
          DEFINE 1           =1 TO SIMULATE A EXPONENT
 F1       DEFINE 4           FIRST FUNCTION UNIT ORDINAL
 F2       DEFINE 4           SECOND FUNCTION UNIT ORDINAL 
 BM       DEFINE 1           NODE BOUNDARY MARKER ( JUMP, LABEL, ETC )
 ^D       DEFINE 1           SET IF INSTRUCTION DOESN-T DEF AN RI/ NO RI
  
**        NOTE - THE BIT FIELD FROM *RJRS* TO *JFT* IS USED BY THE
*         SCHEDULER TO ASSIGN RESULT REGISTERS, SO PLEASE DO NOT REORDER
  
 RJRS     DEFINE 1           PRECEDES AN RJ REGISTER STORE
 PS       DEFINE 1           INST IS AN IMMEDIATE PREDECESSOR OF A STORE
 PRS      DEFINE 1           PRECEDES A REGISTER STORE
 ECJ      DEFINE 1           ERROR CHECK (FALL THROUGH) JUMP
 L2       DEFINE 1           LEVEL 2 LD/ST
 LD       DEFINE 1           LOAD 
 ST       DEFINE 1           STORE
 JP       DEFINE 1           JUMP 
 XMT      DEFINE 1           XMT/SXT
 KS       DEFINE 1           OPERATION DESTROYS OPERAND ( CON SHIFTS )
 PI       DEFINE 1           PSEUDO INSTRUCTION ( RS,DAR,DEF,LAB, ETC ) 
 MUC      DEFINE 1           MULTI USE COMPUTATION ( *JAM* MODE ) 
 JFT      DEFINE 1           JAM FUNCTION TIME, "0 IF USES A FUNCTION UNIT
  
 USI      DEFINE 1           UNSAFE INSTRUCTION ( INTERRUPT POSSIBLE )
 ZP       DEFINE 1           =1 IF INSTRUCTION HAS NO OPERANDS
 CM       DEFINE 1           "0 IF OPERANDS ARE COMMUTATIVE 
 SZ       DEFINE 2           INSTRUCTION SIZE ( PARCEL COUNT )
 SR       DEFINE 1           SET FOR SIZE REDUCIBLE LD/ST-S 
 FP       DEFINE 1           SET IF IH IS AN F.P. 
 XU       DEFINE 1           USES EXTEND PAST A REDEF ( SIO AND GRA ) 
 RF       DEFINE 1           RI USED IN *RF* OF LD/ST/STT/SA
 INC      DEFINE 1           INCREMENT INSTRUCTION ( IA/IS/STT/ST ) 
 REGW     DEFINE 9           X-REGISTER WIDTH OF THE SEQUENCE AT A INST 
 USES     DEFINE 9           USES COUNT 
  
*         COMBINATIONS OF DESCRIPTOR BIT FIELDS 
  
 LDST     DEQU   ST,2        LD AND ST BITS ( MEMORY REFERENCE )
 STRS     DEQU   PRS,2       STORE / RS PRECEDENCE BITS 
 AR       DEQU   FP,2        ADDRESS REDUCTION BITS ( *MCG* ) 
 LSJ      DEQU   JP,3        LD / ST / JP BITS
 TYIO     DEQU   RJRS,2      TYPE I OPERAND BIT DETERMINOR
*                            0 - RJ,RK ARE OPERANDS 
*                            1 - RK IS AN OPERAND 
*                            2 - RI,RJ,RK ARE OPERANDS
 EQV      DEQU   FT,1        "0 IF INST IS PRED OF AN EQUIV LINK
*                ASSUMES THAT FUN TIME OF LD/ST-S IS AN EVEN NUMBER.
 RLIST    EJECT 
**        *IL* INSTRUCTION FIELD DEFINITIONS
  
          DESCRIBE R1.,60    TYI(OC,RJ,RK,RI) / TYII(OC,IN,SO,RI) , ETC 
  
*         TYPE 1 *IL* - BINARY OPERATIONS - RI = RJ.OP.RK 
*                12/PACKED OC,16/RJ,16/RK,16/RI 
  
 OC       DEFINE 12          PACKED OP CODE 
 RJ       DEFINE 16          FIRST OPERAND
 RK       DEFINE 16          SECOND OPERAND 
 RI       DEFINE 16          RESULT RNUMBER 
  
*         TYPE 2 *IL* - 1 ADDRESS AND PSEUDOS - .OP.RI = IN 
*                12/PACKED OC,18/IN,14/SO,16/RI 
  
 IN       DEFINE 18,R1.RJP+15      A CA FIELD 
 SO       DEFINE 14          REGISTER DESIGNATOR
  
*         TYPE 3 *IL* - LOADS,STORES AND JUMPS
*                12/PACKED OC,18/IN,12/H2,2/0,16/RI 
*                R2 WORD = IHINFO FORMAT ( SEE BELOW )
          SPACE  2
*         TYPE 4 *IL* - SPECIAL INSTRUCTIONS, BOUNDARY MARKERS, ETC.
*                12/PACKED OC,18/CA,12/H2,18/IH 
  
          DESCRIBE R1.,60    TYIV(OC,CA,H2,IH)
 OC       DEFINE 12 
 CA       DEFINE 18 
 H2       DEFINE 12          SYMTAB ORDINAL, MISCELLANEOUS INFO 
 IH       DEFINE 18          IH FIELD 
 IHINFO   SPACE  3
**        IH INFO WORD/ R2 WORD FOR MEMORY REFERENCES AND TYPE III INST 
*         NOTE - LD,ST,BM BITS SET BY *BDT* IN *FIL* DURING INTERFERENCE
*                LINKING PHASE ONLY ( BITS ARE SET IN *IH* TABLE ). 
*         LD BIT SET FOR APLIST LD-S IN *PRE* TO PREVENT SQUEEZING OF 
*                ST/LD SEQUENCES IN *SQZ*.
  
          DESCRIBE IH.,60    IHW(RF,CA,IH)
 LD       DEFINE 1           LD BIT FROM DESCR
 ST       DEFINE 1           ST BIT FROM DESCR
 BM       DEFINE 1           SET FOR BOUNDARY MARKERS 
          DEFINE 1
 SIA      DEFINE 1           STT GEN BY *GRA* OF LCM&FP  ADDRESS
*                              WHERE VALUE OF RF MAY BE NEGATIVE
 SRF      DEFINE 1           =1 IF SPECIAL RF NECESSARY ( RF = (RJ,RK) )
 RF       DEFINE 18          R-NUMBER OF MODIFIER 
 CA       DEFINE 18          CONSTANT ADDEND
 I        DEFINE 3           TABLE NUMBER ( 0 - SYMTAB, ETC ) 
 H        DEFINE 15          ORDINAL INTO TABLE 
 IH       DEQU   H,18 
  
 CAIH     DEQU   H,36        COMBINATION OF CA AND IH FIELDS
  
 IH.LCMA  EQU    1S13        =1 IF LCM=I ADDRESS LOAD ( ^F.P. ) 
 IH.LCM   EQU    1S14        *LCM* ( LEVEL 2 ) BIT VALUE SET IN *IH*
*                            FIELD FOR *DRL/DWL*-S .
 RF.MV    EQU    1S16        BIT SET IN *RF* FIELD OF PLD,PST,DRL,DWL 
*                            IF RF IS -VAR  ( A(C-VAR)  ).
 IFIELDS  SPACE  2,6
*         I FIELD VALUES FOR THE FORWARD REFERENCE TABLES.
  
 I.GL     EQU    1S15        #GLNNN 
 I.AP     EQU    2S15        [APNNN 
 I.IO     EQU    3S15        ]IONNN 
 SOREG    SPACE  3
**        SO FIELD  - USED FOR SPECIFYING EXPLICIT RESULT REGISTERS 
*                     IN *RS* AND *DEF* INSTRUCTIONS ONLY.
*                2/INV INFO,2/LOCK TYPE,3/REG TYPE,3/REG NUMBER 
  
          DESCRIBE SO.,11 
 SFL      DEFINE 1           SCRATCHABLE FULL LOCK ( TEMP/FULL LOCK ) 
 INVC     DEFINE 1           INVARIANT IN CURRENT LOOP
 INV      DEFINE 1           INVARIANT IN INNER LOOP
 LK       DEFINE 2           LOCK TYPE, *RS* INSTRUCTION ONLY 
*                            0 - HOLD UNTIL NEXT UNCONDITIONAL JUMP 
*                            1 - HOLD UNTIL USES[RI] = 0
*                            2 - HOLD UNTIL REDEF OR *EOQ*
*                            3 - RJ RS, IT IS A *DEF* IN DISGUISE.
*                            3 - A-REG LOCK ( INITIAL *DEF* OF PREFETCH)
 RT       DEFINE 3           REGISTER TYPE ( BAX = 0/1/2 )
 RN       DEFINE 3           REGISTER NUMBER ( 0 - 7 )
 REG      DEQU   RN,6        RT + RN FIELDS 
  
 .LKP     BIT    SO.LKP 
 SO.TLOCK EQU    .LKP        TEMP LOCK
*                              WARNING - TEMP LOCKS CAN BE ELIMINATED 
*                              IN *SQZ* IF THEY HAVE NO *REAL* USES.
 SO.LOCK  EQU    2*.LKP      FULL LOCK ( UNTIL REDEF / *EOQ* )
 SO.RJLK  EQU    3*.LKP      RJ LOCK ( B-REG DEF FOR UP / NR INSTRUCTIONS 
  
 RT.BR    EQU    0           VALUE OF B REGISTER TYPE 
 RT.XR    EQU    2           VALUE OF X REGISTER TYPE 
 APL      SPACE  3,10 
**        AP / IO LIST ENTRY FORMAT FOR APLIST PROCESSING, USE/DEF INFO 
  
          DESCRIBE AP.,60 
 ST       DEFINE 1           ST APL ( IH,CA ARE FOR OPT=2 INFO ONLY ) 
 USE      DEFINE 1           =1 IF INPUT LIST ITEM MAY NOT BE DEFINED 
 P1       DEFINE 1           +1 REF FOR A DOUBLE/COMPLEX VARIABLE 
          DEFINE 2
 CR       DEFINE 1           CLASS REFERENCE
          DEFINE 18 
 CA       DEFINE 18          BIAS 
 IH       DEFINE 18          SYMBOL ORDINAL 
  
 IO       DEQU   ST,1        =1 IF INPUT ( DEF ) IN *IOL* 
 CAIH     DEQU   IH,36
 FI       SPACE  3,14 
**        FI. - FUNCTION INFORMATION WORD ( R2 ) FOR RJX-S. 
  
          DESCRIBE FI.,60 
 FT       DEFINE 6           FUNCTION TYPE
*                            0 - IGNORE, 1 - USER, 2 - BEF, 3 - I/O 
 REGP     DEFINE 18          B-REGISTERS PRESERVED ( *BEF"S* ONLY ) 
 LEN      DEFINE 18          LIST LENGTH
 INDX     DEFINE 18          INDEX TO FWA OF LIST IN *IOL*
 IH-LAB   SPACE  3,14 
**        IH. - IH WORD OF LOOP GENERATED LABELS
  
          DESCRIBE IH.,60 
 STK      DEFINE 1           SET IF LOOP FITS IN INSTRUCTION STACK
          DEFINE 41 
 ICV      DEFINE 18          INDEX OF LOOP *CV* TO *UDI*
 IX       SPACE  3,10 
**        IX. - DEFINE FIELDS FOR MC,IH WORD OF *IXFN* MACRO
  
          DESCRIBE IX.,60 
 SUB      DEFINE 6           SUBSCRIPT TERM ORDINAL 
 MC       DEFINE 18          MULTIPLICATIVE CONSTANT FOR VARIABLE 
 CA       DEFINE 18          BIAS 
 IH       DEFINE 18          SYMBOL ORDINAL 
  
 CAIH     DEQU   IH,36       COMBINED IH,CA FIELD 
 OPRS     SPACE  5
**        OPR - MACRO TO DEFINE *IL* INSTRUCTION OPCODES ( OC. SYMBOLS )
  
          MACRO  OPR,N
 OC.N     EQU    .OC
 .OC      SET    .OC+1
 OPR      ENDM
  
          SKIP   1           SO SYMBOLS ARE PUT IN STEXT RECORD 
*CALL     OPRDEFS 
  
*         DEFINE SUBINDEX OPCODES FOR THE X AND B JUMPS ( IN *CA* FIELD ) 
  
          NOREF  .Z 
 .Z       SET    0
          ECHO   2,T=("XJUMPS") 
 JC.T     EQU    .Z 
 .Z       SET    .Z+1 
  
 .Z       SET    0
          ECHO   2,T=("BJUMPS") 
 JC.T     EQU    .Z 
 .Z       SET    .Z+1 
 BIT      TITLE  PASS 2 TABLE FORMATS 
**        BI. - DEFINE FIRST WORD OF A 2 WORD ENTRY IN *BIT*
  
          DESCRIBE BI.,60 
 RB       DEFINE 1           REACHABLE BLOCK ( SET FOR PROG BLOCKS ONLY 
 CB       DEFINE 1           CODED ( NOW IN *MCG/SII* FORMAT )
 IL       DEFINE 1           INITIAL LABEL
 FJ       DEFINE 1           FINAL *UJP*
 LJP      DEFINE 1           BLOCKS CONSISTS OF A *LAB/UJP* ONLY
 HN       DEFINE 1           =1 IF HEADER NODE OF A INTERVAL & *SCR*
 FTH      DEFINE 1           =1 IF A *HB* THAT IS FROM A *FTH* LOOP 
 OLN      DEFINE 15          BN OF HB OF LOOP THAT BLOCK IS IN
 PC       DEFINE 2           PARCEL COUNT 
 FLN      DEFINE 18          FIRST LINE NUMBER ( PROG BLOCKS ONLY ) 
 BVI      DEFINE 18          *BVT* INDEX TO BIT VECTORS 
  
 PII      DEQU   PC,17       INDEX TO *PSI* POST STORE INFO ( "0 )
 PBN      DEQU   FLN         PROG BLOCK INDEX OF HOLDING BLOCK
*                            *BIT* INDEX OF HEADER NODE OF LOOP THAT IT 
*                            IS THE HOLDING BLOCK OF
 MLT      SPACE  3,14 
**        ML. - MOD LIST TABLE ENTRY FORMAT 
* 
*         *MLT* IS THE *MOD* LIST INDEX TABLE.  *MOD* CONSISTS OF RLIST 
*         INSTRUCTIONS ( 4 WORDS/INSTRUCTION ), AND THE FIRST ENTRY IS
*         A DUMMY *BOS*.
*         OPERANDS OF INSTRUCTIONS IN *MOD* WHICH REFERENCE INSTRUCTIONS
*         IN *SEQ* HAVE BIT 15 OF THE R-NUMBER SET ( R+100000B ) .
* 
*         FOR FURTHER INFORMATION ONE MAY LOOK AT *MPB* IN *GPO*. 
  
          DESCRIBE ML.,60    MCW(DEL,II,NI,MTI) 
 DEL      DEFINE 1           DELETE FLAG
          DEFINE 5
 II       DEFINE 18          INSERT INDEX ( IN *SEQ* )
 NI       DEFINE 18          N. INSTRUCTIONS TO BE INSERTED 
 MTI      DEFINE 18          *MOD* TABLE INDEX
 TET      SPACE  3,14 
**        T. - TEMP EQUIVALENCE TABLE FORMAT
  
          DESCRIBE T.,60     TETW(FLAGS,ITI,BI,CA)
 INV      DEFINE 1           =1 IF *INV* TEMP 
 EQV      DEFINE 1           EQV TO ANOTHER *TET* 
 FA       DEFINE 1           FINAL ASSIGNMENT OF *CA* ( *POST* )
 CAL      DEFINE 1           CA FIELD LOCKED
          DEFINE 1
 BIP      DEFINE 1           BASE MEMBER OF *IP* CLASS
 ITI      DEFINE 18          INDEX TO INC FORMULA INFO IN *IIT* ( ^INV )
 BI       DEFINE 18          INDEX IN BLOCK WHERE *LD* GOES 
 CA       DEFINE 18          BIAS OF TST* ( SET IN SQZ * )
  
 HBN      DEQU   ITI         BN OF HB (LOOP) THAT IT. IS ASSOC WITH 
 REG      DEQU   BI          REGISTER THAT IT IS IN ( *MTA* ) 
 IPF      DEQU   ITI,19      *IP* FIELDS
          SPACE  2,8
**        LC. - LABEL CHANGE TABLE ( MULTI PREDECESSOR LOOPS )
  
          DESCRIBE LC.
          DEFINE 6
 NEXT     DEFINE 18          LINK TO NEXT ON CHAIN, 0 IF NONE 
 GLN      DEFINE 18          H FIELD OF GL VALUE OF LABEL 
 HBN      DEFINE 18          BN OF HB THAT LABEL IS DEFINED IN
          SPACE  3,5
**        DC.   DEBUG (LOADER) CONTROL WORD.
* 
*         DC IS A DESCRIPTION OF THE LOADER CONTROL WORD WHICH
*         FTN INTERROGATES TO DETERMINE IF *CID* IS *ON* FOR
*         THIS COMPILATION. 
  
          DESCRIBE DC.,60 
          DEFINE 24 
 FID      DEFINE 1
 STLTAB   SPACE  4,7
**        STLTAB - MACRO TO DETERMINE LENGTH OF WEAK EXTERNAL TABLE.
* 
*         STLTAB NAME 
* 
*         ARGS   *NAME*   = NAME OF *FCL* STATIC LOAD BLOCK.
  
  
          PURGMAC STLTAB
  
 STLTAB   MACRO  NAME 
 S.1      SET    S.1+1
 STLTAB   ENDM
  
 S.1      SET    0
  
*CALL STLOAD
  
 L.STL    =      S.1-S.1/2*2+S.1/2+1 LENGTH/2 + REMAINDER + EOT 
 N.STL    =      S.1
 PASS2TM  EJECT 
**        PASS 2 TABLE MANAGER MACRO DEFINITIONS
  
 PASS2TM  MACRO 
  
**        ADDWRD - ADD WORD TO MANAGED TABLE. 
* 
*         ADDWRD TABLE,REG
*         ENTRY  *TABLE* = TABLE NUMBER.
*                *REG* = REGISTER NAME OR EXPRESSION FOR WORD TO ADD. 
*         USES   A0, X1.
  
          PURGMAC ADDWRD
 ADDWRD   MACRO  A,B
          R=     X1,B 
          R=     A0,=XZ.A 
          RJ     =XADW= 
 ADDWRD   ENDM
  
**        ALLOC - ALLOCATE TABLE SPACE. 
* 
*         ALLOC  TABLE,WORDS
*         ENTRY  *TABLE* = TABLE NUMBER.
*                *WORDS* = WORD COUNT OF TABLE. 
  
          PURGMAC ALLOC 
 ALLOC    MACRO  A,B
          R=     X1,B 
          R=     A0,=XZ.A 
          RJ     =XATS= 
 ALLOC    ENDM
  
**        PROCESS - DEFINE PROCESSOR ADDRESSES FOR LIST OF NAMES
* 
*         PROCESS (A,B,C,...,Z) 
  
          PURGMAC PROCESS 
 PROCESS  MACRO  P
          IRP    P
          NOREF  .P 
 .P       BSS    0
          IRP 
 PROCESS  ENDM
  
          B1=1
          NOREF  .B,.D,.L,.P,.Z,.1
 Z.TXT    EQU    1
 O.SYM    EQU    12B         POINTER TO FWA OF SYMTAB 
          PURGMAC  ADEXTS,ADDREF,SYMBOL,WRM,CFO,CALLF,POSTER,LOADX
  
 PASS2TM  ENDM
  
          END 
