MACRO                                                                  
         #COEXIT &EPNAME=,                                             X        
               &EPLIST=,                                               X        
               &ERRUSER='N'                                                     
         LCLA  &EPCNT1,&EPCNT2                                                  
         LCLC  &IONAME                                                          
         SPACE                                                                  
.**********************************************************************         
.*       THE FOLLOWING SHOWS AN EXAMPLE OF A VALID #COEXIT TABLE                
.*       DEFINITION:                                                            
.*                                                                              
.*       #COEXIT EPNAME=IDMSDPLX,EPLIST=(IDMSDPX1,IDMSDPX2,IDMSDPX3)            
.*                                                                              
.**********************************************************************         
.**********************************                                             
.* VALIDATE &EPNAME &EPLIST       *                                             
.**********************************                                             
         AIF   ('&EPNAME' NE '').NAMEIP                                         
         MNOTE 8,'ENTRY POINT NAME MUST BE SPECIFIED'                           
         MEXIT                                                                  
.NAMEIP  ANOP                                                                   
         AIF   ('&EPLIST' NE '').LISTIP                                         
         MNOTE 8,'AT LEAST ONE ENTRY POINT MUST BE SPECIFIED'                   
         MEXIT                                                                  
.LISTIP  ANOP                                                                   
COEXIT   TITLE 'COGITO MULTIPLE SYSTEM EXIT DRIVER'                             
&EPN     SETC  '&EPNAME'(5,4)                                                   
COEXIT   #MOPT ENV=SYS,CSECT=&EPN.STRT                                          
         CNOP  0,4                                                              
&EPCNT1  SETA  N'&EPLIST                                                        
&EPCNT2  SETA  1                                                                
.LOOPIP1 ANOP                                                                   
         AIF   ('&EPCNT1' LT '&EPCNT2').ELOOP1                                  
         WXTRN &EPLIST(&EPCNT2)                                                 
&EPCNT2  SETA  &EPCNT2+1                                                        
         AGO   .LOOPIP1                                                         
.ELOOP1  ANOP                                                                   
        USING CSA,R10                                                           
        USING TCE,R9                                                            
         AIF   ('&EPNAME' NE 'IDMSIOX2').EP100                                  
&EPNAME  #START MPMODE=CALLER                                                   
         AGO   .EP200                                                           
.EP100   ANOP                                                                   
         ENTRY &EPNAME                                                          
&EPNAME  CSECT                                                                  
        USING &EPNAME,R15                                                       
         B     CO&SYSNDX                                                        
         DC    CL8'&EPNAME'                                  * CO900802         
CO&SYSNDX DS   0H                                                               
         AIF   ('&EPNAME' NE 'IDMSDPLX').EUSR0                                  
         AIF   ('&ERRUSER' EQ 'Y').EUSR0                                        
         CLC   =F'4',0(R1)          * TEST FOR FUNCTION CODE 4                  
         BNE   COXIT000             * CONTINUE AS NORMAL                        
         BR    R14                  * JUST RETURN - IO ERROR                    
COXIT000 DS    0H                                                               
.EUSR0   ANOP                                                                   
         LA    R13,16(R13)          * BUMP UP R13                               
         AIF   ('&EPNAME' NE 'IDMSDPLX').EUSR1                                  
         CLC   =F'4',0(R1)          * TEST FOR FUNCTION CODE 4                  
         BE    COXIT050             * IO ERROR - NO STACK CHECK                 
.EUSR1   ANOP                                                                   
         CLC   TCEID,=C'TCE*'       * LOCAL MODE?                               
         BNE   COXIT050             * YES                                       
         C     R13,TCESTKEA         * ROOM IN STACK?                            
         BNH   COXIT050             * YES                                       
*        #ABEND ABCODE='D009'       * ABORT                                     
         #ABEND ABCODE='D009'       * ABORT                                     
         EJECT                                                                  
COXIT050 DS    0H                                                               
         SH    R13,=H'16'           * RESTORE R13                               
         ST    R14,0(R13)           * SAVE RETURN ADDRESS                       
         STM   R11,R13,4(R13)       * SAVE R11-R13                              
         LA    R13,16(R13)          * BUMP UP R13                               
         LR    R12,R15              * BASE REG IS 12                            
        DROP  R15                                                               
        USING &EPNAME,R12                                                       
.EP200   ANOP                                                                   
         LA    R11,COXIT0VL         * ADDRESS FIRST VCON                        
COXIT100 DS    0H                                                               
         CLC   =F'-1',0(R11)        * END ?                                     
         BE    COXIT900             * END OF TABLE SO EXIT                      
         L     R15,0(R11)           * LOAD ENTRY POINT ADDRESS                  
         LTR   R15,R15              * IS THERE ONE ?                            
         BZ    COXIT200             * NO GET THE NEXT                           
         AIF   ('&EPNAME' NE 'IDMSDPLX').EUSR2                                  
         CLC   =F'4',0(R1)          * TEST FOR FUNCTION CODE 4                  
         BNE   COXIT150             * CONTINUE AS NORMAL                        
         CLC   4(4,R15),=CL4'CCSA'  * COGITO EXIT?                              
         BE    COXIT200             * BYPASS COGITO EXIT FOR IO ERROR           
COXIT150 DS    0H                                                               
.EUSR2   ANOP                                                                   
         BALR  R14,R15              * CALL THE EXIT ROUTINE                     
COXIT200 DS    0H                                                               
         LA    R11,4(R11)           * ADDRESS THE NEXT                          
         B     COXIT100             * TRY THE NEXT                              
COXIT900 DS    0H                                                               
         AIF   ('&EPNAME' NE 'IDMSIOX2').EP900                                  
         #RTN                                                                   
         AGO   .EP990                                                           
.EP900   ANOP                                                                   
         SH    R13,=H'16'           * RESTORE R13                               
         L     R14,0(R13)           * RETURN ADDRESS                            
         LM    R11,R12,4(R13)       * CALLERS R11-R12                           
         BR    R14                  * RETURN                                    
.EP990   ANOP                                                                   
         SPACE                                                                  
************************************                                            
*** GENERATE TABLE OF VCONS.       *                                            
************************************                                            
&EPCNT1  SETA  N'&EPLIST                                                        
&EPCNT2  SETA  1                                                                
COXIT0VL DS    0F                   * VCON LIST                                 
.LOOPIP  ANOP                                                                   
         AIF   ('&EPCNT1' LT '&EPCNT2').ELOOP                                   
         AIF   ('&EPLIST(&EPCNT2)'(1,2) NE 'CO').NOTCOG                         
&IONAME  SETC  '&EPLIST(&EPCNT2)'(5,4)                                          
         ENTRY &IONAME.VCON                                                     
&IONAME.VCON DS 0F                                                              
.NOTCOG  ANOP                                                                   
         DC    V(&EPLIST(&EPCNT2))  * NEXT USER EXIT.                           
&EPCNT2  SETA  &EPCNT2+1                                                        
         AGO   .LOOPIP                                                          
.ELOOP   ANOP                                                                   
         DC    F'-1'                * END OF ENTRY POINT LIST                   
         LTORG                                                                  
         TITLE 'CULLINET DSECTS'                                                
*        COPY  #TCEDS                                                           
*        COPY  #CSADS                                                           
         PRINT OFF                                                              
         COPY  #TCEDS                                                           
         COPY  #CSADS                                                           
         PRINT ON                                                               
         END   &EPNAME                                                          
         MEND