*DECK     FTNMAC
          IDENT  FTNMAC 
 FTNMAC   TITLE  FTNMAC - FTN OBJECT CODE MACRO DEFINITIONS 
          STEXT 
          LIST   F
          SPACE  4
***       FTNMAC - FORTRAN EXTENDED OBJECT CODE MACRO DEFINITION TEXT.
* 
*         THIS FILE CONTAINS THE MACRO DEFINITIONS AND DECLARATIVE
*         STATEMENTS NECESSARY FOR THE "COMPASS" ASSEMBLER TO ASSEMBLE
*         THE COMPS FILE. 
* 
  
*CALL     OPTIONS 
          TITLE 
*** 
*         MACROS OUTPUT BY THE HEADER CARD PROCESSOR. 
* 
 USEBLK   SPACE  4,8
**        USEBLK - ESTABLISH ORDER OF PROGRAM BLOCKS. 
  
  
          PURGMAC   USEBLK
  
 USEBLK   MACRO 
          USE    START.            1
          USE    VARDIM.           2
          USE    ENTRY.            3
          USE    CODE.             4
          USE    DATA.             5
          USE    DATA..            6
          USE    HOL.              7
*                                  DEFINE .CPU FOR MACROS IN FTNMAC.
 .CPU     EQU    "MDL"
 USEBLK   ENDM
 STLTAB   SPACE  4,7
**        STLTAB - GENERATE STATIC MODE WEAK EXTERNAL TABLE.
* 
*         STLTAB NAME 
* 
*         ARGS   *NAME*  = NAME OF *FCL* STATIC LOAD BLOCK. NOTE
*                          THAT THIS TABLE IS GENERATED WITH ALL
*                          POSSIBLE NAMES.
  
  
          PURGMAC STLTAB
  
 STLTAB   MACRO  NAME 
          VFD    30/=Y_NAME 
 STLTAB   ENDM
 LIBLNK   SPACE  4,7
**        LIBLNK - RUN-TIME OBJECT LIBRARY COMMUNICATION LINK.
* 
* 
*         LIBLNK NRFILES,PRNTLIM,STATIC,WKEXT 
* 
*         ARGS   *NRFILES* = NUMBER OF FILES DECLARED BY MAIN PROGRAM.
*                *PRNTLIM* = RUN-TIME OUTPUT FILE PRINT LIMIT.
*                *STATIC*  = 1 IF STATIC LOAD OPTION SELECTED.
*                            MAY BE OMITTED FOR DYNAMIC LOAD. 
*                *WKEXT*   = 1 IF WEAK EXTERNAL TABLE MUST BE GENERATED.
*                              WILL ONLY BE SET TO 1 FOR MAIN PROGRAMS
*                              WITHOUT FILES AND STATIC = 1.
  
  
          PURGMAC   LIBLNK
  
 LIBLNK   MACRO  N,PL,S,W 
          LOCAL  ST 
 ST       SET    S  0 
+         VFD    12/N+2000B,30/0,18/FILES.
          VFD    1/ST,59/PL 
 .1       IFEQ   W,1
          VFD    12/2001B,48/WXTTAB.
          CON    0
 WXTTAB.  BSS    0
*CALL STLOAD
          IFNE   *P,0,1 
          VFD    30/0 
 .1       ENDIF 
 +        CON    0
 LIBLNK   ENDM
 TRACE    SPACE  4,10 
**        TRACE - TRACE BACK DATA MACRO.
  
  
          PURGMAC   TRACE 
  
 TRACE    MACRO  NAME,ADDR,NARGS
 TRACE.   VFD    42/0H_NAME,18/ADDR 
*                                  DEFINE ARGS. FOR ENTR. MACRO.
 ARGS.    EQU    NARGS 0
*         CONDITIONALLY DEFINE *TEMPA0.* FOR *PENTRY* MACRO TESTS.
          IFC    NE,/NARGS//,1
 TEMPA0.  BSS    1
 TRACE    ENDM
 PENTRY   SPACE  4,4
**        PENTRY - PROGRAM ENTRY NAME MACRO.
  
  
          PURGMAC   PENTRY
  
 PENTRY   MACRO  NAME,LNAME,VAL,ER
          IFNE   ER,0,2 
+         SB0    B2-Z.+TRACE. 
          SB0    B2+TRACE.
 EXIT.    BSS    0
          IFEQ   VAL,2,2
          SA5    VALUE.+1 
          BX7    X5 
          IFNE   VAL,0,2
          SA4    VALUE. 
          BX6    X4 
          IF     DEF,TEMPA0.,2
          SA3    TEMPA0.
          SA0    X3+0 
          ENTRY  NAME 
 NAME     BSS    0
          IFC    NE,//LNAME/,1
 LNAME    EQ     *+4S15 
          IF     DEF,TEMPA0.,3
+         SX6    A0 
          SA0    A1 
          SA6    TEMPA0.
 PENTRY   ENDM
 FLINK    SPACE  4,9
**        FLINK - FILE NAME LINK MACRO. 
  
  
          PURGMAC   FLINK 
  
 FLINK    MACRO  NAME 
 X        MICRO  1,,"C"NAME"C"
          VFD    42/0L"X",18/NAME 
 FLINK    ENDM
 FEQU     SPACE  4,4
**        FEQU - FILE NAME EQUIVALENCE MACRO. 
* 
*         ALSO USED BY THE ENTRY STMT PROCESSOR TO DEFINE ENTRY POINTS
*         THAT OCCUR BEFORE THE FIRST EXECUTABLE STATEMENT. 
  
  
          PURGMAC   FEQU
  
 FEQU     MACRO  LFN1,LFN2,NOENT
          IFC    EQ,/NOENT//,1
          ENTRY  LFN1 
 LFN1     EQU    LFN2 
 FEQU     ENDM
 FILXRM   SPACE  4,8
**        FILCRM/FIL7RM - FORM FILE FIT AND BUFFERS.
* 
* 
*         FILCRM    NAME,BFS,MRL,STATIC,NOEPT 
*         FIL7RM    NAME,BFS,MRL,,NOEPT 
* 
*         ARGS   *NAME*   = LOGICAL FILE NAME, WITH SPECIAL CHAR SUFFIX.
*                *BFS*    = CIO BUFFER LENGTH (BFS).
*                *MRL*    = MAXIMUM RECORD LENGTH IN CHARACTERS (MRL).
*                *STATIC* = NON-BLANK IF STATIC LOAD OPTION SELECTED. 
*                *NOEPT*  = NON-BLANK IF *SYSEDIT* OPTION SELECTED. 
*                           IF BLANK, *NAME* IS DECLARED TO BE AN 
*                           ENTRY POINT.
  
  
**                           DEFINE CRM FIT AND BUFFERS.
  
          PURGMAC   FILCRM
  
 FILCRM   MACRO  NAME,BFS,MRL,STATIC,NOEPT
          LOCAL  FWB,WSA,MRLW 
*                            DECLARE ENTRY POINT IF *NOEPT* IS BLANK. 
          IFC    EQ,$NOEPT$$,1
          ENTRY  NAME 
* 
*                            DEFINE CRM FIT SKELETON. 
* 
 LFN      MICRO  1,,"C"_NAME_"C"
*                                  WORD 0 - LOGICAL FILE NAME (LFN),
*                                           CIO COMPLETE BIT (CMPLT). 
 NAME     VFD    42/0L"LFN",18/1
*                                  WORD 1 - FWA CIO BUFFER (FWB). 
          IFEQ   BFS,0,1
 FWB      SET    0
          VFD    36/0,6/L.FIT6-L.FCLX-5,18/FWB
          BSSZ   12B-*+NAME 
*                                  WORD 12B - LABEL TYPE (LT)=ANY.
          VFD    36/0,2/3,22/0
*                                  WORD 13B - OPEN (OF)=N, CLOSE (CF)=N.
          VFD    25/0,2/2,3/2,30/0
*                                  WORD 14B - MAXIMUM RECORD LEN (MRL). 
          VFD    24/MRL,36/0
*                                  WORD 15B - DAYFILE CONTROL (DFC)=3.
          VFD    2/0,2/3,56/0 
          DATA   0
*                                  ASSEMBLE WORKING STORAGE AREA. 
*                                  WORD 17B - ERROR OPT (EO)=6, (WSA).
*                                  WORD 21B - CIRCULAR BUFF SIZE (BFS). 
*                                  WORD 43B - (MRL), (WSA). 
          IFNE   MRL,0,11 
          VFD    27/0,3/6,12/0,18/WSA 
          BSSZ   1
          VFD    42/0,18/BFS
          DATA   0
          DATA   0
          DATA   0
          DATA   0
          VFD    20/0,4/1,36/0         FORTRAN GENERATED FIT FLAG 
          BSSZ   43B-*+NAME 
          VFD    24/MRL,18/0,18/WSA 
          SKIP   8
*                                  ASSEMBLE NO WORKING STORAGE AREA.
*                                  WORD 17B - ERROR OPTION (EO)=6.
*                                  WORD 21B - CIRCULAR BUFF SIZE (BFS). 
*                                  WORD 43B - 0.
          VFD    27/0,3/6,30/0
          BSSZ   1
          VFD    42/0,18/BFS
          DATA   0
          DATA   0
          DATA   0
          DATA   0
          VFD    20/0,4/1,36/0         FORTRAN GENERATED FIT FLAG 
*                                  COMPLETE FIT.
          BSSZ   51B-*+NAME 
* 
*                            DEFINE CIO BUFFER. 
* 
          IFNE   BFS,0,1
 FWB      BSS    BFS
* 
*                            DEFINE WORKING STORAGE AREA. 
* 
          IFNE   MRL,0,3
 MRLW     SET    MRL+9D 
 MRLW     SET    MRLW/10D 
 WSA      BSS    MRLW 
 FILCRM   ENDM
  
  
**                           DEFINE 7RM FIT AND BUFFER. 
  
          PURGMAC   FIL7RM
  
 FIL7RM   MACRO  NAME,BFS,MRL,,NOEPT
          LOCAL  MRLW,UBC,WSA 
*                            DECLARE ENTRY POINT IF *NOEPT* IS BLANK. 
          IFC    EQ,$NOEPT$$,1
          ENTRY  NAME 
* 
*                            DEFINE 7RM FIT SKELETON. 
* 
 NAME     BSSZ   2
*                                  WORD 2 - OPEN (OF)=N, LABEL (LT)=UL. 
          VFD    24/0,2/2,4/1,2/2,28/0
          BSSZ   3
*                                  WORD 6 - (MRL - UBC,MRLW), (WSA).
          IFNE   MRL,0,5
 MRLW     SET    MRL+9D 
 MRLW     SET    MRLW/10D 
 UBC      SET    10*MRLW-MRL
 UBC      SET    6*UBC
          VFD    6/UBC,18/MRLW,15/0,21/WSA
          DATA   0
          VFD    14/0,4/1,42/0         FORTRAN GENERATED FIT FLAG 
*                                  COMPLETE FIT.
          BSSZ   20B-*+NAME 
* 
*                            DEFINE WORKING STORAGE AREA (WSA). 
* 
          IFNE   MRL,0,2
          BSS    BFS
 WSA      BSS    MRLW 
 FIL7RM   ENDM
 FILEF    SPACE  4,8
**        FILEF - FORM FILE TABLES. 
* 
*         77 FEB 01. -- FORTRAN EXTENDED OBJECT CODE NOW REFERENCES THE 
*         *FILCRM/FIL7RM* MACRO INSTEAD OF THE *FILEF* MACRO. 
*                THE *FILEF* MACRO DEFINITION THAT FOLLOWS WILL BE
*         PERMANENTLY REMOVED FROM *FTNMAC* BY 78 JAN 01.  USERS ARE
*         ADVISED TO MODIFY EXISTING SYMBOLIC CODE BEFORE THAT DATE,
*         BY RECOMPILING OR OTHER SUITABLE METHOD.
* 
*         FORMS THE FOLLOWING FILE TABLES --
*                A.  SKELETON FILE INFORMATION TABLE (FIT). 
*                B.  SKELETON FILE ENVIRONMENT TABLE (FET) - 6RM ONLY.
*                C.  CIRCULAR I/O BUFFER - 6RM ONLY.
*                D.  IF *FMRL* IS NON-ZERO, ALLOCATES A WORKING STORAGE 
*                    AREA, OF LENGTH (*FMRL*+9)/10+4 WORDS. 
* 
* 
*         FILEF     BUFL,FMRL,NAME,NOENT
* 
*         ENTRY  *BUFL*  = CIO BUFFER LENGTH (WORDS). 
*                *FMRL*  = MAXIMUM RECORD LENGTH (CHARACTERS).
*                          MAY BE ZERO OR OMITTED.
*                *NAME*  = FILE NAME. 
*                *NOENT* = NON-BLANK TO SUPPRESS DECLARATION OF 
*                          *NAME* AS AN ENTRY POINT.  MAY BE OMITTED. 
  
  
          PURGMAC   FILEF 
  
 #RM      IFEQ   OT#RM,6
  
 FILEF    MACRO  BUFL,FMRL,NAME,NOENT 
          LOCAL  FMRLW,FWSA,FFET,FBUF 
          IFC    EQ,$NOENT$$,1
          ENTRY  NAME 
 FWSA     MICRO  1,, 0
*                            SET MAXIMUM RECORD LENGTH (WORDS). 
          IFNE   FMRL,0,4 
 FMRLW    SET    FMRL+9D
 FMRLW    SET    FMRLW/10D
 FWSA     MICRO  1,,$FWSA$
          SKIP   1
 FMRLW    SET    0
*                            FORM 6RM FIT SKELETON. 
 NAME     DATA   0
          CON    FFET 
          VFD    24/0,2/2,4/0,2/3,28/0   OPEN (NO REWIND), LT=ANY 
          VFD    24/0,18/BUFL,18/0
          DATA   0
          CON    FBUF 
          VFD    24/FMRL,15/0,21/"FWSA" 
          BSSZ   19D-*+NAME 
*                            FORM FET SKELETON. 
 FFET     BSSZ   13D
*                            FORM CIO BUFFER. 
 FBUF     BSSZ   BUFL 
*                            FORM WSA.
          BSSZ   4*FMRLW/FMRLW
 FWSA     BSSZ   FMRLW
 FILEF    ENDM
  
 #RM      ELSE
  
 FILEF    MACRO  BUFL,FMRL,NAME,NOENT 
          LOCAL  FMRLW,FWSA 
          IFC    EQ,$NOENT$$,1
          ENTRY  NAME 
 FWSA     MICRO  1,, 0
*                            SET MAXIMUM RECORD LENGTH (WORDS). 
          IFNE   FMRL,0,5 
 FMRLW    SET    FMRL+9D
 FMRLW    SET    FMRLW/10D
 FWSA     MICRO  1,,$FWSA$
 FMRLW1   SET    60*FMRLW-6*FMRL
          SKIP   2
 FMRLW1   SET    0
 FMRLW    SET    0
*                            FORM 7RM FIT SKELETON. 
 NAME     BSSZ   2
          VFD    24/0,2/2,4/0,2/2,28/0   OPEN (NO REWIND), LT=UL
          BSSZ   3
          VFD    6/FMRLW1,18/FMRLW,15/0,21/"FWSA" 
          BSSZ   16D-*+NAME 
*                            FORM WSA.
          BSSZ   4*FMRLW/FMRLW
 FWSA     BSSZ   FMRLW
 FILEF    ENDM
  
 #RM      ENDIF 
          SPACE  3
*         FILE - FORM A FIT, FET, AND BUFFER FOR A FILE 
* 
*         73 JUN 01. -- FORTRAN EXTENDED OBJECT CODE NOW REFERENCES THE 
*         *FILEF* MACRO INSTEAD OF THE *FILE* MACRO, TO INCLUDE A 
*         WORKING STORAGE AREA AND TO PREVENT POSSIBLE INTERFERENCE 
*         FROM/TO THE RECORD MANAGER *FILE* MACRO.
*                THE FOLLOWING DEFINITION OF *FILE* WILL BE PERMANENTLY 
*         REMOVED FROM *FTNMAC* BY 74 JUN 01.  USERS ARE ADVISED TO 
*         MODIFY EXISTING SYMBOLIC CODE BEFORE THAT DATE, BY
*         RECOMPILING OR OTHER SUITABLE METHOD. 
  
          PURGMAC   FILE
  
 FILE     MACRO  LEN,NAME,NOENT 
          IFC    EQ,/NOENT//,1
          ENTRY  NAME 
 NAME     BSSZ   1
          VFD    42/0,18/NAME+18   FET ADDRESS
          VFD    24/0,2/2,4/0,2/3,28/0    LT=ANY , NOREWIND 
          VFD    24/0,18/LEN+2,18/0    BUFFER SIZE
          BSSZ   1
          VFD    42/0,18/NAME+18+10    BUFFER ADDRESS 
          BSSZ   12+10+LEN+2 18 FOR FIT   10 FOR FET
          ENDM
          SPACE  3
*         FORPAR - MACRO TO ESTABLISH THE ORDERING OF THE F.P.
*         BLOCKS FOR FORMAL PARAMETER ADDRESS SUBSTITUTION. 
*         ASSIGNS BASE ADDRESSES FOR EACH F.P. BLOCK AND
*         GENERATES A SPECIAL F.P. SYMBOL EQUATED TO THIS F.P.
*         POSITION IN THE PARAMETER LIST. 
  
 FORPAR   MACRO  FP 
          USE    FP 
 FP       BSS    0
          IF     -DEF,.NFP,2
 .DEL     SET    -1 
 .NFP     SET    0
 .FP      SET    0
 (FP      EQU    .NFP 
 .NFP     SET    .NFP+1 
          ENDM
          EJECT 
*** 
*         GENERAL MACROS. 
* 
 GNAME    SPACE  4,8
**        GNAME - MACRO TO DEFINE A NAMELIST GROUP NAME.
  
  
          PURGMAC   GNAME 
  
 GNAME    MACRO  NAME 
          LOCAL  X
*                            REMOVE POSSIBLE $. 
 X        MICRO  1,,$NAME$
 NAME     BSS    0
          VFD    42/0L"X",18/0
 GNAME    ENDM
 NAME     SPACE  4,8
**        NAME - DEFINE PROPERTIES OF A NAMELIST GROUP VARIABLE.
  
  
          PURGMAC   NAME
  
 NAME     MACRO  N,T,BASE,BIAS,FP,NDIM,D1,D2,D3 
          LOCAL  Z
 Z        MICRO  1,,$N$ 
          VFD    42/0L"Z",12/NDIM,6/T-T/8*8 
 .FP      IFC    NE,/FP// 
          VFD    30/D1,1/T/8,1/1,28/FP
 .FP      ELSE
          VFD    30/D1
 .BASE    IFC    NE,/BASE// 
          VFD    1/T/8,29/BASE+BIAS 
 .BASE    ELSE
          VFD    1/T/8,29/N 
 .BASE    ENDIF 
 .FP      ENDIF 
          IFGT   NDIM,1,1 
          VFD    30/D3,30/D2
 NAME     ENDM
 FMT      SPACE  4,10 
**        FMT - DEFINE A FORMAT LABEL.
  
  
          PURGMAC   FMT 
  
 FMT      MACRO  LABEL
          LOCAL  X
 X        MICRO  2,,/LABEL/ 
 LABEL    DATA   6L "X" 
 FMT      ENDM
 EIO      SPACE  4,8
**        EIO - MACRO TO DEFINE I/O APLIST TERMINATOR.
  
  
          PURGMAC   EIO 
  
 EIO      MACRO  P
          VFD    60/P 
 EIO      ENDM
 IOM      SPACE  4,8
**        IOM - MACRO TO DEFINE I/O APLIST ENTRY. 
  
  
          PURGMAC   IOM 
  
 IOM      MACRO  BASE1,BIAS,TYPE,COUNT,B59,B57,BASE2
 .P       MICRO  1,,
 .1       MICRO  1,1,/BASE1/
          IFC    EQ,/".1"/#/,1
 .P       MICRO  1,,/=S/
          VFD    1/B59
          IFC    EQ,/BASE1//,2
          VFD    1/1
          ELSE   1
          VFD    1/0
          VFD    1/B57
          VFD    9/TYPE 
          IFC    EQ,/BASE2//,3
          VFD    24/COUNT 
          VFD    24/".P"BASE1+BIAS
          SKIP   2
          VFD    24/COUNT 
          VFD    18/BASE2,6/BIAS
 IOM      ENDM
 ORG      SPACE  4,8
**        ORG - SET FWA ADDRESS FOR DATA PLACEMENT. 
* 
* 
*         ARGS   *NAME* = SYMBOL NAME.  IF ABSENT, MACRO GENERATES
*                         AN  *  ORG. K.*  STATEMENT. 
*                *BIAS* = SYMBOL BIAS.
*                *F*    = NON-BLANK IF 2ND OCCURRENCE OF A USAGE DEFINED
*                         VARIABLE. 
  
  
 ORG.     OPSYN  ORG
          PURGMAC   ORG 
  
 ORG      MACRO  NAME+BIAS,F
NN        IFC    NE,//NAME/ 
* 
D         IF     -DEF,NAME
          USE    DATA.
 NAME     BSS    0
D         ELSE
          IFC    NE,/F//,2
          USE    DATA.
*                            SAVE CURRENT DATA. ADDRESS.
 K.       SET    *
          ORG.   NAME+BIAS
 S.       SET    *
D         ENDIF 
* 
NN        ELSE
*                            RESTORE ADDRESS. 
          ORG.   K. 
NN        ENDIF 
* 
 ORG      ENDM
 REPI     SPACE  4,8
**        REPI - INSTANT REPLICATION TABLE MACRO. 
* 
* 
*         ARGS   *DLEN*   = LENGTH OF CONSTANTS TO BE REPLICATED. 
*                *RC*     = REPETITION COUNT. 
*                *INC*    = INCREMENT OF FIRST WORD ADDRESS.
*                *DESTIN* = DESTINATION ADDRESS.
  
  
 REPI.    OPSYN  REPI 
          PURGMAC   REPI
  
 REPI     MACRO  DLEN,RC,INC,DESTIN 
          LOCAL  II 
*                            PROVIDE 3RD ARG IF ABSENT. 
 II       SET    INC  0 
          IFC    EQ,//DESTIN/ 
          REPI.  S/S.,B/DLEN,C/RC,I/II
          ELSE
          REPI.  S/S.,B/DLEN,C/RC,I/II,D/S.+DESTIN
          ENDIF 
 REPI     ENDM
 HOL      SPACE  4,8
**        HOL - MACRO TO PUT OUT THE LAST WORD OF A HOLLERITH CONSTANT. 
  
  
          PURGMAC   HOL 
  
 HOL      OPSYN  DATA 
 ENTR.    SPACE  4,8
**        ENTR. - DEFINE ALTERNATE ENTRY POINT IN FORTRAN PROGRAM UNIT. 
  
  
          PURGMAC   ENTR. 
  
 ENTR.    MACRO  N
          LOCAL  X,Z
* 
 ANA      IFEQ   ARGS.,0
* 
*         *ENTR.* MACRO FOR SUBROUTINE WITHOUT ARGUMENTS. 
*         TRANSFER  *EQ EXIT.*  JUMP TO MAIN ENTRY POINT. 
* 
          ENTRY  N
 N        BSSZ   1
          SA1    N
          BX6    X1 
          SA6    ENTRY. 
          RJ     *+1
          BSSZ   1
          BSS    0
* 
 ANA      ELSE
* 
*         *ENTR.* MACRO FOR SUBROUTINE WITH FORMAL PARAMETERS.
* 
 N        BSSZ   1
          ENTRY  N
          SA2    X
          BX6    X2 
          SA6    FTNNOP.
          RJ     *+1
          BSSZ   1
          EQ     ENTRY.+1 
 X        EQ     Z
 Z        SA1    NOPS.
          SA2    N
          BX6    X1 
          LX7    X2 
          SA6    FTNNOP.
          SA7    ENTRY. 
          RJ     *+1
          BSSZ   1
          BSS    0
* 
 ANA      ENDIF 
* 
 ENTR.    ENDM
 APL      SPACE  4,8
**        APL - FORM APLIST PARAMETER WORD. 
  
  
          PURGMAC   APL 
  
 APL      MACRO  X
          CON    X 0
 APL      ENDM
 EPL      SPACE  4,8
**        EPL - DEFINE EQUIVALENCED APLIST. 
  
  
          PURGMAC   EPL 
  
 EPL      MACRO  N,I,CA 
 [AP_N    EQU    [AP_I+CA 
 EPL      ENDM
 LAP      SPACE  4,8
**        LAP - DEFINE LCM APLIST ITEM. 
  
  
          PURGMAC   LAP 
  
 LAP      MACRO  SYM,BIAS 
          VFD    1/1,59/SYM+BIAS
 LAP      ENDM
          EJECT 
*** 
*         MACROS ISSUED BY *POST*.
* 
 RJT      SPACE  4,8
**        RJT - DEFINE RETURN JUMP WITH TRACEBACK MACRO.
  
  
          PURGMAC   RJT 
  
 RJT      MACRO  SYM,LINE,FP
 +        RJ     SYM
          IFC    NE,//FP/,1 
          SUB    SYM
          IFLT   LINE,7777B,2 
-         VFD    12/LINE,18/TRACE.
          ELSE   3
-         VFD    12/-0,18/TRACE.
          SB0    0
          SB0    LINE 
 RJT      ENDM
 ED       SPACE  4,8
**        ED - OUTPUT EQ JUMP FOR *DEBUG* MODE FOR TRACED LABEL.
  
  
          PURGMAC   ED
  
 ED       MACRO  SYM,CA 
+         EQ     SYM
-         VFD    30/LABEL.+CA 
 ED       ENDM
 SUB      SPACE  4,8
**        SUB - RUN-TIME FORMAL PARAMETER SUBSTITUTION MACRO. 
  
  
          PURGMAC   SUB 
  
 SUB      MACRO  FP,CA
 .POS     SET    $+2001B-$/59*61
 .ORG     SET    *L-$/59
          USE    FP 
          IFEQ   *L,FP,1
 .DEL     SET    1
          IFEQ   .ORG,.FP,1 
 .DEL     SET    1
          VFD    12/.DEL*.POS,6/(FP,6/0,18/CA,18/.ORG 
 .DEL     SET    -1 
 .FP      SET    .ORG 
          USE    *
          ENDM
          SPACE  3
          END 
