//JOBNAME JOB (ACCT),NAME,CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1),TIME=(,59) //********************************************************************* //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 UNIT=SYSALLDA,SPACE=(TRK,1),VOL=SER=volnam //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.6 * * ===================================================== * * INFORM UCB IOQ CHAIN AND DUMP UCB AND IOS PREFIX AREA. * *---------------------------------------------------------------------* * //GO EXEC PGM=LOADER,COND=(5,LT,ASM), * * //SYSUT1 DD ... ...,VOL=SER=volnam <=== * *********************************************************************** * *----------------------------------* * * EXTRACT UCB ADDRESS * * * ============================== * * * GR6 --> UCB * * * GR7 --> UCB IOS PREFIX * * *----------------------------------* LA RA,DOUBLE LOAD WORKAREA ADDRESS EXTRACT (10),'S',FIELDS=TIOT EXTRACT OUR TIOT ADDRESS L RA,DOUBLE LOAD TIOT ADDRESS LA RA,TIOENTRY-TIOT1(,RA) LOCATE TO 1ST DD ENTRY USING TIOENTRY,RA ADDRESS IT SLR RF,RF CLEAR WORKREG CLC TIOEDDNM,=CL8'SYSUT1' IS HERE SYSUT1 DD ENTRY ? BE *+4+4+4+4 YES, FOUND IT IC RF,TIOELNGH ADD CURRENT ENTRY LENGTH LA RA,0(RF,RA) LOCATE TO NEXT ENTRY B *-4-4-4-6 FIND OUR DD STATEMENT SPACE , SLR R6,R6 GR6 --> SYSUT1 DEVICE UCB ADDR ICM R6,B'0111',TIOEFSRT LOAD UCB(CAPTURED) ADDRESS ST R6,AUCB SAVE IT FOR LATER DROP RA FORGET TIOT USING UCBOB,R6 ADDRESS TO UCB LR R1,R6 COPY UCB ADDRESS SH R1,=Y(UCBOB-UCBIEXT) LOCATE TO IOS EXTENTION PTR L R7,0(,R1) LOAD UCB IOS PREFIX AREA ADDR USING UCBPDATA,R7 ADDRESS TO UCB IOS PREFIX AREA SPACE , * *----------------------------------* * * SEARCH UCB IOQ CHAIN * * * ============================== * * * GR6 --> UCB * * * GR7 --> UCB IOS PREFIX * * * GR8 --> CURRENT IOQ ELEMENT * * *----------------------------------* ******** ICM R0,B'1111',UCBIOQF CHAINED ANY IOQ ELEMENT ? ******** BZ *-4 NO, LOOP FOR UNTIL IOQ WAS CHAINED. SPACE , LA R8,UCBIOQF LOCATE TO 1ST IOQ POINTER SH R8,=Y(IOQCHAIN-IOQ) SETUP FOR LOOP SLR R2,R2 CLEAR SEQUENCE# IOQLOOP DS 0H ICM R8,15,IOQCHAIN-IOQ(R8) GR8 --> NEXT IOQ ELEMENT BZ DUMPUCB IF TARGET NOT FOUND LA R2,1(,R2) INCREMENT SEQUENCE# LH R3,IOQASID-IOQ(,R8) LOAD ASSOCIATED ASID SPACE , *------- SET IOQ ADDRESS INTO MSG ST R8,DOUBLE SET IOQ ADDR TO WORKAREA LA R0,4 LOAD BINARY DATA LENGTH LA RF,DOUBLE LOAD BINARY DATA ADDRESS LA R1,INFOMSG+4+12 LOAD EDIT FIELD IN MSG TEXT BAS RE,CNVBTX CONVERT BI TO HEX-DECIMAL CHARS *------- SET SEQ# INTO MSG CVD R2,DOUBLE CONVERT TO DECIMAL UNPK INFOMSG+4+25(4),DOUBLE CONVERT TO ZONE-DECIMAL OI INFOMSG+4+28,C'0' MAKE IT HUMAN READABLE *------- SET ASID INTO MSG STH R3,DOUBLE SET ASID TO WORKAREA LA R0,2 LOAD BINARY DATA LENGTH LA RF,DOUBLE LOAD BINARY DATA ADDRESS LA R1,INFOMSG+4+35 LOAD EDIT FIELD IN MSG TEXT BAS RE,CNVBTX CONVERT BI TO HEX-DECIMAL CHARS SPACE , * *----------------------------------* * * FIND TARGET ADDRESS SPACE ASCB * * *----------------------------------* L R1,CVTPTR LOAD CVT L R1,CVTASVT-CVT(,R1) LOAD ASVT USING ASVT,R1 ADDRESS IT L R0,ASVTMAXU LOAD MAXIMUM ASID NUMBER FINDASCB DS 0H TM ASVTENTY,ASVTAVAL IS THIS ASSIGNED ASCB ? BO NEXTASCB NO, IGNORE THIS ENTRY L RE,ASVTENTY LOAD CURRENT ASCB CH R3,ASCBASID-ASCB(,RE) IS HERE TARGET JOB ASCB ? BE SETJOBNM YES, FOUND TARGET NEXTASCB DS 0H LA R1,4(,R1) LOCATE NEXT ASCB ENTRY BCT R0,FINDASCB TRY TO NEXT B WRITEMSG WRITE INFORM MSG DROP R1 FORGET ASVT SPACE , SETJOBNM DS 0H ICM RF,15,ASCBJBNI-ASCB(RE) LOAD BATCH JOBNAME POINTER BNZ *+4+4 IF NZERO, MAY BE BATCH L RF,ASCBJBNS-ASCB(,RE) LOAD STC/TSO NAME POINTER MVC INFOMSG+4+48(8),0(RF) SET JOBNAME INTO MSG WRITEMSG DS 0H WTO MF=(E,INFOMSG) INFORM IOQ CHAINED MESSAGE B IOQLOOP FIND NEXT IOQ... SPACE , * *----------------------------------* * * DUMP UCB AND IOS PREFIX AREA * * * ============================== * * * GR6 --> UCB * * * GR7 --> UCB IOS PREFIX * * *----------------------------------* DUMPUCB DS 0H OPEN (SNAPDCB,OUTPUT) OPEN SNAPDUMP DATASET LA RA,47(,R6) LOCATE TO END OF UCB-1 SNAP DCB=SNAPDCB, DUMP UCB COMMON SEGMENT AREA + STORAGE=((6),(10)) LA RA,47(,R7) LOCATE TO END OF UCB IOS PRFX-1 SNAP DCB=SNAPDCB, DUMP UCB IOS PREFIX AREA + STORAGE=((7),(10)) CLOSE SNAPDCB CLOSE SNAPDUMP DATASET SPACE , * *----------------------------------* * * ENDING PROCEDURE * * *----------------------------------* ENDPROC DS 0H 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 * *********************************************************************** *---------------------------------------------------------------------* * 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 *---------------------------------------------------------------------* * *----------------------------------* * * MISCELLANEOUS WORKAREA * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA AUCB DC A(0) TARGET DEVICE UCB ADDRESS AUCBIOSP DC A(0) TARGET DEVICE UCB IOS PART ADDR SPACE , INFOMSG WTO 'CHAINED IOQ=@@@@@@@@ SEQ=@@@@ ASID=@@@@ JOBNAME=@@@@@@@+ @',MF=L,MCSFLAG=HRDCPY ZOSv23 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 * *---------------------------------------------------------------------* DTIOT DSECT , IEFTIOT1 , TIOT IEFUCBOB PREFIX=YES,SSMD=YES,DEVCLAS=DA UCB WITH PREFIX PART IOSDUPI , UCB IOS PREFIX PART(IOSDUCBP) IECDIOQ IOSIOQM=YES IOS QUEUE ELEMENT IHAPSA , PSA CVT DSECT=YES CVT IHAASVT , ASVT IHAASCB , ASCB *---------------------------------------------------------------------* * 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 // //