//JOBNAME JOB (ACCT),NAME,CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1) //********************************************************************* //ASMCG PROC AOPT=,APARM=,LOPT=, // MAC1='SYS1.MACLIB', // MAC2='SYS1.MACLIB', // MAC3='SYS1.MODGEN' //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) //GO EXEC PGM=LOADER,COND=(5,LT,ASM), // PARM=('LIST,LET,MAP,XREF,&LOPT') //SYSLOUT DD DUMMY //SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE) //SNAPDUMP DD SYSOUT=* // PEND //********************************************************************* //STEP1 EXEC ASMCG //GO.SYSUT1 DD DISP=SHR,DSN=... input dsname ... //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 SPACE , *********************************************************************** * MAIN LINE PROCESSING. * * ===================================================== * * GR1 -- EXEC PARAMETER PLIST * * GR12 - BASE REGISTER * * GR13 - OUR REGISTER SAVEAREA * *---------------------------------------------------------------------* * SAMPLE CODE OF 'MVS ADVANCED SKILL Vol-2' CHAPTER 5.5 * * ===================================================== * * EXCP PROGRAMMING EXERCISE: * * READ MULTIPLE CKD(READ TRACK DATA) * *---------------------------------------------------------------------* * PHYSICALLY READ 15 TRACKS FROM BEGIN OF DATASET EXTENT. * *---------------------------------------------------------------------* * //GO EXEC PGM=&N,COND=(5,LT,ASM) * * //SYSUT1 DD DISP=SHR,DSN=... input dsname ... <=== * *********************************************************************** USING IHADCB,UT1DCB ADDRESS TO SYSUT1 DCB USING IOBSTDRD,IOBAREA ADDRESS TO IOB STD SECTION * *----------------------------------* * * SETUP PROCESSING * * * ============================== * * * - OPEN TARGET DATASET/DEVICE * * * - BUILD IOB AND CORRECT CCW * * * - GET DATASET EXTENT ADDRESS * * * - OBTAIN TRACK I/O BUFFER * * *----------------------------------* SETUP DS 0H OPEN (SNAPDCB,OUTPUT) OPEN SNAPDUMP DATASET SPACE , OPEN (UT1DCB) OPEN TARGET VOLUME L R1,DCBDEBAD LOAD DEB ADDRESS ST R1,ADEB SAVE IT FOR CALLING PCNVT RTN SPACE , OI IOBFLAG1,IOBCMDCH INDICATE USE COMMAND CHAIN OI IOBFLAG1,IOBUNREL INDICATE UNRELATED I/O LA R0,EXCPECB ST R0,IOBECBPT SET ECB ADDRESS LA R0,UT1DCB STCM R0,B'0111',IOBDCBPB SET DCB ADDRESS LA R0,CCWRDTRK ST R0,IOBSTART SET CCW ADDRESS SPACE , L RA,=A(65536) LOAD I/O BUFFER LENGTH GETMAIN RU,LV=(10),BNDRY=PAGE, GETMAIN EXCP I/O BUFFER + LOC=ANY ST R1,ATRKBUFF SAVE IT SPACE , SNAP DCB=SNAPDCB,SDATA=DM PRINT DATA MANAGEMENT AREA SPACE , * *----------------------------------* * * DO TRACK DATA DUMP * * *----------------------------------* SLR R4,R4 GR4 --> NEXT TRACK RTA + RTA = RELATIVE TRACK ADDRESS LA R5,15 GR5 --> REMAINING TRACKS READTRAK DS 0H LR R0,R4 LOAD NEXT TRACK ADDRESS(RTA) LA R1,IOBSEEK LOAD CONVERTED MBBCCHHR AREA BAS RA,GET@CCHH CONVERT RTA TO CCHHR FORMAT LTR RF,RF SUCCESSFUL ? BNZ ENDOFEXT NO, IT MAY BE INVALID RTA WAS + PASSED. SPACE , MVI EXCPECB,0 CLEAR ECB EXCP IOBSTDRD ISSUE EXCP I/O WAIT ECB=EXCPECB WAIT FOR I/O COMPLETION SPACE , CLI IOBECBCC,X'7F' SUCCESSFUL ? BNE IOERROR NO, SPACE , SLR RE,RE CLEAR READ LENGTH ICM RE,B'0011',IOBCSW+5 LOAD RESIDUAL COUNT L RF,=F'65535' SR RF,RE GET READ LENGTH + (ACTUAL DATA LENGTH ON TRACK) L R2,ATRKBUFF GR2 --> ALL CKD DATA ON TRACK LA R3,0(RF,R2) LOAD END OF DATA AREA ADDRESS BCTR R3,0 CORRECT IT SNAP DCB=SNAPDCB, PRINT STORAGE AREA + STORAGE=((2),(3)) SPACE , NEXTTRAK DS 0H LA R4,1(,R4) LOCATE TO NEXT TRACK ADDRESS BCT R5,READTRAK LOOP FOR NEXT TRACK DATA SPACE , * *----------------------------------* * * ENDING PROCEDURE * * *----------------------------------* ENDPROC DS 0H L R0,=A(65536) LOAD I/O BUFFER LENGTH L R1,ATRKBUFF LOAD I/O BUFFER ADDRESS FREEMAIN RU,LV=(0),A=(1) FREEMAIN EXCP I/O BUFFER CLOSE UT1DCB CLOSE TARGET VOLUME CLOSE SNAPDCB CLOSE SNAPDUMP DATASET SVC 3 RETURN TO OS(END OF PROGRAM) SPACE , ENDOFEXT DS 0H WTO 'REACHED END OF DATASET EXTENT',MCSFLAG=HRDCPY ZOSv23 B ENDPROC DO ENDING PROCEDURE EJECT , *********************************************************************** * I N T E R N A L S U B R O U T I N E S * *********************************************************************** GET@CCHH DS 0H GR0 --> RTA + GR1 --> MBBCCHHR AREA SLL R0,16 MAKE RTA TO TTR0 FORMAT LR R2,R1 LOAD MBBCCHHR FIELD ADDRESS L R1,ADEB LOAD DEB ADDRESS ST RA,DOUBLE SAVE GPR USED BY CONV.RTN ST RD,DOUBLE+4 SAVE GPR USED BY CONV.RTN LR R8,RC SAVE GR12(USED BY CONV.RTN) L RF,CVTPTR LOAD CVT ADDR L RF,CVTPCNVT-CVT(,RF) LOAD TTR->CCHHR CONV.RTN BAS RE,00(,RF) CALL IT(CONVERT TO CCHHR) LR RC,R8 RESTORE GR12 L RA,DOUBLE RESTORE GR10 L RD,DOUBLE+4 RESTORE GR13 BR RA RETURN TO CALLER SPACE , IOERROR DS 0H LA R0,1 LOAD BINARY DATA LENGTH LA RF,IOBECBCC LOAD BINARY DATA ADDRESS LA R1,ERRMSG1+23 LOAD EDIT FIELD IN MSG TEXT BAS RE,CNVBTX CONVERT BI TO HEX-DECIMAL CHARS LA R0,2 LOAD BINARY DATA LENGTH LA RF,IOBSTBYT LOAD BINARY DATA ADDRESS LA R1,ERRMSG1+30 LOAD EDIT FIELD IN MSG TEXT BAS RE,CNVBTX CONVERT BI TO HEX-DECIMAL CHARS LA R0,2 LOAD BINARY DATA LENGTH LA RF,IOBSENS0 LOAD BINARY DATA ADDRESS LA R1,ERRMSG1+41 LOAD EDIT FIELD IN MSG TEXT BAS RE,CNVBTX CONVERT BI TO HEX-DECIMAL CHARS LA R0,5 LOAD BINARY DATA LENGTH LA RF,IOBCC LOAD BINARY DATA ADDRESS LA R1,ERRMSG1+51 LOAD EDIT FIELD IN MSG TEXT BAS RE,CNVBTX CONVERT BI TO HEX-DECIMAL CHARS WTO MF=(E,ERRMSG1) INFORM I/O ERROR MESSAGE B NEXTTRAK RETURN TO MAINLINE ERRMSG1 WTO 'I/O ERROR, EXCP-CC=@@ DSB=@@@@ SENSE=@@@@ SEEK=@@@@@@@@+ @@',MF=L, + MCSFLAG=HRDCPY ZOSv23 SPACE , *---------------------------------------------------------------------* * CNVBTX - CONVERT BINARY TO HEX-DECIMAL TEXT (VARIABLE LENGTH TYPE) * * CALL INTERFACE - * * GR0: BINARY VALUE LENGTH * * GR1: OUTPUT-AREA ADDRESS (NEED DOUBLE LENGTH OF BINARY) * * GR15: BINARY VALUE ADDRESS * * BAS 14,CNVBTX * *---------------------------------------------------------------------* CNVBTX DS 0H CONVERT BINARY TO HEX-DECIMAL MVN 1(1,1),0(15) MVO 0(2,1),0(1,15) NI 1(1),X'0F' TR 0(2,1),CNVTRT2 LA 15,1(,15) LA 1,2(,1) BCT 0,*-4-4-6-4-6-6 BR 14 CNVTRT2 DC CL16'0123456789ABCDEF' TRANS TABLE FOR HEX-CHARACTER EJECT , *********************************************************************** * DATA AREA * *********************************************************************** DS 0D *---------------------------------------------------------------------* * *----------------------------------* * * CHANNEL PROGRAM * * *----------------------------------* CCWRDTRK DS 0D CCW X'31',IOBAREA+(IOBCC-IOBSTDRD),X'40',5 SERACH ID EQ CCW X'08',*-8,X'00',0 TIC BACK CCW X'5E',ATRKBUFF,X'24',65535 READ MULTIPLE CKD SPACE , * *----------------------------------* * * EXCP INTERFACE PARAMETERS * * *----------------------------------* DC A(C'IOB.') EYE-CATCHER IOBAREA DC 10F'0' IOB(40BYTES) EXCPECB DC F'0' ECB FOR I/O SYNCHRONIZE UT1DCB DCB DDNAME=SYSUT1,MACRF=E DCB FOR EXCP SPACE , * *----------------------------------* * * WORKING DATA * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA ADEB DC A(0) DEB ADDRESS ATRKBUFF DC A(0) V-IDAW(TRACK I/O BUFFER PTR) SPACE , SNAPDCB DCB DDNAME=SNAPDUMP, DCB FOR SNAP DUMP DATASET + DSORG=PS,MACRF=W,RECFM=VBA,BLKSIZE=1632,LRECL=125 *---------------------------------------------------------------------* LTORG , LITERAL POOL AT HERE DROP , FORGET ALL BASE REGISTERS EJECT , *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * DSECTS * *---------------------------------------------------------------------* IEZIOB DSECT=YES IOB DCBD DEVD=DA DCB IEZDEB LIST=YES DEB IHAPSA , PSA CVT DSECT=YES CVT *---------------------------------------------------------------------* * 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 // //