***********************************************************************
* SAMP1 (SAMPLE PROGRAM 1) IS DESIGNED TO BE
* RELATIVELY EASY TO UNDERSTAND. IT ILLUSTRATES:
*
* 0 OPENING AND CLOSING A PROGRAM, INCLUDING A TPEND
* EXIT ROUTINE.
*
* 0 ESTABLISHING SESSIONS WITH LOGICAL UNITS IN A LOGON
* EXIT ROUTINE.
*
* 0 RECEIVING AND SENDING REQUESTS AS SYNCHRONOUS OPERATIONS.
* NOTE THAT THE RECEIVE USES OPTCD=ASY AND AN ECB FOLLOWED
* BY A MULTIPLE WAIT, IN ORDER TO ALLOW WHAT TPEND DOES
* (FOR EXAMPLE: SET A CLOSEDOWN SWITCH FOR MAINLINE) TO TAKE
* EFFECT EVEN DURING A LULL IN COMMUNICATION ACTIVITY.
*
* 0 RESETTING A SESSION TO CONTINUE-ANY MODE.
*
* 0 RECEIVING AND SENDING RESPONSES TO REQUESTS.
*
* 0 RESP, TPEND, LOSTERM, LERAD, AND SYNAD EXIT ROUTINES.
*
* 0 THE LINKAGE BETWEEN THE MAINLINE PROGRAM, VTAM, AND
* EXIT ROUTINES.
*
* SAMP1 (SAMPLE PROGRAM 1) UTILIZES THE FOLLOWING MACROS TO REMOVE
* OPERATING SYSTEM DEPENDENCIES
*
* 0 ENTER - ENTRY POINT LINKAGE FOR ROUTINES
* 0 EXIT - EXIT POINT LINKAGE FOR ROUTINES
* 0 GETSTOR - OBTAIN STORAGE FROM OPERATING SYSTEM
* 0 FREESTOR - RETURN STORAGE TO OPERATING SYSTEM
* 0 CHKECB - CHECKS ECB
* 0 ABTERM - HANDLES ABNORMAL TERMINATION
*
* SAMP1 (SAMPLE PROGRAM 1) IS ORGANIZED INTO:
*
* 0 MAINLINE PROGRAM.
* 0 LOGON EXIT ROUTINE.
* 0 RESP EXIT ROUTINE.
* 0 LERAD EXIT ROUTINE.
* 0 SYNAD EXIT ROUTINE.
* 0 TPEND EXIT ROUTINE.
* 0 LOSTERM EXIT ROUTINE.
***********************************************************************
MACRO
&NAME ENTER &SAVAREA=,&SAVE=,&TPEND=,&XTRA=0,&R14=,&OS=
***********************************************************************
*
* MACRO: ENTER - ROUTINE ENTRY LINKAGE
*
* PARAMETERS:
* SAVAREA: GET - GET THE STORAGE FOR A SAVEAREA
* NONE - NO SAVEAREA, DO NOT STORE REGISTERS
* SAVEAREA - NAME OR ADDRESS OF SAVEAREA
*
* SAVE: YES - SAVE THE CALLERS REGS IN THE SAVEAREA
* POINTED TO BY R13
* NO - DO NOT SAVE THE CALLERS REGS
* MAINLINE - DO NOT SAFE CALLERS REGS AND
* DO NOT DROP REG 12
*
* TPEND: CHECK - CHECK THE TPENDFLG, AND IF IT HAS
* BEEN TURNED ON, THEN EXIT W/O ANY ACTION
* NULL - DO NOT CHECK THE TPENDFLG
*
* XTRA: NUMBER - # OF EXTRA BYTES TO GET WHEN GETTING
* SAVEAREA
*
* R14: (REG) - REGISTER TO SAVE R14 IN FOR RETURN
* ADDRESS - ADDRESS OF PLACE TO SAVE R14
*
* OS: MVS - GENERATE LINKAGE AND MACROS FOR MVS
* VSE - GENERATE LINKAGE AND MACROS FOR VSE
*
* RETURNS:
* NORMAL:
* R12: BASE
* R13: SAVEAREA (IF REQUESTED)
* CALLERS REGS SAVED IN CALLERS SAVEAREA IF REQUESTED
* R2,R3,R6,R15: MAY BE DESTROYED
* R14(P) P CONTAINS R14 IF REQUESTED
*
* ABNORMAL:
* ABEND: CAN'T GET STORAGE, OR PROCESSING ERROR
* IMMEDIATE EXIT: TPEND=CHECK IS SPECIFIED AND TRUE
*
********************************************************************
GBLC &SYSTEM
LCLC &SAVED
GBLA &TPRET
GBLC &NEEDRET
&NEEDRET SETC '
AIF ('&SAVE' EQ 'MAINLINE').SKIPDRP
DROP R12 FROM PREVIOUS USING
.SKIPDRP ANOP
AIF ('&OS' EQ '').SKIPSYS
&SYSTEM SETC '&OS'
.SKIPSYS ANOP
&NAME DS 0H
.*
AIF ('&SAVE' NE 'YES').SKIPSAV
STM R14,R12,12(R13) SAVE CALLER'S REGS
&SAVED SETC 'YES'
.SKIPSAV ANOP
BALR R12,0 ESTABLISH BASE
USING *,R12 ESTABLISH ADDRESSABILITY
AIF ('&TPEND' NE 'CHECK').SKIPCHK
L R6,=A(TPENDFLG)
TM 0(R6),X'FF' HAS TPEND BEEN DRIVEN?
&TPRET SETA &TPRET+1
&NEEDRET SETC 'YES'
BO RET&TPRET YES, SO JUST EXIT
.SKIPCHK ANOP
AIF ('&R14' EQ '').SKIPR14
AIF ('&R14'(1,1) EQ '(').DOLOAD
ST R14,&R14 SAVE RETURN
ADDRESS
AGO .SKIPR14
.DOLOAD ANOP
LR &R14,R14
.SKIPR14 ANOP
AIF ('&SAVAREA' EQ 'NONE').SKIPMST
AIF ('&SAVAREA' NE 'GET').SKIPGET
LR R2,R0 SAVE R0
LR R3,R1 SAVE R1
GETSTOR 72+&XTRA GET SAVEAREA
LTR R15,R15 OK?
BZ ER&SYSNDX YES, CONTINUE
ABTERM 4
ER&SYSNDX DS 0H
LR R15,R1 SETUP R15
LR R0,R2 RESTORE R0
LR R1,R3 RESTORE R1
AGO .SKIPLD
.SKIPGET ANOP
AIF ('&SAVAREA' EQ '').SKIPLD
L R15,=A(&SAVAREA) GET ADDRESS
OF OUR SAVEAREA
.SKIPLD ANOP
AIF ('&SAVE' EQ 'MAINLINE').SKIPFOR
ST R13,4(R15) SAVE BACKWARD
POINTER
.*
AIF ('&SAVE' NE 'YES').SKIPFOR
ST R15,8(R13) SAVE FORWARD
POINTER
.SKIPFOR ANOP
LR R13,R15 SETUP SAVEAREA
POINTER
.SKIPMST ANOP
MEND******************************************************************
*
* MACRO: EXIT - ROUTINE EXIT LINKAGE
*
* PARAMETERS:
* SAVEAREA: FREE - FREE THE STORAGE FOR A SAVEAREA
*
* RESTORE: YES - RESTORE THE CALLERS REGS
* NO - DO NOT RESTORE THE CALLERS REGS
*
* XTRA: NUMBER - # OF EXTRA BYTES TO FREE WHEN FREEING
* SAVEAREA
*
* R14: (REG) - REGISTER THAT R14 WAS SAVED IN
* ADDRESS - ADDRESS OF PLACE R14 WAS SAVED
*
* RETURNS:
* NORMAL:
* R15: RETURN CODE IF SPECIFIED
* OTHER REGS RESTORED IF SPECIFIED
*
* ABNORMAL
** ABEND FOR FREEMAIN FAILURES
*
******************************************************************
MACRO
&NAME EXIT &RESTORE=,&R14=,&SAVAREA=,&RC=YES,&XTRA=0,&EOJ=NO
GBLC &SYSTEM
GBLA &TPRET
GBLC &NEEDRET
&NAME DS 0H
AIF ('&RESTORE' NE 'YES').SKIPRS1
L R2,4(R13) GET BACKWARD
SAVEAREA
AIF ('&RC' NE 'YES').SKIPRC1
ST R15,16(R2) SAVE RETURN
CODE
AGO .SKIPRC1
.SKIPRS1 ANOP
AIF (('&RC' NE 'YES') OR ('&RESTORE'
NE 'YES') ).SKIPRC1
LR R3,R15 SAVE RETURN
CODE
.SKIPRC1 ANOP
AIF ('&SAVAREA' NE 'FREE').SKIPFRE
FREESTOR LEN=72+&XTRA,AREA=(R13)
.SKIPFRE ANOP
AIF ('&RESTORE' NE 'YES').SKIPRS2
LR R13,R2 SETUP OLD SAVEAREA
LM R14,R12,12(R13) RESTORE ALL
REGS
AGO .SKIPRC2
.SKIPRS2 ANOP
AIF (('&RC' NE 'YES') OR ('&RESTORE' NE 'YES') ).SKIPRC2
LR R15,R3
AIF (('&SYSTEM' EQ 'VSE') AND ('&EOJ'
EQ 'YES')).DOEOJ
.SKIPRC2 ANOP
AIF ('&R14' EQ '').DORET
AIF ('&R14'(1,1) NE '(').DOLOAD
LR R14,&R14 GET RETURN
ADDRESS
AGO .DORET
.DOLOAD ANOP
L R14,&R14 GET RETURN
ADDRESS
.DORET ANOP
BR R14
AGO .TRYRET
.DOEOJ ANOP
EOJ
.TRYRET ANOP
AIF ('&NEEDRET' NE 'YES').SKIPRET
RET&TPRET DS 0H
AIF ('&RESTORE' NE 'YES').SKIPRS3
LM R14,R12,12(R13)
.SKIPRS3 ANOP
AIF (('&SYSTEM' EQ 'VSE') AND ('&EOJ'
EQ 'YES')).DOEOJ2
BR R14
MEXIT
.DOEOJ2 ANOP
EOJ
.SKIPRET ANOP MEND
******************************************************************
*
* MACRO: GETSTOR - GET STORAGE
*
* PARAMETERS:
* LEN: NUMBER - # OF BYTES OF STORAGE TO GET
*
* RETURNS:
* IF LEN BYTES OF STORAGE ARE SUCCESSFULLY OBTAINED,
* THEN R1 CONTAINS THE ADDRESS OF THE AREA AND R15
* CONTAINS ZERO
*
* IF THE STORAGE CANNOT BE OBTAINED THEN THE PROGRAM
* IS ABNORMALLY TERMINATED
*
*
******************************************************************
MACRO
&NAME GETSTOR &LEN
GBLC &SYSTEM
AIF ('&SYSTEM' EQ 'VSE').GETVSE
GETMAIN R,LV=&LEN
MEXIT
.GETVSE ANOP
GETVIS ADDRESS=(R1),LENGTH=&LEN
MEND******************************************************************
*
* MACRO: FREESTOR - FREE STORAGE
*
* PARAMETERS:
* LEN: NUMBER - # OF BYTES OF STORAGE TO FREE
*
* AREA: ADDR - ADDRESS OF AREA TO FREE
*
* RETURNS:
* IF LEN BYTES OF STORAGE ARE SUCCESSFULLY FREED, THEN
* R15 CONTAINS ZERO
*
* IF THE STORAGE CANNOT BE FREED THEN THE PROGRAM
* IS ABNORMALLY TERMINATED
*
******************************************************************
MACRO
&NAME FREESTOR &LEN=,&AREA=
GBLC &SYSTEM
AIF ('&SYSTEM' EQ 'VSE').FREEVSE
FREEMAIN R,LV=&LEN,A=&AREA
MEXIT
.FREEVSE ANOP
FREEVIS ADDRESS=&AREA,LENGTH=&LEN
MEND******************************************************************
*
* MACRO: CHKECB - CHECK ECB
*
* PARAMETERS:
* ECB: SPECIFIES ECB TO CHECK
*
* RETURNS:
* TM CONDITION CODE IS SET DEPENDING ON ECB BEING POSTED
*
******************************************************************
MACRO
&NAME CHKECB &ECB
GBLC &SYSTEM
LCLA &POST
LCLA &BYTE
AIF('&SYSTEM' EQ 'VSE').CKVSE
&POST SETA X'40'
&BYTE SETA 0
AGO .CHECK
.CKVSE ANOP
&POST SETA X'80'
&BYTE SETA 2
.CHECK ANOP
&NAME TM &ECB+&BYTE,&POST
MEND
******************************************************************
*
* MACRO: ABTERM - ABNORMAL TERMINATE
*
* PARAMETERS:
* 1ST POSITIONAL PARAMETER IS THE ABEND CODE, DEFAULTS TO ZERO
*
* RETURNS:
* (IT DOESN'T)
*
******************************************************************
MACRO
&NAME ABTERM
GBLC &SYSTEM
LCLC &CODE
AIF (N'&SYSLIST EQ 1).SETCODE
&CODE SETC '0'
AGO .DOIT
.SETCODE ANOP
&CODE SETC '&SYSLIST(1)'
.DOIT ANOP
AIF ('&SYSTEM' EQ 'VSE').ABVSE
&NAME ABEND &CODE,DUMP
MEXIT
.ABVSE ANOP
&NAME LA R10,&CODE
JDUMP
MEND
***********************************************************************
*
* NAME = MAINLINE PROGRAM
*
* FUNCTION = OPENS THE ACB, ISSUES SETLOGON, RECEIVES INPUT FROM
* ANY ESTABLISHED SESSION, SENDS A RESPONSE IF REQUESTED,
* FORWARDS INPUT TO A PROCESSOR, SENDS A REPLY PREPARED BY THE
* PROCESSOR, AND LOOPS BACK TO RECEIVE MORE INPUT AFTER SENDING
* THE REPLY. CLOSES THE ACB (CLOSES THE PROGRAM) IF A TPEND ECB
* IS POSTED BY VTAM HALT OR IF 'CLOSE ACB' IS ENTERED AS A
* A REQUEST.
*
* NOTE: THE PROGRAM HANDLES ONE REQUEST OF AN INPUT CHAIN AT A
* TIME. BE CAREFUL WITH HDX-FF PROTOCOLS.
*
* ENTRY POINT = SAMP1
*
* INPUT = REQUESTS RECEIVED FROM SESSIONS ESTABLISHED WITH LOGICAL
* UNITS; A POSTED TPEND ECB. EACH REQUEST CONTAINS A 6-BYTE
* HEADER DESCRIBING THE ACTION TO BE TAKEN. (SEE EQUATES IN
* MAINLINE PROGRAM CONSTANTS.) NOTE THAT DFASY INPUT
* CAUSES A CLSDST. BRACKET PROTOCOL IS NOT SUPPORTED AND
* CAUSES UNPREDICTABLE RESULTS.
*
* OUTPUT = REQUESTS AND RESPONSES SENT TO LOGICAL UNITS AS A RESULT
* OF INPUT REQUESTS. PROGRAM TERMINATION AND A DUMP IF THE
* PROGRAM CANNOT CONTINUE.
*
* EXTERNAL REFERENCES = OPEN, SETLOGON, RECEIVE, CLSDST,
* WAIT(M), CHECK, AND SEND.
*
* EXIT, NORMAL = BR 14
*
* EXIT, ABNORMAL = DUMP (DIRECTLY OR BY SYNAD OR LERAD).
*
* ATTRIBUTES = NOT SERIALLY REUSABLE
*
* REGS USED
*
* 3 = RETURN ADDRESS
* 4 = WORK REG
* 5 = A(PRPL)
* 12 = BASE REG
* 13 = A(SAVE0)
*
*********************************************************************
**********************************************************************
*
SAMP1 CSECT
ENTER SAVE=MAINLINE,SAVAREA=SAVE0,OS=MVS
**********************************************************************
* *
* OPEN THE ACB *
* *
**********************************************************************
GLBC &SYSTEM
OPNACB EQU *
SLR R15,R15
OPEN PACB ASSOCIATE THE PROGRAM WITH VTAM
LTR R15,R15 TEST FOR ERRORS
BZ OPENOK
**********************************************************************
* IT WOULD BE NORMAL HERE TO TEST FOR AN INVALID APPLID AND LET THE *
* VTAM OPERATOR KNOW OF THE PROBLEM RATHER THAN CAUSING AN ABEND. *
**********************************************************************
DUMP ST R1,R1CONTS SAVE THE CONTENTS OF REG 1
ABTERM
VERSION DC C'DATE OF LAST CHANGE 09/16/91'
OPENOK LA R5,PRPL SET UP BASE FOR RPL DSECT
USING IFGRPL,R5
SETLOGON RPL=PRPL,OPTCD=START ALLOW LOGON REQUESTS
LTR R15,R15 TEST FOR ERRORS
BNZ DUMP
**********************************************************************
* SOLICIT INPUT FROM ANY LOGICAL UNIT. *
**********************************************************************
RECANY MVI AREA1,C'*' SET ASTERISK IN 1ST BYTE OF
* AREA1 (FOR DEBUGGING PURPOSES)
MVC AREA1+1(L'AREA1-1),AREA1 ROLL IT
RECEIVE RPL=PRPL,AREA=AREA1,AREALEN=100,
OPTCD=(ASY,ANY,CS),ECB=RCVECB, RESP HANDLED BY EXIT
RTYPE=(DFSYN,DFASY)
**********************************************************************
* THE PARAMETER OPTCD=CS IS USED ON THE RECEIVE-ANY TO FORCE A *
* ROTATION OF THE SESSIONS WHICH COULD POSSIBLY SATISFY THE RECEIVE. *
* WITHOUT THIS PARAMETER, A BUSY SESSION COULD UNINTENTIONALLY LOCK *
* OUT OTHER SESSIONS SENDING DATA. *
**********************************************************************
LTR R15,R15 TEST FOR ACCEPTANCE
BNZ DUMP DUMP IF NOT ACCEPTED
CHKECB RCVECB
BO CHECK YES, BYPASS WAITM SVC
AIF ('&SYSTEM' EQ 'VSE').WAITVSE
WAIT ECBLIST=ECBLST
AGO .COMCODE
.WAITVSE ANOP
WAITM RCVECB,TPENDECB
.COMCODE ANOP
CHKECB TPENDECB
BO RETURN1 YES, GO TO CLOSE ACB
CHECK EQU *
OI RESETCAF,X'FF' INIT RESETSR CA NEEDED FLAG
CHECK RPL=PRPL NO, CHECK COMPLETION OF RECEIVE
LTR R15,R15 TEST FOR SUCCESSFUL COMPLETION
BNZ RECANY NO, CONTINUE WITH NEXT INPUT
**********************************************************************
* THE SYNAD EXIT ROUTINE WILL EITHER ISSUE A CLSDST TO TERMINATE THE *
* FAILING SESSION OR CLEAR THE EXCEPTION AND RESTORED THE SESSION TO *
* CONTINUE ANY MODE. *
**********************************************************************
TM RPLSRTYP,RPLDFASY DFASY RECEIVED?
BNO TESTRRN NO
CLSDST RPL=PRPL,OPTCD=SYN
**********************************************************************
* IGNORE THE POSSIBLE FAILURE OF THE CLSDST MACRO. THE SYNAD/LERAD *
* ROUTINES WILL HANDLE ANY ERRORS. *
**********************************************************************
B CHCKTPND ALLOW FOR PROGRAM CLOSEDOWN
TESTRRN EQU *
TM RPLVTFL2,RPLRRN RRN RESPONSE WANTED
BO TESTEXCP
TM RPLVTFL2,RPLNFME TEST FOR NO RESPONSE
BO PROCESS
TESTEXCP EQU *
TM AREACODE,AEXCEPT EXCEPTION RESPONSE WANTED?
**********************************************************************
* THE PRECEDING TEST WAS CHANGED FROM A 'CLI' INSTRUCTION TO A 'TM' *
* INSTRUCTION TO PROCESS EBCDIC HEADERS. *
**********************************************************************
BNO RESPTEST NO, CHECK FOR DEFINITE RESPONSE
MVC RPLSSEO,AREASENS SET SYS SENSE OUTPUT
MVC RPLSSMO,AREASENS+1
MVC RPLUSNSO,AREASENS+2
OI RPLVTFL2,RPLEX
NI RPLOPT5,X'FF'-RPLDLGIN SET OPTCD=CA FOR SENDD
B SENDRESP SEND THE EXCEPTION RESPONSE
RESPTEST TM RPLVTFL2,RPLEX
BNO SENDRESP DEFINITE RESP SO LEAVE OPTCD=CS
NI RPLOPT5,X'FF'-RPLDLGIN SET OPTCD=CA FOR SENDD
B PROCESS
SENDRESP EQU *
SEND RPL=PRPL,STYPE=RESP,OPTCD=(SYN,SPEC) SEND PREPARED RESP
LTR R15,R15 TEST FOR SUCCESSFUL COMPLETION
BNZ DUMP DUMP IF SEND COULD NOT BE
* SCHEDULED
NI RESETCAF,X'00' TURN OFF RESETSR CA NEEDED FLAG
PROCESS EQU *
TEST1 EQU *
CLOSETST CLC AREADATA(9),=C'CLOSE ACB' IS CLOSE ACB REQUESTED
BNE TEST2
OI TPENDFLG,X'80' SET ON TPEND FLAG TO CLOSE ACB
TEST2 EQU *
OI AREACODE,ASAD
TM AREACODE,AECHOB IS TERMINAL ECHO NEEDED?
BNO TEST3
OI AREACODE,AECHO YES, TURN ON ECHO FLAG
NI AREACODE,X'FF'-AECHOB TURN OFF PLEASE ECHO BACK FLAG
SENDDATA EQU *
SENDD SEND RPL=PRPL,STYPE=REQ, NOTE THAT THIS
OPTCD=SYN,POST=SCHED LEAVES CA,CS AS SET ABOVE.
LTR R15,R15 TEST FOR SUCCESSFUL COMPLETION
BNZ DUMP DUMP IF SEND COULD NOT BE SCHED
NI RESETCAF,X'00' TURN OFF RESETSR CA FLAG
TEST3 EQU *
CLI RESETCAF,X'FF' IS A RESETSR CA NEEDED
BNE TEST4
RESETSR RPL=PRPL,OPTCD=(CA,SYN)
LTR R15,R15
BNZ DUMP
TEST4 EQU *
CHCKTPND CLI TPENDFLG,X'80' SEE IF TPEND IS SIGNALLED
BNE RECANY IF NOT, BRANCH BACK TO RECEIVE
RETURN1 MVI TPENDFLG,X'FF' SIGNAL CLOSE IN PROGRESS TO
**********************************************************************
* *
* CLOSE THE ACB AND EXIT THE PROGRAM *
* *
**********************************************************************
CLOSE PACB CLOSE THE ACB
EXIT SAVAREA=SAVE0,EOJ=YES
*
*
**********************************************************************
**********************************************************************
* *
* VARIABLE DECLARATIONS *
* *
**********************************************************************
*
**********************************************************************
* *
* ACB, RPL, AND EXLST *
* *
**********************************************************************
PACB ACB AM=VTAM,APPLID=APPL1,EXLST=EXLST1,MACRF=LOGON
EXLST1 EXLST AM=VTAM,LOGON=LOGON1,SYNAD=SYNAD1,LERAD=LERAD1,
RESP=RESP1,TPEND=TPEND1,LOSTERM=LOSTERM1
PRPL RPL AM=VTAM,ACB=PACB
**********************************************************************
* *
* CONSTANTS *
* *
**********************************************************************
R1CONTS DC F'0' SAVE AREA FOR REG 1 IN DUMP
ECBLST DC A(RCVECB)
DC X'80' END OF ECB LIST MARKER
DC AL3(TPENDECB)
RCVECB DC F'0' ECB USED FOR RECANY
TPENDECB DC F'0' ECB POSTED BY TPEND EXIT
TPENDFLG DC X'00' SET BY MAINLINE TO FORCE CLOSE
RESETCAF DC X'00' RESETSR CA NEEDED IF 00
SAVE0 DC 18F'0' SAVE AREA NEEDED FOR MAINLINE
* PROGRAM
APPL1 DC X'08' APPLID FOR ACB
DC CL8'PROG1'
AREAOFLO DC C'*THIS SHOULD NOT BE DISPLAYED: CHECK RECLEN'
**********************************************************************
* *
* LOCAL STORAGE VARIABLES *
* *
**********************************************************************
DS 0H
AREA1 DS 0CL100 I/O DATA AREA
AREAHEAD DS 0CL6 HEADER
AREACODE DS XL1
RSV1 DS XL1 RESERVED
AREASENS DS XL4 SENSE FIELD WHEN AREACODE='01'
AREADATA DS CL94 DATA FIELD
**********************************************************************
* *
* EQUATES FOR INPUT/OUTPUT *
* *
**********************************************************************
AEXCEPT EQU X'01' PLEASE RETURN AN EXCEPTION
* RESPONSE AS SPECIFIED IN
* AREASENS
AECHOB EQU X'04' PLEASE ECHO THIS BACK TO ME
ASAD EQU X'80' SEND THIS MESSAGE TO THE SCREEN
AECHO EQU X'02' THIS IS THE ECHO YOU REQUESTED
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
LTORG
EJECT
IFGRPL AM=VTAM
EJECT
ISTUSFBC
EJECT
IFGACB AM=VTAM
EJECT
IFGEXLST AM=VTAM
*
*
***********************************************************************
*
* NAME = LOGON EXIT ROUTINE
*
* FUNCTION = ESTABLISH A SESSION AND SEND A 'LOGON ACCEPTED'
* MESSAGE TO ANY LOGICAL UNIT THAT LOGS ON IF THE LOGON MESSAGE
* STARTS WITH 'XYZ'; OTHERWISE, REJECT THE REQUEST FOR A SESSION.
*
* ENTRY POINT = LOGON1
*
* INPUT
* REGISTERS
* 0 = UNPREDICTABLE
* 1 = POINTER TO A 4-WORD PARAMETER LIST
* 2-13 = UNPREDICTABLE
* 14 = ADDRESS TO RETURN CONTROL TO
* 15 = ENTRY ADDRESS OF THIS ROUTINE
* PARAMETER LIST - 6 WORDS
* 1 = ACB ADDRESS
* 2 = POINTER TO SYMBOLIC NAME OF LOGICAL UNIT
* 3 = ZEROS
* 4 = LENGTH OF LOGON MESSAGE
* 5 = ADDRESS OF READ-ONLY RPL
* 6 = CID OF PENDING ACTIVE SESSION
*
* OUTPUT
* A REQUEST TO VTAM TO ACCEPT OR REJECT THE SESSION; OR PROGRAM
* TERMINATION AND A DUMP IF UNABLE TO CONTINUE. IF SESSION IS
* ESTABLISHED, A 'LOGON ACCEPTED' MESSAGE IS SENT TO THE LOGICAL
* UNIT SPECIFYING EXCEPTION RESPONSE ONLY.
*
* EXTERNAL REFERENCES = INQUIRE, OPNDST, CLSDST, SEND.
*
*
* EXIT, NORMAL = BR 14
*
* EXIT, ABNORMAL = DUMP
*
* ATTRIBUTES = SERIALLY REUSABLE
*
* REGS USED
*
* 3 = RETURN ADDRESS
* 4 = A(SYMBOLIC NAME OF LU)
* 5 = A(PRPLCONN),IFGRPL
* 6 = A(LOGON EXIT PARM LIST)
* 7 = A(PNIB),ISTDNIB
* 8 = LENGTH OF LOGON MESSAGE
* 9 = ACB ADDRESS
* 12 = BASE REG
* 13 = A(SAVE2)
*
***********************************************************************
SAMP1 CSECT RESTART CSECT
LOGON1 ENTER SAVE=NO,SAVAREA=SAVE2,TPEND=CHECK,R14=SAVE1
* LOGONS
LR R6,R1 SAVE THE PARAMETER LIST ADDRESS
L R9,0(R6) PICK UP ACB ADDRESS
L R4,4(R6) POINT TO THE SYMBOLIC NAME OF
* THE LOGICAL UNIT
LA R5,PRPLCONN SET UP BASE FOR RPL DSECT
LA R7,PNIB LOAD BASE FOR NIB DSECT
USING IFGRPL,R5
USING ISTDNIB,R7
MVC NIBSYM,0(R4)
MVC NIBUSER,4(R4)
MVC NIBCID, 20(R6) PUT CID INTO NIB FOR OPNDST
MVC RPLUSFLD,4(R4) PUT USER FIELD IN OPNDST RPL ...
* VTAM DOES NOT SET IT ON OPNDST
MVC FIRSTMID(8),0(R4) PUT ID IN GOOD MORNING MESSAGE
B VALIDATE
CANCEL2 ST R1,R1CONTS2 SAVE THE CONTENTS OF REGISTER 1
ABTERM
**********************************************************************
* VALIDATE THE LOGON MESSAGE *
**********************************************************************
VALIDATE EQU *
L R8,12(R6) PUT LENGTH OF LOGON MSG IN 8
LTR R8,R8 IS LOGONMSG LENGTH ZERO?
BZ DISCONN YES -- TERMINATE THE SESSION
**********************************************************************
* CLEAR THE LOGON MESSAGE DATA *
**********************************************************************
MVI MSGAREA,C'*'
MVC MSGAREA+1(79),MSGAREA
INQUIRE INQUIRE RPL=PRPLCONN,OPTCD=LOGONMSG,NIB=PNIB, OBTAIN
AREA=MSGAREA,AREALEN=L'MSGAREA, LOGON
ACB=(R9) MESSAGE
LTR R15,R15
BNZ CANCEL2
LTR R0,R0 IS CONDITIONAL COMPLETION CODE 0
BZ COMPARE YES, CHECK MESSAGE
B DISCONN NO, SHOULD NOT OCCUR
COMPARE CLC MSGAREA(3),=C'XYZ' CHECK PASSWORD IN USER LOGON
* MESSAGE
BNE DISCONN IF NOT, CANNOT GRANT REQUEST
CONNECT OPNDST RPL=PRPLCONN,OPTCD=(SYN,ACCEPT,CA)
LTR R15,R15 SESSION ESTABLISHED SUCCESSFULLY
BZ SNDFIRST
B RETURN2
SNDFIRST EQU *
SEND RPL=PRPLCONN,AREA=FIRSTMSH,ACB=(R9), SEND FIRST MESSAGE
RECLEN=L'FIRSTMSG+6+L'FIRSTMID,OPTCD=CA, STILL SET
RESPOND=(EX,FME) INPUT MAY SATISFY RECANY.
* ABANDON THIS SESSION .....
* SYNAD WILL HAVE CLSDST FOR US
RETURN2 EXIT RESTORE=NO,R14=SAVE1
*
*TERMINATE THE SESSION
* IT MIGHT BE BETTER TO SEND A REJECTION MESSAGE TO THE VTAM
* OPERATOR BEFORE CLOSING.
DISCONN EQU *
CLSDST RPL=PRPLCONN,OPTCD=SYN,ACB=(R9),NIB=PNIB
* IF CONTROL RETURNS HERE THERE IS NO NEED TO TEST FOR SUCCESS OR
* FAILURE SINCE LERAD OR SYNAD COPE WITH FAILURE.
B RETURN2 IF SO, BRANCH TO RETURN
*
*
**********************************************************************
* *
* VARIABLE DECLARATIONS *
* *
**********************************************************************
*
**********************************************************************
* *
* RPL AND NIB *
* *
**********************************************************************
PRPLCONN RPL AM=VTAM
PNIB NIB ALLOW USE OF RESP EXIT FOR LU
PROC=(RESPX,TRUNC) AND TRUNCATE EXCESS INPUT DATA
**********************************************************************
* *
* CONSTANTS *
* *
**********************************************************************
SAVESENS DC F'0' SENSE FROM FAILED OPNDST
MSGAREA DC CL80' ' AREA FOR LOGON MESSAGE
FIRSTMSH DC XL6'840000000000' HEADER CODE FOR DISPLAY ON
* TERMINAL AND ECHO BACK TO
* PROG1.
FIRSTMID DC CL9'********-'
FIRSTMSG DC C'LOGON ACCEPTED. VTAM PROG READY FOR FIRST INPUT'
**********************************************************************
* *
* LOCAL STORAGE VARIABLES *
* *
**********************************************************************
SAVE1 DS F SAVE REG14 RETURN ADDRESS
SAVE2 DS 18F SAVEAREA FOR VTAM EXITS
R1CONTS2 DS F'0' SAVEAREA FOR REG 1 FOR DUMP
LTORG
EJECT
ISTDNIB INVOKE NIB, DEVCH, AND PROC
DSECT
*
**********************************************************************
**********************************************************************
* *
* RESP EXIT *
* *
**********************************************************************
SAMP1 CSECT CONTINUE SAMP1 CSECT
***********************************************************************
*
* NAME = RESP EXIT ROUTINE
*
* FUNCTION = RECEIVE A RESPONSE TO THE REQUEST SENT IN THE MAINLINE
* PROGRAM. IF THE RESPONSE IS NORMAL (POSITIVE), RESET THE SESSION
* TO CONTINUE-ANY MODE SO THAT THE MAINLINE PROGRAM RECEIVE
* OPTCD=ANY SPECIFIED ACCEPTS INPUT FROM IT. IF THE RESPONSE IS
* NEGATIVE, CALL SYNAD1 TO ANALYZE THE EXCEPTION AND TAKE
* WHATEVER ACTION IS POSSIBLE. SYNAD'S ACTION IS EITHER TO CLSDST
* THE FAILING SESSION OR TO PERFORM A SESSIONC CONTROL=CLEAR AND
* SDT. IN BOTH CASES CONTROL IS RETURNED TO THIS EXIT AT LABEL
* SYNRTURN.
*
* ENTRY POINT = RESP1
*
* INPUT
* REGISTERS
* 0 = UNPREDICTABLE
* 1 = ADDRESS OF A 5-WORD PARAMETER LIST
* 2-13 = UNPREDICTABLE
* 14 = ADDRESS TO RETURN CONTROL TO
* 15 = ENTRY ADDRESS TO THIS ROUTINE
* PARAMETER LIST - 5 WORDS
* 1 = ADDRESS OF THE ACB
* 2 = THE CID OF THE LOGICAL UNIT
* 3 = THE CONTENTS OF THE USERFLD (FROM
* THE NIB SPECIFIED AT OPNDST)
* 4 = UNPREDICTABLE
* 5 = THE ADDRESS OF A READ-ONLY RPL THAT IS
* USED TO DETERMINE WHAT KIND OF RESPONSE
* HAS BEEN RECEIVED
*
* OUTPUT = A RESETTING TO CONTINUE-ANY MODE FOR ANY SESSION
* FROM WHICH A RESPONSE IS RECEIVED.
*
* EXTERNAL REFERENCES = RESETSR, SYNAD1.
*
* EXIT, NORMAL = BR 14
*
* EXIT, ABNORMAL = DUMP
*
* ATTRIBUTES = SERIALLY REUSABLE
*
* REGS USED
*
* 3 = RETURN ADDRESS
* 4 = A(PRPLR),IFGRPL
* 5 = A(VRPL),IFGRPL
* 6 = WORK,A(RESP1 PARM LIST)
* 8 = CID
* 9 = A(ACB)
* 12 = BASE REG
* 13 = A(SAVE2)
***********************************************************************
RESP1 ENTER SAVE=NO,R14=SAVE4,TPEND=CHECK
*
LR R6,R1 SAVE PARAMETER LIST ADDRESS
L R9,0(R6) PICK UP ACB ADDRESS
L R5,16(R6) PUT ADDR OF READ ONLY RPL IN R5
LA R4,PRPLR INITIALIZE R4
DROP R5 FROM LOGON EXIT USE
USING IFGRPL,R4 BASE ON PRPLR
MVC RPLARG,4(R6) MOVE CID TO PRPLR FOR RESETSR
NI RPLEXTDS,X'FF'-RPLNIB TURN OFF NIB FLAG
DROP R4
USING IFGRPL,R5 BASE ON READ-ONLY RPL
TM RPLVTFL2,RPLEX NORMAL RESPONSE?
BO EXCEPTN
B RESET
CANCEL3 ST R1,R1CONTS3 OTHERWISE, MUST TERMINATE AND
* ABEND
RESET RESETSR RPL=PRPLR,OPTCD=CA, RESET THE SESSION FOR
RTYPE=DFSYN,ACB=(R9) DFSYN INPUT. OPTCD-(SYN,SPEC)
LTR R15,R15 SEE IF RESETSR REQUEST ACCEPTED
BNZ CANCEL3 IF NOT, GO TO TERMINATE AND DUMP
RETURN3 EXIT RESTORE=NO,R14=SAVE4
*
EXCEPTN EQU * SET UP LINKAGE FOR SYNAD1
STM R14,R12,12(R13) SAVE REGISTERS
LA R0,4 SHOW EXTRAORDINARY COMPLETION
L R15,=A(SYNAD1)
LR R1,R5 POINT TO READ-ONLY RPL
BALR R14,R15 CALL SYNAD ROUTINE
SYNRTURN LM R1,R12,24(R13) RESTORE RESP EXIT REGS
LTR R15,R15 SUCCESSFUL RECOVERY?
BZ RESET YES, ALLOW NEXT TRANSACTION IN
**********************************************************************
* SYNAD SETS R15-R12 IF THE CLSDST MACRO WAS ISSUED TO TERMINATE THE *
* SESSION; IN THIS CASE, NO RESETSR SHOULD BE ISSUED *
**********************************************************************
B RETURN3 RETURN TO VTAM
*
*
**********************************************************************
* *
* VARIABLE DECLARATIONS *
* *
**********************************************************************
*
**********************************************************************
* *
* RPL *
* *
**********************************************************************
PRPLR RPL AM=VTAM COULD BE SAME ONE AS PRPLCONN
* SINCE BOTH ARE SYNCHRONOUSLY
* USED IN VTAM EXITS.
**********************************************************************
* *
* CONSTANTS *
* *
**********************************************************************
R1CONTS3 DC F'0' SAVEAREA FOR REG 1 AT DUMP
**********************************************************************
* *
* LOCAL STORAGE VARIABLES *
* *
**********************************************************************
SAVE4 DS F SAVEAREA FOR EXIT RETURN ADDRESS
LTORG
*
*
**********************************************************************
***********************************************************************
*
* NAME = LERAD EXIT ROUTINE
*
* FUNCTION = HANDLE TELEPROCESSING-ORIENTED LOGIC ERRORS
*
* ENTRY POINT = LERAD1
*
* INPUT
* REGISTERS
* 0 = RECOVERY ACTION RETURN CODE
* 1 = RPL ADDRESS
* 2-12 = UNPREDICTABLE
* 13 = ADDRESS OF SAVE AREA SUPPLIED TO MACRO THAT
* CAUSED LERAD ENTRY
* 14 = RETURN ADDRESS
* 15 = ADDRESS OF THIS ROUTINE'S ENTRY POINT
*
* OUTPUT = NONE
*
* EXTERNAL REFERENCES = GETMAIN (MVS/VM), FREEMAIN (MVS/VM).
*
* EXIT, NORMAL = BR 14
*
* EXIT, ABNORMAL = DUMP
*
* ATTRIBUTES = REENTRANT
*
* REGS USED
*
* 3 = RETURN ADDRESS
* 6 = A(RPL),IFGRPL
* 12 = BASE REG
* 13 = A(SAVEAREA)
***********************************************************************
LERAD1 ENTER SAVAREA=GET,SAVE=NO,R14=(R10)
DROP R5 USED IN RESP EXIT
USING IFGRPL,R1
CLI RPLFDB2,X'12'
BE IGNORE
CLI RPLFDB2,X'13'
BE IGNORE
CLI RPLFDB2,X'60' CLSDST W/SYMBOLIC NAME FAILED?
BE IGNORE YES SO IGNORE
B LEOVERID BRANCH AROUND DUMP ID
DC C'LERAD1' DUMP ID
R1DUMP DC F'0' REG1 CONTENTS AT DUMP
LEOVERID EQU *
ST R1,R1DUMP SAVE REG 1 FOR DUMP
ABTERM
IGNORE EQU *
SLR R0,R0 INDICATE SUCCESSFUL COMPLETION
SLR R15,R15 INDICATE SUCCESSFUL COMPLETION
EXIT SAVAREA=FREE,RESTORE=YES,R14=(R10)
LTORG
***********************************************************************
*
* NAME = TPEND EXIT ROUTINE
*
* FUNCTION = SET AN INDICATION FOR THE MAINLINE PROGRAM
* TO CLOSE THE ACB AND TERMINATE
*
* ENTRY POINT = TPEND1
*
* INPUT
* REGISTERS
* 0 = UNPREDICTABLE
* 1 = ADDRESS OF A 2-WORD PARAMETER LIST
* 2-13 = UNPREDICTABLE
* 14 = RETURN ADDRESS
* 15 = ADDRESS OF THIS ROUTINE'S ENTRY POINT
* PARAMETER LIST - 2 WORDS
* 1 = ADDRESS OF THE ACB
* 2 = A VALUE INDICATING WHY TPEND WAS ENTERED
*
* OUTPUT = INDICATION TO CLOSE ACB SET FOR MAIN PROGRAM
*
* EXTERNAL REFERENCES = POST.
*
* EXIT, NORMAL = BR 14
*
* EXIT, ABNORMAL = NONE
*
* ATTRIBUTES = SERIALLY REUSABLE.
*
* REGS USED
*
* 3 = RETURN ADDRESS
* 4 = A(TPENDECB)
* 12 = BASE REG
*
***********************************************************************
TPEND1 ENTER SAVE=NO,SAVAREA=NONE,R14=TPENDS14
L R4,=A(TPENDECB) POINT TO MAINLINE'S CLOSEDOWN ECB
POST (R4) INDICATE TPEND REQUIRED
EXIT RESTORE=NO,R14,=TPENDS14
TPENDS14 DC F'0' SAVE AREA FOR VTAM RETURN ADDRESS
LTORG
***********************************************************************
*
* NAME = SYNAD EXIT ROUTINE
*
* FUNCTION = HANDLE ERRORS AND SPECIAL CONDITIONS OTHER THAN
* TELEPROCESSING LOGIC ERRORS. ATTEMPTS TO CLEAR
* THE CONDITION OR TERMINATE THE SESSION.
*
* ENTRY POINT = SYNAD1
*
* INPUT
* REGISTERS
* 0 = RECOVERY ACTION RETURN CODE
* 1 = RPL ADDRESS (HIGH-ORDER BIT ON IF RECURSIVE ENTRY)
* 2-12 = UNPREDICTABLE
* 13 = ADDRESS OF SAVE AREA SUPPLIED PRIOR TO CAUSING
* SYNAD ENTRY
* 14 = RETURN ADDRESS
* 15 = ADDRESS OF THIS ROUTINE'S ENTRY POINT
*
* OUTPUT = A VALUE SET IN REGISTER 15:
* 0 = SUCCESSFUL RECOVERY
* 8 = EXCEPTION REQUEST RECEIVED
* 12 = CLSDST PERFORMED
*
* EXTERNAL REFERENCES = SESSIONC, SEND,
* RESETSR, CLSDST, GETMAIN (MVS/VM), FREEMAIN (MVS/VM),
* AND EXECRPL.
*
* EXIT, NORMAL = BR 14
*
* EXIT, ABNORMAL = DUMP
*
* ATTRIBUTES = QUASI-REENTERABLE. THIS ROUTINE IS REENTERED
* IF A MACROINSTRUCTION IT ISSUES FAILS. AS INDICATED
* BY THE HIGH-ORDER BIT OF REG 1 BEING ON UPON ENTRY
* TO SYNAD1. THE PROGRAM TERMINATES AND A DUMP IS
* REQUESTED. OTHERWISE, IF SYNAD IS REENTERED,
* PROCESSING CONTINUES.
*
* REGS USED
*
* 3 = RETURN ADDRESS
* 4 = ACTION CODE
* 5 = A(RPL),IFGRPL
* 6 = A(GETMAIN RPL),IFGRPL
* 7 = REG0 RETURN CODE
* 8 = REG15 RETURN CODE, A(PARMLIST FOR MANIP MACROS)
* 9 = A(PACB)
* 10 = LINKAGE TO SESSIONC
* 11 = CID
* 12 = BASE REG
* 13 = A(GETMAIN SAVEAREA),SAVE5
*
**********************************************************************
SYNAD1 ENTER SAVAREA=GET,SAVE=NO,XTRA=SDXTRA,R14=(R10)
DROP R1 USED IN LERAD EXIT
LR R5,R1 GET RPL ADDRESS
LR R4,R0 GET ACTION CODE
USING IFGRPL,R5
USING SDSECT,R13 SET BASE FOR REENTRANT WORKAREA
**********************************************************************
* CHECK FOR RECURSIVE ENTRY TO SYNAD *
**********************************************************************
ST R5,REGNWORK
TM REGNWORK,X'80' IS THIS RECURSIVE ENTRY TO SYNAD?
BO CANCEL4 YES -- CANCEL
OI REGNWORK,X'80' NO -- INDICATE RECURSION
L R5,REGNWORK SAVE RPL ADDRESS
LA R0,SRPLEND-SRPL SET LENGTH OF RPL IN R0
GETSTOR (R0)
LTR R15,R15
BNZ CANCEL4
MVC 0(SRPLEND-SRPL,R1),SRPL COPY SRPL
ST R1,REGNWORK POINT TO SYNAD1'S OWN RPL
OI REGNWORK,X'80' SET HIGH-ORDER BIT OF R6
L R6,REGNWORK (RPLSYN ADDRESS) FOR RECURSION.
L R9,=A(PACB) PICK UP ADDRESS OF ACB
L R11,RPLARG
CH R4,=H'16' IS IT OVER MAX FOR SYNAD?
BH CANCEL4 YES,GIVE UP
B *+4(R4) USE ACTION CODE IN BRANCH TABLE
B SNORM CODE=X'00' SHOULD NOT OCCUR
B SXTRA CODE=X'04' EXTRAORD. COMPLETION
B SRETRY CODE=X'08' RETRIABLE
B SDAMAGE CODE=X'0C' DAMAGE
B SENVIR CODE=X'10' ENVIRONMENT ERROR
*
SNORM SR R7,R7 INDICATE SUCCESSFUL
SR R8,R8 COMPLETION.
SABNORM L R0,SAVE6 LENGTH OF STORAGE TO BE FREED
SLL R6,1 GET RID OF HIGH-ORDER BIT
FREESTOR AREA=(R6),LEN=(R0)
LTR R15,R15
BNZ CANCEL4
EXIT RESTORE=NO,SAVAREA=FREE,RC=YES
SYNADR1 DC F'0' SPACE FOR R1
CANCEL4 ST R1,SYNADR1
ABTERM
*
SXTRA EQU * EXTRAORDINARY COMPLETION
SXPATHE TM RPLSSEI,RPLPATHI
BO SDISCONN
CLI RPLFDB2,X'03'
BE EXMSG YES--EXCEPTION REQUEST RECEIVED
* NO--EXCEPTION RESPONSE RECEIVED
LA R10,SNORM PREPARE FOR NORMAL RETURN
*
DROP R5
USING IFGRPL,R6
SESSIONC SESSIONC RPL=(R6),ACB=(R9),ARG=(R11), CLEAR SESSION
CONTROL=CLEAR,STYPE=REQ,OPTCD=SYN
LTR R15,R15
BNZ SDISCONN
SESSIONC RPL=(R6),CONTROL=SDT START DATA TRAFFIC
LTR R15,R15 SUCCESSFUL RECOVERY?
BNZ SDISCONN NO, TERMINATE THE SESSION
BR R10 YES, RETURN TO CALLER
DROP R6
USING IFGRPL,R5
*
EXMSG EQU * THIS CANNOT BE REACHED FROM THE RESP EXIT
TM RPLVTFL2,RPLNFME
BO STBAL
**********************************************************************
* MOVE SSENSEI TO SSENSEO *
**********************************************************************
MVC RPLSSEO,RPLSSEI
STEND EQU *
MVC RPLSSMO,RPLSSMI
SEND RPL=(R5),STYPE=RESP, SEND THE EXCEPTION RESPONSE
OPTCD=SYN
LTR R15,R15
BNZ SDISCONN
DROP R5
USING IFGRPL,R6
STBAL BAL R10,SESSIONC GO THROUGH CLEAR AND SDT
RESETSR RPL=(R6),RTYPE=DFSYN, RESTORE TO CA MODE
OPTCD=(SYN,CA)
LTR R15,R15
BNZ CANCEL4
LA R8,8 SIGNAL UNSUCCESSFUL COMPLETION
B SABNORM RETURN TO RECANY
*
SDISCONN EQU * UNRECOVERABLE ERRORS
CLSDST RPL=(R6),ACB=(R9),ARG=(R11)
LTR R15,R15
BNZ CANCEL4
LA R8,12 SIGNAL UNSUCCESSFUL RECOVERY
B SABNORM
*
SRETRY EQU *
**********************************************************************
* RETRY REQUEST *
**********************************************************************
EXECRPL RPL=(R5) RETRY FAILED MACRO
LTR R15,R15
BNZ CANCEL4
B SNORM RETURN TO ORIGINAL NSI
*
SDAMAGE EQU *
CLI RPLREQ,RPLRCVCD
BNE SNORM NO, PRETEND COMPLETION WAS OK
LA R8,16 YES, SET R15 CODE REG NONZERO
B SABNORM RETURN TO NSI, WHICH MAY BE
* ABLE TO IGNORE THE ERROR
*
SENVIR EQU *
CLI RPLREQ,RPLSNDCD
BE SDISCONN ATTEMPT TO CLSDST
CLI RPLREQ,RPLRSRCD
BE SDISCONN ATTEMPT TO CLSDST LU
LA R8,20 SET NONZERO CODE AND ALLOW
B SABNORM IN-LINE CODE TO RECOVER.
* (MAY BE AN OPNDST OR INQUIRE)
*
*
**********************************************************************
* *
* VARIABLE DECLARATIONS *
* *
**********************************************************************
**********************************************************************
* *
* BASED STORAGE AREA AND VARIABLES *
* *
**********************************************************************
SDSECT DSECT
SAVE5 DS 18F NEW SAVEAREA
SHOWWORK DS 0F
SFDBK2 DS F SPECIFIC REASON CODE
SSSENSMI DS F SYSTEM SENSE MODIFIER INPUT
REGNWORK DS F FOR RETRIABLE ERRORS
SAVE6 DS F LENGTH OF RPL
SARG DS F ARG - CID VALUE
SDXTRA EQU *-SHOWWORK
*
**********************************************************************
* *
* RPL *
* *
**********************************************************************
SAMP1 CSECT
SRPL RPL AM=VTAM RPL TO BE COPIED
SRPLEND EQU * END OF SRPL FOR LENGTH CALC.
SAMP1 CSECT
LTORG
*
*
**********************************************************************
**********************************************************************
*
* NAME = LOSTERM EXIT ROUTINE
*
* FUNCTION = HANDLE SITUATIONS IN WHICH A LOGICAL UNIT HAS
* UNEXPECTEDLY BECOME UNAVAILABLE
*
* ENTRY POINT = LOSTERM1
*
* INPUT
* REGISTERS
* 0 = UNPREDICTABLE
* 1 = ADDRESS OF A 4-WORD PARAMETER LIST
* 2-13 = UNPREDICTABLE
* 14 = RETURN ADDRESS
* 15 = ADDRESS OF THIS ROUTINE'S ENTRY POINT
* PARAMETER LIST - 4 WORDS
* 1 = ADDRESS OF THE ACB
* 2 = THE CID OF THE LOGICAL UNIT
* 3 = THE CONTENTS OF THE USERFLD (FROM THE NIB
* SPECIFIED AT OPNDST)
* 4 = A VALUE INDICATING WHY LOSTERM WAS ENTERED
*
* OUTPUT = TERMINATION OF THE SESSION
*
* EXTERNAL REFERENCES = CLSDST, DUMP
*
* EXIT, NORMAL = BR 14
*
* EXIT, ABNORMAL = DUMP
*
* ATTRIBUTES = SERIALLY REUSABLE.
*
* REGS USED
*
* 3 = RETURN ADDRESS
* 4 = A(PRPLCONN)
* 5 = A(ACB)
* 6 = CID
* 7 = A(TPENDFLG)
* 12 = BASE REG
* 13 = A(SAVE2)
*
*
**********************************************************************
LOSTERM1 ENTER SAVE=NO,SAVAREA=NONE,TPEND=CHECK,R14=SAVELOST
L R4,=A(PRPLCONN) POINT TO OPNDST/CLSDST RPL
L R5,0(R1) PICK UP ACB ADDRESS
DROP R6
USING IFGRPL,R4 BASE ON PRPLCONN
MVC RPLUSFLD,8(R1) MOVE USER FIELD
L R6,4(R1) PICK UP CID OF LOST TERMINAL
LR R8,R1 POINT TO PARMLIST
LOSTCLOS EQU *
CLSDST RPL=(R4),ACB=(5),ARG=(R6),OPTCD=(RELEASE,SYN)
LTR R15,R15
BZ RETURNL
ABTERM
RETURNL EXIT RESTORE=NO,R14=SAVELOST
*
*
**********************************************************************
* *
* VARIABLE DECLARATIONS *
* *
**********************************************************************
*
**********************************************************************
* *
* CONSTANTS *
* *
**********************************************************************
SAVELOST DC F'0'
LTORG
END SAMP1
z/OS Communications Server: SNA Programming
Copyright IBM Corporation 1990, 2014