*DECK     MACROX
          IDENT  MACROX 
 MACROX   TITLE  MACROX - OBJECT CODE PRODUCTION DATA BASE
*CALL     SSTCALL 
 B=MACRX  RPVDEF
          LIST   -R          ** TURN OFF THE REF MAP ** 
 MACROX   SPACE  3
**        MACROX - OBJECT CODE PRODUCTION DATA BASE 
* 
*         MACROX CONTAINS 2 TABLES WHICH DEFINE THE CODE PRODUCED 
*         FOR A GIVEN "RLIST" MACRO CALL. 
* 
*         THE MACRO DESCRIPTOR TABLE, STARTING AT "MACDESC" CONTAINS
*         ONE WORD FOR EACH RLIST MACRO DESCRIBING -
*         THE NUMBER OF SYMBOLS, R NUMBERS, CONSTANTS, INTERMEDIATE 
*         PARAMETERS, AND THE FWA AND LENGTH OF THE MACRO.
* 
*         THE SECOND TABLE CONTAINS THE MACRO TEXT NECESSARY IN ORDER 
*         FOR *EMR* TO EXPAND THE MACRO INTO *IL* BY SUBSTITUTING 
*         THE ACTUAL PARAMETERS FROM THE MACRO CALL.
  
          USE    MACTEXT     MACRO TEXT BLOCK 
          USE    MACDESC     TABLE OF DESCRIPTORS 
 MACDESC  BSS    0
  
          ENTRY  MACORG 
 MACORG   EQU    100B        BASE NUMBER OF MACROX MACROS 
 MACNUM   SET    MACORG      INITIALIZE MACNUM
          ENTRY  F.MACD 
 F.MACD   EQU    MACDESC-MACORG    BASE OF MACRO DESCRIPTOR TABLE 
  
          ECHO   1,X=(SM,CM,RM,.UNUS) 
 X        SET    0
  
 AVAIL    MICRO  ,,          EMPTY
  
*         PARAMETER EXPANSION BUFFERS FOR *EMR* 
  
          RMT 
          USE    MACTEXT
          ENTRY  SBUF,RBUF,CBUF 
          LIST   D
 SBUF     BSSZ   SM+2        SYMBOL BUFFER
 RBUF     CON    0,1         R NUMBER BUFFER
          BSSZ   RM+2 
 CBUF     BSSZ   CM+3        CONSTANT PARAM BUFFER
          RMT 
 MACROS   TITLE  MACRO DEFINITIONS
**        DEFINE SYMBOLS USED IN RMACROS
*                PJ - J"TH PARAMETRIC R-NUMBER
*                IJ - J"TH INTERMEDIATE R-NUMBER
*                KJ - J"TH PARAMETRIC CONSTANT
*                THE J"TH PARAMETRIC SYMBOL IS REFERED TO BY ITS NUMBER.
  
 X        SET    1
          DUP    24 
 C        DECMIC X
 I"C"     EQU    1S15+X 
          NOREF  I"C" 
          IFLT   X,9,3
          NOREF  P"C",K"C"
 P"C"     EQU    X+1
 K"C"     EQU    X
 X        SET    X+1
          ENDD
 TYPEI SPACE 3
**        TYPEI - GENERATE TYPE I *IL* INSTRUCTION MACRO DEFINITION 
*                VFD  12/1S10+OC,16/RJ,16/RK,16/RI
  
          MACRO  TYPEI,NAM,OC,SS
 C        GETARG 23,4,(SS)
 Z        IFC    NE,/"C"/COMM/
 NAM      MACRO  RI,RJ,RK 
  VFD 12/OC,16/RJ,16/RK,16/RI 
IMAX MAX IMAX,RI-100000B
 NAM      ENDM
 Z        ELSE
 NAM      MACRO  RI,RJ,RK 
  IFGE RJ,RK,2
  VFD 12/OC,16/RJ,16/RK,16/RI 
          SKIP   2
  VFD 12/OC 
  VFD 16/RK,16/RJ,16/RI 
IMAX MAX IMAX,RI-100000B
 NAM      ENDM
 Z        ENDIF 
 TYPEI    ENDM
 TYPEII   SPACE  3
**        TYPEII - GENERATE TYPE II *IL* INSTRUCTION MACRO DEFINITION 
*                VFD  12/1S10+OC,18/IN,1/INFLAG,13/SO,16/RI 
*                INFLAG = 0 THEN *IN* IS CON, ELSE ORDINAL OF PARAMETER 
  
          MACRO  TYPEII,NAM,OC
 NAM      MACRO  RI,IN,SO 
  IFC LT,/IN/0/,2 
  VFD 12/OC,18/IN,14/1S13+SO,16/RI
  ELSE 1
  VFD 12/OC,18/IN,14/SO,16/RI 
IMAX MAX IMAX,RI-100000B
          ENDM
 TYPEIII  SPACE  4,8
**        TYPEIII - GENERATE TYPE III *IL* INSTRUCTION MACRO DEFINITION 
*         NOTE - FOR ACTUAL CA"X ( NUMBERS ), ABS(CA) < 4000B 
  
          MACRO  TYPEIII,NAM,OC 
 NAM      MACRO  RI,RF,CA,SY
  IFC LT,/CA/0/,2 
  VFD 12/OC,3/SY,12/CA,1/1,16/RF,16/RI
  ELSE 1
  VFD 12/OC,3/SY,12/CA,1/0,16/RF,16/RI
IMAX MAX IMAX,RI-100000B
TY3 SET TY3+1 
          ENDM
 XJUMPS   SPACE  3
**        TYPE III X-JUMPS
  
          ECHO   ,JT=("XJUMPS") 
  
 JT       MACRO  RI,IH
  VFD 12/2000B+OC.JPX,3/IH,12/JC.JT,33/RI 
 TY3 SET TY3+1
 JT       ENDM
  
 RJ_JT    MACRO  RI,RF,IH 
  VFD 12/2000B+OC.RJXJ,3/IH,12/JC.JT,17/RF,16/RI
 TY3 SET TY3+1
          ENDM
  
          ENDD
  
 ORX      OPSYN  OR          SAVE DEFINITION OF *OR* X-JUMP 
          PURGMAC OR
 TYPEIV   SPACE  3
**        TYPEIV - GENERATE TYPE IV *IL* INSTRUCTION MACRO DEFINITIONS
*                VFD  12/1S10+OC,18/CA,30/SY  ( CA IS ALWAYS A FORMAL CA
  
          MACRO  TYPEIV,NAM,OC
 NAM      MACRO  CA,SY
  VFD 12/OC,18/CA,30/SY 
          ENDM
 OPR      SPACE  3
**        OPR - MACRO TO DEFINE THE *IL* INSTRUCTION MACRO DEFINITIONS. 
  
          MACRO  OPR,NAME,SS
          IF     -DEF,/NODEF/NAME,3 
 T        GETARG 18,3,(SS)
 OC       OCTMIC OC.NAME+2000B
 NAME     TYPE"T" "OC"B,(SS)
          ENDM
 RMACRO   SPACE  3,14 
**        RMACRO - BEGIN *IL* MACRO DEFINITION
  
          MACRO  RMACRO,NAM,NSY,NR,NC 
          LOC    MACNUM 
 NAM      BSS    0
 TY3 SET 0
 IMAX SET 0 
 SM MAX SM,NSY
 RM MAX RM,NR 
 CM MAX CM,NC 
 MACNUM   SET    MACNUM+1 
          USE    MACTEXT
 FM       SET    *
 MP       SET    NC*10000B+NR*100B+NSY
          ENDM
 ENDR     SPACE  2
**        ENDR - TERMINATE A *RMACRO* DEFINITION. 
  
          MACRO  ENDR,MT
 LM SET *-FM
          USE    MACDESC
  ERRZR LM       MACRO TEXT MAY NOT BE EMPTY
  VFD 18/MP,6/IMAX,6/LM,6/.MT,6/-LM-TY3,18/FM 
          ENDM
 UNUSED   SPACE  2
**        UNUSED - DEFINE AN UNUSED RMACRO NUMBER 
  
 UNUSED   MACRO 
 MACNUM   OCTMIC MACNUM,3 
 AVAIL    MICRO  1,,/"AVAIL" "MACNUM"/
          USE    MACDESC
*                FORCE A MODE ERROR IN *MACROE* 
          CON    1S17+MACNUM
 MACNUM   SET    MACNUM+1 
 .UNUS    SET    .UNUS+1
          ENDM
 SODEF    SPACE  3
**        IN RLIST MACROS ONE MAY SPECIFY A SPECIFIC DESTINATION REGISTE
*         FOR THE *RI* OF AN INSTRUCTION BY IMMEDIATELY FOLLOWING IT
*         WITH A REGISTER STORE INSTRUCTION.
*         THE NAMES OF THE REGISTER APPEARS IN THE *SO* FIELD FOLLOWED
*         BY A PERIOD, AND PRECEEDED BY A T ONLY IF IT IS A TEMPORARY 
*         REGISTER STORE. 
  
          ECHO   3,R=(B,X),Z=(0,20B)
          ECHO   2,N=(0,1,2,3,4,5,6,7)
 R_N.     EQU    Z+N
 T_R_N.   EQU    SO.TLOCK+Z+N 
  
 A0.      EQU    10B         SO REG NUMBER FOR A0 
 SBR      EQU    B2.         SCRATCH B-REGISTER USED FOR INDEXED SHIFTS 
*                            JUMPS, UNPACKS, ETC
 NODEF    SPACE  3
**        THE BELOW OPCODES MAY NOT APPEAR IN MACROX
*         I.E. - IT IS IMPOSSIBLE FOR *EMR* TO PROPERLY EXPAND THEM, ETC
  
          QUAL   NODEF
          ECHO   1,N=(EOQ,BOS,DAR,PLD,PST,SLD,SST,SDL,SDS,DRL,DWL)
 N        EQU    1
  
          QUAL
*CALL     OPRDEFS 
          SPACE 3 
          PURGMAC TYPEI,TYPEII,TYPEIII,TYPEIV 
  
*         ADJUST DEFINITION OF *OR* SO IT CAN EXPAND TO AN INCLUSIVE OR 
*         OR THE *OR* X-JUMP. 
  
 IOR      OPSYN  OR 
          PURGMAC OR
  
 OR       MACRO  RI,RJ,RK 
          IFC    NE,/RK//,2 
          IOR    RI,RJ,RK 
          ELSE   1
          ORX    RI,RJ
          ENDM
 RJUSES   SPACE  3
**        REDEFINE THE UP, NR MACROS SO THAT THEY AUTOMATICALLY GENERATE
*         A REGISTER STORE ON THE *RJ* FIELD IF IT IS " 0 . 
  
 UP.      OPSYN  UP 
 NR.      OPSYN  NR 
          PURGMAC UP,NR 
  
 UP       MACRO  RI,RJ,RK 
          UP.    RI,RJ,RK 
          IFNE   RJ,0,1 
          RS     RJ,1,SO.RJLK+SBR 
          ENDM
  
 NR       MACRO  RI,RJ,RK 
          NR.    RI,RJ,RK 
          IFNE   RJ,0,1 
          RS     RJ,1,SO.RJLK+SBR 
          ENDM
  
*         PNR - PROTECTED NORMALIZE, CANNOT BE ELEMINATED BY *SQZ* .
  
 PNR      MACRO  RI,RJ,RK 
          NR.    RI,1,RK
          ENDM
 LDAP     SPACE  3
**        LDAP - LOAD APLIST ADDRESS
  
 LDAP     MACRO  CA,IH,RI 
          LD     RI,,CA,IH
          RS     RI,,X1.
          ENDM
          SPACE  3
**        DEFINE VALUES OF MACRO TYPE FOR *ENDR* MACRO
  
 .        EQU    0
 .LABEL   EQU    1           LABEL DEFINITION 
 .ENTRY   EQU    2           ENTRY. DEFINITION
 .EXIT    EQU    3           SUBROUTINE EXIT
 .UJP     EQU    4           UNCONDITIONAL JUMP MACRO 
 .IF      EQU    5           IF MACRO 
 .AGOTO   EQU    6           ASSIGNED GOTO
 .CGOTO   EQU    7           COMPUTED GOTO
 .RJX     EQU    8           MACRO WITH AN *RJX* TO AN EXT ROUTINE
 .REGST   EQU    9           MACRO WITH A *RS* THAT MIGHT BE SEPARATED
*                            FROM OPERATION DEFINING THE *RI*.
 .STORE   EQU    10          STORE TO PROGRAMMER DEFINED VARIABLES
 JUMPS    TITLE  UNCONDITIONAL JUMPS / LABEL DEFINITION 
 RETURN   RMACRO 1,0,0
          UJP    0,1
 EXIT     ENDR
  
 NSRETURN RMACRO 1,1,1
          LD     I1,1,K1     LOAD A0+ORDINAL
          SA     I2,I1
          RS     I2,,SO.TLOCK+SBR 
          LD     I3,0,0,1    LOAD TEMPA0. 
          EOS                * TO PREVENT THE *SA* FROM FLOATING
          SA     I4,I3       RESTORE A0 
          RS     I4,,A0.           *LOCK UNTIL NEXT UJP*
          JIN    I2 
 EXIT     ENDR
  
 PEND     RMACRO 2,0,2       EQ  END. / STOP. ( PROGRAM EXIT MACROS ) 
          LDAP   K2,2,I1
          UJP    0,1
 EXIT     ENDR
  
 ENTRY    RMACRO 1,0,0       ALTERNATE ENTRY POINT DEFINITION 
          ENT    0,1
 ENTRY    ENDR
  
 LABEL    RMACRO 1,0,0       LABEL DEFINITION 
          LAB    0,1
 LABEL    ENDR
  
 UJUMP    RMACRO 1,0,0       UNCONDITIONAL JUMP 
          UJP    0,1
 UJP      ENDR
  
 ASSIGN   RMACRO 2,0,1       ASSIGN LABEL TO IVAR 
          STT    I1,,,1      SXI   LABEL
          ST     I1,,K1,2 
 STORE    ENDR
  
 AGOTO    RMACRO 1,0,2       ASSIGNED GOTO , ( K2 = N.BRANCES IF OPT=2 )
          LD     I1,,K1,1 
          SA     I2,I1
          RS     I2,,SO.TLOCK+SBR 
          JIN    I2 
 AGOTO    ENDR
  
 CGOTO    RMACRO 2,1,3       COMPUTED GOTO
          FMA    I1,59
          IA     I2,P1,I1    R1 = X1-1
          S      I3,K1
          IA     I4,P1,I3    R2 = X1-N.BRANCH 
          IMP    I5,I4,I2    R3 = -R2+R1
          SXT    I6,I5
          KRS    I7,I6,59 
          FMA    I8,K3       I8 = -1 IF LINENUM > 4095 ELSE 0 
          IS     I9,P1,I8 
          STR    I10,I7,I9   R4 = 0 IF OUT OF RANGE 
          SA     I11,I10
          RS     I11,,SO.TLOCK+SBR
          JIN    I11,,,1
          LAB    0,1         #GLN  BSS  0 
          RJ6    K2,2        RJ  ACGOER$,12/LINE NUM,18/TRACE.
 CGOTO    ENDR
 RJX      TITLE  FUNCTION / SUBROUTINE CALL MACROS
*     REGISTER STORE MACROS FOR BASIC EXT ARGS.  THE 1ST 4 ARE USED IF
*   THE ARG IS A FUNCTION RESULT, OTHERWISE, THE LAST 4 ARE USED. 
  
 RI=X1    RMACRO 0,1,0       RI=X1
          XMT    I1,P1
          RS     I1,0,X1. 
          ENDR
  
 RI=X3    RMACRO 0,1,0       RI=X3
          XMT    I1,P1
          RS     I1,0,X3. 
          ENDR
  
 RI=X2    RMACRO 0,1,0       RI=X2
          XMT    I1,P1
          RS     I1,0,X2. 
          ENDR
  
 RI=X4    RMACRO 0,1,0       RI=X4
          XMT    I1,P1
          RS     I1,0,X4. 
          ENDR
  
 RI=X1.   RMACRO 0,1,0       RI=X1
          RS     P1,0,X1. 
 REGST    ENDR
  
 RI=X3.   RMACRO 0,1,0       RI=X3
          RS     P1,0,X3. 
 REGST    ENDR
  
 RI=X2.   RMACRO 0,1,0       RI=X2
          RS     P1,0,X2. 
 REGST    ENDR
  
 RI=X4.   RMACRO 0,1,0       RI=X4
          RS     P1,0,X4. 
 REGST    ENDR
 RJX      SPACE  3
*         RETURN JUMP MACROS
  
 BEFCALL  RMACRO 1,0,0       BASIC EXT FUNCTION CALL
          RJ3    0,1
 RJX      ENDR
  
 RJ60     RMACRO 1,0,1       RJ6 - NO APLIST
          RJ6    K1,1 
 RJX      ENDR
  
 GEFWOTR  RMACRO 2,0,2       GEN EXT CALL WITHOUT TRACEBACK 
          LDAP   K2,2,I1
          RJ3    0,1
 RJX      ENDR
  
 GEFCALL  RMACRO 2,0,2       GENERAL EXTERNAL FUNCTION CALL 
          LDAP   K2,2,I1
          RJ6    K1,1        AND CALL THE ROUTINE WITH TRACEBACK
 RJX      ENDR
 DEF      SPACE  3
 DEFX6    RMACRO 0,1,0       DEFINE X6=RI 
          DEF    P1,0,X6. 
          ENDR
  
 DEFX7    RMACRO 0,1,0       DEFINE X7=RI 
          DEF    P1,0,X7. 
          ENDR
  
 STEMP    RMACRO 1,1,1       STORE TO COMPILER GENERATED TEMPORARY
          ST     P1,,K1,1 
          ENDR
  
          UNUSED
 BASIC    TITLE  ARITH MACROS 
 DBLD     RMACRO 1,3,2       DBL LOAD 
          LD     P1,P2,K1,1 
          LD     P3,P2,K2,1 
          ENDR
  
 DBLSTR   RMACRO 1,3,2       DOUBLE STORE (MUST FOLLOW DBLE LOAD) 
          ST     P1,P2,K1,1 
          ST     P3,P2,K2,1 
 STORE    ENDR
  
 LOAD     RMACRO 1,2,1       SINGLE LOAD
          LD     P1,P2,K1,1 
          ENDR
  
 STORE    RMACRO 1,2,1       SINGLE STORE 
          ST     P1,P2,K1,1 
 STORE    ENDR
  
 XMIT     RMACRO 0,2,0       TRANSMIT 
          XMT    P1,P2
          ENDR
  
 DBLXMT   RMACRO 0,4,0       DBLE TRANSMIT (MUST FOLLOW SNGLE XMT)
          XMT    P1,P2
          XMT    P3,P4
          ENDR
  
          UNUSED
  
          UNUSED
  
          UNUSED
  
 SET.CON  RMACRO 0,1,1       SET R TO A CON 
          S      P1,K1
          ENDR
  
 SETR     RMACRO 1,2,1       SET RI=IH+CA+RF (SXTAMC EQU SETMC+1) 
          STT    P1,P2,K1,1 
          ENDR
  
 P2TON    RMACRO 0,2,1       (2**K)**N = SHIFT( MASK(1) , K+1 ) 
          FMA    I1,1 
          STT    I2,P1,K1    K1 = K + 1 
          RS     I2,,SO.TLOCK+SBR 
          ILS    P2,I2,I1 
          ENDR
  
 MASKZR   RMACRO 0,1,0       MXI   0
          CLR    P1,0 
          ENDR
  
 DBLZR    RMACRO 0,2,0       ZERO 2 REGISTERS 
          CLR    P1,0 
          CLR    P2,0 
          ENDR
  
 SDL      RMACRO 1,2,1       SNGLE TO DBLE LD (SDLMC EQU MZZMC+1) 
          LD     I1,0,K1,1
          XMT    P1,I1
          CLR    P2,0 
          ENDR
  
 MINUSZR  RMACRO 0,1,0       -0 
          FMA    P1,60
          ENDR
  
 DLTS     RMACRO 1,3,2       DBLE LD TO SNGLE (DLTSMC EQU MIZMC+1)
          LD     P1,P2,K1,1 
          ENDR
 MODECH   SPACE  4
**        MODE CHANGE MACROS
  
 ITOR     RMACRO 0,2,0,,10   INTEGER TO REAL
          PK     I1,0,P1
          NR     P2,0,I1
          ENDR
  
 ITODC    RMACRO 0,3,0       INTEGER TO DOUBLE OR COMPLEX 
          PK     I1,0,P1
          CLR    P3,0 
          NR     P2,0,I1
          ENDR
  
 RTOI     RMACRO 0,2,0,,10   REAL TO INTEGER
          UP     I1,I2,P1 
          ILS    P2,I2,I1 
          ENDR
  
 RDCOH.DC RMACRO 0,3,0       REAL,DBLE,CMPX,OCT,HOL TO DBL OR CMPX
          XMT    P2,P1
          CLR    P3,0 
          ENDR
  
 DTOR     RMACRO 0,2,0,,10   DOUBLE TO REAL 
          XMT    P2,P1
          ENDR
 REL-MAC  TITLE  LOGICAL/RELATIONAL MACROS
 .OR.     RMACRO 0,3,0       .OR. 
          OR     P1,P3,P2 
          ENDR
  
 .AND.    RMACRO 0,3,0       .AND.
          AND    P1,P3,P2 
          ENDR
  
 .NOT.    RMACRO 0,2,0
          XMTC   P1,P2
          ENDR
  
**        RELATIONAL MACROS 
  
 .LE.REAL RMACRO 0,3,0
          FS     I1,P3,P2 
          PNR    I2,,I1 
 #MD      IFEQ   .NRFCO,1 
          XMTC   P1,I2
 #MD      ELSE
          CLR    I3 
          IAZ    I4,I3,I2 
          XMTC   P1,I4
 #MD      ENDIF 
          ENDR
  
 .LE.INT  RMACRO 0,3,0
          IS     I1,P3,P2 
          CLR    I2 
          IAZ    I3,I2,I1 
          XMTC   P1,I3
          ENDR
  
 .LE.DBL  RMACRO 0,6,0
          DFS    I1,P3,P2 
          FS     I2,P6,P5 
          FS     I3,P3,P2 
          PNR    I4,,I3 
 #MD      IFEQ   .NRFCO,1 
          FA     I5,I2,I1 
          FA     I6,I5,I4 
          XMTC   P1,I6
 #MD      ELSE
          CLR    I5 
          IAZ    I6,I5,I4 
          FA     I7,I1,I2 
          FA     I8,I6,I7 
          XMTC   P1,I8
 #MD      ENDIF 
          ENDR
  
 .LE.CMPX RMACRO 0,6,0
          FS     I1,P3,P2 
          PNR    I2,,I1 
 #MD      IFEQ   .NRFCO,1 
          XMTC   P1,I2
 #MD      ELSE
          CLR    I3 
          IAZ    I4,I3,I2 
          XMTC   P1,I4
 #MD      ENDIF 
          ENDR
  
 .LT.REAL RMACRO 0,3,0
          FS     I1,P2,P3 
 #MD      IFEQ   .NRFCO,1 
          PNR    P1,,I1 
 #MD      ELSE
          NR     I2,0,I1
          CLR    I3 
          IAZ    P1,I3,I2 
 #MD      ENDIF 
          ENDR
  
 .LT.INT  RMACRO 0,3,0
          IS     I1,P2,P3 
          CLR    I2 
          IAZ    P1,I2,I1 
          ENDR
  
 .LT.DBL  RMACRO 0,6,0
          FS     I1,P5,P6 
          FS     I2,P2,P3 
          PNR    I3,,I2 
 #MD      IFEQ   .NRFCO,1 
          DFS    I4,P2,P3 
          FA     I5,I4,I1 
          FA     P1,I5,I3 
 #MD      ELSE
          CLR    I4 
          IAZ    I5,I4,I3 
          DFS    I6,P2,P3 
          FA     I7,I1,I6 
          FA     P1,I5,I7 
 #MD      ENDIF 
          ENDR
  
 .LT.CMPX RMACRO 0,6,0
          FS     I1,P2,P3 
 #MD      IFEQ   .NRFCO,1 
          PNR    P1,,I1 
 #MD      ELSE
          CLR    I2 
          IAZ    P1,I2,I1 
 #MD      ENDIF 
          ENDR
  
 .GE.REAL RMACRO 0,3,0
          FS     I1,P2,P3 
          PNR    I2,,I1 
 #MD      IFEQ   .NRFCO,1 
          XMTC   P1,I2
 #MD      ELSE
          CLR    I3 
          IAZ    I4,I3,I2 
          XMTC   P1,I4
 #MD      ENDIF 
          ENDR
  
 .GE.INT  RMACRO 0,3,0
          IS     I1,P2,P3 
          CLR    I2 
          IAZ    I3,I2,I1 
          XMTC   P1,I3
          ENDR
  
 .GE.DBL  RMACRO 0,6,0
          DFS    I1,P2,P3 
          FS     I2,P2,P3 
          PNR    I3,,I2 
 #MD      IFEQ   .NRFCO,1 
          FS     I4,P5,P6 
          FA     I5,I4,I1 
          FA     I6,I5,I3 
          XMTC   P1,I6
 #MD      ELSE
          CLR    I4 
          IAZ    I5,I4,I3 
          FS     I6,P5,P6 
          FA     I7,I1,I6 
          FA     I8,I5,I7 
          XMTC   P1,I8
 #MD      ENDIF 
          ENDR
  
 .GE.CMPX RMACRO 0,6,0
          FS     I1,P2,P3 
          PNR    I2,,I1 
 #MD      IFEQ   .NRFCO,1 
          XMTC   P1,I2
 #MD      ELSE
          CLR    I3 
          IAZ    I4,I3,I2 
          XMTC   P1,I4
 #MD      ENDIF 
          ENDR
  
 .GT.REAL RMACRO 0,3,0
          FS     I1,P3,P2 
 #MD      IFEQ   .NRFCO,1 
          PNR    P1,,I1 
 #MD      ELSE
          NR     I2,0,I1
          CLR    I3 
          IAZ    P1,I3,I2 
 #MD      ENDIF 
          ENDR
  
 .GT.INT  RMACRO 0,3,0
          IS     I1,P3,P2 
          CLR    I2 
          IAZ    P1,I2,I1 
          ENDR
  
 .GT.DBL  RMACRO 0,6,0
          FS     I2,P3,P2 
          FS     I1,P6,P5 
          PNR    I3,,I2 
 #MD      IFEQ   .NRFCO,1 
          DFS    I4,P3,P2 
          FA     I5,I4,I1 
          FA     P1,I5,I3 
 #MD      ELSE
          CLR    I4 
          IAZ    I5,I4,I3 
          DFS    I6,P3,P2 
          FA     I7,I1,I6 
          FA     P1,I5,I7 
 #MD      ENDIF 
          ENDR
  
 .GT.CMPX RMACRO 0,6,0
          FS     I1,P3,P2 
 #MD      IFEQ   .NRFCO,1 
          PNR    P1,,I1 
 #MD      ELSE
          NR     I2,0,I1
          CLR    I3 
          IAZ    P1,I3,I2 
 #MD      ENDIF 
          ENDR
  
 .NE.REAL RMACRO 0,3,0
          FS     I1,P2,P3 
          PNR    I2,,I1 
          CLR    I3 
          ISZ    I4,I3,I2 
 #MD      IFEQ   .NRFCO,1 
          OR     P1,I4,I2 
 #MD      ELSE
          IAZ    I5,I3,I2 
          OR     P1,I5,I4 
 #MD      ENDIF 
          ENDR
  
 .NE.INT  RMACRO 0,3,0
          CLR    I1 
          IS     I2,P2,P3 
          IAZ    I3,I2,I1 
          ISZ    I4,I1,I3 
          OR     P1,I4,I3 
          ENDR
  
 .NE.DBL  RMACRO 0,6,0
          FS     I1,P2,P3 
          FS     I2,P5,P6 
          PNR    I3,,I1 
          CLR    I4 
          PNR    I5,,I2 
 #MD      IFEQ   .NRFCO,1 
          OR     I6,I5,I3 
          ISZ    I7,I4,I6 
          OR     P1,I7,I6 
 #MD      ELSE
          IAZ    I6,I4,I3 
          IAZ    I7,I5,I4 
          OR     I8,I6,I7 
          ISZ    I9,I4,I8 
          OR     P1,I9,I8 
 #MD      ENDIF 
          ENDR
  
 .NE.CMPX RMACRO 0,6,0
          FS     I1,P2,P3 
          FS     I2,P5,P6 
          PNR    I3,,I1 
          CLR    I4 
          PNR    I5,,I2 
 #MD      IFEQ   .NRFCO,1 
          OR     I6,I5,I3 
          ISZ    I7,I4,I6 
          OR     P1,I7,I6 
 #MD      ELSE
          IAZ    I6,I4,I3 
          IAZ    I7,I5,I4 
          OR     I8,I6,I7 
          ISZ    I9,I4,I8 
          OR     P1,I9,I8 
 #MD      ENDIF 
          ENDR
  
 .EQ.REAL RMACRO 0,3,0
          FS     I1,P2,P3 
          PNR    I2,,I1 
          CLR    I3 
 #MD      IFEQ   .NRFCO,1 
          ISZ    I4,I3,I2 
          EQV    P1,I2,I4 
 #MD      ELSE
          IAZ    I4,I3,I2 
          ISZ    I5,I3,I4 
          EQV    P1,I4,I5 
 #MD      ENDIF 
          ENDR
  
 .EQ.INT  RMACRO 0,3,0
          IS     I1,P2,P3 
          CLR    I2 
          IAZ    I3,I2,I1 
          ISZ    I4,I2,I3 
          EQV    P1,I4,I3 
          ENDR
  
 .EQ.DBL  RMACRO 0,6,0
          FS     I1,P2,P3 
          PNR    I2,,I1 
          FS     I3,P5,P6 
          CLR    I4 
          PNR    I5,,I2 
 #MD      IFEQ   .NRFCO,1 
          OR     I6,I5,I2 
          ISZ    I7,I4,I6 
          EQV    P1,I7,I6 
 #MD      ELSE
          IAZ    I6,I4,I2 
          IAZ    I7,I4,I5 
          OR     I8,I6,I7 
          ISZ    I9,I4,I8 
          EQV    P1,I9,I8 
 #MD      ENDIF 
          ENDR
  
 .EQ.CMPX RMACRO 0,6,0
          FS     I1,P2,P3 
          PNR    I2,,I1 
          FS     I3,P5,P6 
          CLR    I4 
          PNR    I5,,I3 
 #MD      IFEQ   .NRFCO,1 
          OR     I6,I5,I2 
          ISZ    I7,I4,I6 
          EQV    P1,I7,I6 
 #MD      ELSE
          IAZ    I6,I4,I2 
          IAZ    I7,I4,I5 
          OR     I8,I6,I7 
          ISZ    I9,I4,I8 
          EQV    P1,I9,I8 
 #MD      ENDIF 
          ENDR
          TITLE  ARITHMETIC OPERATIONS
 SUB.REAL RMACRO 0,3,0       REAL - REAL
          FS     I1,P2,P3 
          NR     P1,0,I1
          ENDR
  
 SUB.INT  RMACRO 0,3,0       INTEGER - INTEGER
          IS     P1,P2,P3 
          ENDR
  
 SUBD     RMACRO 0,6,0       DOUBLE - DOUBLE
          FS     I1,P2,P3 
          DFS    I2,P2,P3 
          FS     I3,P5,P6 
          FA     I5,I3,I2 
          FA     I6,I5,I1 
          NR     I7,0,I6
          DFA    I8,I5,I1 
          NR     I9,0,I8     THIS IS IN CASE A-B=0
          FA     P1,I9,I7 
          DFA    P4,I9,I7 
          ENDR
  
 SUBC     RMACRO 0,6,0       COMPLEX - COMPLEX
          FS     I1,P2,P3 
          NR     P1,0,I1
          FS     I2,P5,P6 
          NR     P4,0,I2
          ENDR
  
 ADD.REAL RMACRO 0,3,0       REAL + REAL
          FA     I1,P3,P2 
          NR     P1,0,I1
          ENDR
  
 ADD.INT  RMACRO 0,3,0       INTEGER + INTEGER
          IA     P1,P3,P2 
          ENDR
  
 ADDD     RMACRO 0,6,0       DOUBLE + DOUBLE
          FA     I1,P3,P2 
          DFA    I2,P3,P2 
          FA     I3,P6,P5 
          FA     I5,I3,I2 
          FA     I6,I5,I1 
          NR     I7,0,I6     I4 AND I5 COULD HAVE OPPOSITE SIGNS
          DFA    I8,I5,I1 
          NR     I9,0,I8
          FA     P1,I9,I7 
          DFA    P4,I9,I7 
          ENDR
  
 ADDC     RMACRO 0,6,0       COMPLEX + COMPLEX
          FA     I1,P3,P2 
          NR     P1,0,I1
          FA     I2,P6,P5 
          NR     P4,0,I2
          ENDR
  
 MPY.REAL RMACRO 0,3,0       REAL * REAL
          FM     P1,P3,P2 
          ENDR
  
 MPY.INT  RMACRO 0,3,0       INTEGER * INTEGER
          IM     P1,P3,P2 
          ENDR
  
 MPYD     RMACRO 0,6,0       DOUBLE * DOUBLE
          FM     I1,P5,P3    I1=L(A)*H(B) 
          FM     I2,P2,P6    I2=H(A)*L(B) 
          FA     I3,I1,I2    I3=I1+I2 
          FM     I4,P2,P3    I4=H(A)*H(B) 
          DFM    I5,P2,P3    I5=H(A)L*H(B)
          FA     I6,I3,I5 
          FA     P1,I4,I6 
          DFA    P4,I4,I6 
          ENDR
  
 MPYC     RMACRO 0,6,0       COMPLEX * COMPLEX
          FM     I1,P2,P3    I1=R(A)*R(B) 
          FM     I2,P5,P6    I2=I(A)*I(B) 
          FS     I3,I1,I2    I3=I1-I2 
          NR     P1,0,I3     P1=N(I3) 
          FM     I4,P2,P6    I4=R(A)*I(B) 
          FM     I5,P5,P3    I5=I(A)*R(B) 
          FA     I6,I4,I5    I6=I4+I5 
          NR     P4,0,I6     P4=N(I6) 
          ENDR
  
 DIV.REAL RMACRO 0,3,0       REAL / REAL
          FD     P1,P2,P3 
          ENDR
  
 DIV.INT  RMACRO 0,3,0       INTEGER / INTEGER
          PK     I1,0,P3     I1=P(J)
          NR     I2,0,I1     I2=N(I1) 
          PK     I3,0,P2     I3=P(I)
          FD     I4,I3,I2 
          UP     I5,I6,I4 
          ILS    P1,I6,I5 
          ENDR
  
 DIVD     RMACRO 0,6,0       DOUBLE / DOUBLE
          FD     I1,P2,P3    I1=HA/HB 
          FM     I2,I1,P3    GET HIGH ORDER REMAINDER 
          FS     I3,P2,I2 
          DFS    I4,P2,I2 
          NR     I5,0,I3
          FA     I6,I4,I5 
          DFM    I7,I1,P3 
          FM     I8,I1,P6 
          FS     I9,P5,I7 
          FA     I10,I6,I9
          FS     I11,I10,I8 
          FD     I12,I11,P3 
          DFA    I13,I1,I12 
          FA     I14,I1,I12 
          NR     I15,0,I14
          FA     P1,I13,I15 
          DFA    P4,I13,I15 
          ENDR
  
 DIVC     RMACRO 0,6,0       COMPLEX / COMPLEX
          FM     I1,P2,P6    I1=A*D 
          FM     I2,P5,P3    I2=B*C 
          FS     I3,I2,I1    I3=I2-I1 
          NR     I4,0,I3     I4=NR(I3)
          FM     I5,P2,P3 
          FM     I6,P5,P6 
          FA     I7,I5,I6 
          NR     I8,0,I7     I8=N(A*C+B*D)
          FM     I9,P3,P3 
          FM     I10,P6,P6
          FA     I11,I9,I10 
          NR     I12,0,I11
          FD     P1,I8,I12
          FD     P4,I4,I12
          ENDR
  
 UMINUS   RMACRO 0,2,0       -REAL OR -INTEGER
          XMTC   P1,P2
          ENDR
  
 UMINUS2  RMACRO 0,4,0       -DOUBLE, -COMPLEX
          XMTC   P1,P2
          XMTC   P3,P4
          ENDR
  
 RMINR    RMACRO 0,3,0       -A + B 
          FS     I1,P3,P2 
          NR     P1,0,I1
          ENDR
  
 RMINI    RMACRO 0,3,0       REVERSE MINUS, INTEGER 
          IS     P1,P3,P2 
          ENDR
  
 RMIND    RMACRO 0,6,0       REVERSE MINUS, DOUBLE
          FS     I1,P3,P2 
          DFS    I2,P3,P2 
          FS     I3,P6,P5 
          FA     I5,I2,I3 
          FA     I6,I1,I5 
          NR     I7,0,I6
          DFA    I8,I1,I5 
          NR     I9,0,I8
          FA     P1,I7,I9 
          DFA    P4,I7,I9 
          ENDR
  
 RMINC    RMACRO 0,6,0       REVERSE MINUS, COMPLEX 
          FS     I1,P3,P2 
          NR     P1,0,I1
          FS     I2,P6,P5 
          NR     P4,0,I2
          ENDR
  
 RDIVR    RMACRO 0,3,0       REVERSE DIVIDE, REAL 
          FD     P1,P3,P2 
          ENDR
  
 DIVCR    RMACRO 0,6,0       COMPLEX / REAL 
          FD     P1,P2,P3 
          FD     P4,P5,P3 
          ENDR
  
 RDIVD    RMACRO 0,6,0       REVERSE DIVIDE, DOUBLE 
          FD     I1,P3,P2 
          FM     I2,I1,P2 
          FS     I3,P3,I2 
          DFS    I4,P3,I2 
          NR     I5,0,I3
          FA     I6,I4,I5 
          DFM    I7,I1,P2 
          FM     I8,I1,P5 
          FS     I9,P6,I7 
          FA     I10,I6,I9
          FS     I11,I10,I8 
          FD     I12,I11,P2 
          DFA    P4,I1,I12
          FA     P1,I1,I12
          ENDR
  
 RDIVC    RMACRO 0,6,0       REVERSE DIVIDE, COMPLEX
          FM     I1,P3,P5 
          FM     I2,P6,P2 
          FS     I3,I2,I1 
          NR     I4,0,I3
          FM     I5,P3,P2 
          FM     I6,P6,P5 
          FA     I7,I5,I6 
          NR     I8,0,I7
          FM     I9,P2,P2 
          FM     I10,P5,P5
          FA     I11,I9,I10 
          NR     I12,0,I11
          FD     P1,I8,I12
          FD     P4,I4,I12
          ENDR
          TITLE  ROUNDED OPERATION MACROS 
 SUBRREAL RMACRO 0,3,0       ROUNDED REAL SUBTRACT
          RFS    I1,P2,P3 
          NR     P1,0,I1
          ENDR
  
 SUBRCMPX RMACRO 0,6,0       ROUNDED COMPLEX SUBTRACT 
          RFS    I1,P2,P3 
          NR     P1,0,I1
          RFS    I2,P5,P6 
          NR     P4,0,I2
          ENDR
  
 ADDRREAL RMACRO 0,3,0       ROUNDED REAL ADD 
          RFA    I1,P2,P3 
          NR     P1,0,I1
          ENDR
  
 ADDRCMPX RMACRO 0,6,0       ROUNDED COMPLEX ADD
          RFA    I1,P2,P3 
          NR     P1,0,I1
          RFA    I2,P5,P6 
          NR     P4,0,I2
          ENDR
  
 MPYRREAL RMACRO 0,3,0       ROUNDED REAL MULTIPLY
          RFM    P1,P2,P3 
          ENDR
  
 MPYRCMPX RMACRO 0,6,0       ROUNDED COMPLEX MULTIPLY 
          RFM    I1,P2,P3 
          RFM    I2,P5,P6 
          RFS    I3,I1,I2 
          NR     P1,0,I3
          RFM    I4,P2,P6 
          RFM    I5,P5,P3 
          RFA    I6,I4,I5 
          NR     P4,0,I6
          ENDR
  
 DIVRREAL RMACRO 0,3,0       ROUNDED REAL DIVIDE
          RFD    P1,P2,P3 
          ENDR
  
 DIVRCMPX RMACRO 0,6,0       ROUNDED COMPLEX DIVIDE 
          RFM    I1,P2,P6    P2*P6
          RFM    I2,P5,P3    P5*P3
          RFS    I3,I2,I1 
          NR     I4,0,I3     P5*P3 - P2*P6
          RFM    I5,P2,P3    P2*P3
          RFM    I6,P5,P6    P5*P6
          RFA    I7,I5,I6 
          NR     I8,0,I7     P2*P3 + P5*P6
          RFM    I9,P3,P3    P3**2
          RFM    I10,P6,P6   P6**2
          RFA    I11,I9,I10 
          NR     I12,0,I11   P3**2 + P6**2
          RFD    P1,I8,I12   (P2*P3 + P5*P6)/(P3**2 + P6**2)
          RFD    P4,I4,I12   (P2*P3 + P5*P6)/(P3**2 + P6**2)
          ENDR
  
 RMINREAL RMACRO 0,3,0       ROUNDED REAL REVERSE SUBTRACT
          RFS    I1,P3,P2 
          NR     P1,0,I1
          ENDR
  
 RMINRCMP RMACRO 0,6,0       ROUNDED COMPLEX REVERSE SUBTRACT 
          RFS    I1,P3,P2 
          NR     P1,0,I1
          RFS    I2,P6,P5 
          NR     P4,0,I2
          ENDR
  
 RDIVRREL RMACRO 0,3,0       ROUNDED REAL REVERSE DIVIDE
          RFD    P1,P3,P2 
          ENDR
  
 RDIVRCMP RMACRO 0,6,0       ROUNDED COMPLEX REVERSE DIVIDE 
          RFM    I1,P3,P5    P3*P5
          RFM    I2,P6,P2    P6*P2
          RFS    I3,I2,I1 
          NR     I4,0,I3     P3*P5 - P6*P2
          RFM    I5,P3,P2    P3*P2
          RFM    I6,P6,P5    P6*P5
          RFA    I7,I5,I6 
          NR     I8,0,I7     P3*P2 + P6*P5
          RFM    I9,P2,P2    P2**2
          RFM    I10,P5,P5   P5**2
          RFA    I11,I9,I10 
          NR     I12,0,I11   P2**2 + P5**2
          RFD    P1,I8,I12   (P3*P2 + P6*P5)/(P2**2 + P5**2)
          RFD    P4,I4,I12   (P3*P5 - P6*P3)/(P2**2 + P5**2)
          ENDR
          TITLE  INTRINSIC FUNCTION MACROS
**        INTRINSIC FUNCTION MACRO SKELTONS 
  
  
 ABS      RMACRO 0,2,0
          SXT    I1,P1
          KRS    I2,I1,59 
          XOR    P2,I2,P1    B
          ENDR
  
          UNUSED
  
 DABS     RMACRO 0,4,0
          SXT    I1,P1
          KRS    I2,I1,59 
          XOR    P3,I2,P1    B
          XOR    P4,I2,P2    B
          ENDR
  
 AINT     RMACRO 0,2,0
          CLR    I1 
          PK     I2,0,I1
          FA     I3,I2,P1 
          NR     P2,0,I3
          ENDR
  
 INT      RMACRO 0,2,0
          UP     I1,I2,P1 
          ILS    P2,I2,I1 
          ENDR
  
 IDINT    RMACRO 0,3,0
          UP     I1,I2,P1 
          ILS    P3,I2,I1 
          ENDR
  
 AMOD     RMACRO 0,3,0
          FD     I1,P1,P2    F
          CLR    I2 
          PK     I3,0,I2
          FA     I4,I1,I3 
          NR     I5,0,I4
          FM     I6,I5,P2 
          DFM    I7,I5,P2 
          DFS    I8,P1,I6 
          FS     I9,P1,I6 
          FS     I10,I8,I7
          NR     I11,0,I9 
          FA     I12,I10,I11
          NR     P3,0,I12 
          ENDR
  
 MOD      RMACRO 0,3,0
          PK     I1,,P1 
          PK     I2,,P2 
          NR     I3,,I2 
          FD     I4,I1,I3 
          UP     I5,I6,I4 
          ILS    I7,I6,I5 
          IM     I8,I7,P2 
          IS     P3,P1,I8 
          ENDR
  
 FLOAT    RMACRO 0,2,0
          PK     I1,,P1 
          NR     P2,,I1 
          ENDR
  
 IFIX     RMACRO 0,2,0
          UP     I1,I2,P1 
          ILS    P2,I2,I1 
          ENDR
  
 SIGN     RMACRO 0,3,0
          XOR    I1,P1,P2 
          SXT    I2,I1
          KRS    I3,I2,59 
          XOR    P3,P1,I3 
          ENDR
  
 MODP2    RMACRO 0,2,1       MOD( I , 2**K1 ) 
          SXT    I1,P1
          KRS    I2,I1,59 
          XOR    I3,P1,I2          ABS(P1)
          FMA    I4,K1
          STR    I5,I4,I3 
          XOR    P2,I5,I2 
          ENDR
  
 DSIGN    RMACRO 0,6,0
          SXT    I1,P1
          KRS    I2,I1,59 
          XOR    I3,I2,P1 
          XOR    I4,I2,P2 
          SXT    I5,P3
          KRS    I6,I5,59 
          XOR    P5,I6,I3 
          XOR    P6,I6,I4 
          ENDR
  
 DIM      RMACRO 0,3,0
          FS     I1,P1,P2 
          NR     I2,0,I1
          SXT    I3,I1
          KRS    I4,I3,59 
          STR    P3,I4,I2 
          ENDR
  
 IDIM     RMACRO 0,3,0
          IS     I1,P1,P2 
          SXT    I2,I1
          KRS    I3,I2,59 
          STR    P3,I3,I1 
          ENDR
  
 SNGL     RMACRO 0,3,0
          XMT    P3,P1
          ENDR
  
 REAL     RMACRO 0,3,0
          XMT    P3,P1
          ENDR
  
 AIMAG    RMACRO 0,3,0
          XMT    P3,P2
          ENDR
  
 DBLE     RMACRO 0,3,0
          XMT    P2,P1
          CLR    P3,0 
          ENDR
  
 CMPLX    RMACRO 0,4,0
          XMT    P3,P1
          XMT    P4,P2
          ENDR
  
 CONJG    RMACRO 0,4,0
          CLR    I1,0 
          XMT    P3,P1
          ISZ    P4,I1,P2    NOT TO GENERATE -0.
          ENDR
  
 SHIFT    RMACRO 0,3,0
          SA     I1,P2
          RS     I1,,SO.TLOCK+SBR 
          ILS    P3,I1,P1 
          ENDR
  
 AND      RMACRO 0,3,0
          AND    P3,P2,P1 
          ENDR
  
 OR       RMACRO 0,3,0
          OR     P3,P2,P1 
          ENDR
  
 COMPL    RMACRO 0,2,0
          XMTC   P2,P1
          ENDR
  
 MASK     RMACRO 0,2,0       VARIABLE LENGTH MASK 
          FMA    I2,1        1S59 
          STT    I1,P1,-1    SHIFT COUNT - 1
          RS     I1,,SO.TLOCK+SBR 
          IRS    I3,I1,I2    CORRECT MASK IF CONST .GT. 0 
          SXT    I4,I3       MOVE RESULT
          KRS    I5,I4,59    EXTEND SIGN
          AND    P2,I5,I3 
          ENDR
  
 MASK(C)  RMACRO 0,1,1       MASK(CON)
          FMA    P1,K1
          ENDR
  
 KLSHIFT  RMACRO 0,2,1
          SXT    I1,P1
          KLS    P2,I1,K1 
          ENDR
  
 KRSHIFT  RMACRO 0,2,1
          SXT    I1,P1
          KRS    P2,I1,K1 
          ENDR
  
          UNUSED
  
 XOR      RMACRO 0,3,0       Y = XOR(A,B) 
          XOR    P3,P2,P1 
          ENDR
  
 COUNT    RMACRO 0,2,0       Y = COUNT(A) 
          CX     P2,P1
          ENDR
  
 UNPEXP   RMACRO 0,2,0       EXP = UNPEXP(A)
          UP     I1,I2,P1 
          SA     P2,I2       MOVE TO AN X REGISTER
          ENDR
  
 UNPCOE   RMACRO 0,2,0       COE = UNPCOE(A)
          UP     P2,0,P1     P2 = COEFFICIENT 
          ENDR
  
 PKEXPCO  RMACRO 0,3,0
          SA     I1,P1       MOVE EXPONENT TO A B REGISTER
          RS     I1,,SO.TLOCK+SBR 
          PK     P3,I1,P2 
          ENDR
  
 RANF(0)  RMACRO 1,1,0       Y = RANF(0)
          LD     I1,0,0,1    I1 = RANDOM.  ( SEED ) 
          LD     I2,0,1,1    I2 = RANMLT. ( MULTIPLIER )
*                                  LOCF(RANMLT.) = LOCF(RANDOM.)+1
          DFM    I3,I2,I1 
          NR     P1,0,I3     RESULT = NORM(I1*I2) 
          ST     I3,0,0,1    UPDATE SEED
          ENDR
  
 SETX     RMACRO 0,2,0       SHORT SET FUNCTION 
          SA     P2,P1
          ENDR
  
 DMULTF   RMACRO 0,3,0       P3 = D(P1*P2)
          DFM    P3,P2,P1 
          ENDR
  
 NORM     RMACRO 0,2,0       NORMALIZE ARGUMENT 
          NR     P2,0,P1
          ENDR
  
 NORMC    RMACRO 0,2,0       RETURN NORMALIZATION COUNT 
          NR     I2,I1,P1 
          SA     P2,I1
          ENDR
  
 IFTHEN   RMACRO 0,4,0       Y = IFTHEN(LOGICAL,A,B)
          SXT    I1,P1
          KRS    I2,I1,59 
          AND    I3,I2,P2    L & A
          STR    I4,I2,P3    ^L & B 
          IA     P4,I4,I3 
          ENDR
  
 FADD     RMACRO 0,3,0       Y = FADD(A,B)
          FA     P3,P2,P1 
          ENDR
  
 RADD     RMACRO 0,3,0       Y = RADD(A,B)
          RFA    P3,P2,P1 
          ENDR
  
 FSUB     RMACRO 0,3,0       Y = FSUB(A,B)
          FS     P3,P1,P2 
          ENDR
  
 RSUB     RMACRO 0,3,0       Y = RSUB(A,B)
          RFS    P3,P1,P2 
          ENDR
          TITLE  MAX/MIN MACROS 
 MAXI     RMACRO 0,3,0       MAX INTEGER
          IS     I1,P1,P2    I
          SXT    I2,I1       B
          KRS    I3,I2,59    A
          XOR    I4,P2,P1 
          AND    I5,I4,I3 
          XOR    P3,I5,P1 
          ENDR
  
 MAXR     RMACRO 0,3,0       MAX REAL 
          FS     I1,P1,P2 
          SXT    I2,I1
          KRS    I3,I2,59 
          XOR    I4,P2,P1 
          AND    I5,I4,I3 
          XOR    P3,I5,P1 
          ENDR
  
 MAXD     RMACRO 0,6,0       MAX DOUBLE 
          FS     I1,P1,P3    GET SIGN OF ARG1-ARG2
          DFS    I2,P1,P3 
          FS     I3,P2,P4 
          NR     I4,0,I1
          FA     I5,I2,I3 
          FA     I6,I4,I5 
          SXT    I7,I6       EXTEND SIGN
          KRS    I8,I7,59 
          XOR    I9,P1,P3 
          XOR    I10,P2,P4
          AND    I11,I8,I9
          XOR    P5,I11,P1
          AND    I12,I8,I10 
          XOR    P6,I12,P2
          ENDR
  
 MINI     RMACRO 0,3,0       MIN INTEGER
          IS     I1,P1,P2 
          SXT    I2,I1
          KRS    I3,I2,59 
          XOR    I4,P2,P1 
          AND    I5,I4,I3 
          XOR    P3,I5,P2 
          ENDR
  
 MINR     RMACRO 0,3,0       MIN REAL 
          FS     I1,P1,P2 
          SXT    I2,I1
          KRS    I3,I2,59 
          XOR    I4,P2,P1 
          AND    I5,I4,I3 
          XOR    P3,I5,P2 
          ENDR
  
 MIND     RMACRO 0,6,0       MIN DOUBLE 
          FS     I1,P1,P3 
          DFS    I2,P1,P3 
          FS     I3,P2,P4 
          NR     I4,0,I1
          FA     I5,I2,I3 
          FA     I6,I4,I5 
          SXT    I7,I6
          KRS    I8,I7,59 
          XOR    I9,P1,P3 
          XOR    I10,P2,P4
          AND    I11,I8,I9
          XOR    P5,I11,P3
          AND    I12,I8,I10 
          XOR    P6,I12,P4
          ENDR
 I/O-MAC  TITLE  I/O MACROS 
*         FORMAT I/O LIST ELEMENT AT EXECUTION TIME 
  
 IOAPL    RMACRO 0,3,1       12/TYPE,24/ITEMCT,24/ADDR
          S      I1,K1          K1      P1        P2
          SXT    I2,I1
          KLS    I3,I2,48 
          FMA    I4,36
          STR    I5,I4,P1 
          SXT    I6,I5
          KLS    I7,I6,24 
          OR     I8,I7,I3 
          IA     P3,I8,P2 
          ENDR
  
 SSORI    RMACRO 0,2,2       SET, SHIFT, OR 
          S      I1,K1
          SXT    I2,I1
          KLS    I3,I2,K2 
          OR     P1,I3,P2 
          ENDR
  
 MSORI    RMACRO 0,2,2             MASK, SHIFT, OR
          FMA    I1,K1
          SXT    I2,I1
          KLS    I3,I2,K2 
          OR     P1,I3,P2 
          ENDR
  
*         MACROS TO COMPUTE PRODUCT OF DIMENSIONS OF AN ARRAY 
  
 V1       RMACRO 3,1,1
          LD     I1,0,0,1 
          XMT    P1,I1
          ENDR
  
 V2       RMACRO 3,1,1
          LD     I1,0,0,1 
          LD     I2,0,0,2 
          IM     P1,I2,I1 
          ENDR
  
 V3       RMACRO 3,1,1
          LD     I1,0,0,1 
          LD     I2,0,0,2 
          LD     I3,0,0,3 
          IM     I4,I2,I1 
          IM     P1,I4,I3 
          ENDR
  
 V1C1     RMACRO 3,1,1
          LD     I1,0,0,1 
          S      I2,K1
          IM     P1,I2,I1 
          ENDR
  
 V2C1     RMACRO 3,1,1
          LD     I1,0,0,1 
          LD     I2,0,0,2 
          S      I3,K1
          IM     I4,I2,I1 
          IM     P1,I4,I3 
          ENDR
  
 BCM.V30  RMACRO 3,1,1
          LD     I1,0,0,1 
          LD     I2,0,0,2 
          LD     I3,0,0,3 
          IM     I4,I2,I1 
          IA     I5,I3,I3 
          IM     P1,I5,I4 
          ENDR
  
**        COLLAPSED I/O LIST MACROS 
*         PARAMETERS USED --
*                   1        I/O ROUTINE NAME SYMBOL ORDINAL
*                   2,K2     FIRST VARIABLE (BASE,BIAS) 
*                   3,K3     SECOND VARIABLE (BASE,BIAS) IF PRESENT 
*                   K1       CONSTANT (OR CONSTANT MULTIPLIER)
*                   K3       (SECOND CONSTANT IF PRESENT) 
*                   P1       FIRST WORD ADDRESS 
*                   P2       LAST WORD ADDRESS + 1 OR 
*                            R-NUMBER TO PLACE LENGTH INTO
  
 IOLP1C   RMACRO 4,6,4       LENGTH = CON 
          S      I1,K1
          SXT    I2,I1
          KLS    I3,I2,24 
          S      I4,K4
          SXT    I5,I4
          KLS    I6,I5,48 
          OR     I7,I3,I6 
          IA     P1,P2,I7 
          ENDR
  
 IOLCVMC  RMACRO 4,6,4       P2=FWA, LEN=CON*(VAR-CON)
          LD     I1,,K2,2 
          S      I2,K3
          IS     I3,I1,I2 
          S      I4,K1
          IM     P1,I3,I4 
          ENDR
  
 IOLCCMV  RMACRO 4,6,4       LEN=CON*(CON-VAR)
          LD     I1,,K2,2 
          S      I2,K3
          IS     I3,I2,I1 
          S      I4,K1
          IM     P1,I3,I4 
          ENDR
  
 IOLCVMV  RMACRO 4,6,4       LEN=CON*(VAR-VAR)
          LD     I1,,K2,2 
          LD     I2,,K3,3 
          IS     I3,I2,I1    L-1=VAR-VAR
          FMA    I4,59
          IS     I5,I3,I4 
          S      I6,K1
          IM     P1,I5,I6 
          ENDR
  
 IOLCV    RMACRO 4,6,4       LEN=CON*VAR
          LD     I1,,K2,2 
          S      I2,K1
          IM     P1,I1,I2 
          ENDR
  
 IOLP1P2  RMACRO 4,6,4       LENGTH = LWA+1 - FWA 
          IS     I1,P3,P2 
          S      I9,K4
          SXT    I10,I9 
          KLS    I11,I10,48 
          FMA    I12,36 
          STR    I13,I12,I1 
          SXT    I14,I13
          KLS    I15,I14,K1 
          OR     I16,I11,I15
          IA     P1,P2,I16
          ENDR
 IF-MAC   TITLE  IF MACROS
 IF(R)123 RMACRO 3,2,0       IF (REAL   )  1, 2, 3
          ZR     P1,2 
          PL     P1,3 
          UJP    0,1
 IF       ENDR
 IF(I)123 EQU    IF(R)123 
 IF(D)123 EQU    IF(R)123 
  
 IF(R)122 RMACRO 3,2,0       IF (REAL   )  1, 2, 2
 #MD      IFEQ   .NRFCO,1 
          PNR    I1,,P1 
          PL     I1,2 
 #MD      ELSE
          CLR    I1 
          IAZ    I2,I1,P1 
          PL     I2,2 
 #MD      ENDIF 
          UJP    0,1
 IF       ENDR
  
 IF(I)122 RMACRO 3,2,0       IF (INTEGER)  1, 2, 2
          CLR    I1 
          IAZ    I2,I1,P1 
          PL     I2,2 
          UJP    0,1
 IF       ENDR
 IF(D)122 EQU    IF(R)122 
  
 IF(R)113 RMACRO 3,2,0       IF (REAL   )  1, 1, 3
 #MD      IFEQ   .NRFCO,1 
          XMTC   I1,P1
          PNR    I2,,I1 
 #MD      ELSE
          CLR    I1 
          ISZ    I2,I1,P1 
 #MD      ENDIF 
          PL     I2,1 
          UJP    0,3
 IF       ENDR
  
 IF(I)113 RMACRO 3,2,0       IF (INTEGER)  1, 1, 3
          CLR    I1 
          ISZ    I2,I1,P1 
          PL     I2,1 
          UJP    0,3
 IF       ENDR
 IF(D)113 EQU    IF(R)113 
  
 IF(R)121 RMACRO 3,2,0       IF (REAL   )  1, 2, 1
          ZR     P1,2 
          UJP    0,1
 IF       ENDR
 IF(I)121 EQU    IF(R)121 
 IF(D)121 EQU    IF(R)121 
  
 IF(R)N23 RMACRO 3,2,0       IF (REAL   )  N, 2, 3
          ZR     P1,2 
          PL     P1,3 
 IF       ENDR
 IF(I)N23 EQU    IF(R)N23 
 IF(D)N23 EQU    IF(R)N23 
  
 IF(R)1N3 RMACRO 3,2,0       IF (REAL   )  1, N, 3
 #MD      IFEQ   .NRFCO,1 
          PNR    I1,,P1 
          MI     I1,1 
          NZ     I1,3 
 #MD      ELSE
          CLR    I1 
          IAZ    I2,I1,P1 
          MI     I2,1 
          NZ     I2,3 
 #MD      ENDIF 
 IF       ENDR
  
 IF(I)1N3 RMACRO 3,2,0       IF (INTEGER)  1, N, 3
          CLR    I1 
          IAZ    I2,I1,P1 
          MI     I2,1 
          NZ     I2,3 
 IF       ENDR
 IF(D)1N3 EQU    IF(R)1N3 
  
 IF(R)12N RMACRO 3,2,0       IF (REAL   )  1, 2, N
          ZR     P1,2 
          MI     P1,1 
 IF       ENDR
 IF(I)12N EQU    IF(R)12N 
 IF(D)12N EQU    IF(R)12N 
  
 IF(R)N22 RMACRO 3,2,0       IF (REAL   )  N, 2, 2
 #MD      IFEQ   .NRFCO,1 
          PNR    I1,,P1 
          PL     I1,2 
 #MD      ELSE
          CLR    I1 
          IAZ    I2,I1,P1 
          PL     I2,2 
 #MD      ENDIF 
 IF       ENDR
  
 IF(I)N22 RMACRO 3,2,0       IF (INTEGER)  N, 2, 2
          CLR    I1 
          IAZ    I2,I1,P1 
          PL     I2,2 
 IF       ENDR
 IF(D)N22 EQU    IF(R)N22 
  
 IF(R)1NN RMACRO 3,2,0       IF (REAL   )  1, N, N
 #MD      IFEQ   .NRFCO,1 
          PNR    I1,,P1 
          MI     I1,1 
 #MD      ELSE
          CLR    I1 
          IAZ    I2,I1,P1 
          MI     I2,1 
 #MD      ENDIF 
 IF       ENDR
  
 IF(I)1NN RMACRO 3,2,0       IF (INTEGER)  1, N, N
          CLR    I1 
          IAZ    I2,I1,P1 
          MI     I2,1 
 IF       ENDR
 IF(D)1NN EQU    IF(R)1NN 
  
 IF(R)NN3 RMACRO 3,2,0       IF (REAL   )  N, N, 3
 #MD      IFEQ   .NRFCO,1 
          XMTC   I1,P1
          PNR    I2,,I1 
          MI     I2,3 
 #MD      ELSE
          CLR    I1 
          ISZ    I2,I1,P1 
          MI     I2,3 
 #MD      ENDIF 
 IF       ENDR
  
 IF(I)NN3 RMACRO 3,2,0       IF (INTEGER)  N, N, 3
          CLR    I1 
          ISZ    I2,I1,P1 
          MI     I2,3 
 IF       ENDR
 IF(D)NN3 EQU    IF(R)NN3 
  
 IF(R)11N RMACRO 3,2,0       IF (REAL   )  1, 1, N
 #MD      IFEQ   .NRFCO,1 
          XMTC   I1,P1
          PNR    I2,,I1 
          PL     I2,1 
 #MD      ELSE
          CLR    I1 
          ISZ    I2,I1,P1 
          PL     I2,1 
 #MD      ENDIF 
 IF       ENDR
  
 IF(I)11N RMACRO 3,2,0       IF (INTEGER)  1, 1, N
          CLR    I1 
          ISZ    I2,I1,P1 
          PL     I2,1 
 IF       ENDR
 IF(D)11N EQU    IF(R)11N 
  
 IF(R)N2N RMACRO 3,2,0       IF (REAL   )  N, 2, N
          ZR     P1,2 
 IF       ENDR
 IF(I)N2N EQU    IF(R)N2N 
 IF(D)N2N EQU    IF(R)N2N 
  
 IF(R)1N1 RMACRO 3,2,0       IF (REAL   )  1, N, 1
          NZ     P1,1 
 IF       ENDR
 IF(I)1N1 EQU    IF(R)1N1 
 IF(D)1N1 EQU    IF(R)1N1 
 LOGICAL  SPACE  3
**        LOGICAL IF MACROS 
  
 IF(L)12  RMACRO 3,2,0       IF (LOGICAL)  1, 2 
          MI     P1,1 
          UJP    0,2
 IF       ENDR
  
 IF(L)N2  RMACRO 3,2,0       IF (LOGICAL)  N, 2 
          PL     P1,2 
 IF       ENDR
  
 IF(L)1N  RMACRO 3,2,0       IF (LOGICAL)  1, N 
          MI     P1,1 
 IF       ENDR
  
 IF(C)121 RMACRO 3,2,0
          NZ     P1,1 
          NZ     P2,1 
          UJP    0,2
 IF       ENDR
  
 IF(C)N2N RMACRO 3,2,0
          CLR    I1 
          IAZ    I2,P1,I1 
          IAZ    I3,P2,I1 
          OR     I4,I2,I3 
          FMA    I5,59
          IA     I6,I4,I5 
          EQV    I7,I6,I4 
          PL     I7,2 
 IF       ENDR
  
 IF(C)1N1 RMACRO 3,2,0
          NZ     P1,1 
          NZ     P2,1 
 IF       ENDR
  
 IF(R)111 RMACRO 3,2,0,A     IF (REAL   )  1, 1, 1
          UJP    0,1
 UJP      ENDR
 LD-LD    TITLE  LCM LOAD MACROS
 INDMDLD  RMACRO 4,6,4       INDIRECT MODE LCM LOAD 
          LD     I1,0,K1,1
          XMT    P1,I1
          ST     P1,0,K2,2
          ENDR
 DEBUG    SPACE  4,10 
*         MACROS FOR DEBUG MODE 
  
 JPB0     RMACRO 0,0,0
          CLR    I1,0        FUDGE A ZERO TO GET THORUGH *SQZ*
          JIN    I1 
          ENDR
 FCLSPP   SPACE  3,14 
 #T       IFNE   TEST,0 
*         DEFINITIONS OF SPECIAL INLINE FUNCTIONS FOR *FCL* PROJECT 
  
 FMULT    RMACRO 0,3,0
          FM     P3,P2,P1 
          ENDR
  
 RMULT    RMACRO 0,3,0
          RFM    P3,P2,P1 
          ENDR
  
 FDIV     RMACRO 0,3,0
          FD     P3,P1,P2 
          ENDR
  
 DADD     RMACRO 0,3,0
          DFA    P3,P1,P2 
          ENDR
  
 DSUB     RMACRO 0,3,0
          DFS    P3,P1,P2 
          ENDR
  
 RNORM    RMACRO 0,2,0
          RNZ    P2,0,P1
          ENDR
  
 DSUMH    RMACRO 0,6,0
          FA     P5,P1,P3 
          DFA    I1,P1,P3 
          FA     I2,P2,P4 
          FA     P6,I1,I2 
          ENDR
  
 DDIFH    RMACRO 0,6,0
          FS     P5,P1,P3 
          DFS    I1,P1,P3 
          FS     I2,P2,P4 
          FA     P6,I1,I2 
          ENDR
  
 DDIVH    RMACRO 0,6,0
          FD     P5,P1,P3 
          FM     I2,P5,P3 
          FS     I3,P1,I2 
          DFS    I4,P1,I2 
          NR     I5,0,I3
          FA     I6,I4,I5 
          DFM    I7,P5,P3 
          FM     I8,P5,P4 
          FS     I9,P2,I7 
          FA     I10,I6,I9
          FS     I11,I10,I8 
          FD     P6,I11,P3
          ENDR
  
 DMULH    RMACRO 0,6,0
          FM     P5,P1,P3 
          FM     I1,P2,P3 
          FM     I2,P1,P4 
          FA     I3,I1,I2 
          DFM    I5,P1,P3 
          FA     P6,I3,I5 
          ENDR
  
 BOOL     RMACRO 0,2,0
          XMT    P2,P1
          ENDR
 #T       ENDIF 
 DO-MAC   TITLE  DO BEGIN/END MACROS
          ENTRY  DOBGN,DOEND
 DOBGN    EQU    MACNUM      BASE OF DO BEGIN MACROS
  
 DOI=CON  RMACRO 5,1,4       DO N I = CON 
          S      P1,K1
          ST     P1,,K4,5    I = CON
          ENDR
  
 DOI=VAR  RMACRO 5,1,4       DO N I = VAR 
          LD     I1,,K1,2 
          XMT    P1,I1
          ST     P1,,K4,5 
          ENDR
  
 DOI=EXP  RMACRO 5,1,4       DO N I = EXP 
          XMT    I1,P1
          ST     I1,,K4,5 
          ENDR
  
 DOEND    EQU    MACNUM      BASE OF DO END MACROS
  
 DOXCC    RMACRO 5,1,4       DO N I = B,CC,CD 
          LD     I1,,K4,5 
          STT    I2,I1,K3    I = I + D
          ST     I2,,K4,5 
          STT    I3,I2,K2 
          MI     I3,1 
          ENDR
  
 DOXCV    RMACRO 5,1,4       DO N I = B,CC,SD 
          LD     I1,,K4,5 
          LD     I2,,K3,4 
          IA     I3,I2,I1    I = I + D
          ST     I3,,K4,5 
          STT    I4,I3,K2 
          MI     I4,1 
          ENDR
  
 DOXVC    RMACRO 5,1,4       DO N I = B,SC,D
          LD     I1,,K4,5 
          STT    I2,I1,K3    I = I + D
          ST     I2,,K4,5 
          LD     I3,,K2,3 
          IS     I4,I3,I2 
          PL     I4,1        IF( I @ D ) GO TO )XX
          ENDR
  
 DOXVV    RMACRO 5,1,4       DO N I = B,SC,SD 
          LD     I1,,K4,5 
          LD     I2,,K3,4 
          IA     I3,I2,I1    I = I + D
          ST     I3,,K4,5 
          LD     I4,,K2,3 
          IS     I5,I4,I3 
          PL     I5,1        IF( I @ D ) GO TO )XX
          ENDR
          SPACE  4
          LIST   L,A
 U        EQU    .UNUS       NUMBER OF UNUSED MACROS
  
*                            ** LIST OF UNUSED R-MACRO NUMBERS ** 
  
          NIL    "AVAIL"
  
          END    FTN22
