*DECK C$CALL
          IDENT  C$CALL 
          TITLE  C$CALL - CALL/CANCEL OBJECT ROUTINES 
          TITLE  C.CALL - EXECUTE CALL STATEMENT
 CBCALL   SPACE  4
          COMMENT  CALL/CANCEL OBJECT ROUTINES
**
*         C.CALL - EXECUTE CALL STATEMENT IN JOB USING FDL
* 
*         CALLING SEQUENCE
*                B3  - LOCATION OF ROUTINE NAME 
*                B4  - OFFSET OF ROUTINE NAME 
*                B5  - ROUTINE NAME LENGTH
*                B7  - PARAMETER LIST ADDRESS 
*                RJ   C.CALL
* 
*         GIVEN - ABOVE PARAMETERS AND FDL TABLE
*                FORMAT OF FDL TABLE
*                FOR EACH CALLABLE PROGRAM :  
*                WORD 0      VFD   60/PROGRAM-NAME (1ST 10 CHARS) 
*                WORD 1      VFD   60/PROGRAM-NAME (2ND 10 CHARS) 
*                WORD 2      VFD   60/PROGRAM-NAME (3RD 10 CHARS) 
*                WORD 3      VFD   42/ACCESS-NAME,18/EXIT-FLAG
*                WORD 4      VFD   1/STATIC-FLAG,59/ENTRY-POINT 
*                WORD 5      VFD   42/LIBRARY-NAME,18/0 
*                TABLE TERMINATED BY ZERO WORD
* 
*         OUTPUT
*                B6 - OVERFLOW FLAG 
* 
*         DOES - CALLS FDL TO LOAD CALLED ROUTINE IF NOT STATIC AND NOT 
*                ALREADY LOADED.  EXECUTES CALLED ROUTINE. UPON RETURN
*                SETS OVERFLOW FLAG FALSE. RETURN ADDRESSES ARE STACKED 
*                SINCE C.CALL MAY BE ENTERED RECURSIVELY. 
* 
* 
*         SAVES NO REGISTERS
* 
          SST 
          ENTRY  C.CALL 
 C.CALL   DATA   0
          SX6    B7 
          SA6    PLIST       SAVE PARAM LIST ADDRESS
          RJ     LOOKUP 
          NZ     B7,CALLERR1
          SA1    INDEX
          SX3    #ENTLEN
          IX1    X1*X3
          SA2    FDLLIST
          SX2    X2 
          IX6    X1+X2
          SA1    X6+#STATIC 
          NG     X1,CALL5    STATIC 
          SA2    X6+#PADDR
          SX2    X2 
          NZ     X2,CALL5    LOADED 
          SA6    SAVE 
          SX1    OVFL 
          RJ     =XCMM.OWN
          SA1    SAVE 
          BX6    X1 
          MX1    0           GROUP NAME NOT USED
          MX0    42 
          SA2    X6+#ANAME
          BX2    X0*X2       CAPSULE NAME 
          SA3    X6+#LIBNAME
          BX7    X0*X3
          SA7    LIBNAME
          SX3    A7          LIBRARY LIST 
          BX7    X2 
          SA7    PASSLOC+1
          MX7    0           ENTRY POINT NAME 
          SA7    A7+B1
          SX4    PASSLIST    PASSLOC LIST 
          RJ     =XFDL.LOC   LOAD OVERLAY CAPSULE 
          NZ     X6,CALLERR1 ERROR
          SA1    FDLLIST
          SA2    INDEX
          SX3    #ENTLEN
          IX2    X3*X2
          SX1    X1 
          IX6    X1+X2
          SA3    X6+#PADDR
          SA4    PASSLOC+2
          MX0    42 
          BX7    X0*X3
          BX7    X7+X4
          SA7    A3          SET ENTRY ADDRESS
 CALL5    BSS    0
          SA2    X6+#EXIT 
          MX0    42 
          BX7    X0*X2
          SA7    A2          CLEAR EXIT FLAG
          SA1    RETLIST
          LX1    30 
          SA2    DEPTH
          SX3    X1 
          IX6    X2-X3
          NG     X6,CALL7 
          LX1    30 
          SX3    X1-LOCTAB
          NZ     X3,CALL6    JP IF NOT THE LOCAL TABLE
          SB5    A1 
          SB6    INCR*2      ALLOCATE DOUBLE SIZE BLOCK 
          SB7    B1+B1       FLAG AS GROWING BLOCK
          RJ     =XC.GETBK   GET A NEW TABLE IN CMM SPACE 
          SX1    INCR        NBR WORDS TO MOVE
          SX2    LOCTAB      SOURCE 
          SA3    RETLIST     ADDR OF DESTINATION
          SX3    X3 
          RJ     =XMVE=      MOVE TABLE TO CMM BLOCK
          EQ     CALL7
 CALL6    BSS    0
          SB6    A1          POINTER ADDRESS
          SB7    INCR        INCREMENT
          RJ     =XC.GROWB
 CALL7    BSS    0
          SA1    RETLIST
          SA3    DEPTH
          SX6    X3+B1
          SA6    A3 
          SA4    C.CALL 
          SA5    INDEX
          BX7    X4+X5       SAVE INDEX 
          IX6    X1+X3
          SA7    X6          SAVE RETURN ADDRESS
          SX3    #ENTLEN
          IX1    X3*X5
          SA2    FDLLIST
          SX2    X2 
          IX6    X1+X2
          SA3    X6+#PADDR
          SB6    X3+B1
          SA2    RETURN 
          BX6    X2 
          SA6    X3          PLUG RETURN
          SA2    PLIST
          SA1    X2          PARAMETER LIST 
          SA3    C.CALL 
          AX3    30 
          SA4    X3-1 
          BX7    X4 
          SA7    LINE        PLACE CALLING LINE NUMBER FOR C.ENTRY
          JP     B6          ENTER CALLED ROUTINE 
          SPACE  3
 LINE     BSS    1           LINE NUMBER PLUGGED HERE 
 RETADDR  BSS    0
          SA1    DEPTH
          SX7    X1-1 
          SB6    B0          NO OVERFLOW
          SA7    A1 
          SA2    RETLIST
          IX6    X7+X2
          SA1    X6 
          SX2    X1 
          SX3    #ENTLEN
          IX2    X2*X3
          SA4    FDLLIST
          SX4    X4 
          IX6    X4+X2
          SA3    X6+#EXIT 
          SX7    B1 
          BX7    X3+X7
          SA7    A3          SET EXIT FLAG
          AX1    30 
          SB3    X1          RETURN ADDRESS 
          JP     B3 
          SPACE  3
 CALLERR1 BSS    0
          SX1    #CALL1 
          MX2    0
          SA3    C.CALL 
          LX3    30 
          SX3    X3-1 
          SX6    1
          RJ     =XC.MSG
          TITLE  C.CNCL - CANCEL
**
*         C.CNCL - CANCEL ROUTIME 
* 
*         CALLING SEQUENCE
*                B3  - LOCATION OF ROUTINE NAME 
*                B4  - OFFSET OF ROUTINE NAME 
*                B5  - LENGTH OF ROUTINE NAME 
* 
*         GIVEN - ABOVE AND FDL TABLE 
* 
*         DOES - IF CANCELLED ROUTINE IS STATIC, ISSUES ERROR MESSAGE.
*                IF CANCELLED ROUTINE DOES NOT EXIST, OR HAS NOT BEEN 
*                EXITED, ABORTS.
*                IF ROUTINE IS NOT LOADED, RETURNS. 
*                OTHERWISE CALLS FDL TO RELEASE SPACE.
* 
*         SAVES NO REGISTERS
* 
          ENTRY  C.CNCL 
 C.CNCL   DATA   0
          RJ     LOOKUP      FIND TABLE ENTRY 
          NZ     B7,CNCLERR3
          SA1    FDLLIST
          SX1    X1 
          SA2    INDEX
          SX3    #ENTLEN
          IX6    X2*X3
          IX7    X6+X1
          SB2    X7          ADDRESS OF ENTRY 
          SA1    B2+#STATIC 
          NG     X1,CNCLERR1 STATIC 
          SA2    B2+#PADDR
          ZR     X2,C.CNCL   NOT LOADED 
          SA1    B2+#EXIT 
          SX1    X1 
          ZR     X1,CNCLERR2 STILL ACTIVE 
*       CLOSE ANY FILES IN CAPSULE WHICH ARE STILL OPEN 
          SB3    X2          ADDRESS OF ENTRY TO CAPSULE
          SA1    65B         RA+65 - CMM POINTER
          BX2    -X1         ADDR OF DABA 
          SB4    X2+B1       FIRST REGION POINTER 
 CNCL1    BSS    0           GO THROUGH CMM CHAIN LOOKING FOR BLOCK 
          ZR     B4,CNCLER   JP IF ALL REGIONS EXAMINED - IS ERROR
          SA1    B4          GET HEADER 
          SB5    B4          SAVE FWA OF BLOCK IF ONE 
          MX6    3
          SB4    X1          NEXT BLOCK 
          BX6    X6*X1
          ZR     X6,CNCL1    JP IF FREE REGION - IGNORE 
          MX2    1
          BX6    X2-X6
          ZR     X6,CNCL1    JP IF A VP REGION - IGNORE VAR POS BLOCKS
          ZR     B4,CNCLER   JP IF END OF CHAIN - IS ERROR
          GT     B3,B4,CNCL1 JP IF ABOVE THIS BLOCK 
          LT     B3,B5,CNCLER      JP IF BELOW BLOCK - ERROR
          SX6    B2 
          SA6    SAVE        SAVE B2 OVER CLOSE 
          SX7    B4          LWA+1 OF BLOCK 
          SX5    B5          FWA-1 OR 2 OF BLOCK
          LX7    18 
          BX7    X7+X5
          SA7    =XC.CLSFF   SET FWA AND LWA FOR C.CLOSF
          SA1    C.CNCL      ENTRY
          MX6    30 
          AX1    30 
          SA2    X1-1        LINE NUMBER
          SA3    CLOSFJP
          BX2    -X6*X2 
          BX3    X6*X3
          BX6    X2+X3
          SA6    A3          PUT LINE NBR IN RJ - STACK VOID NOT NEEDED 
 CLOSFJP  RJ     =XC.CLOSF   CLOSE ANY FILES LOCAL TO CAPSULE 
          SA2    SAVE 
          SB2    X2          RESTORE ADDR OF ENTRY
*      CALL FDL 
          SA1    FDLLIST
          MX0    42 
          BX1    X0*X1       GROUP NAME 
          SA2    B2+#ANAME
          BX2    X0*X2       CAPSULE NAME 
          MX4    0           PASS LOC LIST
          RJ     =XFDL.UOC   UNLOAD OVERLAY CAPSULE 
          NZ     X6,CNCLERR3 ERROR
          SA1    FDLLIST
          SX1    X1 
          SA2    INDEX
          SX3    #ENTLEN
          IX2    X3*X2
          IX6    X1+X2
          SA3    X6+#PADDR
          MX0    42 
          BX7    X0*X3
          SA7    A3          ZERO ENTRY ADDRESS 
          EQ     C.CNCL 
          SPACE  3
 CNCLERR1 BSS    0
          SX1    #CNCL1 
          MX2    0
          SA3    C.CNCL 
          LX3    30 
          SX3    X3-1 
          MX6    0
          RJ     =XC.MSG
          EQ     C.CNCL 
          SPACE  3
 CNCLERR2 BSS    0
          SX1    #CNCL2 
          MX2    0
          SA3    C.CNCL 
          LX3    30 
          SX3    X3-1 
          SX6    1
          RJ     =XC.MSG
          SPACE  3
 CNCLERR3 BSS    0
          SX1    #CNCL3 
          MX2    0
          SA3    C.CNCL 
          LX3    30 
          SX3    X3-1 
          SX6    1
          RJ     =XC.MSG
  
*     THE FOLLOWING IS PLACED HERE ON PURPOSE - IT SHOULD NEVER HAPPEN
*     SINCE THE REGISTERS ARE IMPORTANT, AN ABORT HERE RATHER THAN
*     A CALL TO C.MSG IS USED.
 CNCLER   EQ     *+400000B   ABORT WITH EM 1
          EJECT 
* 
*         LOOKUP - FIND PROGRAM NAME IN FDL TABLE 
* 
*         INPUT 
*                B3 - ADDRESS OF NAME 
*                B4 - OFFSET OF NAME
*                B5 - LENGTH OF NAME
*         OUTPUT
*                B7 - NONZERO IF NAME NOT FOUND 
*                INDEX - TABLEY ENTRY NUMBER
* 
 LOOKUP   DATA   0
          MX6    0
          SA6    INDEX
          SX2    B4 
          SX4    314632B
          IX4    X4*X2
          AX4    20 
          SB3    B3+X4       UPDATED ADDRESS
          IX5    X4+X4
          LX4    3
          IX5    X5+X4
          IX6    X2-X5
          SB4    X6          BCP
*      SKIP LEADING BLANKS
          SA1    B3          PROGRAM NAME 
          SB2    B4+B4
          SB4    B2+B4
          SB2    B4+B4       6*BCP
          LX1    X1,B2
          MX0    6
          SB6    10 
          SB4    X6 
          SB2    B6-B4       CHARS IN FIRST WORD
          LT     B2,B5,CALL1
          SB2    B5 
 CALL1    BX6    X0*X1
          LX6    6
          SX7    X6-55B 
          NZ     X7,CALL2 
          SB5    B5-B1       DECREMENT LENGTH 
          SB2    B2-B1
          SB4    B4+B1       INCR BCP 
          LX1    6
          NZ     B2,CALL1 
          ZR     B5,LOOKERR  ALL BLANKS 
          SB3    B3+B1       NEW WORD 
          SA1    A1+B1
          SB2    10 
          SB4    B0 
          LT     B2,B5,CALL1
          SB2    B5 
          EQ     CALL1
          SPACE  3
*      NOW SEARCH TABLE FOR MATCH 
 CALL2    SX7    B3 
          SA7    ADDR 
          SX6    B4 
          SA6    BCP
          SX7    B5 
          SA7    LENGTH 
          SX1    B4          BCP OF NAME
 CALL3    SA3    INDEX
          SX4    #ENTLEN
          IX6    X3*X4
          MX2    0           BCP TABLE ENTRY
          SA3    FDLLIST
          SX3    X3 
          IX3    X6+X3
          SA5    X3 
          ZR     X5,LOOKERR  END OF TABLE 
          SB4    X3+#PNAME
          SB6    30          LENGTH TABLE ENTRY 
          RJ     =XC.BCDCM
          SB7    B0 
          ZR     B3,LOOKUP   FOUND
          SA1    INDEX
          SX6    X1+B1
          SA6    A1 
          SA1    BCP
          SA2    ADDR 
          SB3    X2 
          SA2    LENGTH 
          SB5    X2 
          EQ     CALL3
          SPACE  3
 LOOKERR  BSS   0 
          SB7    B1 
          EQ     LOOKUP 
 OVFL     BSS    0
          SB6    B1          OVERFLOW 
          EQ     C.CALL 
          EJECT 
          SPACE  3
          USE    /C.FDLCM/
 FDLLIST  BSS    1
          USE    *
 ADDR     BSS    1
 BCP      BSS    1
 DEPTH    DATA   0
 INDEX    BSS    1
 LENGTH   BSS    1
 LIBNAME  BSS    1
          DATA   0           LIBLIST TERMINATOR 
 PASSLIST VFD    42/0,18/PASSLOC
          DATA   0           PASSLOC LIST TERMINATOR
 PASSLOC  VFD    12/24B,12/2,36/0 
          BSS    2           NAME, ENTRY POINT
 PLIST    BSS    1
 RETURN   EQ     RETADDR
 RETLIST  VFD    30/INCR,12/0,18/LOCTAB  POINTER TO RETURN TABLE
 INCR     EQU    10 
 LOCTAB   BSS    INCR        LOCAL RETURN TABLE 
 SAVE     BSS    1
 #ANAME   EQU    3
 #ENTLEN  EQU    6
 #EXIT    EQU    3
 #LIBNAME EQU    5
 #PADDR   EQU    4
 #PNAME   EQU    0
 #STATIC  EQU    4
          END 
