          SPACE  2
          LIST   -L
* FOLLOWING MACROS (ENTR,DONE,SHORTEX) SUPPORT CYBIL/COMPASS INTERFACE.
          PURGMAC ENTR,DONE
          MACRO  ENTR,NAME,SFSIZE
          LOCAL  MORE
          IFC    EQ, SFSIZE  ,1
          ERR    STACKFRAME SIZE NEEDED.
 MORE     SB7    SFSIZE
          RJ     =XCIL#SPE
 NAME     SX0    B2          COPY POINTER TO CALLER'S STACK FRAME
          LX0    18D
          SB2    B2-SFSIZE   ADJUST STACK FRAME POINTER
          BX6    X7+X0       MERGE INTO LINKAGE WORD
          GE     B3,B2,MORE  CHECK IF ROOM IN STACK SEGMENT
          SA6    B2          SAVE LINKAGE WORD INTO STACK
          ENDM
 DONE     MACRO
          SA1    B2          LOAD LINKAGE WORD
          SB7    X1          GET RETURN ADDRESS
          LX1    42D
          SB2    X1          RESTORE CALLERS'S STACK POINTER
          LX1    18D
          JP     B7          RETURN
          ENDM
 SHORTEX  MACRO
          SX1    B2     SETUP
          LX1    18D         X1
          BX1    X7+X1         FOR CYBIL
          SB7    X7     AND
          JP     B7        RETURN
          ENDM
* FOLLOWING MACRO DEFINES A FIELD FOR THE *FMOVE* MACRO.
          MACRO   DEFFLD,NAME,A,B,C,D,E
          IFGT    A,-1,8
          IFGT    B,-1,7
          IFGT    C,-1,6
          IFGT    D,-1,5
          IFLT    E,B+2,4
          IFLT    E,D+2,3
          IFGT    E,0,2
          IFLT    D,60,1
          IFGT    B,59,2
          ERR     ERROR IN PARAMETERS
          SKIP    1
#_NAME    MICRO   1,, (A,B,C,D,E)
          ENDM
* FOLLOWING MACRO MOVES THE CONTENTS OF A CONTROLBLOCK FIELD.
FMOVE     MACRO   NAME,B
          LOCAL   MIC
MIC       MICRO   1,, "#_NAME"
          IFC     NE, B  ,1
MIC       MICRO   1,, "MIC",BACK
          CBFMOVE "MIC"
          ENDM
*       CBFMOVE - MACRO TO MOVE CONTROLBLOCK FIELDS.
*       INPUTS  -  B2     CONTAINS INPUT CB BASE ADDRESS.
*                  B3     CONTAINS OUTPUT CB BASE ADDRESS.
*       USES    -  A1,A2,A6, X1,X2,X6
*       PARAMETER - MICRO CONSISTING OF 5 SUBFIELDS, TO BE
*                   DEFINED BY A MICRO OF THE FORM:
*             #NAME  MICRO  1,,/(IW,IB,OW,OB,L)/
*                    IW/OW - INPUT/OUTPUT CB WORD OFFSET
*                    IB/OB - INPUT/OUTPUT FIELD LEFTMOST BIT NUMBER
*                    L     - FIELD LENGTH IN BITS
*
CBFMOVE MACRO NAME,KEY1,KEY2,KEY3
        LOCAL NOSWD,NOSBIT,NBEWD,NBEBIT,LEN,T
        LOCAL DIR,FILL,VALUE,SINGLE
DIR     MICRO 1,, F
FILL    SET   0
VALUE   SET   0
SINGLE  SET   0
CBACK   IFC   EQ, KEY1 BACK
DIR     MICRO 1,, BACK
        IFC   EQ, KEY2 ONE ,2
FILL    SET   1
        SKIP  3
        IFC   NE, KEY2 ZERO ,2
VALUE   SET   KEY2
        SKIP  2
SINGLE  SET   1
VALUE   SET   KEY3
CBACK   ELSE
        IFC   EQ, KEY1 ONE ,2
FILL    SET   1
        SKIP  3
        IFC   NE, KEY1 ZERO ,2
VALUE   SET   KEY1
        SKIP  2
SINGLE  SET   1
VALUE   SET   KEY2
CBACK   ENDIF
T       SET   0
        IRP   NAME
        IFEQ  T,0,1
NOSWD   MICRO 1,, NAME
        IFEQ  T,1,4
        IFC   EQ, "DIR" F ,1
NOSBIT  MICRO 1,, NAME
        IFC   EQ, "DIR" BACK ,1
NBEBIT  MICRO 1,, NAME
        IFEQ  T,2,1
NBEWD   MICRO 1,, NAME
        IFEQ  T,3,4
        IFC   EQ, "DIR" F ,1
NBEBIT  MICRO 1,, NAME
        IFC   EQ, "DIR" BACK ,1
NOSBIT  MICRO 1,, NAME
        IFEQ  T,4,1
LEN     MICRO 1,, NAME
T       SET   T+1
        IRP
        IFC   EQ, "NOSWD" 0 ,1
NOSWD   MICRO 1,, B0
        IFC   EQ, "NBEWD" 0 ,1
NBEWD   MICRO 1,, B0
        IFC   EQ, "NOSWD" 1 ,1
NOSWD   MICRO 1,, B1
        IFC   EQ, "NBEWD" 1 ,1
NBEWD   MICRO 1,, B1
        IFC   EQ, "DIR" BACK ,3
        SA2   B2+"NOSWD"
        IFEQ  SINGLE,0,1
        SA1   B3+"NBEWD"
        IFC   EQ, "DIR" F ,3
        SA2   B3+"NBEWD"
        IFEQ  SINGLE,0,1
        SA1   B2+"NOSWD"
        IFEQ  SINGLE+FILL,0,1
        IFNE  "LEN",60,1
        MX6   "LEN"
        IFNE  "NBEBIT",59,1
        LX6   "NBEBIT"+1
CFILL   IFEQ  SINGLE,0
        IFGT  "NOSBIT","NBEBIT",1
        LX1   "NBEBIT"+60-"NOSBIT"
        IFGT  "NBEBIT","NOSBIT",1
        LX1   "NBEBIT"-"NOSBIT"
        IFNE  "LEN",60,3
        BX1   X1*X6
        BX6   -X6*X2
        BX6   X6+X1
        IFEQ  "LEN",60,1
        BX6   X1
CFILL   ELSE
        IFEQ  FILL,0,2
        BX6   -X6*X2
        SKIP  1
        BX6   X6+X2
CFILL   ENDIF
        SA6   A2
        ENDM
          LIST   *
          SPACE  2
