//JOBNAME JOB (ACCT),NAME,CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1) //********************************************************************* //ASMCLG PROC N=TEMPNAME,AOPT=,APARM=,LOPT=, // MAC1='SYS1.MACLIB', // MAC2='SYS1.MACLIB', // MAC3='SYS1.MODGEN', // LLIB='MY.APFLOAD' <== Your APF Load module library //ASM EXEC PGM=ASMA90, // PARM=('OBJ,NODECK,LC(32767),XREF(SHORT),TERM,RLD,ASA,&AOPT', // 'US(MAP,WARN(11)),SYSPARM(&APARM)') //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //SYSLIB DD DISP=SHR,DSN=&MAC1 // DD DISP=SHR,DSN=&MAC2 // DD DISP=SHR,DSN=&MAC3 //SYSUT1 DD UNIT=SYSALLDA,SPACE=(TRK,(80,20)) //SYSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(TRK,(30,15),RLSE), // DCB=(RECFM=FB,BLKSIZE=0,LRECL=80) //LKD EXEC PGM=IEWL,COND=(5,LT,ASM), // PARM=('LIST,LET,MAP,XREF,&LOPT') //SYSPRINT DD SYSOUT=* //SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE) // DD DDNAME=SYSIN //SYSLMOD DD DISP=SHR,DSN=&LLIB(&N) //GO EXEC PGM=*.LKD.SYSLMOD,COND=(5,LT,ASM),PARM=('') //SYEPLIB DD DISP=SHR,DSN=&LLIB //SYSPRINT DD SYSOUT=* //SYSUDUMP DD SYSOUT=* //SYSIN DD UNIT=SYSDA,SPACE=(TRK,1) //SYSTCPD DD * LOADDBCSTABLES SJISKANJI // PEND //********************************************************************* //STEP1 EXEC ASMCLG,LOPT='AC=1',N=SAPITEST //ASM.SYSIN DD * *=====================================================================* * MVS STANDARD HOUSE KEEPING PROCEDURE * *=====================================================================* * *----------------------------------* * * ENTRY PROCESSING * * *----------------------------------* MYASMPGM CSECT , DEFINE CONTROL SECTION MYASMPGM AMODE 31 DEFINE DEFAULT AMODE=31 MYASMPGM RMODE 24 DEFINE DEFAULT RMODE=24 USING *,12 DEFINE BASE REGISTER SAVE (14,12),,* SAVE CALLER REGISTERS LA 12,0(,15) GR12 --> OUR 1ST BASE ADDRESS LR 15,13 SAVE CALLER SAVEAREA CNOP 0,4 INSURE FULL WORD BOUNDARY BAS 13,*+4+72 AROUND OUR SAVEAREA DC 18F'-1' OUR GPR SAVEAREA ST 15,4(,13) SAVE CALLER SAVEAREA POINTER ST 13,8(,15) SET BACK CHAIN FOR LINK TRACE B MAINPROC DO MAINLINE PROCESSING * *----------------------------------* * * EXIT PROCESSING * * *----------------------------------* EXITPROC DS 0H L 13,4(,13) RESTORE CALLER SAVEAREA ST 15,16(,13) PASS RETURN CODE TO CALLER RETURN (14,12),T RESTORE CALLER REGISTERS + AND RETURN TO CALLER EJECT , *********************************************************************** * MAIN LINE PROCESSING. * * ===================================================== * * GR1 -- EXEC PARAMETER PLIST * * GR12 - BASE REGISTER * * GR13 - OUR REGISTER SAVEAREA * *---------------------------------------------------------------------* * SAMPLE CODE OF 'MVS ADVANCED SKILL Vol-1' CHAPTER 5.8 * * ===================================================== * * GET SYSOUT DATASET AND TRANSFER IT BY FTP. * * THIS PROGRAM SELECT SYSOUT BY DEST PARAMETER. * * WHEN NO MATCHING SYSOUT IN JES2 SPOOL, WAIT UNTIL NEW * * SYSOUT OCCURRED OR ENTERED STOP COMMAND. * * ===================================================== * * >>> Correct for z/OS V1R9 or higher. 2020/04/03 <<< * * >>> Removed MODESET macro to call SSI(SAPI). <<< * * >>> No longer need SUP authority to call SSI(SAPI)<<< * * >>> under z/OS V1R9 or higher. <<< * * ===================================================== * * COMPLETION CODE * * 00 --- PROCESSING DONE(ENTERED STOP COMMMAND) * * 04 --- TRANSFER FAILED. * * 08 --- SYSOUT DATASET DYNALLOC FAILED. * * ABEND CODE * * U0001: IEFSSREQ UNEXPECTED ERROR. * * GR15 CONTAIN SSS2REAS+SSOBRETN * *********************************************************************** MAINPROC DS 0H * *----------------------------------* * * SETUP OPERATOR CMD ACCEPTION * * *----------------------------------* EXTRACT ACOMLIST,FIELDS=COMM ISSUE EXTRACT COMM L R2,ACOMLIST LOAD COMLIST ADDRESS USING DCOM,R2 ADDRESS TO COMM AREA(IEZCOM) ICM R1,B'1111',COMCIBPT LOAD START COMMAND CIB BZ *+4+4 IF ZERO, WE ARE NOT STC BAS RA,FREECIB FREE START COMMAND CIB QEDIT ORIGIN=COMCIBPT, SET AVAILABLE COMMAND QUEUES + CIBCTR=1 DROP R2 FORGET COMLIST SPACE , * *----------------------------------* * * SETUP SAPI SSI INTERFACE AREA * * * ============================== * * * BUILD SSOB AND SSOB EXTENSION * * *----------------------------------* USING SSOB,SSOBAREA ADDRESS TO SAPI SSOB LA R0,SSOBAREA INIT SSOB AND EXTENSION LA R1,LAPISSOB I SLR RF,RF I MVCL R0,RE V MVC SSOBID,=CL4'SSOB' SET SSOB IDENTIFIER MVC SSOBLEN,=Y(SSOBHSIZ) SET SSOB HEADER LENGTH MVC SSOBFUNC,=Y(SSOBSOU2) INDICATE SSI FUNCTION CODE LA R0,SSS2 LOAD SSOB SAPI EXTENSION ST R0,SSOBINDV SET FUNCTION DEPENDENT AREA PTR SPACE , MVC SSS2LEN,=Y(SSS2SIZE) SET SSS2 AREA LENGTH MVI SSS2VER,SSS2CVER SET SSOB VERSION LEVEL MVC SSS2EYE,=CL4'SSS2' SET SSS2 IDENTIFIER MVI SSS2TYPE,SSS2PUGE INDICATE REQUEST IS PUT/GET LA R0,SAPIECB LOAD ECB ADDRESS ST R0,SSS2ECBP SET IT INTO SSS2 AREA OI SSS2SEL1,SSS2SDST SELECT BY DEST FILTER OI SSS2SEL1,SSS2SAWT SELECT FROM ALL OUTPUT TYPES ******** OI SSS2DISP,SSS2DKPE+SSS2RNPR INDICATE KEEP AND + DOESN'T NOTIFY TO US AGAIN MVC SSS2DEST,DESTNAME SET REQUEST FILTER KEY(DEST) SPACE , * *----------------------------------* * * CALL SSI TO GET JES2 SYSOUT DS * * * ============================== * * * GET SYSOUT DATASET BY SAPI SSI * * *----------------------------------* ASKNEWSO DS 0H MVI SAPIECB,0 CLEAR SAPI WAITING ECB LA R1,SSIPARM LOAD PLIST POINTER IEFSSREQ , CALL SSI REQUEST ROUTINE L RF,SSOBRETN LOAD SSOB RETURN CODE CH RF,=Y(SSS2RTOK) SUCCESSFUL ? BE READSOUT YES, READ IT CH RF,=Y(SSS2EODS) NO MORE SYSOUT ? BNE U0001 NO, UNEXPECTED ERROR ZOSv23 SPACE , WAITEVNT DS 0H L R2,ACOMLIST LOAD COMLIST ADDRESS USING DCOM,R2 ADDRESS TO COMM AREA(IEZCOM) MVC ECBLIST(4),COMECBPT SET OP-COMMAND ECB ADDRESS WAIT ECBLIST=ECBLIST WAIT NEXT OP-COMMAND OR SYSOUT L R1,ECBLIST LOAD OP-COMMAND ECB TM 0(R1),X'40' ENTER OP-COMMAND ? BNO ASKNEWSO NO, ASK NEW SYSOUT DATASET L R1,COMCIBPT YES, CHECK IT USING DCIB,R1 ADDRESS TO CIB IC R2,CIBVERB-DCIB(R1) SAVE CIBVERB FIELD BAL RA,FREECIB FREE CURRENT CIB CLM R2,B'0001',=AL1(CIBSTOP) STOP COMMAND ? BNE WAITEVNT NO, WAIT AGAIN B ENDPROC YES, PROCESSING DONE DROP R1,R2 FORGET CIB,COMLIST SPACE , * *----------------------------------* * * PROCESSING FOR NEXT SYSOUT DS * * * ============================== * * * SSOB OUTPUT FIELDS. * * * ------------------- * * * SSS2BTOK: DYNALLOC TOKEN * * * SSS2JOBR: SYSOUT JOBNAME * * * SSS2JBIR: SYSOUT JOBID * * * SSS2CRER: SYSOUT OWNER USERID * * * SSS2DSN : SYSOUT DSNAME * * * SSS2CLAR: SYSOUT CLASS * * * SSS2MLRL: SYSOUT MAX LRECL * * * SSS2LNCT: SYSOUT NUM OF LINES * * * SSS2PRCD: SYSOUT PROCSTEP NAME * * * SSS2STPD: SYSOUT STEP NAME * * * SSS2DDND: SYSOUT DDNAME * * * SSS2DATE: DATE 0CYYDDDF * * * SSS2TIME: TIME 1/100SEC FROM * * * MIDNIGHT * * * SSS2SYS : SYSTEM NAME * * * SSS2MBR : SMF SYSTEM NAME * * *----------------------------------* READSOUT DS 0H L R1,SSOBSSIB LOAD SSIB MVC SSNAM,SSIBSSNM-SSIB(R1) SET RELATED SUBSYSTEM NAME L R0,SSS2BTOK LOAD SPOOL BROWSE TOKEN ST R0,DYNATUPL+12 SET IT INTO DYNALLOC TUPL MVC DSNAME,SSS2DSN SET SYSOUT DATASET NAME MVC DDNAME-6(2),=AL2(DALRTDDN) INDICATE REQ TO RETURN DDN USING S99RB,DYNALRB ADDRESS TO DYNALLOC RB MVI S99VERB,S99VRBAL INDICATE ALLOCATION LA R1,DYNALRBP LOCATE DYNALLOC RB POINTER DYNALLOC , ALLOCATE SYSOUT DATASET LTR RF,RF SUCCESSFUL ? BNZ EXIT8 NO, ABORT PROCESSING ZOSv23 SPACE , * *----------------------------------* * * SETUP FTP TRANSFER * * * ============================== * * * BUILD FTP/CLIENT PARAMETER * * *----------------------------------* MVC FTPRFNAM+9(8),DDNAME SET ALLOCATED DDNAME LA R1,FTPRFNAM+18 LOAD DSNAME FIELD MVC 0(44,R1),SSS2DSN SET SYSOUT DSNAME CLI 0(R1),C' ' END OF DSN ? BE *+4+4+4+4+4+2 YES, CLI 0(R1),C'?' INVALID CHARACTER ? BE *+4+4+4 YES, LA R1,1(,R1) NO, LOCATE TO NEXT BYTE B *-4-4-4-4-4 FIND LOOP BCTR R1,0 ADJUST END OF DSN MVC 0(4,R1),=CL4'.txt' SET FILE TYPE=TXT SPACE , OPEN (SYSIN,OUTPUT) OPEN FTP SYSIN DATASET LA R2,FTPCARD# SET LOOP COUNTER LA R3,FTPCARD LOCATE 1ST SYSIN CARD BLDSYSIN DS 0H PUT SYSIN,(3) PUT NEXT SYSIN CARD LA R3,80(,R3) LOCATE TO NEXT CARD BCT R2,BLDSYSIN LOOP FOR NEXT CARD CLOSE (SYSIN) CLOSE FTP SYSIN DATASET SPACE , * *----------------------------------* * * TRANSFER SYSOUT DATASET TO PC * * * ============================== * * * ATTACH FTP CLIENT UTILITY TO * * * SEND SYSOUT DATASET TO FTP * * * SERVER ON DESTINATION COMPUTER * * *----------------------------------* MVI FTPECB,0 CLEAR EOT ECB LA R1,FTPPLIST GR1 --> EXEC PLIST ATTACH EPLOC=FTPNAME, ATTACH FTP UTILITY TASK M002 + ECB=FTPECB, + SZERO=NO ST R1,FTPTCB SAVE TCB ADDRESS WAIT ECB=FTPECB SYNCHRONIZE FTP TASK END DETACH FTPTCB PURGE FTP TASK TCB L RF,FTPECB GET COMPLETION CODE N RF,=A(X'3FFFFFFF') DROP CONTROL BITS SPACE , LTR RF,RF TRANSFER SUCCESSFUL ? ZOSv23 BNZ EXIT4 NO, ABORT PROCESSING ZOSv23 SPACE , * INFORM TRANSFER COMPLETION STATUS IF YOU NEED... B ASKNEWSO ASK NEXT SYSOUT DATASET SPACE , * *----------------------------------* * * END OF PROCESSING * * * ============================== * * * CLEAN UP USED SSI RESOURCES * * * AND RELEASE DATASET I/O BUFFER * * *----------------------------------* U0001 DS 0H ZOSv23 ICM RF,B'0100',SSS2REAS LOAD SSS2 REASON CODE ZOSv23 ABEND 1,DUMP ABEND WITH U0001 ZOSv23 EXIT8 DS 0H ZOSv23 MVC COMPCODE,=H'8' SET CC=8 ZOSv23 B ENDPROC ZOSv23 EXIT4 DS 0H ZOSv23 MVC COMPCODE,=H'4' SET CC=4 ZOSv23 B ENDPROC ZOSv23 ENDPROC DS 0H MVI SSS2MSC1,SSS2CTRL INDICATE PROCESSING COMPLETED + ITS MEAN RESOURCE CLEANUP LA R1,SSIPARM LOAD PLIST POINTER IEFSSREQ , CALL SSI REQUEST ROUTINE SPACE , FREEPOOL SYSIN RELEASE SYSIN QSAM I/O BUFFER SPACE , * *----------------------------------* * * END OF PROCESSING * * *----------------------------------* LH 15,COMPCODE LOAD RETURN CODE = 0 ZOSv23 B EXITPROC DO EXIT PROCESSING EJECT , *********************************************************************** * I N T E R N A L S U B R O U T I N E S * *********************************************************************** * *----------------------------------* * * CIB FREEING SUBROUTINE * * * ============================== * * * GR1 --> CIB * * *----------------------------------* FREECIB DS 0H L RE,ACOMLIST LOAD COMLIST ADDRESS LA R0,COMCIBPT-DCOM(,RE) LOAD ORIGIN CIB POINTER QEDIT ORIGIN=(0), FREE THIS CIB + BLOCK=(1) BR RA RETURN TO CALLER *---------------------------------------------------------------------* EJECT , *********************************************************************** * DATA AREA * *********************************************************************** DS 0D *---------------------------------------------------------------------* * *----------------------------------* * * MISCELLANEOUS * * * ============================== * * *----------------------------------* ACOMLIST DC A(0) POINTER TO COMLIST ECBLIST DC A(0) ECBLIST DC A(SAPIECB+X'80000000') DESTNAME DC CL18'MYDEST1' SELECTING DESTINATION NAME COMPCODE DC Y(0) COMPLETION CODE SPACE , * *----------------------------------* * * SAPI SUBSYSTEM INTERFACE AREA * * * ============================== * * *----------------------------------* SSIPARM CALL ,(SSOBAREA),VL,MF=L PLIST FOR IEFSSREQ SERVICE SAPIECB DC F'0' SAPI WAITING ECB DS 0D SSOBAREA DC (SSOBHSIZ)X'00' SSOB HEADER AREA DS 0D SAPISSOB DC (SSS2SIZE)X'00' SAPI SSOB AREA LAPISSOB EQU *-SSOBAREA (LENGTH OF SSOB) SPACE , * *----------------------------------* * * SYSOUT DS DYNALLOC PARAMETER * * * ============================== * * *----------------------------------* DYNALRBP CALL ,(DYNALRB),VL,MF=L SVC99 PLIST POINTER DYNALRB DC (S99RBEND-S99RB)X'00' SVC99 PLIST ORG DYNALRB DC AL1(S99RBEND-S99RB) DC AL1(0) DC AL2(0) DC AL4(0) DC A(DYNATUPL) DC A(DYNALRBX) ZOSv23 ORG , DYNALRBX DC (S99RBXLN)X'00' SVC99 PLIST(RBX) ZOSv23 ORG DYNALRBX ZOSv23 DC CL6'S99RBX' ZOSv23 DC AL1(S99RBXVR) ZOSv23 DC AL1(S99EIMSG+S99EWTP) ZOSv23 DC AL1(0,0,S99XINFO,0) ZOSv23 ORG , ZOSv23 DYNATUPL CALL ,(DDNAME-6, SVC99 TEXT UNIT POINTER LIST + FREECLS-6, + DSNAME-6, + 0, + SSNAM-6), + VL,MF=L DC AL2(DALRTDDN),AL2(1),AL2(8) DDNAME DC CL8' ' DC AL2(DALCLOSE),AL2(0),AL2(0) FREECLS EQU * DC AL2(DALDSNAM),AL2(1),AL2(44) DSNAME DC CL44' ' DC AL2(DALSSREQ),AL2(1),AL2(4) SSNAM DC CL4' ' SPACE , * *----------------------------------* * * FTP UTILITY PARAMETERS * * * ============================== * * *----------------------------------* FTPNAME DC CL8'FTP' FTP PROGRAM NAME FTPTCB DC A(0) FTP SUBTASK TCB FTPECB DC F'0' FTP SUBTASK EOT ECB FTPPLIST DC A(FTPPARM+X'80000000') PLIST FOR FTP CALL FTPPARM DC H'5',CL100'(EXIT' FTP EXEC PARAMETER FTPCARD DS 0H FTP PARAMETER CARD DC CL80'192.168.1.127' TARGET PC IP ADDRESS DC CL80'VWTRUSER VWTRUSER' TARGET FTP SERVER ACCOUNT DC CL80'SENDSITE' DC CL80'LOCSITE NOTRAIL' DC CL80'SJISKANJI (NOTYPE SOSI' FTPRFNAM DC CL80'PUT //DD:SYS00000 SYSOUT-DSNAME' DC CL80'QUIT' FTPCARD# EQU (*-FTPCARD)/80 NUM OF FTP PARAMETER CARDS SPACE , SYSIN DCB DDNAME=SYSIN, SYSIN DATASET I/O DCB(QSAM) + DSORG=PS,MACRF=(PM), + RECFM=FB,BLKSIZE=0,LRECL=80 *---------------------------------------------------------------------* LTORG , LITERAL POOL AT HERE DROP , FORGET ALL BASE REGISTERS EJECT , *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * DSECTS * *---------------------------------------------------------------------* DCOM DSECT IEZCOM , COMMUNICATION AREA DCIB DSECT IEZCIB , CIB CVT DSECT=YES CVT IEFJESCT , JESCT IEFSSOBH SSOB(HEDAER) SSOBGN EQU * IAZSSS2 , SSOB(SAPI) IAZBTOKP , SYSOUT BROWSE TOKEN IEFJSSIB , SSIB IEFZB4D0 , SVC99 PLIST IEFZB4D2 , SVC99 TEXT UNIT PARAMETER *---------------------------------------------------------------------* * S/370, ESA/390 REGISTER EQUATES * *---------------------------------------------------------------------* YREGS , OS: REGISTER EQUATES RA EQU 10 ADD EQUATION FOR GR10 RB EQU 11 ADD EQUATION FOR GR11 RC EQU 12 ADD EQUATION FOR GR12 RD EQU 13 ADD EQUATION FOR GR13 RE EQU 14 ADD EQUATION FOR GR14 RF EQU 15 ADD EQUATION FOR GR15 END // //