For SYSTEM 2000 Version: 12.1
Problem Status: ZC (Zap Coded) -- Fix has received limited testing
Description of Problem:
PROGRAM TERMINATING AND NOT ISSUING STOP S2K LEAVES USER ACTIVE IN CICS INTERFACE AND IN MULTI-USER.
Note: Please send email to s2k@sas.com telling us which problem fixes you have downloaded so we can keep track of the fixes at your site in case questions or problems arise.
Top of Zap Deck:
* IBM R12.1 BUG 4883 MVS
./ ADD NAME=B4883
./ NUMBER NEW1=1000,INCR=1000
************************************************************************
* *
* BUG FIX 4883 PROVIDES URB CLEANUP VIA TASK-RELATED USER EXIT *
* "PLXTRUE". *
* *
* 1). APPLY FIX 4883. THE SKIPTRAN LABEL IN PROGRAM PLXTRUE SHOULD *
* BE COMMENTED OUT IF THE NEXT TRANSID CHECK IS TO BE PERFORMED. *
* *
* 2). EITHER RE-RUN JCLS2KIV OR MODIFY JCLCPLEX TO ADD PLXTRUE *
* (SHOULD LOOK LIKE PLXFRMT) *
* *
* 3). RUN JCLCPLEX FOR PLXFRMT AND PLXTRUE. *
* *
* 4). MODIFY YOUR CSD FILE TO ADD PROGRAM PLXTRUE. *
* *
* DEFINE PROGRAM(PLXTRUE) GROUP(S2K) LANGUAGE(ASSEMBLER) EXECKEY(CICS)*
* DESCRIPTION(PLEX TASK RELATED USER EXIT) *
* *
* 5). START YOUR CICS. *
* *
* *
************************************************************************
./ CHANGE NAME=MACCPLEX
.* *08* MDW 07/11/97 ADD PLXTRUE B4883. *08* 00007100
PUNCH '//PLEX7 EXEC CLTPASM,S=PLXTRUE,A=31,R=ANY,' *08* 00095100
PUNCH '// PARM.CICSEIP=''SP,NOPROLOG,NOEPILOG''' *08* 00095200
./ CHANGE NAME=PLXFRMT
* *36* 07JUL97 MDW B4883 ADD "TRUE" LOGIC. *36* 00010970
RESPCDE DS F *36* 00064010
INITR13S DS 18F *36* 00064020
LA R4,EXITACT EXIT CALL SWITCH. *36* 00106010
L R15,=A(INITPLX) LOAD INITIALIZATION @. *36* 00106020
BALR R14,R15 GO DO INIT LOGIC. *36* 00106030
B FRMT0015 CONTINUE MAINLINE. *36* 00106040
LTORG *36* 00106050
INITPLX CSECT *36* 00106060
STM R14,R12,INITR13S SAVE REGISTERS *36* 00106070
USING INITPLX,R3 *36* 00106080
LR R3,R15 RELOAD BASE AT NEW DISPL. *36* 00106090
* 1). ENABLE AND START TASK-RELATED USER EXIT. *36* 00171010
EXEC CICS ENABLE PROGRAM('PLXTRUE') LINKEDITMODE NOHANDLE, X00171020
TALENGTH(12) RESP(RESPCDE) START 00171030
CLC RESPCDE,DFHRESP(NORMAL) ALL GO WELL ? *36* 00171040
BE INIT0165 YES. *36* 00171050
CLC EIBRCODE(3),=X'802000' NO, ALREADY ENABLED ? *36* 00171060
BE INIT0165 YES,O.K. *36* 00171070
MVI 0(R4),C'N' NO, TURN OFF EXIT. *36* 00171080
TRUEBAD DS 0H WRITE ERROR MSG TO CON.*36* 00171090
* WRITE ERROR MSG TO CONSOLE. NO. **36* 00171100
EXEC CICS WRITE OPERATOR EVENTUAL, X00171110
TEXT(TRUEMSG) TEXTLENGTH(L'TRUEMSG) NOHANDLE 00171120
LM R14,R12,INITR13S SAVE REGISTERS *36* 00193010
BR R14 *36* 00193020
C032 DC CL3'032' CICS RELEASE CHECK *36* 00193030
TRUEMSG DC C'S2K3110/00- ERROR ENABLING PLXTRUE -' *36* 00193040
LTORG *36* 00193050
DROP R3 *36* 00193060
PLXFRMT CSECT *36* 00193070
USING PLXFRMT,R3 *36* 00193080
FRMT0015 DS 0H *36* 00193090
* MVC URBTASK,EIBTASKN REMOVED BY FIX *36* *36* 00298000
* MVC URBTASK,EIBTASKN REMOVED BY FIX *36* *36* 00308000
CLC URBTASK,EIBTASKN SAME TASK ? *36* 00334010
BE FRMT0235 YES, NO CALL TO EXIT. *36* 00334020
CLI EXITACT,C'Y' IS EXIT ACTIVE ? *36* 00335010
BNE FRMT0235 NO, SKIP CALL. *36* 00335020
* INVOKE USER EXIT. YES, LETS CALL. *36* 00335030
LA R14,FRMT0233 SET RETURN ADDRESS. *36* 00335040
DFHRMCAL TO=PLXTRUE,RTNABND=YES,DSECTS=NO *36* 00335050
FRMT0233 DS 0H *36* 00335060
LTR R15,R15 WAS CALL TO EXIT GOOD ? *36* 00335070
BNM FRMT0235 YES, CONTINUE. *36* 00335080
MVI EXITACT,C'N' NO, NO MORE CALLS TO EXIT. *36* 00335090
FRMT0235 DS 0H *36* 00335100
*C032 DC CL3'032' REMOVED BY FIX *36*. *36* 01102000
EXITACT DC C'Y' CONTROLS CALLING OF TRUE. *36* 01104010
* DFHAFCD TYPE=DSECT MAP AFCB, *36* 02646010
DFHAFCB DSECT *36* 02646020
AFIDENT DC C'AFCX' CONSTANT TO IDENTIFY AFCB *36* 02646030
AFVER DS B VERSION NUMBER. *36* 02646040
* THIS MUST BE INCREMENTED IF THE *36* 02646050
* LENGTH OF THE AFCB PREFIX IS CHANGED, OR*36* 02646060
* IF ANY OTHER CHANGE IS MADE WHICH REQUI*36* 02646070
* THE AFCB VERSION TO BE IDENTIFIED *36* 02646080
AFVER1 EQU X'01' VERSION 1 - CICS 1.7 *36* 02646090
AFVER2 EQU X'02' VERSION 2 - CICS 3.1 *36* 02646100
AFSVCNO DS B SVC NO. OF OWNER *36* 02646110
AFLENG DS H LENGTH OF TABLE OF DWORD ADDRESSES. *36* 02646120
* THIS MAY BE CHANGED WITHOUT CHANGING *36* 02646130
* THE VERSION. *36* 02646140
AFCSA1 DS A ADDRESS OF CICS COMMON SYSTEM AREA @BBD*36* 02646150
AFAICB DS A ADDRESS OF APPL INTERFACE BLOCK @BBD*36* 02646160
AFPFXEND DS 0F END OF AFCB PREFIX *36* 02646170
AFPFXLEN EQU *-DFHAFCB LENGTH OF AFCB PREFIX (FIXED) *36* 02646180
* *36* 02646190
PRINT NOGEN *36* 02646200
DFHAICB TYPE=DSECT MAP AICB, *36* 02646210
DFHUEXIT TYPE=RM MAP USER-EXIT DSECT'S, *36* 02646220
DFHEIDDS , MAP EXEC I/F DSECT'S, *36* 02646230
./ CHANGE NAME=CSDS2K
* *06* 11JUL97 MDW ADD PLXTRUE B4883. 00009980
* ADD PLXTRUE. *06* 00060010
DEFINE PROGRAM(PLXTRUE) GROUP(S2K) LANGUAGE(ASSEMBLER) EXECKEY(CICS) 00060020
DESCRIPTION(PLEX TASK RELATED USER EXIT) 00060030
./ ADD NAME=PLXTRUE
./ NUMBER NEW1=1000,INCR=1000
PLXTRUE DFHEIENT CODEREG=3,EIBREG=11,DATAREG=13
***********************************************************************
*PLXTRUE. PLEX TASK-RELATED USER EXIT. *
* *
* FUNCTION: *
* DETERMINE IF "STOP S2K" LOGIC NEEDS TO BE SCHEDULED. *
* *
* CALLERS: *
* 1). PLXFRMT (EVERY NEW TASK) *
* 2). CICS TASK MANAGER (TASK TERMINATION) *
* *
* REGS: *
* R1 ==> USER EXIT PARAMETER LIST (DFHUEPAR) *
* *
* *
* *
***********************************************************************
EJECT
***********************************************************************
*P1000. *
* *
* 1). IF PLXFRMT CALLED PERFORM P2000 LOGIC. *
* *
* 2). IF CICS TASK MANAGER CALLED PERFORM P3000 LOGIC. *
* *
* *
* *
***********************************************************************
SPACE
P1000 DS 0H
LR R4,R1 ADDRESS PARAMETER LIST FROM CICS.
EXEC CICS HANDLE ABEND LABEL(ERREXIT)
USING DFHUEPAR,R4
MVC DFHEIBP,UEPEIB GET CORRECT EIB
L DFHEIBR,UEPEIB RELOAD EIB REGISTER
MVC DFHEICAP,=X'80000000'
L R5,UEPEXN ADDRESS FUNCTION DEFINITION.
USING DFHUERTR,R5
TM UERTFID,UERTAPPL DID PLXFRMT INVOKE ?
BO P2000 YES.
TM UERTFID,UERTTASK NO, DID CICS TASK MANAGER CALL ?
BO P3000 YES, GO SEE IF S2K TRX.
B EXIT NO, GET OUT.
EJECT
***********************************************************************
*P2000. PLXFRMT INITIATED. *
* *
* 1). TURN ON BIT MASK FOR TASK MANAGER EXIT CALL, CICS WILL *
* THEN RE-INVOKE AT TASK TERMINATION. *
* *
* *
* *
***********************************************************************
SPACE
P2000 DS 0H
USING SA,R9
USING PLXCOMM,R10
USING DURB,R12
L R9,UEPHMSA GET PLXFRMTS RSA.
L R10,RSAR10 GET ADDRESS OF PLXCOMM.
L R12,RSAR12 GET ADDRESS OF URB.
DROP R9
L R9,UEPTAL @ OF HALFWORD THAT HAS LENGTH OF -
LH R6,0(R9) LOCAL WORK AREA.
CH R6,=AL2(S2KLEN) IS LOCAL WORK AREA BIG ENOUGH ?
BL EXIT NO, GET OUT.
L R6,UEPTAA YES, ADDRESS LOCAL WORK AREA.
USING PLXDATA,R6
MVC PLXTAG,PLEX MARK CONTROL BLOCK WITH "PLEX".
MVC PLXTASK,URBTASK SAVE CICS TASK NUMBER.
MVC PLXURBA,PLXURB SAVE THE URB ADDRESS.
L R9,UEPFLAGS GET SCHEDULE FLAG WORD.
LA R9,UEFDTASK(R9) BUMP TO TASK MANAGER EXIT BIT.
OI 0(R9),UEFMTASK TURN ON TASK MANAGER EXIT.
B EXIT
DROP R6,R10,R12
EJECT
***********************************************************************
*P3000. TASK TERMINATION. *
* *
* IF THE FOLLOWING TESTS ARE TRUE THEN TRANSACTION "SCFZ" *
* WILL BE SCHEDULED TO PERFORM ACTUAL "STOP S2K" PROCESSING: *
* *
* 1). URB TASK NUMBER MUST EQ TASK NUMBER SET ON PLXFRMT *
* CALL. *
* *
* 2). URB MUST NOT BE FREE. *
* *
* 3). URB MUST NOT BE MARKED AS PSEUDO-CONVERSATIONAL *
* *
* 4). URB ERROR, WAIT, AND TERMINATE FLAGS MUST NOT *
* ALREADY BE SET. *
* *
* 5). NEXT TRANSID MUST NOT BE SET. USER MUST COMMENT *
* OUT LABEL "SKIPTRAN" FOR THIS TEST TO BE PERFORMED. *
* *
* NOTE. DFHPEP MUST BE FUNCTIONAL FOR PLXTRUE TO FUNCTION *
* PROPERLY. *
* *
***********************************************************************
SPACE
P3000 DS 0H
USING SA,R9
L R9,UEPHMSA GET CALLERS RSA.
L R1,RSAR1 ADDRESS CALLERS PARM LIST.
* MAKE SURE END OF TASK CALL BY CICS TASK MANAGER.
USING TSKPARMS,R1 DSECT CICS TASK MANAGER PARMS
L R6,TSKPRM1 ADDRESS BYTES THAT INDICATES REASON -
TM 0(R6),UERTEOTR FOR CALL. END OF CICS TASK ?
BNO EXIT NO, GET OUT.
SPACE
P3010 DS 0H GET LOCAL WORK AREA.
L R9,UEPTAL @ OF HALFWORD CONTAING LENGTH OF -
LH R6,0(R9) LOCAL WORK AREA.
CH R6,=AL2(S2KLEN) IS LOCAL WORK AREA BIG ENOUGH ?
BL EXIT NO, NOT BIG ENOUGH.
L R6,UEPTAA YES, ADDRESS LOCAL WORK AREA.
USING PLXDATA,R6
CLC PLXTAG,PLEX IS CONTROL BLOCK INTACT ?
BNE EXIT NO, GET OUT.
USING DURB,R12 YES, MAKE SURE URB IS VALID.
L R12,PLXURBA GET URB ADDRESS.
CLC PLXTASK,URBTASK SAME TASK ?
BNE EXIT NO, GET OUT
TM URBFLAG2,X'80' PSUEDO CONVERSATIONAL ?
BO EXIT YES. DON'T PROCESS
TM URBFLAG1,URBERR IS ERR FLAG ALREADY SET?
BO EXIT YES, BYPASS SETTING INDICATORS
*
* FOR THE USER THAT HAS TRANSACTIONS THAT ARE NOT MARKED AS
* PSEUDO-CONVERSATIONAL BUT RUN IN THAT MODE, THE FOLLOWING
* BRANCH AROUND THE CHECK FOR NEXT TRANS ID SHOULD BE TAKEN
* OUT SO THAT THE LOGIC WILL FALL THROUGH THE CHECK FOR NEXT
* TRANS ID AND NOT CLEAN UP ANY USER THAT HAS IT SET.
*
SKIPTRAN B P3020 BYPASS NEXT TRANSID CHECK.
SPACE
L R9,UEPHMSA GET CALLERS RSA.
L R1,RSAR1 ADDRESS CALLERS PARM LIST.
L R9,TSKPRM2 ADDRESS @ OF NEXT TRANID.
CLC 0(4,R9),NULLS IS NEXT TRX CODE SPECIFIED ?
BNE EXIT YES, ITS PSEUDO-CONVERSATIONAL.
SPACE
P3020 DS 0H PERFORM S2K CLEANUP.
OI URBFLAG1,URBSTOP AND STOP CONDITION.
OI URBFLAG1,URBERR SET TERMINATE.
EXEC CICS START TRANSID('SCFZ') NOHANDLE
SPACE
DROP R1,R9,R12
EXIT DS 0H
DFHEIRET
EJECT
ERREXIT DS 0H
SPACE
DFHEIRET
EJECT
DC C'WORKING STORAGE'
PLEX DC CL4'PLEX'
NULLS DC XL4'00'
EJECT
DFHEISTG DSECT
DFHEISTG
SAVEPSW DS CL8
ABENDCDE DS CL4
LITERAL DS CL10
SAVEREGS DS 16F
EJECT
TSKPARMS DSECT
TSKPRM1 DS F @ OF SINGLE BYTE INDICATING REASON FOR CALL.
TSKPRM2 DS F @ OF 4 CHARACTER FIELD WHICH CONTAINS NEXT TRX CODE.
*
PLXDATA DSECT
PLXTAG DS CL4 CONTROL BLOCK IDENTIFIER = PLEX
PLXTASK DS CL4 CICS TASK NUMBER
PLXURBA DS CL4 ADDRESS OF PLEX URB.
S2KLEN EQU *-PLXDATA
*
SA DSECT REGISTER SAVE AREA DSECT
DS F
RSACB DS F +004
RSACF DS F +008
RSAR14 DS F +012
RSAR15 DS F
RSAR0 DS F
RSAR1 DS F
RSAR2 DS F
RSAR3 DS F
RSAR4 DS F
RSAR5 DS F
RSAR6 DS F
RSAR7 DS F
RSAR8 DS F
RSAR9 DS F
RSAR10 DS F
RSAR11 DS F
RSAR12 DS F
PRINT NOGEN
PLXCOMA
DURBMU
DFHUEXIT TYPE=RM
DFHEIEND
END
End of Zap Deck