//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) // 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 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-2' CHAPTER 5.5 * * ===================================================== * * EXCP PROGRAMMING EXERCISE: * * COUNT PDS DIRECTORY BLOCKS * *---------------------------------------------------------------------* * //GO EXEC PGM=LOADER,COND=(5,LT,ASM), * * //SYSUT1 DD DISP=SHR,DSN=... input dsname ... <=== * *********************************************************************** MAINPROC DS 0H 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 * * * - GET NUM OF DIR BLKS PER TRK * * * - BUILD CCW FOR DIRECTORY READ * * *----------------------------------* SETUP DS 0H OPEN (UT1DCB) 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 LA R0,CCWCDIRB ST R0,IOBSTART SET CCW ADDRESS SPACE , L R1,DCBDEBAD LOAD DEB ADDRESS ST R1,ADEB SAVE IT FOR CALLING PRLTV RTN LA R1,DEBBASND-DEBBASIC(,R1) LOCATE TO DASD SECTION MVC IOBCC,DEBSTRCC-DEBDASD(R1) SET DATASET EXTENT(CCCC) MVC IOBHH,DEBSTRHH-DEBDASD(R1) SET DATASET EXTENT(HHHH) MVC LOCRSEEK(4),IOBCC SET SEEK AND SEARCH ADDRESS MVC LOCSEACH(5),IOBCC TO LOCATE RECORD PARAMETER SPACE , SLR R0,R0 CLEAR WORKREG ICM R0,7,DEBUCBA-DEBDASD(R1) LOAD UCB ADDRESS TRKCALC FUNCTN=TRKCAP, CALL TRKCALC ROUTINE + UCB=(0),R=1,K=8,DD=256,REGSAVE=YES STH R0,PDSDEVDB SAVE NUM OF DIR BLKS/TRACK SPACE , LA R0,NUMCCW# SET NUM OF CCWS LA R1,CCWROOM LOAD CCW ROOM ADDRESS LA RF,CKDAREA LOAD COUNT+KEY READ AREA ADDR MVC 0(L'MODELCCW,R1),MODELCCW MOVE MODEL CCW STCM RF,B'0111',1(R1) SET DATA ADDRESS INTO CCW LA R1,L'MODELCCW(,R1) LOCATE TO NEXT CCW FIELD LA RF,16(,RF) LOCATE TO NEXT DATA FIELD BCT R0,*-4-4-4-6 LOOP FOR NEXT CCW SH R1,=Y(L'MODELCCW) LOCATE TO LAST CCW NI 4(R1),255-X'40' DROP CMD CHAIN FLAG SPACE , * *----------------------------------* * * COUNT PDS DIRECTORY BLOCKS * * * ============================== * * * 1. READ EACH 32BLOCKS COUNT AND * * * KEY FROM PDS DIRECTORY. * * * 2. FIND LAST USED BLOCK WHICH * * * HAS KEY=FFFF..FFFF. * * * IF NOT FOUND, CONTINUE READ * * * DIR NEXT 32BLOCKS. * * * 3. CALCULATE USED DIR BLOCKS * * * FROM THIS RECORD COUNT CCHHR.* * * WHEN READ EOD RECORD AT SAME * * * TIME I/O, FIND DIR EOD COUNT * * * AND CALCULATE ALLOCATED DIR * * * BLOCKS. * * * 4. IF DIR EOD RECORD IS NOT * * * EXIST IN READ AREA, EXECUTE * * * NEW CCW THAT SEARCHING DIR * * * EOD RECORD. * * *----------------------------------* IOLOOP DS 0H MVI EXCPECB,0 CLEAR ECB EXCP IOBSTDRD ISSUE EXCP I/O WAIT ECB=EXCPECB WAIT FOR I/O COMPLETION CLI IOBECBCC,X'7F' SUCCESSFUL ? BE IODONE YES, FIND LAST USED DIR BLOCK CLI IOBECBCC,X'41' PERMANENT I/O ERROR ? BNE IOERROR NO, ITS REAL I/O ERROR CLI IOBUSTAT,X'0D' CE+DE+UNIT EXCEPTION ? BNE IOERROR NO, ITS REAL I/O ERROR + CC=41,DSB=0D = READ EOD RECORD IODONE DS 0H LA R0,NUMCCW# LOAD LOOP COUNTER LA R1,CKDAREA LOCATE TO 1ST COUNT FIELD CLC 8(8,R1),HIGHKEY8 LAST USED BLOCK ? BE GETUSED YES, GET USED BLOCK# LA R1,16(,R1) LOCATE TO NEXT COUNT FIELD BCT R0,*-4-4-6 LOOP FOR NEXT DIR BLOCK SPACE , MVC IOBCC(5),LASTCK SET NEXT EXTENT(CCHHR) MVC LOCRSEEK(4),IOBCC SET SEEK AND SEARCH ADDRESS MVC LOCSEACH(5),IOBCC TO LOCATE RECORD PARAMETER B IOLOOP DO EXCP AGAIN SPACE , GETUSED DS 0H LM RE,RF,0(R1) LOAD LAST DIR(EOF) BLOCK COUNT XC 0(3,R1),0(R1) CLEAR COUNT FIELD STCM RE,B'1111',3(R1) SET CCHH STCM RF,B'1000',7(R1) SET R BAS RA,GET@TTTR CONVERT CCHHR TO TTTR SRDL R0,8 EXTRACT RELATIVE TRACK ADDRESS MH R0,PDSDEVDB GET NUM OF DIR BLKS IN DIR TRKS SRL R1,24 EXTRACT DIR BLKS ON FINAL TRK ALR R0,R1 ADD IT STH R0,USEDBLKS SAVE NUM OF USED DIR BLOCKS SPACE , CLI IOBECBCC,X'7F' EXIST ANY REMAINING BLOCKS ? BE FINDEOD YES, SEARCH EOD-REC OF DIR BLKS SPACE , SLR R0,R0 CLEAR WORKREG LA R1,CKDAREA LOAD COUNT+KEY FIELD AREA CLM R0,B'0111',5(R1) EOD RECORD ? BE *+4+4+4 YES, LA R1,16(,R1) LOCATE TO NEXT COUNT FIELD B *-4-4-4 SEARCH EOD RECORD COUNT AGAIN MVC DOUBLE,0(R1) MOVE EOD RECORD COUNT FIELD B GETALOC GET ALLOCATED BLOCK# SPACE , FINDEOD DS 0H MVC IOBCC(5),3(R2) SET LAST USED DIR BLOCK CCHHR MVC LOCRSEEK(4),IOBCC SET SEEK AND SEARCH ADDRESS MVC LOCSEACH(5),IOBCC TO LOCATE RECORD PARAMETER MVC CCWROOM(LODLCCW2),MODLCCW2 SET MODEL CCW FOR SEARCHING + EOD RECORD SPACE , MVI EXCPECB,0 CLEAR ECB EXCP IOBSTDRD ISSUE EXCP I/O WAIT ECB=EXCPECB WAIT FOR I/O COMPLETION CLI IOBECBCC,X'41' PERMANENT I/O ERROR ? BNE IOERROR NO, ITS REAL I/O ERROR CLI IOBUSTAT,X'0D' CE+DE+UNIT EXCEPTION ? BNE IOERROR NO, ITS REAL I/O ERROR + CC=41,DSB=0D = READ EOD RECORD SPACE , GETALOC DS 0H LM RE,RF,DOUBLE LOAD LAST DIR(EOF) BLOCK COUNT LA R1,CKDAREA LOAD WORKAREA ADDRESS XC 0(3,R1),0(R1) CLEAR MBB STCM RE,B'1111',3(R1) SET CCHH STCM RF,B'1000',7(R1) SET R BAS RA,GET@TTTR CONVERT CCHHR TO TTTR SRDL R0,8 EXTRACT RELATIVE TRACK ADDRESS MH R0,PDSDEVDB GET NUM OF DIR BLKS IN DIR TRKS SRL R1,24 EXTRACT DIR BLKS ON FINAL TRK ALR R0,R1 ADD IT BCTR R0,0 DECREMENT IT(EOD RECORD) STH R0,ALOCBLKS SAVE NUM OF USED DIR BLOCKS SPACE , * *----------------------------------* * * INFORM DIRECTORY BLOCKS * * *----------------------------------* INFODIR# DS 0H LH R0,ALOCBLKS LOAD ALLOCATED BLOCKS CVD R0,DOUBLE CONVERT IT TO PACK UNPK INFOMSG+36(5),DOUBLE CONVERT IT TO ZONE OI INFOMSG+40,C'0' MAKE IT HUMAN READABLE LH R0,USEDBLKS LOAD ALLOCATED BLOCKS CVD R0,DOUBLE CONVERT IT TO PACK UNPK INFOMSG+47(5),DOUBLE CONVERT IT TO ZONE OI INFOMSG+51,C'0' MAKE IT HUMAN READABLE WTO MF=(E,INFOMSG) INFORM DIRECTORY BLOCKS B ENDPROC PROCESSING DONE INFOMSG WTO 'PDS DIRECTORY BLOCKS, ALLOCATED=@@@@@ USED=@@@@@',MF=L,+ MCSFLAG=HRDCPY ZOSv23 SPACE , * *----------------------------------* * * I/O ERROR PROCEDURE * * *----------------------------------* 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 ENDPROC RETURN TO MAINLINE ERRMSG1 WTO 'I/O ERROR, EXCP-CC=@@ DSB=@@@@ SENSE=@@@@ SEEK=@@@@@@@@+ @@',MF=L,MCSFLAG=HRDCPY ZOSv23 SPACE , * *----------------------------------* * * ENDING PROCEDURE * * *----------------------------------* ENDPROC DS 0H CLOSE UT1DCB CLOSE TARGET VOLUME SPACE , * *----------------------------------* * * END OF PROCESSING * * *----------------------------------* SLR 15,15 LOAD RETURN CODE = 0 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 * *********************************************************************** GET@TTTR DS 0H GR1 --> MBBCCHHR AREA 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,CVTPRLTV-CVT(,RF) LOAD CCHHR->TTR CONV.RTN BAS RE,12(,RF) CALL IT(CONVERT TO TTTR) LR RC,R8 RESTORE GR12 L RA,DOUBLE RESTORE GR10 L RD,DOUBLE+4 RESTORE GR13 BR RA RETURN TO CALLER + GR0 <-- TTTR + GR2 <-- MBBCCHHR AREA 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 * * *----------------------------------* CCWCDIRB DS 0D (FOR COUNT PDS DIR BLOCKS) CCW X'47',LOCRPARM,X'40',16 LOCATE RECORD CCWROOM DC (NUMCCW#)XL8'00' READ CKD CCW ROOM SPACE , MODELCCW CCW X'9E',0,X'60',16 READ CKD MODEL CCW MODLCCW2 CCW X'9E',DOUBLE,X'60',8 READ CKD(READ ONLY COUNT FIELD) CCW X'08',CCWROOM,X'00',0 TIC BACK + WE EXPECT STOP THE CCW LOOP AT + EOD, BECAUSE THE EXCP WILL POST+ UNIT EXCEPTION AT READ EOD REC. LODLCCW2 EQU *-MODLCCW2 (LENGTH) SPACE , LOCRPARM DC XL16'00' LOCATE RECORD PARAMETER ORG LOCRPARM DC XL3'868000' OP=READ DATA & USE TLF DC AL1(20) 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(256) TLF ORG , ******** Traditional Style CCW **************************************** OLDCDIRB DS 0D (FOR COUNT PDS DIR BLOCKS) CCW X'31',IOBAREA+(IOBCC-IOBSTDRD),X'40',5 SERACH ID EQ CCW X'08',*-8,X'00',0 TIC BACK GETUSED# CCW X'92',COUNTUSE,X'60',8 READ COUNT CCW X'A9',HIGHKEY8,X'40',8 SEARCH KEY EQUAL CCW X'08',GETUSED#,X'00',0 TIC BACK GETALOC# CCW X'9E',COUNTALC,X'60',8 READ CKD(READ ONLY COUNT FIELD) CCW X'08',GETALOC#,X'00',0 TIC BACK + WE EXPECT STOP THE CCW LOOP AT + EOD, BECAUSE THE EXCP WILL POST+ UNIT EXCEPTION AT READ EOD REC. COUNTUSE DC XL8'00' COUNT READ AREA(USED DIR) COUNTALC DC XL8'00' COUNT READ AREA(LAST DIR) 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 HIGHKEY8 DC 8X'FF' FINAL KEY VALUE ADEB DC A(0) DEB ADDRESS USEDBLKS DC H'0' USED BLOCKS ALOCBLKS DC H'0' ALLOCATED BLOCKS PDSDEVDB DC H'0' NUM OF DIR BLOCKS PER TRACK DS 0D CKDAREA DC (16*NUMCCW#)X'00' DIR BLOCK COUNT+KEY READ AREA LASTCK EQU *-16 LAST COUNT AREA NUMCCW# EQU 32 NUM OF READ CKD CCWS *---------------------------------------------------------------------* 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 // //