*DECK FCMMOWN 
          IDENT  CMMOWN 
 CMMOWN   TITLE  CMMOWN - SET OWN CODE ERROR PROCESSING.
          COMMENT  SET OWN CODE ERROR PROCESSING
          SYSCOM B1 
*CALL FCMMCOM 
***       CMMOWN - SET OWN CODE ERROR PROCESSING. 
* 
*         CALL CMMOWN(EXTRN)
* 
*                EXTRN  - ADDRESS OF ERROR PROCESSOR. 
* 
 CMMOWN   SPACE  4,4
          SUBRTN CMMOWN 
          BX6    X1 
          SA6    USERR       SAVE THE ADDRESS OF THE USER'S ERROR SUB.
          SX1    QQQERQ      SET UP  TO CALL FTN/CMM INTERFACE
+         RJ     =XCMM.OWN        ERROR TRAP ROUTINE
-         VFD    12/0,18/CMMOWN-1 
          RTRN   CMMOWN 
          SPACE  4,4
 USERR    BSS    1
 PARAMAD  VFD    42/0,18/PARAM
 PARAM    BSS    3
 CLSTKRT  EQ     *+1S17      RJ HERE TO CLEAR STACK WHEN RETURNING
 RETURN   EQ     **          MODIFIED TO RETURN TO *CALLADR*
  
 QQQERQ   SB1    1           *CMM* ENTERS OWN-CODE PROCESSING HERE
          MX0    -18
          BX6    -X0*X1      SET *CALLADR* IN PARAMETER ARRAY 
          SA6    PARAM+2
          SX2    0100B       SET UP -RJ- TO USER OWN-CODE ROUTINE 
          SA3    USERR
          BX3    -X0*X3 
          LX2    48 
          LX3    30 
          BX6    X2+X3
          SA6    RJW
          MX0    48 
          LX1    12          GET - ME-
          BX6    -X0*X1 
          SA6    PARAM
          LX1    12          PICK OFF  -UE- 
          BX6    -X0*X1 
          SA6    A6+B1
          SA1    PARAMAD     (A1) = FWA PARAM LIST
          RJ     CLSTKCL     CLEAR STACK BEFORE ENTERING USER ROUTINE 
 CLSTKCL  EQ     *+1S17 
 RJW      VFD    12/0100B,18/0 THE -RJ- SKELETON TO CALL USERS ROUTINE
          VFD    30/0 
          SA2    PARAM+2     CHECK IF USER OWN-CODE ROUTINE 
          MX3    -18          MODIFIED THE RETURN ADDRESS 
          BX2    -X3*X2 
          ZR     X2,ABORT    IF NOT TO RETURN 
          SA1    RETURN      INSERT RETURN ADDRESS
          LX2    30 
          LX3    30 
          BX1    X3*X1
          BX6    X2+X1
          SA6    A1 
          RJ     CLSTKRT     CLEAR STACK BEFORE RETURNING 
  
 ABORT    ABORT 
  
          END 
