*COMDECK  COMAMGM - MORE (LESS) GENERAL MACROS. 
          CTEXT  COMAMGM - MORE (LESS) GENERAL MACROS.
 COMAMGM  SPACE  4,10 
**        COMAMGM - MORE (LESS) GENERAL MACROS. 
* 
*         FTN 5 PROJECT.     77/06/29.
* 
*         COPYRIGHT CONTROL DATA CORPORATION. 1977. 
 COMAMGM  SPACE  4,10 
***       THE MORE (LESS) GENERAL MACROS PROVIDE THE USER WITH
*         MACROS WHICH ARE LESS COMMONLY USED THAN THOSE IN 
*         COMDECK *COMACPU*.
 BSSENT   SPACE  4,8
**        BSSENT - DEFINE A BSS ENTRY POINT.
* 
* SYM     BSSENT AEXP 
* 
*         ENTRY  *SYM* = ENTRY POINT NAME.
*                *AEXP* = NUMBER OF WORDS TO RESERVE. 
  
  
          PURGMAC BSSENT
  
          MACRO  BSSENT,S,A 
 S BSS A
  ENTRY S 
  ENDM
 BSZENT   SPACE  4,8
**        BSZENT - DEFINE A BSSZ ENTRY POINT. 
* 
* SYM     BSZENT AEXP 
* 
*         ENTRY  *SYM* = ENTRY POINT NAME.
*                *AEXP* = NUMBER OF ZERO WORDS TO RESERVE.
  
  
          PURGMAC BSZENT
  
          MACRO  BSZENT,S,A 
 S BSSZ A 
  ENTRY S 
  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
 BC       SPACE  4,10 
**        BC - CONVERT CHARACTER COUNT TO BIT COUNT.
* 
*         COMPUTES --  BIT COUNT = 6 * CHARACTER COUNT
* 
*         BC       X.RESULT,X.OPERAND 
* 
*         ENTRY  *X.RESULT*   =  X-REG TO RECEIVE BIT COUNT 
*                *X.OPERAND*  =  X-REG CONTAINING CHARACTER COUNT 
* 
*         USES   X.RESULT,X.OPERAND 
  
  
          PURGDEF   BC,X,X
  
 BC,X,X   OPDEF  R,P
  LX.R X.P,B1 
  LX.P 3
  IX.R X.P-X.R
  ENDM
 CONENT   SPACE  4,10 
**        CONENT - DEFINE A CON ENTRY POINT.
* 
* SYM     CONENT EXP
* 
*         ENTRY  *SYM* = ENTRY POINT NAME.
*                *EXP* = EXPRESSION VALUE.
  
  
          PURGMAC CONENT
  
          MACRO  CONENT,S,E 
S CON E 
  ENTRY S 
  ENDM
 CW       SPACE  4,20 
**        CW - CONVERT CHARACTER COUNT TO WORD COUNT. 
* 
*         COMPUTES--  WORD COUNT = (CHAR COUNT + 9) / 10
* 
* 
*         CW        X.RESULT,X.OPERAND
* 
*         ENTRY  *X.RESULT*  = X-REG TO RECEIVE INTEGER WORD COUNT
*                *X.OPERAND* = X-REG CONTAINING INTEGER CHARACTER COUNT 
* 
*         USES   A.RESULT, X.RESULT, X.OPERAND
  
  
          PURGDEF   CW,X,X
  
 CW,X,X   OPDEF  R,P
  SX.R 9D 
  IX.P X.R+X.P
  SA.R =00000631463146314632B 
  FX.R X.P*X.R
  ENDM
 EQUENT   SPACE  4,10 
**        EQUENT - DEFINE A EQU ENTRY POINT.
* 
* SYM     EQUENT EXP
* 
*                *SYM* = ENTRY POINT NAME.
*                *EXP* = EVALUATABLE EXPRESSION.
  
  
          PURGMAC EQUENT
  
          MACRO  EQUENT,S,E 
S EQU E 
  ENTRY S 
  ENDM
 EQUEXT   SPACE  4,10 
**        EQUEXT - DEFINE AN EQU EXTERNAL.
* 
* 
* SYM     EQUEXT EXT
* 
*         ENTRY  SYM = LOCATION FIELD FOR SYMBOL TO EQU.
*                EXT = EXTERNAL SYMBOL TO EQUATE TO.
  
  
          PURGMAC EQUEXT
  
          MACRO  EQUEXT,S,E 
  EXT E 
 S = E
 EQUEXT   ENDM
 HX,Q     SPACE  4,10 
**        HXQ - SHIFT FIELD TO HIGH ORDER.
* 
*         THIS OPDEF WILL SHIFT A FIELD TO THE HIGH ORDER PART
*         OF A WORD.  THE FIELD MUST HAVE BEEN DECLARED BY
*         DESCRIBE/DEFINE.  IN PARTICULAR, THE SYMBOLS "FLD_L", 
*         AND "FLD_P" MUST BE THE LENGTH AND LOW-BIT POSITION,
*         OF THE FIELD. 
* 
*         HXI    FLD
* 
*         ENTRY  *XI* = X-REG TO BE SHIFTED.
*                *FLD* = A FIELD DESCRIPTOR SYMBOL. 
* 
*         FOR MAXIMUM UTILITY, THE *LX,Q* NULL-SHIFT SUPPRESSION
*         OPDEF SHOULD ALSO BE DEFINED. 
  
  
          PURGDEF HXQ 
  
 HX,Q     OPDEF  I,FLD
  LX.I -FLD_L-FLD_P 
  ENDM
 ISUSE    SPACE  4,10 
**        ISUSE AND ISUSE$ - ISSUE USE PSEUDO.
* 
* 
*         ISUSE  BLOCK       =   I.USE  BN=BLOCK
*         ISUSE$ BLOCK       =  OC$USE  BN=BLOCK
* 
*         CALLS  WIN VIA WCODE. 
  
  
          PURGMAC ISUSE 
  
 ISUSE    MACRO  BLOCK
          =X1    =XBN=BLOCK 
          =X7    I.USE
          LX1    PB.BIASP 
          LX7    PB.GHIJP 
          WCODE  X1+X7
 ISUSE    ENDM
  
  
          PURGMAC ISUSE$
  
 ISUSE$   MACRO  BLOCK
          =X1    =XBN=BLOCK 
          =X7    OC$USE 
          LX1    PB.BIASP 
          LX7    PB.GHIJP 
          WCODE  X1+X7
 ISUSE$   ENDM
 LDBIT    SPACE  4,20 
***       LDBIT - SET ONE BIT IN A REGISTER.
* 
*         LDBIT  REG,BIT
* 
*         IF (BIT) IS .GT. 17, THEN (REG) MUST BE AN X-REGISTER.
  
  
 LDBIT    MACRO  G,V
  IF    DEF,V,6 
  IFGT  V,1,2 
  IFGE  *P,30,4 
  IFLT  V,17,3
A DECMIC V
  =G    1S"A" 
  SKIP  2 
  M_G   1 
  L_G   1+V 
  ENDM
 LDX      SPACE  4,20 
***       LDX - LOAD A REGISTER WITH A VALUE. 
* 
*         LDX    REG,VAL
* 
*         IF (VAL) IS .GE. 4S15, THEN (REG) MUST BE ONE OF [X1 .. X5],
*         AND THE CORRESPONDING A-REGISTER WILL BE USED TO LOAD A 
*         LITERAL.
  
  
 LDX      MACRO  REG,VAL
   IFEQ  VAL/1S17,,2
   =REG  VAL
.1 SKIP 
*                            LOAD LARGE VALUE VIA A LITERAL.
T  MICRO 1,1,.REG.
   IFC   NE, X "T" ,1 
   ERR  (REG) WONT HOLD (VAL)      "SEQUENCE" 
* 
N  MICRO 2,, REG
   IFNE  "N",0,1
   IFGE  "N",6,1
   ERR   (REG) MUST BE IN [X1 .. X5]          "SEQUENCE"
* 
   SA"N"  =VAL
.1 ENDIF
   ENDM 
 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 
  
  
          PURGDEF   ^XQ 
          PURGDEF   LXQ 
 ^XQ      CPOP      0,200B,100B 
  
 LXQ      OPDEF     I,JK
  IFNE JK,0,2 
  IFNE JK_&60D,0,1
  ^X.I JK 
  ENDM
 MOVEB    SPACE  4,10 
**        MOVEB -  MOVE BIT STRING. 
* 
*         MOVEB  BITCOUNT,SFWA,SFB,DFWA,DFB 
* 
*         ENTRY  *BITCOUNT* = BIT COUNT OF STRING 
*                *SFWA* = SOURCE FIRST WORD ADDRESS 
*                *SFB* = SOURCE FIRST BIT (0-9) 
*                *DFWA* = DESTINATION FIRST WORD ADDRESS
*                *DFB* = DESTINATION FIRST BIT (0-9)
* 
*         USES   X0,X2,X4,B2,B4 
* 
*         CALLS  MNS=        (CPU.MNX)
  
  
          PURGMAC MOVEB 
 MOVEB    MACRO  B,SFA,SFB,DFA,DFB
  =X0 B 
  =X2 SFA 
  =X4 DFA 
  =B2 SFB 
  =B4 DFB 
  RJ =XMNS= 
  ENDM
 MXX+X    SPACE  4,28 
**        MXX+X  - SELECT GREATER (MAXIMUM FUNCTION) OF TWO INTEGERS. 
* 
*         THIS OPDEF COMPARES TWO INTEGERS IN *XJ* AND *XK*, AND PLACES 
*         THE ALGEBRAICALLY GREATER VALUE IN *XI*.
* 
*         MXI    XJ+XK
* 
*         ENTRY  *XI* = RESULT X-REG, CANNOT BE *XJ* OR *XK*
*                *XJ*,*XK* = X-REGS CONTAINING INTEGERS TO BE COMPARED
* 
*         EXIT   (X.LARGER) = 0 
*                (X.SMALLER) = UNCHANGED
*         IF ON ENTRY (XJ)=(XK),
*            THEN ON EXIT (XJ)=0 AND (XK)=UNCHANGED 
*                (XI) = MAX(XJ,XK)
* 
*         USES   XI, XJ, XK 
  
  
          PURGDEF   MXX+X 
  
 MXX+X    OPDEF  I,J,K
  IX.I X.J-X.K
  AX.I -1 
  BX.J -X.I*X.J 
  BX.K X.I*X.K
  IX.I X.J+X.K
 MXX+X    ENDM
 MXX-X    SPACE  4,20 
**        MXX-X  - SELECT LESSER (MINIMUM FUNCTION) OF TWO INTEGERS.
* 
*         THIS OPDEF COMPARES TWO INTEGERS IN *XJ* AND *XK*, AND PLACES 
*         THE ALGEBRAICALLY LESSER VALUE IN *XI*. 
* 
*         MXI    XJ-XK
* 
*         ENTRY  *XI* = RESULT X-REG, CANNOT BE *XJ* OR *XK*
*                *XJ*,*XK* = X-REGS CONTAINING INTEGERS TO BE COMPARED
* 
*         EXIT   (X.LARGER) = 0 
*                (X.SMALLER) = UNCHANGED
*                IF ON ENTRY (XJ)=(XK)
*            THEN ON EXIT (XJ)=0 AND (XK)=UNCHANGED 
*                XI = MIN(XJ,XK)
* 
*         USES   XI, XJ, XK 
  
  
          PURGDEF   MXX-X 
  
 MXX-X    OPDEF  I,J,K
  IX.I X.J-X.K
  AX.I  -1
  BX.J X.I*X.J
  BX.K -X.I*X.K 
  IX.I X.J+X.K
 MXX-X    ENDM
 RMT=     SPACE  4,10 
**        RMT= - MACRO TO FORCE MICRO EVALUATION FOR REMOTES. 
* 
* BLOCK   RMT=   (S)
* 
*         *BLOCK* IS THE RMT BLOCK LABEL, IF ANY. 
*         (S) IS THE STATEMENT TO BE ENTERED INTO THAT RMT BLOCK. 
  
  
          MACRO  RMT=,BLK,S 
 BLK      RMT 
 S
 BLK      RMT 
 RMT=     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 ROUTINE NAME/ADDRESS
*         TABLES USED BY THE UTILITY ROUTINE *RPV=*.
*         FOR PROPER OPERATION, THIS MACRO MUST BE CALLED AT THE
*         BEGINNING OF EACH ROUTINE, BEFORE ANY OTHER INSTRUCTION OR
*         PSEUDO-OP THAT WOULD CAUSE THE LOCATION COUNTER TO BE 
*         ADVANCED BY COMPASS.
* 
* RNAM    RPVDEF ENAM 
* 
*         ENTRY  RNAM = ROUTINE NAME
*                ENAM = ENTRY POINT WILL BE B=*ENAM*.  IF *ENAM* IS 
*                       NULL, THE FIRST 5 CHARACTERS OF *RNAM* ARE
*                       APPENDED TO *B=*. 
  
  
          PURGMAC RPVDEF
  
          MACRO  RPVDEF,R,E 
  IFC EQ,/E//,2 
 '?RPV=A MICRO 1,7,/B=R     / 
  SKIP 1
 '?RPV=A MICRO 1,7,/B=E     / 
  NOREF "'?RPV=A" 
  ENTRY "'?RPV=A" 
 "'?RPV=A" BSS 0
  ENDM
 RPVFWA   SPACE  4,8
**        RPVFWA - DEFINE ENTRY FOR *RPV* NAME/ADDRESS TABLE. 
* 
*         RPVFWA NAM,FWA
* 
*         ENTRY  NAM = ROUTINE NAME 
*                FWA = ROUTINE FWA.  IF NULL, *B=XXXXX* IS USED, WHERE
*                      XXXXX ARE THE FIRST 5 CHARACTERS OF *NAM*. 
  
  
          PURGMAC RPVFWA
  
 RPVFWA   MACRO  NAM,FWA
  VFD 42/0L_NAM 
  IFC EQ,/FWA//,4 
'?RPV=A MICRO 1,5,/NAM     /
  VFD 18/=XB="'?RPV=A"
  NOREF B="'?RPV=A" 
  SKIP 1
  VFD 18/FWA
  ENDM
 RPVON    SPACE  4,10 
**        RPVON - TURN ON REPRIEVE PROCESSING.
* 
*         RPVON  FLAGS
* 
*         ENTRY  FLAGS = REPRIEVE FLAGS AS SPECIFIED IN THE NOS/BE
*                MANUAL.  NO B SUFFIX SHOULD BE USED.  IF NULL, 37B IS
*                ASSUMED. 
  
  
 RPVON    MACRO  FLAGS
  MX1 59
  SA2 =XRPV=
  BX6 X1*X2 
  SA6 A2+ 
  IFNE .OS,2,5
 '?RPV=A SET 37B
  IFC  NE,/FLAGS//,1
 '?RPV=A SET FLAGS_B
  SYSTEM RPV,R,=XRPV=,'?RPV=A*1S6 
  SKIP 1
  REPRIEVE =XRPV= 
  ENDM
 RPVOFF   SPACE  4,10 
**        RPVOFF - TURN OFF REPRIEVE PROCESSING.
* 
*         RPVOFF CELL 
* 
*         CELL   IF SPECIFIED, A CELL TO USE FOR SYSTEM CALL, 
*                  OTHERWISE, WORD 2 OF RPV EXCHANGE AREA IS USED.
  
  
 RPVOFF   MACRO  CELL 
  MX7 0 
  SA7 CELL  =XRPV=+1
  IFNE .OS,2,2
  SYSTEM RPV,R,A7 
  SKIP 1
          REPRIEVE   CELL 
  ENDM
 SBIT     SPACE  4,30 
**        SBIT - MACRO TO SHIFT A BIT INTO SIGN POSITION. 
* 
*         SBIT   XN,WHICH/OFFSET
* 
*         SHIFTS *XN* LEFT CIRCULAR UNTIL BIT 2**WHICH IS IN SIGN BIT,
*                POSITION.  *WHICH* MAY BE PRECEDED BY A MINUS SIGN.
*                IF THE REGISTER HAS ALREADY BEEN SHIFTED, THEN 
*                BIT 2**OFFSET IS THE BIT NOW AT 2**59. 
* 
*         TO RESTORE A REGISTER AFTER USING SBIT, DO A
*         --     LXN    WHICH+1    -- 
* 
*         OF COURSE, THE MACRO MAY BE USED TO POSITION TO ANY POSITION, 
*                (NOT JUST 2**59).  TO POSITION TO BIT *OTHER*, 
*         --     SBIT   XN,WHICH/OFFSET+A    --,
*                               WHERE *A* = MOD (OTHER+1,60). 
*                IN THIS CASE, HOWEVER, THE CODER MUST INSURE THAT THE
*                FINAL SHIFT COUNT IS IN THE RANGE COMPASS WILL ASSEMBLE
*                PROPERLY (I.E...  -60 .LE. COUNT .LE. 60). 
* 
*         IF THE FINAL SHIFT COUNT IS ZERO (AND PREVIOUSLY DEFINED),
*                NO INSTRUCTION WILL BE GENERATED.
* 
*         NOTE THAT *IFBIT* MAKES ASSUMPTIONS ABOUT SOME OF THE SCRATCH 
*                SYMBOLS USED BY *SBIT* -- USE CAUTION. 
  
  
 SBIT     MACRO  XN,WHICH 
 A        MICRO  1,1, WHICH 
 B        SET    1
          IFC    EQ, - "A" ,1 
 B        SET    2
 C        MICRO  B,,/WHICH/ 
 D        MICCNT C
 E        MICRO  B+D+1,, WHICH
          IFC    EQ,/"E"//,1
 E        MICRO  1,,/59/
          L_XN   "E"-"C"
 SBIT     ENDM
 SETMEM   SPACE  4,20 
**        SETMEM - SET BLOCK OF MEMORY TO A GIVEN VALUE.
* 
*         SETMEM FWA,LEN,VAL
* 
*         ENTRY  *FWA* = BLOCK ADDRESS
*                *LEN* = BLOCK LENGTH (IF NULL LEN=1) 
*                *VAL* = VALUE TO SET (IF NULL VAL=0) 
* 
*         EXIT   (B1) = 1 
* 
*         USES   X6, A6     (LEN .GT. 0)
*                X1         (LEN .GT. 2)
*                X2, X7, A7 (LEN .GE. 60, OR NOT ABS) 
* 
*         CALLS  SBM=       (LEN .GT. 60, OR NOT ABS) 
  
  
          PURGMAC SETMEM
  
 SETMEM   MACRO  F,L,V
  IF -DEF,B1=1,1
  SB1 1 
* 
.1 IFC NE, L
.2 IF DEF,L 
.2 IF ABS,L 
.2 IF -REG,L
.2 IFLT L,60
  IFGT L,0,2
  =X6 V 
  SA6 F 
  IFEQ L,2,1
  SA6 A6+B1 
  IFGT L,2,4
  MX1 L-1 
+ LX1 1 
  SA6 A6+B1 
  MI X1,* 
.2 ELSE 
  =X6 V 
  SA6 F 
  =X1 L 
  RJ =XSBM= 
.2 ENDIF
.1 ELSE 
  =X6 V 
  SA6 F 
.1 ENDIF
  ENDM
 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
  
 WXX      SPACE  4,10 
**        WXX - CONVERT CHARACTER COUNT TO WORD COUNT AND REMAINING 
*                CHARACTER COUNT. 
*         COMPUTES --  WORD COUNT = CHAR COUNT / 10 
*                      REMIN CHAR COUNT = CHAR COUNT - WORD COUNT * 10
* 
*         WX.WORDCNT         X.CHARCNT,X.REMAINCNT
* 
*         ENTRY  *X.C* = X-REG TO RECEIVE CHARACTER COUNT 
*         EXIT   *X.W* = X-REG CONTAINING INTEGER WORD COUNT
*                *X.R* = X-REG CONTAINING REMAINING CHAR COUNT
*         USES   *X.C*, *X.W*, *X.R*, *A.W* 
  
  
          PURGDEF            WXX,X
  
 WXX,X  OPDEF    W,C,R
  LOCAL TAG 
  SA.W =00000631463146314632B 
  FX.W X.C*X.W
  IX.R X.W+X.W
  IX.C X.C-X.R
  LX.R 2
  IX.R X.C-X.R
  PL X.R,TAG
  =X.C 1
  IX.W X.W-X.C
  SX.R X.R+10 
TAG BSS 0 
  ENDM
  
 COMAMGM  ENDX
