//SLB0001 JOB (SYSGEN),'USERMOD: SLB0001', // CLASS=A, // MSGCLASS=A, // MSGLEVEL=(1,1), // REGION=4096K /*JOBPARM LINES=100 //JOBLIB DD DISP=SHR,DSN=SYS1.LINKLIB //* //********************************************************************* //* Install USERMOD SLB0001 (source: Shelby Beach) to install TSO * //* exit IKJEFF53 (source: Greg Price/CBT file #134) to validity * //* check JOBNAME on a CANCEL, OUTPUT, or STATUS TSO command. * //********************************************************************* //* //BUPDTE01 EXEC PGM=IEBUPDTE,PARM=NEW //SYSPRINT DD DUMMY //SYSUT2 DD DISP=SHR,DSN=SYS1.UMODSRC //SYSIN DD * ./ ADD NAME=IKJEFF53 IKJEFF53 TITLE 'MVS CUSTOM-BUILT IPO SUPPLIED FIB INSTALLATION EXIT C ' */* */* LIB: IPO1.SAMPLIB(IKJEFF53) */* GDE: CBIPO MVS CUSTOMIZATION */* DOC: THIS IS THE ASSEMBLER SOURCE CODE FOR THE */* SAMPLE MVS CUSTOM-BUILT IPO TSO OUTPUT, STATUS AND */* CANCEL EXIT ROUTINE. */* * MODULE NAME = IKJEFF53 * * * * DESCRIPTIVE NAME = MVS CUSTOM-BUILT IPO * * SUPPLIED FIB EXIT FOR TSO * * CANCEL, OUTPUT AND STATUS COMMANDS * * * * FUNCTION = * * VALIDITY CHECKS JOBNAME ON A CANCEL, OUTPUT OR * * STATUS FIB (FOREGROUND INITIATED BACKGROUND) * * COMMAND. ALLOWS FOR STATUS WITH JOBNAME 'TSO' * * * * OPERATION = * * STATUS: IF JOBNAME IS NOT 'TSO' RETURN TO * * CALLER SINCE ANY JOBNAME WILL BE ALLOWED. * * IF JOBNAME IS 'TSO' PUT OUT LIST OF USERIDS * * WITH ADDRESS SPACE ID AND TERMINAL ADDRESS * * OR SYMBOLIC TERMINAL NAME (TSO/VTAM). * * RETURN TO CALLER WITH RETURN CODE OF 12 TO * * SKIP JOBNAME SEARCH FOR 'TSO'. * * * * OUTPUT: FIRST CHECK IF THE USER HAS OPERATOR * * AUTHORITY. IF YES, ALLOW THE USER TO OUTPUT * * ANY JOBNAME. IF THE USER DOES NOT HAVE OPERATOR * * AUTHORITY COMPARE THE USERID WITH THE JOBNAME * * PASSED. IF THE JOBNAME IS NOT THE USERID OR * * DOES NOT START WITH THE USERID, THE JOBNAME * * IS REJECTED BY FIRST RETURNING TO THE CALLER * * AN ERROR MESSAGE AND A RETURN CODE REQUESTING * * THAT THE MESSAGE BE ISSUED VIA THE PUTLINE * * MECHANISM. WHEN REENTERED FOR THE JOBNAME, * * THE EXIT ISSUES A RETURN CODE REJECTING THE * * JOBNAME. * * * * CANCEL: FIRST CHECK IF THE USER HAS OPERATOR * * AUTHORITY. IF YES, ALLOW THE USER TO CANCEL * * ANY JOBNAME (THE MVS SYSTEM WILL PREVENT THE * * USER FROM CANCELLING STARTED TASKS AND TSO * * SESSIONS). IF THE USER DOES NOT HAVE OPERATOR * * AUTHORITY COMPARE THE USERID WITH THE JOBNAME * * PASSED. IF THE JOBNAME IS NOT THE USERID PLUS * * AT LEAST ONE CHARACTER, THE JOBNAME IS REJECTED * * BY FIRST RETURNING TO THE CALLER AN ERROR * * MESSAGE AND A RETURN CODE REQUESTING THAT THE * * THAT THE MESSAGE BE ISSUED VIA THE PUTLINE * * MECHANISM. WHEN REENTERED FOR THE JOBNAME, * * THE EXIT ISSUES A RETURN CODE REJECTING THE * * JOBNAME. * * CHANGED BY GREG PRICE OF FERNTREE TO ALLOW GIP * * CANCEL OF JOBS WITH NAMES EQUAL TO THE TSO GIP * * USERID. JES WILL NOT ALLOW THE CANCELLING GIP * * OF EXECUTING STARTED TASKS AND TSO SESSIONS, GIP * * BUT A GENERAL TSO USER WILL BE ABLE TO PURGE GIP * * SYSOUT FROM PRIOR TSO SESSIONS WHICH ARE GIP * * NOT YET ON A PRINT/PUNCH DEVICE. GIP * * * * NOTES = * * * * DEPENDENCIES = CHARACTER IS EBCDIC. REASSEMBLE * * IF A DIFFERENT CHARACTER SET IS NEEDED. * * * * RESTRICTIONS = USES SPKA FORM OF MODESET MACRO * * INSTRUCTION SO MUST RUN SUPERVISOR STATE. * * * * REGISTER CONVENTIONS = STANDARD CONVENTIONS. * * REGISTERS 0,1 = WORK REGISTERS * * REGISTER 2 = MODESET KEYADDR * * REGISTER 3 = WORK REGISTER * * REGISTERS 4 = ADDRESSABILITY TO EXIT * * PARAMETER LIST * * REGISTER 5 = RETURN CODE / ASVT MAXUSERS * * REGISTERS 6,7,8,9 = WORK REGISTERS * * REGISTER 10 = ADDRESSABILITY TO REJECT * * MESSAGE GETMAINED AREA * * REGISTER 11 = ADDRESSABILITY TO GETMAINED * * DATA AREA * * REGISTER 12 = ADDRESSABILITY TO IKJEFF53 * * CSECT * * REGISTER 13 = SAVE AREA REGISTER * * REGISTERS 14,15 = WORK REGISTERS * * * * PATCH LABEL = PATCH (UNUSED AND INTIALIZED TO * * 'ZAP*'S) * * * * MODULE TYPE = PROCEDURE * * * * PROCESSOR = ASM * * * * MODULE SIZE = 1K * * * * ATTRIBUTES = PROTECT KEY 1, REENTRANT, * * SUPERVISOR STATE * * * * ENTRY POINTS = IKJEFF53 (ONLY ENTRY POINT) * * * * LINKAGE = * * IKJEFF51: (CANCEL OR STATUS COMMAND) VIA CALL * * IKJCT469: (OUTPUT COMMAND) VIA CALL * * * * INPUT = REGISTER 1 POINTS TO PARAMETER LIST MAPPED * * BY IKJEFFIE MACRO * * * * OUTPUT = SEE EXIT TOPICAL HEADING BELOW * * * * EXIT - NORMAL = AT PROGRAM END VIA BRANCH REGISTER 14 * * * * OUTPUT = NONE * * * * RETURN CODE = ZERO * * * * EXIT - ERROR = AT PROGRAM END VIA BRANCH REGISTER 14 * * * * OUTPUT = MESSAGEP SET IN THE INPUT PARAMETER LIST. * * IF RETURN IS FROM STATUS FOR JOBNAME 'TSO' THEN * * RETURN CODE IS 12 AND NO MESSAGE WILL BE ISSUED. * * * * RETURN CODE = * * 4 - ISSUE PROMPT AND RETURN REPLY (IEPROMPT) * * 8 - ISSUE MESSAGE AND RETURN (IEMSG) * * 12 - REJECT THIS JOB (IEREJECT) * * 16 - TERMINATE THIS COMMAND (IEABORT) * * (THIS VERSION USES ERROR CODE 8 AND 12) * * * * EXTERNAL REFERENCES = * * * * ROUTINES = NONE * * * * DATA AREAS = NONE * * * * CONTROL BLOCKS = PARMLIST, CVT, ASVT, ASCB, TSB * * * * TABLES = DATA AREA TO BE GETMAINED. MAPPED BY DSECT * * BEGINNING AT LABEL DATA. * * * * MACROS = IKJEFFIE, FREEMAIN, GETMAIN, SAVE, TPUT, CVT, * * IKJTSB, IKTTSBX * * * * CHANGE ACTIVITY = * * * COMPARE OF USERID AND JOBNAME LENGTH MOVED CUJ* * CHECK FOR INVALID JOBNAME ADDED INJ* * * * MESSAGES = * * * * NO MESSAGES ARE ISSUED BY THIS MODULE UNLESS * * STATUS IS ISSUED FOR JOBNAME 'TSO'. * * MESSAGE TEXTS ARE, HOWEVER, PASSED BACK TO THE * * CALLER IN AN AREA GETMAINED BY THIS EXIT. * * FOR CANCEL THE MESSAGE IS THAT FOUND AT LABEL * * REJTEXT1. FOR OUTPUT THE MESSAGE IS THAT FOUND * * AT LABEL REJTEXT2. FOR STATUS WITH JOBAME 'TSO' * * TPUT IS USED TO PUT OUT LINES OF OUTPUT WHICH * * GIVE USERID, ADDRESS SPACE ID AND TERMINAL * * ADDRESS. A HEADER LINE IS FOUND AT LABEL * * HEADER AND A TRAILER LINE IS FOUND AT LABEL * * USERS. IF THIS MODULE ISSUED ITS OWN PUTLINE'S OR * * PUTGET'S WITH SECOND LEVELS, IT WOULD NEED TO DO * * MODESET TO KEY 0 BEFORE ISSUING THE MESSAGE(S). * * THEN DO A MODESET BACK TO KEY 1 BEFORE RETURNING * * TO THE CALLER. * * * * ABEND CODES = NONE * * * *********************************************************************** EJECT IKJEFF53 CSECT SAVE (14,12),,IKJEFF53.IPO.&SYSTIME..&SYSDATE SAVE REGISTERS * WITH CSECT IDENTIFIER BALR R12,0 BRANCH AND LOAD REGISTER 12 PSTART DS 0H LABEL USED WHEN ESTABLISHING USING PSTART,R12 CSECT ADDRESSABILITY L R0,SIZDATD LOAD REGISTER 0 WITH SIZE FOR * GETMAIN GETMAIN R,LV=(0) ISSUE REGISTER FORM OF GETMAIN * FOR AREA IN SUBPOOL 0 LR R11,R1 LOAD REGISTER 11 WITH ADDRESS OF * GETMAINED AREA USING DATD,R11 ESTABLISH ADDRESSABILITY TO * GETMAINED AREA ST R13,SAVEAREA+4 SAVE REGISTER 13 FOR SAVEAREA * CHAINING LM R0,R1,20(R13) RELOAD REGISTERS 0 AND 1 FROM * PREVIOUS SAVEAREA ST R11,8(,R13) SAVE ADDRESS OF CURRENT SAVEAREA LR R13,R11 LOAD REGISTER 13 WITH ADDRESS OF * CURRENT SAVEAREA LR R4,R1 LOAD REGISTER 4 WITH POINTER TO * PARAMETER LIST USING IEPARML,R4 ESTABLISH ADDRESSABILITY TO * PARAMETER LIST (USES * IKJEFFIE MAPPING MACRO) LA R5,IECONTIN INITIALIZE REGISTER 5 FOR RETURN * CODE FOR NORMAL CASE - JOBNAME * IS GOOD AND COMMAND SHOULD * CONTINUE PROCESSING SPACE 2 *********************************************************************** * * * ALWAYS DO PROCESSING * * * *********************************************************************** SPACE 2 L R6,IECODEP LOAD COMMAND CODE POINTER CLI 0(R6),IECANCEL SEE IF COMMAND IS CANCEL BE PROCESS YES....CONTINUE PROCESSING CLI 0(R6),IEOUTPUT SEE IF COMMAND IS OUTPUT BE PROCESS YES....CONTINUE PROCESSING CLI 0(R6),IESTATUS SEE IF COMMAND IS STATUS BNE ENDPROC NO.....DO NO PROCESSING * IF INVALID CODE SPACE 2 *********************************************************************** * * * SEE IF SECOND TIME ENTRY FOR A JOB - * * MESSAGE POINTER NOT ZERO * * * *********************************************************************** SPACE 2 PROCESS DS 0H L R6,IEMSGP LOAD MESSAGE POINTER LTR R6,R6 SEE IF MESSAGE ISSUED FOR LAST * ENTRY BNZ FREEMESS YES....GO FREE MESSAGE BUFFER SPACE 2 *********************************************************************** * * * DETERMINE IF THIS IS FOR CANCEL * * NO.....GO TO OUTPUT ROUTINE * * YES....IF USER HAS OPERATOR AUTHORITY THEN O.K. * * ELSE CHECK IF JOBNAME IS VALID FOR CANCEL * * CANCEL NEEDS JOBNAME EQUAL TO USERID * * PLUS AT LEAST ONE CHARACTER * * * *********************************************************************** SPACE 2 VALIDITY DS 0H L R6,IECODEP LOAD COMMAND POINTER CLI 0(R6),IECANCEL SEE IF COMMAND IS CANCEL BNE OUTPUT NO.....GO SEE IF OUTPUT COMMAND EXTRACT PSCBADDR,'S',FIELDS=PSB,MF=(E,EXTLIST) * GET ADDRESS OF PROTECTED STEP * CONTROL BLOCK L R1,PSCBADDR LOAD POINTER TO PSCB TM PSCBATR1(R1),PSCBCTRL SEE IF USER HAS OPERATOR * AUTHORITY BO ENDPROC YES....GO TO END OF PROCEDURE * O.K. TO CANCEL ANY JOBNAME L R15,IEIDLENP LOAD USERID LENGTH POINTER CLI 0(R15),0 CHECK WHETHER JOBNAME IS VALID BE BADJOBN JOBNAME IS INVALID IF USERID * IS NOT AVAILABLE (LENGTH=0 FOR * FOR TSO COMMANDS IN BACKGROUND) SLR R14,R14 ZERO REGISTER 14 IC R14,0(,R15) INSERT USERID LENGTH INTO * REGISTER 14 AND LOAD L R6,IENAMELP LOAD JOBNAME LENGTH POINTER CUJ CH R14,0(,R6) SEE IF USERID LENGTH IS GIP * LONGER THAN JOBNAME LENGTH GIP BH BADJOBN YES....GO BUILD INVALID GIP * JOBNAME MESSAGE CUJ L R6,IEUSRIDP LOAD USERID POINTER CUJ L R1,IEJOBNMP LOAD JOBNAME POINTER CUJ BCTR R14,0 DECREMENT R14 FOR CUJ EX R14,JOBNCOMP EXECUTE OF COMPARE CUJ BNE BADJOBN NO.....GO BUILD INVALID JOBNAME * MESSAGE B ENDPROC GO ACCEPT JOBNAME SPACE 2 *********************************************************************** * * * SEE IF THIS IS OUTPUT COMMAND * * NO.....GO TO STATUS ROUTINE * * YES....IF USER HAS OPERATOR AUTHORITY THEN O.K. * * ELSE CHECK IF JOBNAME IS VALID FOR OUTPUT * * OUTPUT NEEDS JOBNAME EQUAL TO USERID OR * * EQUAL TO USERID PLUS AT LEAST ONE CHARACTER * * * *********************************************************************** SPACE 2 OUTPUT DS 0H CLI 0(R6),IEOUTPUT SEE IF COMMAND IS OUTPUT BNE STATUS NO.....GO SEE IF STATUS COMMAND EXTRACT PSCBADDR,'S',FIELDS=PSB,MF=(E,EXTLIST) * GET ADDRESS OF PROTECTED STEP * CONTROL BLOCK L R1,PSCBADDR LOAD POINTER TO PSCB TM PSCBATR1(R1),PSCBCTRL SEE IF USER HAS OPERATOR * AUTHORITY BO ENDPROC YES....GO TO END OF PROCEDURE * O.K. TO OUTPUT ANY JOBNAME L R15,IEIDLENP LOAD USERID LENGTH POINTER CLI 0(R15),0 CHECK WHETHER JOBNAME IS VALID BE BADJOBN JOBNAME IS INVALID IF USERID * IS NOT AVAILABLE (LENGTH=0 FOR * FOR TSO COMMANDS IN BACKGROUND) SLR R14,R14 ZERO REGISTER 14 IC R14,0(,R15) INSERT USERID LENGTH INTO * REGISTER 14 L R6,IENAMELP LOAD JOBNAME LENGTH POINTER CUJ CH R14,0(,R6) SEE IF USERID LENGTH CUJ * IS EQUAL TO OR SHORTER CUJ * THAN JOBNAME LENGTH CUJ BH BADJOBN NO.....GO BUILD INVALID CUJ * JOBNAME MESSAGE CUJ L R6,IEUSRIDP LOAD USERID POINTER CUJ L R1,IEJOBNMP LOAD JOBNAME POINTER CUJ BCTR R14,0 DECREMENT R14 FOR EX R14,JOBNCOMP EXECUTE OF COMPARE BE ENDPROC EQUAL..RETURN TO CALLER SPACE 2 *********************************************************************** * * * REJECT THIS INVALID JOBNAME AND BUILD INVALID JOBNAME * * MESSAGE * * * *********************************************************************** SPACE 2 BADJOBN DS 0H BUILD BAD JOBNAME MESSAGE L R0,GETMINFO SUBPOOL 0, LENGTH DECIMAL 84 GETMAIN R,LV=(0) GET MESSAGE BUFFER ST R1,IEMSGP STORE POINTER TO MESSAGE BUFFER * INTO PARAMETER LIST LR R10,R1 LOAD REGISTER 10 WITH ADDRESS OF * GETMAINED AREA USING REJMSG,R10 ESTABLISH REGISTER 10 AS BASE * FOR REJECT MESSAGE DSECT MVI REJMSG,BLANK INITIALIZE BUFFER WITH BLANKS MVC REJMSG+1(83),REJMSG MVC REJMLEN(2),HALF84 PUT IN MAXIMUM MESSAGE LENGTH MVC REJJOB(4),JOBWORD PUT IN WORD 'JOB' L R1,IENAMELP LOAD JOBNAME LENGTH POINTER LH R15,0(,R1) LOAD JOBNAME LENGTH LR R14,R15 LOAD REGISTER 14 WITH LENGTH BCTR R14,0 DECREMENT REGISTER 14 FOR MOVE L R1,IEJOBNMP LOAD JOBNAME POINTER EX R14,MOVEJOBN INSERT THE BAD JOBNAME AH R15,HALF2 INDEX PAST BLANK AFTER JOBNAME LR R5,R15 LOAD REGISTER 5 AS TEMPORARY * SAVE AREA FOR REGISTER 15 SPACE 2 *********************************************************************** * * * SAME MESSAGE TEXTS FOR CANCEL AND OUTPUT GIP * * * *********************************************************************** SPACE 2 * L R1,IECODEP LOAD COMMAND POINTER * CLI 0(R1),IECANCEL SEE IF COMMAND IS CANCEL * BNE OUTPMESS NO.....GO TO OUTPUT MESSAGE * ALR R10,R5 OFFSET MESSAGE IN BUFFER * MVC REJSLOT-1(66),REJTEXT1 MOVE IN TEXT FOR CANCEL * B SETRC GO SET RETURN CODE *UTPMESS DS 0H ALR R10,R5 OFFSET MESSAGE IN BUFFER MVC REJSLOT-1(69),REJTEXT2 MOVE IN TEXT FOR OUTPUT SETRC DS 0H LA R5,IEMSG SET RETURN CODE TO PROMPT B ENDPROC GO TO RETURN SPACE 2 *********************************************************************** * * * SEE IF THIS IS STATUS COMMAND * * NO.....GO TO END OF PROCEDURE * * YES....CHECK IF NAME IS 'TSO' * * NO.....GO TO END OF PROCEDURE * * YES....PUT OUT USERIDS, ASIDS, AND ADDRESSES * * * *********************************************************************** SPACE 2 STATUS DS 0H CLI 0(R6),IESTATUS SEE IF COMMAND IS STATUS BNE ENDPROC NO.....GO TO END OF PROCEDURE L R1,IEJOBNMP LOAD POINTER TO JOBNAME CLC TSOWORD,0(R1) SEE IF JOBNAME IS 'TSO' BNE ENDPROC NO.....GO TO END OF PROCEDURE L R1,IENAMELP LOAD POINTER TO JOBNAME LENGTH CLC HALF3,0(R1) SEE IF JOBNAME LENGTH IS 3 BNE ENDPROC NO.....GO TO END OF PROCEDURE L R15,CVTPTR LOAD POINTER TO CVT USING CVTMAP,R15 ESTABLISH ADDRESSABILITY TO CVT L R6,CVTASVT LOAD POINTER TO ASVT DROP R15 DROP ADDRESSABILITY TO CVT L R5,ASVTMAXU(R6) LOAD MAXIMUM NUMBER OF ADDRESS * SPACES LA R6,ASVTENTY-4(R6) LOAD ADDRESS OF FIRST ASVT ENTRY * MINUS 4 LA R3,0 ZERO OUT USER COUNTER TPUT HEADER,L'HEADER PUT OUT HEADER LINE SPACE 2 *********************************************************************** * * * GO DOWN THE ADDRESS SPACE VECTOR TABLE * * SEE IF ADDRESS SPACE CONTROL BLOCK IS FOR A TSO USER * * YES....GET ADDRESS SPACE ID, USERID, AND PHYSICAL * * TERMINAL ADDRESS AND OUTPUT LINE * * NO.....GO CHECK NEXT ASCB * * * *********************************************************************** SPACE 2 ASCBNEXT DS 0H LTR R5,R5 SEE IF MAXUSER COUNTER ZERO BZ LASTASCB YES....GO HANDLE LAST ASCB BCTR R5,0 DECREMENT MAXUSER COUNTER MVI LINE,C' ' BLANK OUT THE OUTPUT LINE MVC LINE+1(L'LINE-1),LINE LA R6,4(R6) LOAD ADDRESS OF NEXT ASVT ENTRY L R7,0(R6) LOAD ADDRESS OF ACSB USING ASCB,R7 ESTABLISH ADDRESSABILITY TO ASCB TM 0(R6),X'80' SEE IF ASID IS AVAILABLE BO ASCBNEXT YES....GO ON TO NEXT ASVT ENTRY CLC ASCBASCB(4),ASCBWORD ENSURE CONTROL BLOCK IS VALID BNE ASCBNEXT NO.....GO ON TO NEXT ASVT ENTRY L R8,ASCBTSB LOAD ADDRESS OF TSB USING TSB,R8 ESTABLISH ADDRESSABILITY TO TSB LTR R8,R8 SEE IF ADDRESS ZERO - NOT TSO BZ ASCBNEXT ZERO...GO ON TO NEXT ASVT ENTRY MODESET EXTKEY=ZERO,SAVEKEY=(2) MODESET AND SAVE OLD KEY TM TSBFLG5,TSBVTAM SEE IF THIS IS A TSO/VTAM TSB BO GETTSBX YES....GO GET TSB EXTENSION LH R8,TSBLINE GET BINARY LINE ADDRESS STH R8,PACK STORE ADDRESS IN WORKAREA UNPK PACK+3(5),PACK(3) UNPACK THE ADDRESS MVC LINEADDR,PACK+4 MOVE UNPACKED ADDRESS INTO LINE TR LINEADDR,TRT-240 TRANSLATE TO EBCDIC B MODEREST GO MODESET AND RESTORE OLD KEY GETTSBX DS 0H L R9,TSBEXTNT GET ADDRESS OF TSB EXTENSION USING TSBX,R9 ESTABLISH ADDRESSABILITY TO TSBX TM TSBXFLG1,TSBXWREC SEE IF TERMINAL AWAITING RECON BNO GETSYM NO.....GO GET SYMBOLIC NAME MVC LINESYM(8),DISCON MOVE IN DISCON'D B MODEREST GO MODESET AND RESTORE OLD KEY GETSYM DS 0H MVC LINESYM(8),TSBTRMID MOVE IN TERMINAL SYMBOLIC NAME DROP R8,R9 MODEREST DS 0H MODESET KEYADDR=(2) MODESET AND RESTORE OLD KEY L R8,ASCBJBNS LOAD POINTER TO JOBNAME FIELD LTR R8,R8 SEE IF POINTER IS ZERO BZ STARTING YES....GO MOVE IN 'STARTING' MVC LINEUSID,0(R8) MOVE USERID TO PRINT LINE B EDITASID GO EDIT ASID TO EBCDIC STARTING DS 0H MVC LINEUSID,STRTWORD MOVE 'STARTING' TO PRINT LINE EDITASID DS 0H LH R8,ASCBASID LOAD ADDRESS SPACE ID CVD R8,PACK CONVERT TO DECIMAL MVC CHAR,EDMSK MOVE EDIT MASK TO CHAR ED CHAR,PACK+4 EDIT TO ASID TO EBCDIC MVC LINEASID,CHAR+5 MOVE THREE CHARS TO PRINT LINE LA R1,LINE LOAD POINTER TO LINE TPUT (R1),L'LINE PUT OUT OUTPUT LINE LA R3,1(R3) ADD 1 TO USER COUNT B ASCBNEXT GO ON TO NEXT ASVT ENTRY DROP R7 SPACE 2 *********************************************************************** * * * AT END OF ASVT CHAIN SO PUT OUT TSO USER COUNT * * AND SET RETURN CODE FOR USERID REJECT * * TO AVOID SEARCH FOR JOBNAME 'TSO' * * * *********************************************************************** SPACE 2 LASTASCB DS 0H CVD R3,PACK CONVERT USER COUNT TO DECIMAL MVC CHAR,EDMSK MOVE EDIT MASK TO CHAR ED CHAR,PACK+4 CONVERT DECIAML COUNT TO EBCDIC MVC LINE(4),CHAR+4 MOVE IN COUNT MVC LINE+4(L'USERS),USERS MOVE IN MESSAGE LA R1,LINE LOAD POINTER TO OUTPUT LINE TPUT (R1),L'LINE PUT OUT COUNT MESSAGE LA R5,IEREJECT TREAT AS IF JOBNAME REJECTED B ENDPROC GO TO END OF PROCEDURE SPACE 2 *********************************************************************** * * * SECOND TIME ENTRY (FREE MESSAGE BUFFER) * * * *********************************************************************** SPACE 2 FREEMESS DS 0H L R1,IEMSGP LOAD POINTER TO GETMAINED AREA L R0,GETMINFO LOAD SUBPOOL NUMBER AND LENGTH * OF GETMAINED AREA FREEMAIN R,LV=(0),A=(1) FREE MESSAGE BUFFER SLR R6,R6 ZERO OUT MESSAGE POINTER ENTRY ST R6,IEMSGP IN PARMLIST LA R5,IEREJECT SET RETURN CODE TO 12 - DELETE * ENTRY SPACE 2 *********************************************************************** * * * RETURN TO CALLER (STATUS, CANCEL, OR OUTPUT COMMAND) * * * *********************************************************************** SPACE 2 ENDPROC DS 0H L R13,4(,R13) RESTORE REGISTER 13 L R0,SIZDATD LOAD REGISTER 0 WITH SIZE OF * GETMAINED AREA LR R1,R11 LOAD REGISTER 1 WITH ADDRESS OF * GETMAINED AREA FREEMAIN R,LV=(0),A=(1) FREE GETMAINED AREA LR R15,R5 LOAD REGISTER 15 WITH RETURN * CODE L R14,12(,R13) LOAD REGISTER 14 WITH RETURN * ADDRESS LM R0,R12,20(R13) RESTORE REGISTERS BR R14 RETURN VIA REGISTER 14 EJECT ******** CONSTANTS AND DSECTS ********* DATA DS 0H JOBNCOMP CLC 0(0,R6),0(R1) MOVEJOBN MVC REJSLOT(0),0(R1) HALF84 DC H'84' HALF2 DC H'2' HALF3 DC H'3' JOBWORD DC CL4'JOB ' BLANK EQU C' ' DATD DSECT DS 0F SAVEAREA DS 18F EXTLIST EXTRACT MF=L PSCBADDR DS F PSCBATR1 EQU 16 PSCBCTRL EQU X'80' PACK DS D CHAR DS CL8 LINE DS CL26 ORG LINE+1 LINEUSID DS CL8 ORG LINE+11 LINEASID DS CL3 ORG LINE+17 LINEADDR DS CL3 ORG LINE+17 LINESYM DS CL8 ORG DS 0D ENDDATD EQU * IKJEFF53 CSECT DS 0F SIZDATD DC AL1(0) DC AL3(ENDDATD-DATD) *EJTEXT1 DC CL66'REJECTED - JOBNAME MUST BE YOUR USERID PLUS AT LEAS * T ONE CHARACTER' GIP REJTEXT2 DC CL69'REJECTED - JOBNAME MUST BE YOUR USERID OR MUST STARC T WITH YOUR USERID' HEADER DC CL21' USERID ASID LINE ' EDMSK DC XL8'4020202020202120' USERS DC CL20' USERS ARE LOGGED ON' TRT DC CL16'0123456789ABCDEF' TSOWORD DC CL3'TSO' ASCBWORD DC CL4'ASCB' STRTWORD DC CL8'STARTING' DISCON DC CL8'DISCON''D' GETMINFO DS 0F SUBPOOL AND LENGTH FOR GETMAIN * OF MESSAGE AREA GETMSP DC AL1(0) GETMLEN DC AL3(84) PATCH DC 8CL4'ZAP*' R0 EQU 00 EQUATES FOR REGISTERS 0-15 R1 EQU 01 R2 EQU 02 R3 EQU 03 R4 EQU 04 R5 EQU 05 R6 EQU 06 R7 EQU 07 R8 EQU 08 R9 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 ASVTENTY EQU 528 ASVTMAXU EQU 516 REJMSG DSECT DSECT FOR RETURN MESSAGE REJMLEN DS H REJJOB DS CL4 REJSLOT DS CL9 IKJEFFIE IETYPE=OUTPUT IKJTSB LIST=YES,EXT=NO IKTTSBX IHAASCB DSECT=YES CVT DSECT=YES END IKJEFF53 ./ ENDUP /* //* //SMPASM02 EXEC SMPASM,M=IKJEFF53,COND=(0,NE) //* //RECEIVE EXEC SMPREC,WORK='SYSALLDA',COND=(0,NE) //SMPPTFIN DD * ++USERMOD (SLB0001) . ++VER (Z038) FMID(EBB1102) . ++MOD(IKJEFF53) TXLIB(UMODOBJ) . /* //SMPCNTL DD * REJECT SELECT(SLB0001) . RESETRC . RECEIVE SELECT(SLB0001) . /* //* //APPLYCK EXEC SMPAPP,WORK='SYSALLDA',COND=(0,NE) //SMPCNTL DD * APPLY SELECT(SLB0001) CHECK . /* //* //APPLY EXEC SMPAPP,COND=(0,NE),WORK='SYSALLDA' //SMPCNTL DD * APPLY SELECT(SLB0001) DIS(WRITE) . /* //