//JOBNAME JOB (ACCT),NAME,CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1) //********************************************************************* //ASMCLG PROC N=TEMPNAM0,AOPT=,APARM=,LOPT=,NCAL=NCAL, // 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)') //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=3120,LRECL=80) //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //LKD EXEC PGM=IEWL,COND=(5,LT,ASM), // PARM=('LIST,MAP,LET,XREF,&NCAL,&LOPT') //SYSPRINT DD SYSOUT=* //SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE) // DD DDNAME=SYSIN //SYSLMOD DD DISP=(,PASS),UNIT=SYSDA,SPACE=(TRK,(1,1,1)) //**SYSLMOD DD DISP=SHR,DSN=...apf library...(&N) //* //GO EXEC PGM=&N,COND=(5,LT,ASM) //STEPLIB DD DISP=SHR,DSN=*.LKD.SYSLMOD //**STEPLIB DD DISP=SHR,DSN=...apf library... //SNAPDUMP DD SYSOUT=* //SYSUDUMP DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SYSUT1 DD UNIT=SYSALLDA,SPACE=(TRK,1),VOL=SER=volnam //SYSIN DD * DUMPTRK RANGE=(0000-0000,0000-000E) DUMPTRK RANGE=(018A-0005,018A-0005) DUMPTRK RANGE=(0326-0000,0326-0002) // PEND //********************************************************************* //MYASMPGM EXEC ASMCLG LOPT='AC=1' //ASM.SYSIN DD * *=====================================================================* *======= HERE IS CONTROL CODE, NEVER CHANGE/MODIFY FROM HERE =========* *=====================================================================* MAINENTR CSECT , DEFINE CODE SECTION MAINENTR AMODE 31 DEFINE DEFAULT AMODE MAINENTR RMODE 24 DEFINE DEFAULT RMODE USING *,12 DEFINE BASE REGISTER SAVE (14,12),,EXCPRVOL SAVE CALLER REGISTERS + AND GENERATE MODULE EYE-CATCHER 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 LR 11,12 AHI 11,4096 GR11 -> OUR 2ND BASE ADDRESS SPACE , *********************************************************************** * AVAILABLE YOUR ASSEMBLER LANGUAGE CODE AT HERE. * * GR1 -- EXEC PARAMETER PLIST * * GR11 - BASE REGISTER(2ND) * * GR12 - BASE REGISTER(1ST) * * GR13 - OUR REGISTER SAVEAREA * *---------------------------------------------------------------------* * SAMPLE CODE OF 'MVS ADVANCED SKILL Vol-2' CHAPTER 5.5 * * ===================================================== * * EXCP PROGRAMMING EXERCISE: * * READ EVERY TRACK ON DASD VOLUME. * *---------------------------------------------------------------------* * PHYSICALLY READ ALL RECORD ON SPECIFIED TRACKS AND DUMP IT * * BY SNAP SVC SERVICE. * * USE IGG019WA EOE APPENDAGE RTN TO ALLOW READING ANY TRACK * * ON VOLUME. ASM AND BIND IGG019WA BEFORE THIS PGM RUN. * *---------------------------------------------------------------------* * //GO EXEC PGM=LOADER,COND=(5,LT,ASM), * * //SYSUT1 DD ... ...,VOL=SER=volnam <=== * * //SYSIN DD * * * DUMPTRK RANGE=(0000-0000,0000-0000) * * DUMPTRK RANGE=(012A-0002,012B-0007) * * DUMPTRK RANGE=(0326-0000,0326-000E) * * // * *********************************************************************** 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 * * * - READ DEVICE CHARACTERISTICS * * *----------------------------------* SETUP DS 0H OPEN (SNAPDCB,OUTPUT, OPEN SNAPDUMP AND SYSIN DATASET+ SYSIN,INPUT) SPACE , OPEN (UT1DCB,INPUT) OPEN TARGET VOLUME 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 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 , LA R0,CCWRDCHR LOAD CCW ADDRESS ST R0,IOBSTART SET IT INTO IOB MVI EXCPECB,0 CLEAR ECB EXCP IOBAREA ISSUE EXCP I/O WAIT ECB=EXCPECB WAIT FOR I/O COMPLETION CLI IOBECBCC,X'7F' SUCCESSFUL ? BE MAINPROC YES, DO MAINLINE PROCESSING BAS RA,IOERROR NO, INFORM I/O ERROR LA R0,8 SET HIGHEST COMPLETION CODE ST R0,COMPCODE SAVE FOR LATER B ENDPROC AND ABORT PROCESSING SPACE , *---------------------------------------------------------------------* * M A I N L I N E P R O C E S S I N G * * ===================================================== * * GR4 --> RTA(RELATIVE TRACK ADDRESS) OF NEXT READING TRACK * * GR5 --> REMAINING TRACKS TO BE DUMPED * *---------------------------------------------------------------------* MAINPROC DS 0H * *----------------------------------* * * GET READING TRACK RANGE * * *----------------------------------* GET SYSIN GET NEXT COMMAND CARD SPACE , LR R2,R1 GR2 --> CARD RECORD ICM R0,B'1111',15(R2) LOAD BEGIN CYL# ICM R1,B'1111',20(R2) LOAD BEGIN TRK# STM R0,R1,DOUBLE MOVE IT LA R0,L'DOUBLE LOAD LENGTH OF TEXT LA R1,DOUBLE LOAD BEGIN OF CYLINDER NUMBER BAS RE,CNVXTR CONVERT CYL-TRK ADDR TO BINARY LTR RF,RF VALID HEX-DATA ? BNZ MAINPROC NO, IGNORE THIS CARD BAS RE,CCHH2RTA YES, CONVERT CCHH TO RTA LR R4,R0 GR4 --> BEGIN TRACK RTA SPACE , ICM R0,B'1111',25(R2) LOAD END CYL# ICM R1,B'1111',30(R2) LOAD END TRK# STM R0,R1,DOUBLE MOVE IT LA R0,L'DOUBLE LOAD LENGTH OF TEXT LA R1,DOUBLE LOAD BEGIN OF CYLINDER NUMBER BAS RE,CNVXTR CONVERT CYL-TRK ADDR TO BINARY LTR RF,RF VALID HEX-DATA ? BNZ MAINPROC NO, IGNORE THIS CARD BAS RE,CCHH2RTA YES, CONVERT CCHH TO RTA LR R5,R0 GR5 --> END TRACK RTA SPACE , SR R5,R4 GET NUM OF DUMP TRACKS BM MAINPROC IF MINUS, IGNORE THIS CARD LA R5,1(,R5) GR5 --> REMAINING TRACKS LA R0,CCWRDTRK LOAD CCW ADDRESS ST R0,IOBSTART SET IT INTO IOB SPACE , * *----------------------------------* * * READ TRACK DATA AND DUMP IT * * *----------------------------------* READTRAK DS 0H LR R0,R4 LOAD NEXT TRACK RTA BAS RE,RTA2CCHH CONVERT IT TO CCHH STCM R0,B'1111',IOBCC SET IT AS IOB SEEK ADDRESS MVC LOCRSEEK(4),IOBCC SET SEEK AND SEARCH ADDRESS MVC LOCSEACH(4),IOBCC TO LOCATE RECORD PARAMETER 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 ? BE *+4+4 YES, BAS RA,IOERROR NO, INFORM I/O ERROR AND + CONTINUE PROCESSING 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) SH RF,=H'8' DROP READ TRK CMD ENDING MARKER 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 , LA R4,1(,R4) LOCATE TO NEXT TRACK ADDRESS BCT R5,READTRAK LOOP FOR NEXT TRACK DATA B MAINPROC READ NEXT COMMAND CARD 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 (SYSIN,,SNAPDCB) CLOSE SNAPDUMP & SYSIN DATASET L RF,COMPCODE LOAD COMPLETION CODE SVC 3 RETURN TO OS(END OF PROGRAM) 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 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 LA R0,4 SET HIGHEST COMPLETION CODE ST R0,COMPCODE SAVE FOR LATER BR RA RETURN TO CALLER ERRMSG1 WTO 'I/O ERROR, EXCP-CC=@@ DSB=@@@@ SENSE=@@@@ SEEK=@@@@@@@@+ @@',MF=L, + MCSFLAG=HRDCPY ZOSv23 SPACE , *---------------------------------------------------------------------* * CONVERT CCCCHHHH TO RTA I/O ADDRESS * * =================================== * * INPUT: * * GR0: CCCCHHHH * * OUTPUT: * * GR0: RTA (RELATIVE TRACK ADDRESS) * *---------------------------------------------------------------------* CCHH2RTA DS 0H LR R1,R0 COPY INPUT CCCCHHHH SRL R1,16 EXTRACT CCCC MH R1,DEVDSTRK CONVERT TO NUM OF TRKS N R0,=A(X'0000FFFF') EXTRACT HHHH ALR R0,R1 CONVERT CCHH TO RTA BR RE RETURN TO CALLER SPACE , *---------------------------------------------------------------------* * CONVERT RTA TO CCCCHHHH I/O ADDRESS * * =================================== * * INPUT: * * GR0: RTA (RELATIVE TRACK ADDRESS) * * OUTPUT: * * GR0: CCCCHHHH * *---------------------------------------------------------------------* RTA2CCHH DS 0H LH RF,DEVDSTRK LOAD TRKS/CYLS ST RF,DOUBLE SAVE FOR DEVIDE LR R1,R0 GR1 --> TRACK NUMBER SLR R0,R0 CLEAR FOR DIVIDE D R0,DOUBLE GET TRKS AND CYLS STCM R1,B'0011',DOUBLE+0 SET CCCC NUMBER STCM R0,B'0011',DOUBLE+2 SET HHHH NUMBER ICM R0,B'1111',DOUBLE+0 LOAD CCCCHHHH INTO GR0 BR RE RETURN TO CALLER 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 *---------------------------------------------------------------------* * CNVXTR - CONVERT HEX DECIMAL-TEXT TO BINARY (REGISTER TYPE) * * CALL INTERFACE - * * GR0: HEX DECIMAL-TEXT LENGTH * * GR1: HEX DECIMAL-TEXT ADDRESS * * GR13: 18WORDS STANDARD SAVEAREA * * BAS 14,CNVXTR * * OUTPUTS - * * GR0: FULL-WORD BINARY * * GR15: RETURN CODE * * 0: CONVERSION COMPLETED * * 4: LENGTH ERROR * * 8: DATA VALIDATION ERROR * *---------------------------------------------------------------------* * Notes: CNVXTR store back into input text area for translation work. * * Caller will get ABENDS0C4 if input area is protected. * * This routine use 2 workarea for re-entrant processing as follows. * * 8bytes workarea in Caller savearea pointed by GR13+12. * * 4bytes workarea in Caller savearea pointed by GR13+20. * * These fileds will be broken after returned from this routine. * * Caller program must provide 18words standard savearea before call * * this routine with MVS standard linkage convention. * * CNVDWRK EQU GR13+12,8 DOUBLE WORD WORKAREA * * CNVFWRK EQU GR13+20,4 FULL WORD WORKAREA * *---------------------------------------------------------------------* CNVXTR DS 0H LA 15,4 SET LENGTH ERROR LTR 0,0 CHECK LENGTH BNPR 14 IF NOT PLUS CH 0,=H'8' MORE THAN 8DIGITS ? BHR 14 YES, AVOID OVERFLOW ST 14,12(,13) (CNVDWRK) SAVE RETURN ADDRESS ST 1,16(,13) (CNVDWRK+4) SAVE INPUT PARAMETER LR 14,0 GR14 -> LENGTH LR 15,1 GR15 -> ADDRESS CNVXTR10 DS 0H CLI 0(15),C'A' LESS THAN A ? BL CNVXTRER YES, DATA ERROR CLI 0(15),C'9' MORE THAN 9 ? BH CNVXTRER YES, DATA ERROR CLI 0(15),C'0' MORE THAN 0 ? BNL CNVXTR11 YES, CHECK NEXT CLI 0(15),C'F' MORE THAN F ? BH CNVXTRER YES, DATA ERROR SLR 1,1 IC 1,0(,15) GET HEX-BYTE(A-F) LA 1,57(,1) CONVERT TO ZONE(XFA-XFF) STC 1,0(,15) SET HEX-BYTE(A-F) CNVXTR11 DS 0H LA 15,1(,15) SET NEXT BYTE BCT 14,CNVXTR10 TEST NEXT BYTE L 14,12(,13) (CNVDWRK) RESTORE RETURN ADDRESS L 1,16(,13) (CNVDWRK+4) RESTORE INPUT PARAMETER LR 15,0 GR15 -> LENGTH BCTR 15,0 EX 15,CNVMVHEX MOVE TO WORKAREA LA 15,12(15,13) (CNVDWRK) GET SIGN POINTER MVI 1(15),X'C0' SET DUMMY SIGN LR 15,0 !!! NEVER MINUS 1 !!! EX 15,CNVPKHEX CONVERT TO HEX-DECIMAL L 0,20(,13) (CNVFWRK) SET INTO GR0 SLR 15,15 CLEAR RETURN CODE BR 14 RETURN TO CALLER CNVXTRER DS 0H LA 15,8 SET VALIDATION ERROR L 14,12(,13) (CNVDWRK) RESTORE RETURN ADDRESS L 1,16(,13) (CNVDWRK+4) RESTORE INPUT PARAMETER BR 14 RETURN TO CALLER CNVMVHEX MVC 12(0,13),0(1) (CNVDWRK) MOVE TO WORKAREA CNVPKHEX PACK 20(5,13),12(0,13) (CNVFWRK) CONVERT TO HEX-DECIMAL EJECT , *********************************************************************** * D A T A A R E A * *********************************************************************** * *----------------------------------* * * CHANNEL PROGRAM * * *----------------------------------* CCWRDCHR DS 0D CCW X'64',DEVCHAR,X'00',64 READ DEVICE CHARACTERISTICS CCWRDTRK DS 0D CCW X'47',LOCRPARM,X'40',16 LOCATE RECORD CCW X'DE',ATRKBUFF,X'24',65535 READ TRACK SPACE , LOCRPARM DC XL16'00' LOCATE RECORD PARAMETER ORG LOCRPARM DC XL3'0C0000' OP=READ TRACK(LOCATE TO CKD) DC AL1(1) NUM OF RECS IN THIS DOMAIN LOCRSEEK DC XL4'00' SEEK ADDRESS LOCSEACH DC XL5'00' SEARCH ADDRESS DC XL1'00' SECTOR NUMBER DC AL2(0) TLF ORG , * *----------------------------------* * * EXCP INTERFACE PARAMETERS * * *----------------------------------* EXCPECB DC F'0' ECB FOR I/O SYNCHRONIZE DC A(C'IOB.') EYE-CATCHER IOBAREA DC 10F'0' IOB(40BYTES) DC 12X'00' NEED RESERVED ROOM FOR IGG019PX+ WHEN USE EOEA=PX. IGG019PX IS + MVS PROVIDED APPENDAGE RTN WHICH USE DFSMSdss PRINT TRACK CMD. + IF THIS SAMPLE PGM HAS APF STATE THEN USE IGG019PX FOR MORE EASY DC A(C'DCB.') EYE-CATCHER UT1DCB DCB DDNAME=SYSUT1, DCB FOR EXCP + MACRF=E,EOEA=WA (USE E.O.E APPENDAGE) SPACE , * *----------------------------------* * * WORKING DATA * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA COMPCODE DC F'0' COMPLETION CODE ATRKBUFF DC A(0) TRACK I/O BUFFER SPACE , DEVCHAR DC XL64'00' DEVICE CHARACTERISTICS READAREA DEVDSTRK EQU DEVCHAR+14,2 NUM OF TRKS PER CYLINDER SPACE , SYSIN DCB DDNAME=SYSIN,DSORG=PS,MACRF=GL,EODAD=ENDPROC SNAPDCB DCB DDNAME=SNAPDUMP, DCB FOR SNAP DUMP DATASET + DSORG=PS,MACRF=W,RECFM=VBA,BLKSIZE=1632,LRECL=125 LTORG , USER LITERAL PLACE AT HERE *---------------------------------------------------------------------* IEZIOB DSECT=YES IOB DCBD DEVD=DA,DSORG=PS DCB IEZDEB LIST=YES DEB IHAPSA , PSA CVT DSECT=YES CVT *---------------------------------------------------------------------* * S/370, ESA/390 REGISTER EQUATES * *---------------------------------------------------------------------* *------- YREGS , OS: REGISTER EQUATES R0 EQU 0 GENERAL REGISTER 0 R1 EQU 1 GENERAL REGISTER 1 R2 EQU 2 GENERAL REGISTER 2 R3 EQU 3 GENERAL REGISTER 3 R4 EQU 4 GENERAL REGISTER 4 R5 EQU 5 GENERAL REGISTER 5 R6 EQU 6 GENERAL REGISTER 6 R7 EQU 7 GENERAL REGISTER 7 R8 EQU 8 GENERAL REGISTER 8 R9 EQU 9 GENERAL REGISTER 9 RA EQU 10 GENERAL REGISTER 10 RB EQU 11 GENERAL REGISTER 11 RC EQU 12 GENERAL REGISTER 12 RD EQU 13 GENERAL REGISTER 13 RE EQU 14 GENERAL REGISTER 14 RF EQU 15 GENERAL REGISTER 15 END // //