*COMDECK  CCOMGCM            GENERAL COMPILER MACROS
          CTEXT  CCOMGCM - GENERAL COMPILER MACROS
 LXQ      SPACE  3,18 
**        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
 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 THE CRADLE).
*         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. 
* 
* RNAM    RPVDEF ENAM 
* 
*         ENTRY  RNAM = ROUTINE NAME
*                ENAM = ENTRY POINT WILL BE B=*ENAM*.  IF ENAM IS 
*                        ABSENT, THE FIRST 5 CHARACTERS OF *RNAM* ARE 
*                        APPENDED TO *B=* ( IF NOT PRESENT ALREADY ). 
  
          PURGMAC RPVDEF
  
          MACRO  RPVDEF,R,E 
 '?RPV=A  MICRO  1,7, R 
          IFC    NE,/E//,1
 '?RPV=A  MICRO  1,7, E 
 '?RPV=B  MICRO  1,2, "'?RPV=A" 
          IFC    NE,/"'?RPV=B"/B=/,1
 '?RPV=A  MICRO  1,7, B="'?RPV=A" 
          NOREF  "'?RPV=A"
          ENTRY  "'?RPV=A"
 "'?RPV=A"  BSS  0
 RPVDEF   ENDM
 RPVFWA   SPACE  3,14 
**        RPVFWA - DEFINE ENTRY POINT FOR *RPV* NAME/ADDRESS TABLE. 
* 
*         RPVFWA NAM,FWA
* 
*                NAM = ROUTINE NAME 
*                FWA = ROUTINE FWA.  IF ABSENT, *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 
 RPVFWA   ENDM
 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,NBL
* 
*         ENTRY  *BUF*   = FIRST WORD ADDRESS OF LINE BUFFER
*                *WORDS* = LINE LENGTH (WORDS)
*                *NBL* = NUMBER OF BLANK LINES TO BE PRINTED BEFORE 
*                        DATA IN LINE BUFFER.  IF NBL > LINES REMAINING 
*                        THEN A PAGE EJECT IS DONE. 
* 
*         USES   X6, B6, B7 
* 
*         CALLS  FA=LOL ( CCOMLOL ) 
  
  
          PURGMAC   LISTL 
  
 LISTL    MACRO  S,N,NBL
          R=     B6,S 
* 
          IFC    EQ, N  ,1
          ERR    NO LENGTH "SEQUENCE" 
* 
          R=     B7,N 
* 
          SX6    NBL 0
* 
          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 ( CCOMLOL ) 
  
  
          PURGMAC   NUPAGE
  
 NUPAGE   MACRO 
          RJ     =XFA=NPG 
 NUPAGE   ENDM
  
  
          ENDX
