For SYSTEM 2000 Version: 11.63
Problem Status: ZC (Zap Coded) -- Fix has received limited testing
Description of Problem:
IN RELEASES OF CICS AFTER 3.1, THE AUTOMATIC STOP S2K PROCESSING NO LONGER WORKS FOR PLEX USERS.
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 V11.63 BUG 4707 OS
./ CHANGE NAME=PLXFRMT
* *18* 12MAY93 GOH B4707 FOR CICS 3.2 AND 3.3 FIX 'STOP S2K' *18* 00010980
BE INIT0165 YES. BYPASS LOGIC *18* 00127000
CLI 13(R1),X'00' EVER DONE ? *18* 00127010
BNE INIT0165 YES. BYPASS LOGIC *18* 00127020
* START TRANSACTON PLXS FOR THE PURPOSE OF ENABLING THE *18* 00130000
* AUTOMATIC 'STOP S2K' PROCESSING FOR PLEX USERS. *18* 00131000
*18* CHANGE S2KX TO PLXS IN NEXT LINE 00133000
EXEC CICS START TRANSID('PLXS') 00134000
B INIT0165 CONTINUE *18* 00134010
MVC URBTASK,EIBTASKN SET TASK NUMBER *18* 00255010
MVC URBTASK,EIBTASKN SET TASK NUMBER *18* 00264010
CLI URBECB,URBTRMU WAS USER CANCELLED BY S2K *18* 00445010
BE FRMT9030 YES. FLUSH REQUEST *18* 00445020
BZ FRMT9150 YES. CONTINUE *18* 00918000
* *18* CHANGE DATASET TO FILE IN SET COMMANDS 01390990
EXEC CICS SET FILE(S2KCOM) CLOSED WAIT 01391000
EXEC CICS SET FILE(S2KCOM) OPEN 01392000
CLI RTRYSW,X'01' IN RETRY MODE ? *18* 01450010
BE ADR$0400 YES. DON'T RESET SWITCH *18* 01450020
ADR$0400 EQU * *18* 01451010
MVI READSW,X'FF' YES. TURN TO NORMAL *18* 01482010
./ CHANGE NAME=PLXINIT
* *18* 12MAY93 GOH B4707 CICS 3.2 'STOP S2K' PROCESS CHANGES *18* 00029999
BE INITTPLX YES. CONTINUE *18* 00086000
INIT0012 EQU * *18* 00092010
BE INIT0045 YES. *18* 00122010
CLC 0(3,R1),CSHU SHUTDOWN OPTION ? *18* 00122020
MVI PLXTALL,2 SET SHUTDOWN FLAG *18* 00123010
B INIT0012 FINISH UP *18* 00123020
CLC EIBTRNID,CTALL TERMINATE ALL ? *18* 00124010
BE INIT0010 YES. FINISH UP *18* 00124020
CLI PLXTALL,0 TERM ALL SET ? *18* 00199000
BNE INIT0140 YES. CONTINUE *18* 00200000
B INIT0150 BYPASS START LOGIC HERE *18* 00217010
CSHU DC CL3'SHU' *18* 00282010
./ CHANGE NAME=PLXTERM
* *17* 12MAY93 GOH B4707 CICS 3.2 'STOP S2K' PROCESS CHANGES 00018980
TERMCAP DS F *17* 00041010
SR R10,R10 CLEAR COMMAREA VECTOR *17* 00050010
ST R10,TERMCAP SAVE VALUE *17* 00057010
CLI PLXTALL,2 TERMINATE SYSTEM ? *17* 00067010
BE TERM0060 YES. DO IT *17* 00067020
L R15,TERMCAP ADDR COMMON AREA *17* 00085010
CLC 0(4,R15),CATDX FROM AUTO INST DELETE ? *17* 00085020
BNE TERM0052 NO. CONTINUE *17* 00085030
OI URBFLAG1,URBSTOP TURN ON STOP S2K *17* 00085040
TERM0052 EQU * *17* 00085050
TERM0060 EQU * *17* 00094020
L R14,PLXCUSE ADDRESS USER MODULE *17* 00094030
MVC S2KCSHD-DS2KCUSE(4,R14),=F'-1' SET SHUTDOWN *17* 00094040
LA R2,TERMMSG4 ADDRESS MESSAGE *17* 00094050
B TERM9930 RETURN TO CALLER *17* 00094060
CLI PLXTALL,0 TERM ALL ON ? *17* 00294000
BNE TERM9950 YES. WORK IS DONE *17* 00295000
CATDX DC CL4'ATDX' *17* 00339010
./ ADD NAME=PLXSTOP
./ NUMBER NEW1=1000,INCR=1000
**********************************************************************
* *
* PLXSTOP - STOP S2K LOGIC FOR PROCEDURAL LANGUAGE USERS *
* *
* FUNCTION - *
* *
* THIS ROUTINE WILL PROCESS THE STOP S2K FOR A GIVEN PLEX *
* USER OR USERS. *
* *
* INPUT - *
* *
* PLXCOMM - PLEX COMMON BLOCK *
* *
* REGISTER USAGE - *
* *
* 10 - PLEX COMMON AREA *
* *
**********************************************************************
* *00* 09JUN93 GOH B4707 ORIGINAL MODULE FOR NEW STOP S2K PROCESSING *
**********************************************************************
DFHEISTG
R14SAV1 DS F
TRMCOM DS F
STOPRC DS F
STOPFCI DS F
STOPTRN DS CL4
EJECT
USING PLXCOMM,R10
USING DURB,R8
USING DS2KCUSE,R7
PLXSTOP CSECT
B STOP0001
DC CL8'PLXSTOP'
STOP0001 EQU *
XC TRMCOM,TRMCOM CLEAR DUMMY COMMON AREA
EXEC CICS LINK PROGRAM('PLXINIT') COMMAREA(TRMCOM) LENGTH(4)
L R10,TRMCOM GET ADDRESS OF COMMON AREA
LTR R10,R10 OKAY ?
BZ STOP9950 NO. JUST RETURN
STOP0003 EQU *
MVI PLXTFLG,X'00' CLEAR PROCESS FLAG
L R7,PLXCUSE ADDRESS USER MODULE
L R9,S2KPLST ADDR STOP PARMS
L R5,STPMTRN-DSTOPPRM(R9) ADDR TRAN TABLE
EXEC CICS ASSIGN FCI(STOPFCI)
CLI STOPFCI,X'01' TERMINAL ORIENTED ?
BE STOP0004 YES. CHECK IT OUT
MVI 13(R9),X'FF' SET IT AS STARTED
B STOP0070 CONTINUE
STOP0004 EQU *
*
* THE USER HAS ISSUED A REQUEST FROM A TERMINAL TO START
* THE PLXSTOP PROGRAM. WE WILL DO THAT WITH A REQUEST TO
* START THE PLXS TRASACTION.
*
XC S2KCSHD,S2KCSHD CLEAR SHUTDOWN FLAG
EXEC CICS START TRANSID('PLXS')
MVI 13(R9),X'FF' YES. SET AS STARTED
EXEC CICS SEND FROM(STOPMSG1) LENGTH(50) ERASE
B STOP9960 RETURN TO CICS
*********************************************************************
* **
* PROCESS STOP S2K FOR ALL INACTIVE TASKS THAT HAVE URBS ASSIGNED **
* **
*********************************************************************
STOP0070 EQU *
CLC S2KCSHD,=F'-1' SHUTDOWN SET ?
BE STOP9950 YES. WRAPUP
L R8,S2KPLXU ADDRESS PLEX URBS
*
* REGISTER 8 POINTS TO THE FIRST PLEX URB (FROM PARM LIST)
*
STOP0072 EQU *
TM URBFLAG2,X'80' PSUEDO CONVERSATIONAL USER ?
BO STOP0074 YES. BY PASS THIS URB
OC URBUSER,URBUSER URB IN USE ?
BZ STOP0074 NO. CHECK NEXT ONE
*
* URB IN USE, SHOULD HAVE TASK NUMBER ASSOCIATED WITH IT.
* VERIFY THAT TASK IS STILL ACTIVE. IF NOT, STOP S2K USER.
*
EXEC CICS INQUIRE TASK(URBTASK) TRANSACTION(STOPTRN) RESP(STOPRC)
CLC STOPRC,=F'0' OKAY ?
BNE STOP0080 NO. HANDLE URB
STOP0074 EQU *
TM URBFLAG1,URBLAST LAST URB ?
BO STOP9000 YES. FINISH UP
AH R8,URBLEN NEXT URB
B STOP0072 CHECK IT
STOP0080 EQU *
*
* CHECK TRAN CODE FOR ONE THAT DOESN'T GET STOP ISSUED FOR IT.
* R5 POINTS TO TRAN CODE LIST.
*
LA R15,ACCTPGM ADDR TRAN CODE IN URB
LTR R6,R5 ADDRESS TRANSACTION TABLE
BZ STOP0090 NO TRAN TABLE. PROCESS URB
STOP0085 EQU *
CLC 2(4,R6),0(R15) MATCH ?
BE STOP0074 YES. BYPASS PROCESSING
CLI 0(R6),X'FF' NO. END OF TABLE ?
BE STOP0090 YES. PROCESS THE URB
LA R6,6(R6) NEXT ENTRY IN TRAN TABLE
B STOP0085 CHECK IT
STOP0090 EQU *
*
* FOR THE USER THAT HAS TRANSACTIONS THAT ARE NOT MARKED AS
* PSUEDO-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.
*
B STOP0095 BYPASS NEXT TRAN ID CHECK
*
* CHECK IS NEXT TRANSACTION ID IS SET IN TERMINAL DEFINITION
* AND IF SO BYPASS STOP S2K LOGIC.
*
EXEC CICS INQUIRE TERMINAL(URBUSER) NEXTTRANSID(STOPTRN)
CLC STOPTRN,=CL4' ' ALL BLANK ?
BNE STOP0074 NO. MUST BE SET, BYPASS STOP
STOP0095 EQU *
MVC PLXUID,URBUSER SET USER ID
ST R8,PLXURB SET URB ADDRESS
OI URBFLAG1,URBERR+URBSTOP SET ERROR TASK AND NO STOP
BAL R14,STOP0100 PROCESS AN URB
B STOP0074 CONTINUE
EJECT
***********************************************************************
* *
* PROCEDURAL LANGUAGE URB HANDLING FOLLOWS. *
* *
***********************************************************************
*
STOP0100 EQU *
MVI PLXTFLG,X'01' A USER STOPPED
ST R14,R14SAV1 SAVE R14
NI URBFLAG1,X'FF'-URBSTOP RESET URBSTOP FLAG
MVI PLXTFLG,X'02' SET FOR NO DISPLAY
XC DUMCOM(120),DUMCOM ZERO COMMBLOCK
LA R1,DUMCOM UNIVERSAL DUMMY C B
ST R1,AS2KDM SET IN PARMS AS S2KDUM
ST R1,ACOMBK FILL PARM LIST
ST R1,ASCHEM
ST R1,ALIST
MVC DUMCOM,=F'92' SIMULATE STOP S2K COMMAND
MVI URBOPCOD,#URBONOR SUBMIT
B STOP0110 GO ON
*
STOP0105 EQU *
MVI URBOPCOD,X'00' INDICATE CLEAR OPERATION
STOP0110 DS 0H
LA R0,SVCPOSTC R0 <- POST SVC OP CODE
*
** ISSUE SVC
*
ST R0,PLXSVCC SET FUNCTION CODE
XC URBECB,URBECB CLEAR ECB
EXEC CICS LINK PROGRAM('S2KADRC') COMMAREA(PLXCOMM) LENGTH(500)
L R0,PLXRTCD SET RETURN CODE
*
LTR R0,R0 SUCCESSFUL RETURN CODE ?
BNZ STOP0150 NO ->TRY TO CLEAR SVC SLOT
*
** WAIT FOR RESPONSE FROM SYSTEM 2000.
*
LA R4,URBECB
TM URBTYPE2,#URBXMS IS THIS XMS?
BO STOP0132 YES...WAIT ON THIS URB
TM URBTYPE,#URBMVS IS THIS MVS?
BZ STOP0130 NO.
L R4,URBDUP WAIT ON URB IN CSA
STOP0130 EQU *
OI URBMUFLG-URBECB(R4),#URBWAIT TELL MU NO POST YET
STOP0132 EQU *
EXEC CICS WAIT EVENT ECADDR(R4)
TM URBTYPE2,#URBXMS IS THIS XMS?
BO STOP0140 YES..CHECK STATUS
TM URBTYPE,#URBMVS IS THIS MVS?
BZ STOP0140 NO...CHECK STATUS
L R15,URBDUP -> URB IN CSA
L R14,0(,R15) GET POST CODE FROM CSA
ST R14,URBECB MOVE TO INTERFACE URB
MVI 0(R15),X'00' CLEAR HIGH ORDER BYTE
NI URBMUFLG-URBECB(R15),X'FF'-#URBWAIT TELL MU POSTED
STOP0140 EQU *
*
** CHECK FOR POSSIBLE OUTPUT RESULTING FROM STOP S2K
*
CLI STATUS,#URBSWM
BL STOP0150 NO OUTPUT...DISCONNECT
CLI STATUS,#URBSWR
BH STOP0150 NO OUTPUT...DISCONNECT
MVI URBOPCOD,#URBOCIO LINE OF OUTPUT WRITTEN
B STOP0110 GO TO CHECK FOR MORE
STOP0150 EQU * DISCONNECT THE USER
*
* FREE LINK STORAGE
*
LA R4,10 LOOP CONTROL
LA R5,PILINKAR ADDRESS OF LINK BLOCK
USING PILINK,R5
STOP0160 EQU *
L R2,LNKRI ADDR LINK STORAGE
LTR R2,R2 VALID ?
BZ STOP0170 NO. FINISH FREE URB
XC LNKRI,LNKRI CLEAR POINTER
LA R5,LNKLNGTH(R5) NEXT ONE
BCT R4,STOP0160 DO IT
STOP0170 EQU *
*
* FREE URB
*
XC URBECB,URBECB CLEAR ECB
XC URBDUP,URBDUP DUPLICATE POINTER
XC URBECHO(URBUADDR-URBECHO),URBECHO REST OF URB
XC URBTCB(URBOPCOD-URBTCB),URBTCB MORE OF IT
XC URBSVC(URBCFLEN-URBSVC),URBSVC EVEN MORE
NI URBFLAG1,URBLAST CLEAN UP FLAG1
XC URBFLAG2,URBFLAG2 FLAG2 CLEAR
XC URBPLEXT(256),URBPLEXT CLEAN UP PLEX EXTENTION
XC URBPLEXT+256(256),URBPLEXT+256 "
XC URBPLEXT+512(URBPLEN$-URBBLEN$-512),URBPLEXT+512
L R14,R14SAV1 RESTORE RETURN ADDRESS
BR R14 RETURN
EJECT
**********************************************************************
* *
* DELAY FOR SPECIFED TIME INTERVAL *
* DEFAULT IS 00-HOURS 00-MINUTES 20-SECONDS
* CHANGE ACCORDING TO REQUIREMENTS
* *
**********************************************************************
STOP9000 EQU *
EXEC CICS DELAY INTERVAL(S2KCSTWT)
B STOP0070 RUN URBS AGAIN
EJECT
**********************************************************************
* *
* RETURN TO CALLING PROGRAM *
* *
**********************************************************************
STOP9950 EQU *
EXEC CICS DUMP DUMPCODE('ST02') TASK
LA R1,S2KPLST ADDRESS PARMS
MVI 13(R1),X'01' SET AS BEING STOPPED
STOP9960 EQU *
EXEC CICS RETURN
EJECT
**********************************************************************
* *
* PLXSTOP DEFINED CONSTANTS AND DEFINED STORAGE *
* *
**********************************************************************
STOPMSG1 DC CL50'PLXSTOP - START ISSUED FOR PLXS TRAN'
EJECT
LTORG
PLXCOMA
DS2KCUSE
DURBMU
DPLRBLKS
DSTOPPRM
END
./ CHANGE NAME=CICSIJCL
&STOPWT=000020, *10* X00010010
.* *10* 09JUN93 GOH B4707 ALLOW FOR NEW PLEX STOP S2K PROCESS *10* 00079010
PUNCH ' STOPWT=&STOPWT, *10* X00085010
****************' *10* 00085020
./ CHANGE NAME=DS2KCUSE
* *04* 09JUN93 GOH B4707 ALLOW FOR AUTOMATIC STOP S2K IN CICS 3.2 00006998
S2KCSHD DS F SHUTDOWN FLAG FOR PLXS TRAN *04* 00024010
S2KCSTWT DS F TIME TO WAIT TO ACTIVATE PLXS TRAN *04* 00024020
./ CHANGE NAME=DURBMU
.* DURBMU- 08 12MAY93 GOH B4707 CICS 3.2 'STOP S2K' PROCESS CHANGE 00011010
URBTASK DS F CICS TASK NUMBER *08* 00120010
DS 3F RESERVED *08* 00121000
./ CHANGE NAME=S2KUGEN
&STOPWT=000020, PLXSTOP WAIT INTERVAL *06* *00003010
.*06* GOH 13MAY93 B4707 CICS 3.X CHANGES FOR STOP S2K PROCESS 00042990
S2KCSHD DC F'0' SHUTDOWN SWITCH FOR PLXSTOP *06* 00080010
S2KCSTWT DC PL4'&STOPWT' PLXSTOP WAIT INTERVAL *06* 00080020
./ ADD NAME=DSTOPPRM
./ NUMBER NEW1=1000,INCR=1000
MACRO
DSTOPPRM
******************************************************************
* MAP OF THE STOP S2K PARAMETER LIST IN THE S2KCUSE LOAD MODULE *
******************************************************************
SPACE
DSTOPPRM DSECT
SPACE
STPMCON DS CL4 CONSTANT 'PLX '
STPMTRN DS F ADDRESS OF TRAN ID TABLE
STPMURB DS F ADDRESS OF START OF PLEX URBS
MEND
End of Zap Deck