CATALOG LNKEDT24.PROC                     REPLACE=YES                           
// PROC                                                                         
LIBDEF OBJ,SEARCH=(SRUL.COBOL,SRUL.TEST,SRUL.PROD,SRUL.SYS,            X        
               PRD2.SCEEBASE,PRD2.PROD,PRD2.DBASE,PRD2.COMM,           X        
               PRD2.COMM2,PRD1.BASE,SRUL.DARS515),TEMP                          
   INCLUDE UPSI@SRU             LE/370 Exit CEEBXITA for UPSI support           
// EXEC LNKEDT,PARM='AMODE=24,RMODE=24'                                         
/+                                                                              
/*                                                                              
---------------------------------------------------------------------           
* $$ JOB JNM=CEEBXITA,CLASS=A                                                   
* $$ LST CLASS=C                                                                
// JOB CEEBXITA                         LE/370 EXIT WITH UPSI SUPPORT           
/*       D=11/06/96,T=06:02:18,L=PROG,N=J.CEEBXITA,U=FRAN           */          
// OPTION DECK                                                                  
// EXEC PROC=DSKPUNCH                                                           
   CATALR UPSI@SRU,1.0                                                          
// EXEC ASMA90                                                                  
         TITLE 'LE/VSE Assembler User Exit'                             00001000
*/*******************************************************************/  00002000
*/*                                                                 */  00003000
*/*    LICENSED MATERIALS - PROPERTY OF IBM                         */  00004000
*/*                                                                 */  00005000
*/*    5686-067  (C) COPYRIGHT IBM CORP. 1991, 1995.                */  00006000
*/*    ALL RIGHTS RESERVED.                                         */  00007000
*/*                                                                 */  00008000
*/*    SEE COPYRIGHT INSTRUCTIONS.                                  */  00009000
*/*                                                                 */  00010000
*/*******************************************************************/  00011000
CEEBXITA CSECT                                                          00012000
CEEBXITA AMODE  ANY                                                     00013000
CEEBXITA RMODE  ANY                                                     00014000
         ENTRY  CEEBXITA                                                00015000
*/*-----------------------------------------------------------------*/  00016000
*/* This exit modified by SRU to set the UPSI run time option equal */  00018000
*/* to the UPSI in the COMREG so normal UPSI statements can be used */  00018000
*/* by COBOL/VSE programs.            See LE/370 Programming Guide. */  00018000
*/* Added statements are identified by 'UPSI' in cc 68-71.          */  00018000
*/* Modification by Fran Hensler 10/31/96   fjh@sruvm.sru.edu       */          
*/*                 Slippery Rock University                        */          
*/*-----------------------------------------------------------------*/  00016000
*/* CEEBXITA - Run-Time Assembler User Exit under VSE.              */  00017000
*/*                                                                 */  00018000
*/* Function code:                                                  */  00019000
*/*    1 - first enclave initialization                             */  00020000
*/*    2 - first enclave termination                                */  00021000
*/*    3 - nested enclave initialization                            */  00022000
*/*    4 - nested enclave termination                               */  00023000
*/*    5 - PROCESS TERMINATION                                      */  00024000
*/*                                                                 */  00025000
*/* Notes:                                                          */  00026000
*/*    In the VSE batch environment, nested enclaves are not        */  00027000
*/*    supported so the exit will not be invoked for function       */  00028000
*/*    codes 3 and 4.                                               */  00029000
*/*                                                                 */  00030000
*/* Register Usage:                                                 */  00031000
*/*    Input                                                        */  00032000
*/*       R1  - A(A(Assembler User Exit Plist cntrl blk)) - CEEAUE  */  00033000
*/*             NOTE: CEEAUE  contains the address of a 256 Byte    */  00034000
*/*                   work area initialized to zero which is used   */  00035000
*/*                   as the CEEBXITA's Save Area                   */  00036000
*/*       R15 - Entry Point Address                                 */  00037000
*/*       R14 - Return Address                                      */  00038000
*/*       R12 - Pointer to CAA                                      */  00039000
*/*    Output                                                       */  00040000
*/*       CEEAUE  altered                                           */  00041000
*/*    Work Regs                                                    */  00042000
*/*       R3 - Code Base                                            */  00043000
*/*       R2 - Base for User Exit Control Block (CEEAUE)            */  00044000
*/*                                                                 */  00045000
*/* History:                                                        */  00046000
*/*                                                                 */  00047000
*/*-----------------------------------------------------------------*/  00048000
         SPACE 2                                                        00049000
         USING CEEBXITA,R3        Code Base                             00050000
         USING CEEAUE,R2         User Exit Control Block                00051000
         SPACE 1                                                        00052000
         STM   14,12,12(13)       Save Registers in caller's S.A.       00053000
         LR    R3,R15             Set Module Base                       00054000
         B     AROUND                                                   00055000
         DC    CL8'CEEBXITA'      Eye-catcher for Debugging             00056000
         DC    CL8'V1.R1.M0'                                            00057000
*                                                                       00058000
AROUND   DS    0H                                                       00059000
         L     R2,0(,R1)          Get the parm passed                   00060000
         L     R10,CEEAUE_A_WORK    Obtain the workarea                 00061000
*                                 Chain the Save Areas                  00062000
         ST    R10,8(,R13)        Old points to new                     00063000
         ST    R13,4(,R10)        New SaveArea points to old            00064000
         LR    R13,R10            R13 points to new SaveArea            00065000
*                                                                       00066000
         L    R4,CEEAUE_FUNC        Get the function code.              00067000
         C    R4,FRST_INIT_CODE   First EnclaveInitialization Exit?     00068000
         BE   FRST_INIT_EXIT      Yes. Branch to it?                    00069000
*                                                                       00070000
         C    R4,FRST_TERM_CODE   First Enclave Termination Exit?       00071000
         BE   FRST_TERM_EXIT      Yes. Branch to it?                    00072000
*                                                                       00073000
         C    R4,NSTD_INIT_CODE   Nested Enclave Initialization Exit?   00074000
         BE   NSTD_INIT_EXIT      Yes. Branch to it?                    00075000
*                                                                       00076000
         C    R4,NSTD_TERM_CODE   Nested Enclave Termination Exit?      00077000
         BE   NSTD_TERM_EXIT      Yes. Branch to it?                    00078000
*                                                                       00079000
         C    R4,PROC_TERM_CODE   Process Termination Exit?             00080000
         BE   PROC_TERM_EXIT      Yes. Branch to it?                    00081000
*                                                                       00082000
         B    RETURN              It is neither Init nor Term           00083000
*                                 ...exit code. Simply Return           00084000
         EJECT                                                          00085000
*/*=================================================================*/  00086000
*/*      First enclave initialization exit.                         */  00087000
*/*=================================================================*/  00088000
FRST_INIT_EXIT DS   0H                                                  00089000
         SPACE 1                                                        00090000
*/*=================================================================*/  00099000
*/*      Begin of SRU code to set UPSI run_time option              */  00100000
*/*=================================================================*/  00101000
         COMRG                                                     UPSI         
         LA    R6,23(R1)           GET UPSI ADDRESS                UPSI         
         CLI   0(R6),B'00000000'   IF UPSI = 000000000             UPSI         
         BE    RETURN                 THEN RETURN                  UPSI         
TEST_0   TM    0(R6),B'10000000'                                   UPSI         
         BZ    TEST_1                                              UPSI         
         MVI   UPSI_0,C'1'                                         UPSI         
TEST_1   TM    0(R6),B'01000000'                                   UPSI         
         BZ    TEST_2                                              UPSI         
         MVI   UPSI_1,C'1'                                         UPSI         
TEST_2   TM    0(R6),B'00100000'                                   UPSI         
         BZ    TEST_3                                              UPSI         
         MVI   UPSI_2,C'1'                                         UPSI         
TEST_3   TM    0(R6),B'00010000'                                   UPSI         
         BZ    TEST_4                                              UPSI         
         MVI   UPSI_3,C'1'                                         UPSI         
TEST_4   TM    0(R6),B'00001000'                                   UPSI         
         BZ    TEST_5                                              UPSI         
         MVI   UPSI_4,C'1'                                         UPSI         
TEST_5   TM    0(R6),B'00000100'                                   UPSI         
         BZ    TEST_6                                              UPSI         
         MVI   UPSI_5,C'1'                                         UPSI         
TEST_6   TM    0(R6),B'00000010'                                   UPSI         
         BZ    TEST_7                                              UPSI         
         MVI   UPSI_6,C'1'                                         UPSI         
TEST_7   TM    0(R6),B'00000001'                                   UPSI         
         BZ    TEST_END                                            UPSI         
         MVI   UPSI_7,C'1'                                         UPSI         
TEST_END EQU   *                                                   UPSI         
         LA    R4,RUN_OPTION_A                                     UPSI         
         ST    R4,CEEAUE_A_OPTIONS                                 UPSI         
*/*=================================================================*/  00099000
*/*      End of SRU code to set UPSI run_time option                */  00100000
*/*=================================================================*/  00101000
*                                                                       00091000
*  To activate the abend codes table, uncomment the next 2 lines        00092000
*                                                                       00093000
*        LA    R4,ABEND_CODES     Get addr(abend codes table)           00094000
*        ST    R4,CEEAUE_A_AB_CODES Store it in slot                    00095000
*                                                                       00096000
         B     RETURN                                                   00097000
         SPACE 1                                                        00098000
*/*=================================================================*/  00099000
*/*      First enclave termination exit.                            */  00100000
*/*=================================================================*/  00101000
         SPACE 1                                                        00102000
*                                                                       00103000
FRST_TERM_EXIT DS   0H                                                  00104000
         B     RETURN                                                   00105000
         SPACE 1                                                        00106000
*/*=================================================================*/  00107000
*/*      Nested enclave initialization exit.                        */  00108000
*/*=================================================================*/  00109000
         SPACE 1                                                        00110000
*                                                                       00111000
NSTD_INIT_EXIT DS   0H                                                  00112000
         B     RETURN                                                   00113000
         SPACE 1                                                        00114000
*/*=================================================================*/  00115000
*/*      Nested enclave termination exit.                           */  00116000
*/*=================================================================*/  00117000
         SPACE 1                                                        00118000
*                                                                       00119000
NSTD_TERM_EXIT DS   0H                                                  00120000
         B     RETURN                                                   00121000
*                                                                       00122000
         SPACE 1                                                        00123000
*/*=================================================================*/  00124000
*/*      Process termination exit.                                  */  00125000
*/*=================================================================*/  00126000
         SPACE 1                                                        00127000
*                                                                       00128000
PROC_TERM_EXIT DS   0H                                                  00129000
*        B     RETURN                                                   00130000
*                                                                       00131000
         SPACE 1                                                        00132000
*/*=================================================================*/  00133000
*/*               R E T U R N     T O    C A L L E R                */  00134000
*/*=================================================================*/  00135000
RETURN   DS    0H                                                       00136000
         L     R13,4(,R13)        Get A(caller's save area)             00137000
         LM    R14,R12,12(R13)    Restore caller's regs                 00138000
         BR    R14                Go home                               00139000
         EJECT                                                          00140000
*              CONSTANTS AND WORKAREAS                                  00141000
*                                                                       00142000
FRST_INIT_CODE  DC  F'1'          First enclave initialization code     00143000
FRST_TERM_CODE  DC  F'2'          First enclave termination code        00144000
NSTD_INIT_CODE  DC  F'3'          Nested enclave initialization code    00145000
NSTD_TERM_CODE  DC  F'4'          Nested enclave termination code       00146000
PROC_TERM_CODE  DC  F'5'          Process termination code              00147000
*                                                                       00148000
*                                                                       00149000
*   The first field in the following table is a count                   00150000
*   of how many abend codes are not to be trapped by                    00151000
*   the LE/VSE error handler.                                           00152000
*                                                                       00153000
*   If you want the LE/VSE error handler NOT to trap:                   00154000
*      - a system ss cancel code, enter X'000000ss' into the table      00155000
*      - a system ii interruption code, enter X'800000ii' into the      00156000
*        table                                                          00157000
*      - a user uuuu abend, enter F'uuuu' into the table                00158000
*                                                                       00159000
*   Note that this table is set up so that the LE/VSE error             00160000
*   handler will not trap the user 7777 abends.                         00161000
*                                                                       00162000
ABEND_CODES DS 0H                                                       00163000
*                                                                       00164000
           DC  A(((ABEND_CODES_END-ABEND_CODES)/4)-1)                   00165000
*                                                                       00166000
           DC  F'7777'            LE/VSE won't trap user 777 abends     00167000
*                                                                       00168000
*          DC  F'uuuu'            LE/VSE won't trap user uuu abends     00169000
*          DC  X'000000ss'        LE/VSE won't trap system ss cancel    00170000
*                                 codes                                 00171000
*          DC  X'800000ii'        LE/VSE won't trap system ii           00172000
*                                 interruption codes                    00173000
*                                                                       00174000
ABEND_CODES_END DS 0H                                                   00175000
*                                                                       00176000
                     SPACE 1                                            00177000
RUN_OPTION_A    DC   A(RUN_OPTION)                                 UPSI         
RUN_OPTION      DC   AL2(L'UPSI_PARM)                              UPSI         
UPSI_PARM       DC   C'UPSI(00000000)'                             UPSI         
UPSI_0          EQU  UPSI_PARM+5+0                                 UPSI         
UPSI_1          EQU  UPSI_PARM+5+1                                 UPSI         
UPSI_2          EQU  UPSI_PARM+5+2                                 UPSI         
UPSI_3          EQU  UPSI_PARM+5+3                                 UPSI         
UPSI_4          EQU  UPSI_PARM+5+4                                 UPSI         
UPSI_5          EQU  UPSI_PARM+5+5                                 UPSI         
UPSI_6          EQU  UPSI_PARM+5+6                                 UPSI         
UPSI_7          EQU  UPSI_PARM+5+7                                 UPSI         
*===================================================================    00178000
*         Parameter list passed to the User Exit.                       00179000
*         Addressed by Reg 1 = A(A(CEEAUE))                             00180000
*===================================================================    00181000
CEEAUE               DSECT 0D                                           00182000
CEEAUE_LEN           DS  F        Len of user exit Ctl Blk              00183000
CEEAUE_FUNC          DS  F        Function Code                         00184000
*                                 1 ==> Initialization Exit             00185000
*                                 2 ==> Termination Exit                00186000
*                                 3 ==> Init Exit for nested enclave    00187000
*                                 4 ==> Term Exit for nested enclave    00188000
*                                 5 ==> Process termination Exit        00189000
CEEAUE_RETC          DS  F        Return or ABEND code                  00190000
CEEAUE_RSNC          DS  F        Return or ABEND Reason Code           00191000
*                                                                       00192000
CEEAUE_FLAGS         DS  0F       Flags                                 00193000
CEEAUE_FLAG1         DS  X                                              00194000
CEEAUE_ABTERM        EQU X'80'    0 = Normal termination                00195000
*                                 1 = Abnormal termination              00196000
CEEAUE_ABND          EQU X'40'    0 = terminate pgm with Return/Reason  00197000
*                                 1 = terminate pgm with ABEND/Reason   00198000
CEEAUE_DUMP          EQU X'20'    0 = If CXIT_ABND is 1, ABEND without  00199000
*                                     a dump                            00200000
*                                 1 = IF CXIT_ABND is 1, ABEND  w/ dump 00201000
                     SPACE 1                                            00202000
CEEAUE_FLAG2         DS  X        Reserved                              00203000
CEEAUE_FLAG3         DS  X        Reserved                              00204000
CEEAUE_FLAG4         DS  X        Reserved                              00205000
                     SPACE 1                                            00206000
CEEAUE_A_CC_PLIST    DS  A        Ptr to Reg 1 upon invocation          00207000
*                                 ...Initialization Exit Only           00208000
CEEAUE_A_WORK        DS  A        Ptr to 256-byte work area             00209000
CEEAUE_A_OPTIONS     DS  A        A(A(Run-Time Options string))         00210000
CEEAUE_USERWD        DS  F        User word. Retained thru Termination  00211000
CEEAUE_A_AB_CODES    DS  A        Ptr to list of abend codes that       00212000
*                                 LE/VSE error handler shouldn't trap   00213000
*                                  format of table is:                  00214000
*                                    fullword: # of entries             00215000
*                                    fullword: error code               00216000
*                                    fullword: error code               00217000
*                                      ...                              00218000
*                                  Use X'000000ss' for system cancel    00219000
*                                                  codes                00220000
*                                  Use X'800000ii' for system interrupt 00221000
*                                                  codes                00222000
*                                      F'uuuu'     for user abends      00223000
CEEAUE_FBCODE        DS  A        Feedback code                         00224000
CEEAUE_PAGE          DS  F        Minimum value for page allocations    00225000
                     SPACE 1                                            00226000
*/*=================================================================*/  00227000
*/*      E N D     O F     P A R A M E T E R    L I S T             */  00228000
*/*=================================================================*/  00229000
                     SPACE 1                                            00230000
CEEBXITA CSECT                                                          00231000
R0       EQU   0                                                        00232000
R1       EQU   1                                                        00233000
R2       EQU   2                                                        00234000
R3       EQU   3                                                        00235000
R4       EQU   4                                                        00236000
R5       EQU   5                                                        00237000
R6       EQU   6                                                        00238000
R7       EQU   7                                                        00239000
R8       EQU   8                                                        00240000
R9       EQU   9                                                        00241000
R10      EQU   10                                                       00242000
R11      EQU   11                                                       00243000
R12      EQU   12                                                       00244000
R13      EQU   13                                                       00245000
R14      EQU   14                                                       00246000
R15      EQU   15                                                       00247000
         END                                                            00248000
/*                                                                              
// EXEC PROC=SRULPROD                                                           
// EXEC PROC=DSKMAINT                                                           
/&                                                                              
// JOB UPSITEST    2050                                                      000
// EXEC PROC=SRULTEST                                                           
// OPTION LINK,NOXREF,CATAL,NODUMP                                        000050
 PHASE UPSITEST,*                                                           0000
// EXEC PROC=COBOL                                                            00
   CBL TEST,SSRANGE                                                             
       IDENTIFICATION DIVISION.                                           000090
       PROGRAM-ID. UPSITEST.                                                 000
       AUTHOR. Fran Hensler                                               000110
       INSTALLATION.  SLIPPERY ROCK UNIVERSITY COMPUTER CENTER            000120
       DATE-WRITTEN.  10/06/96                                            000130
       DATE-COMPILED.                                                     000140
       REMARKS.                                                           000160
       ENVIRONMENT DIVISION.                                              000190
       CONFIGURATION SECTION.                                             000200
       SPECIAL-NAMES.                                                     000210
           UPSI-0 IS UP0 ON STATUS IS TEST-RUN,                           000220
                         OFF STATUS IS NORMAL-RUN,                              
           UPSI-7 IS UP7 ON STATUS IS UPSI-7-ON.                          000220
       INPUT-OUTPUT SECTION.                                              000240
       FILE-CONTROL.                                                      000250
           SELECT DATE-CARD ASSIGN TO SYS011-UR-2540R-S.                  000260
       DATA DIVISION.                                                     000380
       FILE SECTION.                                                      000390
       FD  DATE-CARD                                                      000400
           RECORDING MODE IS F                                            000410
           LABEL RECORDS ARE OMITTED                                      000420
           RECORD CONTAINS 80 CHARACTERS                                  000430
           DATA RECORD IS CARD-REC.                                       000440
       01  CARD-REC.                                                      000450
           02  SESSION-SELECT.                                                  
               03  SESSION-SELECT-YR  PIC X(02).                          000460
               03  SESSION-SELECT-MO  PIC X(02).                          000470
           02  FILLER                 PIC X(02).                          000480
           02  DATE-SELECT            PIC X(06).                          000480
           02  FILLER                 PIC X(09).                          000510
           02  FILLER                 PIC X(03).                          000510
           02  WRITE-SELECT           PIC X(01).                          000480
           02  FILLER                 PIC X(09).                          000510
           02  SEMESTER-START-DATE    PIC S9(08).                               
           02  FILLER                 PIC X(37).                          000510
        WORKING-STORAGE SECTION.                                                
        PROCEDURE DIVISION.                                                     
            IF TEST-RUN DISPLAY 'TEST-RUN' UPON CONSOLE.                        
            IF NORMAL-RUN DISPLAY 'NORMAL RUN' UPON CONSOLE.                    
            IF UPSI-7-ON DISPLAY 'UPSI-7-ON' UPON CONSOLE.                      
            STOP RUN.                                                           
/*                                                                              
// EXEC PROC=LNKEDT24                                                           
LOG                                                                             
// UPSI 10000000                                                                
// EXEC UPSITEST                                                                
// UPSI 11111111                                                                
// EXEC UPSITEST                                                                
// UPSI 00000000                                                                
// EXEC UPSITEST                                                                
NOLOG                                                                           
/*                                                                              
/&                                                                              
* $$ EOJ                                                                        
