//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 //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.1 * * ===================================================== * * CREATE GDG DATASET. * * WHEN DYNALLOC FAILED, ANY ERROR MESSAGES WILL BE SENT TO * * TSO TERMINAL AND PROGRAM ABENDED U0001 WITH GR15 CONTAIN * * SVC99 ERROR AND INFO CODE. * *********************************************************************** MAINPROC DS 0H * *----------------------------------* * * SETUP DYNALLOC PARAMETERS * * *----------------------------------* USING S99RBP,RBPAREA ADDRESS TO SVC99 RB POINTER USING S99RB,RBAREA ADDRESS TO SVC99 RB AREA USING S99RBX,RBXAREA ADDRESS TO SVC99 RBX AREA SPACE , XC S99RB(S99RBEND-S99RB),S99RB CLEAR SVC99 RB AREA MVI S99RBLN,(S99RBEND-S99RB) SET RB AREA LENGTH MVI S99VERB,S99VRBAL SET VERB CODE=ALLOCATION OI S99FLG11,S99GDGNT REQUIRE THAT NEW GENERATION + NUMBER WILL BE ASSIGND WHENEVER+ ALLOCATE NEW DATASET. LA R1,TULIST LOAD TEXT UNIT LIST ADDRESS ST R1,S99TXTPP SET IT INTO RB SPACE , XC S99RBX(S99ERSN+L'S99ERSN-S99RBX),S99RBX CLEAR SVC99 RBX MVC S99EID,=CL6'S99RBX' SET EYE-CATCHER MVI S99EVER,S99RBXVR SET VERSION NUMBER MVI S99EOPTS,S99ERMSG+S99ELSTO SET PROCESSING OPTIONS MVI S99EMGSV,S99XWARN SET MSG SEVERITY LEVEL MVI S99ESUBP,127 SET MSG BLOCK SUBPOOL# LA R1,S99RBX LOAD RBX AREA ADDRESS ST R1,S99S99X SET IT INTO RB SPACE , * *----------------------------------* * * DO DYNAMIC ALLOCATION * * *----------------------------------* LA R1,S99RBP LOAD RB POINTER FIELD ADDRESS DYNALLOC , CALL DYNALLOC SERVICE(ALLOC) LTR RF,RF SUCCESSFUL ? BNZ DYNALERR NO, DO ERROR PROCESSING SPACE , LA R1,S99RBP LOAD RB POINTER FIELD ADDRESS DYNALLOC , CALL DYNALLOC SERVICE(ALLOC) LTR RF,RF SUCCESSFUL ? BNZ DYNALERR NO, DO ERROR PROCESSING SPACE , B ENDPROGM GO TO EPILOGUE PROCEDURE SPACE , * *----------------------------------* * * DYNALLOC FAILED PROCESSING * * *----------------------------------* DYNALERR DS 0H ICM R3,B'1111',S99EMSGP LOAD SVC99 ERROR MSG BLOCK BZ ENDPROGM IF NO MSG BLOCK RETURNED IAZXJSAB READ,USERID=DESTID READ OUR RELATED USERID USING MCSM,R3 ADDRESS TO MSG BLOCK + (THE MSG RETURNED BY SMS MSG + SERVICE) SENDMSG DS 0H LH R0,MCSMLNG LOAD MSG TEXT LENGTH LA R1,MCSMTXT LOAD MSG TEXT ADDRESS O R1,=A(X'40000000') LOAD TPUT OPTION FLAGS + EDIT,WAIT,NOHOLD,NOBREAK,HIGHP + AND GR15 CONTAIN USERIDL LA RF,DESTID LOAD USERID LIST ADDR IN GR15 TPUT (1),(0),R ISSUE TPUT SVC ICM R3,B'1111',MCSMPTRN CHAIN NEXT MSG BLOCK ? BNZ SENDMSG YES, SEND IT SPACE , SLR RF,RF CLEAR WORK REG IC RF,S99ESUBP LOAD MSG BLOCK SUBPOOL# FREEMAIN RU,SP=(15) RELEASE MSG BLOCK STORAGE POOL DROP R3 L R0,S99ERROR LOAD SVC99 ERROR AND INFO CODE *ZOSv23* B ENDPROGM PROCESSING DONE SPACE , U0001 DS 0H ZOSv23 LR RF,R0 GR15 <-- DYNALLOC ERRCD ZOSv23 ABEND 1,DUMP ABEND WITH U0001 ZOSv23 SPACE , * *----------------------------------* * * END OF PROCESSING * * *----------------------------------* ENDPROGM DS 0H SLR 15,15 LOAD RETURN CODE = 0 B EXITPROC DO EXIT PROCESSING EJECT , *********************************************************************** * DATA AREA * *********************************************************************** DS 0D *---------------------------------------------------------------------* * *----------------------------------* * * DYNALLOC PARAMETER LIST * * *----------------------------------* RBPAREA CALL ,(RBAREA),VL,MF=L SVC99 RB POINTER RBAREA DC (S99RBEND-S99RB)X'00' SVC99 RB AREA RBXAREA DC (S99ERSN+L'S99ERSN-S99RBX)X'00' SVC99 RBX AREA SPACE , TULIST DC A(DSNAME) SVC99 TEXT UNIT LIST DC A(DSMEMBR) DC A(DSSTAT) DC A(DSNDISP) DC A(DSSTOR) DC A(DSDATA) DC A(RTNDDNAM+X'80000000') SPACE , * *----------------------------------* * * DYNALLOC TEXT UNITS * * *----------------------------------* RTNDDNAM DS 0H DC AL2(DALRTDDN) KEY=RETURN DDNAME DC AL2(1) PARM# DC AL2(8) PARM LENGTH DC CL8' ' (ALLOCATED DDNAME) DSNAME DS 0H DC AL2(DALDSNAM) KEY=DSNAME DC AL2(1) PARM# DC AL2(44) PARM LENGTH DC CL44'UAP8.URIAGE' (ALLOCATING DSNAME) DSMEMBR DS 0H DYNALLOC TEXT UNIT DC AL2(DALMEMBR) MEMBER DC AL2(1) NUM OF PARMS DC AL2(2) PARM LENGTH DC CL2'+1' VALUE DSSTAT DS 0H DC AL2(DALSTATS) KEY=DS STATUS DC AL2(1) PARM# DC AL2(1) PARM LENGTH DC XL1'04' (DISP=NEW) SPACE , DSNDISP DS 0H DC AL2(DALNDISP) KEY=NORMAL DISPOSITION DC AL2(1) PARM# DC AL2(1) PARM LENGTH DC XL1'02' (DISP=,CATLG) SPACE , DSSTOR DS 0H DC AL2(DALSTCL) KEY=STOR CLASS DC AL2(1) PARM# DC AL2(8) PARM LENGTH DC CL8'SMSSTD' (STOR=SMSSTD) SPACE , DSDATA DS 0H DC AL2(DALDACL) KEY=DATA CLASS DC AL2(1) PARM# DC AL2(8) PARM LENGTH DC CL8'UAPDATA1' (DATA=UAPDATA1) SPACE , DESTID DC CL8' ' TPUT DESTINATION USERID *---------------------------------------------------------------------* LTORG , LITERAL POOL AT HERE DROP , FORGET ALL BASE REGISTERS EJECT , *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * DSECTS * *---------------------------------------------------------------------* IEFZB4D0 , SVC99 PLIST DSECTS IEFZB4D2 , SVC99 TEXT UNIT EQUATES IGDMCSMG , SVC99 RETURNED ERR MSG FORMAT IHAPSA , PSA FOR IAZXJSAB MACRO IHAASCB , ASCB FOR IAZXJSAB MACRO IAZJSAB , JSAB FOR IAZXJSAB MACRO IHAASSB , ASSB FOR IAZXJSAB MACRO IHASTCB , STCB FOR IAZXJSAB MACRO IKJTCB , TCB FOR IAZXJSAB MACRO *---------------------------------------------------------------------* * 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 // //