//JOBNAME JOB (ACCT),NAME,CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1) //********************************************************************* //ASMCG PROC AOPT=,APARM=,LOPT=,NCAL=NCAL, // MAC1='SYS1.MACLIB', // MAC2='SYS1.MACLIB', // MAC3='SYS1.MODGEN', // LLIB='NULLFILE' //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=* //GO EXEC PGM=LOADER,COND=(5,LT,ASM), // PARM=('LIST,LET,MAP,PRINT,XREF,&NCAL,&LOPT') //SYSLOUT DD DUMMY //SYSLIB DD DISP=SHR,DSN=&LLIB //SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE) // DD DDNAME=SYSIN //OUTLIST DD SYSOUT=* // PEND //********************************************************************* //MYASMPGM EXEC ASMCG //ASM.SYSIN DD * LCLC &MDLNM &MDLNM SETC 'CALLAMS2' SET THIS MODULE NAME &MDLNM TITLE 'TEST AND WORK ASSEMBLER PROGRAM' *---------------------------------------------------------------------* * HOUSEKEEPING PROCEDURE * * ===================================================== * *---------------------------------------------------------------------* * *----------------------------------* * * ENTRY PROCESSING * * *----------------------------------* &MDLNM CSECT , DEFINE CODE SECTION &MDLNM AMODE 31 DEFINE DEFAULT AMODE &MDLNM RMODE 24 DEFINE DEFAULT RMODE SAVE (14,12),,* SAVE CALLER REGISTERS USING &MDLNM,RC DEFINE OUR BASE REGISTERS LA RC,0(,RF) LOAD OUR 1ST BASE ADDRESS LR RF,RD SAVE CALLER SAVEAREA CNOP 0,4 INSURE FULL WORD BOUNDARY BAS RD,*+4+72 AROUND OUR SAVEAREA DC 18F'-1' OUR GPR SAVEAREA ST RF,4(,RD) SAVE CALLER SAVEAREA POINTER ST RD,8(,RF) SET BACK CHAIN FOR LINK TRACE B MAINPROC DO MAIN PROCESSING SPACE , * *----------------------------------* * * EXIT PROCESSING * * *----------------------------------* EXITPROC DS 0H L RD,4(,RD) LOAD CALLER SAVEAREA ST RF,16(,RD) PASS RETURN CODE TO CALLER LM RE,RC,12(RD) RESTORE CALLER REGISTERS BSM 0,RE RETURN TO CALLER EJECT , *********************************************************************** * MAIN LINE PROCESSING * * ===================================================== * * GR1 -- PSEUDO EXEC PARAMETER PLIST * * GR12 - BASE REGISTER * * GR13 - OUR REGISTER SAVEAREA * *---------------------------------------------------------------------* * SAMPLE CODE OF 'MVS ADVANCED SKILL Vol-2' CHAPTER A.1 * * ===================================================== * * CALL IDCAMS SERVICE PROGRAM. * *********************************************************************** MAINPROC DS 0H L R1,0(,R1) LOAD EXEC PARM PLIST LH R0,0(,R1) LOAD STRING LENGTH LA R1,2(,R1) GR1 --> BEGINNING OF PARM + GR0 --> REMAINING LENGTH SPACE , * *----------------------------------* * * CALL IDCAMS * * * ============================== * * * - SETUP CALLING PARAMETERS * * * - ISSUE LINK SVC TO CALL IDCAMS * * *----------------------------------* CALLAMS DS 0H LINK EPLOC=AMSNAME, CALL IDCAMS ROUTINE + PARAM=(HWKZERO,HWKZERO,HWKZERO,IOLIST),VL=1 SPACE , B EXITPROC DO EXIT PROCESSING WITH UTY-CC EJECT , *********************************************************************** * I N T E R N A L S U B R O U T I N E S * *********************************************************************** *---------------------------------------------------------------------* * CNVRTX - CONVERT BINARY TO HEX-DECIMAL TEXT (REGISTER TYPE) * * CALL INTERFACE - * * GR0: FULL-WORD BINARY VALUE * * GR1: 8BYTES OUTPUT-AREA ADDRESS * * BAS 14,CNVRTX * *---------------------------------------------------------------------* CNVRTX DS 0H CONVERT GR0 TO HEX-DECIMAL LA 1,7(,1) LA 15,8 STC 0,0(,1) NI 0(1),X'0F' TR 0(1,1),CNVTRT2 SRL 0,4 BCTR 1,0 BCT 15,*-2-4-6-4-4 BR 14 CNVTRT2 DC CL16'0123456789ABCDEF' TRANS TABLE FOR HEX-CHARACTER *---------------------------------------------------------------------* EJECT , *********************************************************************** * OS ASYNC EXIT ROUTINES * * ACCESS METHOD EXIT ROUTINES * *********************************************************************** * *----------------------------------* * * IDCAMS USER I/O EXIT ROUTINE * * * (IDCAMS I/O SIMULATOR) * * * (ENTERED WITH AMODE=24) * * * ============================== * * * INPUT: * * * GR0 --> N/A * * * GR1 --> PLIST(SEE AMS MANUAL) * * * +0: A(USERPARM) * * * --> DWORK * * * +4: A(IOFLAGS) * * * --> AMSIOFLG DSECT * * * +8: A(IOINFO) * * * --> DDNAME(OPEN) * * * --> DDNPTR(CLOSE) * * * GR2-12: N/A * * * GR13 -> CALLER(IDCAMS) SAVEAREA * * * GR14 -> RETURN ADDRESS(BALR) * * * GR15 -> ENTRY ADDRESS * * * OUTPUT: * * * GR15 -> RETURN CODE * * * 00: OPERATION COMPLETED * * * 04: E.O.D * * * 08: I/O ERROR(CONTINUE) * * * 12: I/O ERROR(ABORT) * * *----------------------------------* AMSUIOSR DS 0H USING *,RF SET TEMP BASE REGISTER STM RE,RC,12(RD) SAVE CALLER GPRS L RC,MAINBASE ESTABLISH OUR MAIN BASE REGS DROP RF FORGET TEMP BASE ******** SAM31 , CHANGE US TO AMODE=31 LA RF,*+4+4+2 SET BRANCH ADDRESS O RF,=A(X'80000000') SET TO 31BIT MODE BSM RE,RF EXTRACT CALLER AMODE AND + CHANGE AMODE TO 31BIT MODE ST RE,12(,RD) RESAVE RETURN ADDRESS AND AMODE LR RF,RD SAVE CALLER SAVEAREA CNOP 0,4 INSURE FULL WORD BOUNDARY BAS RD,*+4+72 AROUND OUR SAVEAREA DC 18F'-1' OUR GPR SAVEAREA ST RF,4(,RD) SAVE CALLER SAVEAREA POINTER ST RD,8(,RF) SET BACK CHAIN FOR LINK TRACE SPACE , LM R6,R7,4(R1) LOAD INPUT PARMS(IOFLAGS,IOINFO USING AMSIOFLG,R6 ADDRESS TO IOFLAGS AREA CLI AMSIOTYP,AMSIOOPN OPEN REQUEST ? BE AMSUOPCL YES, OPEN PSEUDO SYSIN/SYSPRINT CLI AMSIOTYP,AMSIOCLS CLOSE REQUEST ? BE AMSUOPCL YES, CLOSE PSEUDO SYSIN/SYSPRNT CLI AMSIOTYP,AMSIOGET GET REQUEST ? BE AMSUGETR YES, READ FROM PSEUDO SYSIN CLI AMSIOTYP,AMSIOPUT PUT REQUEST ? BE AMSUPUTR YES, WRITE TO PSEUDO SYSPRINT B AMSUIOR0 NO, NO PROCESSING IN HERE SPACE , * *----------------------------------* * * PSEUDO OPEN/CLOSE PROCESSING * * * ============================== * * * - OPEN/CLOSE OUR LIST DATASET * * *----------------------------------* AMSUOPCL DS 0H TM AMSIOCTL,AMSINOPN SYSIN OPEN/CLOSE REQUEST ? BO AMSUIOR0 YES, NO PROCESSING AT HERE SPACE , CLI AMSIOTYP,AMSIOCLS CLOSE REQUEST ? BE AMSUCLOS YES, CLOSE OUR LIST DATASET OPEN (QSAMDCB,OUTPUT) NO, OPEN OUR LIST DATASET B AMSUIOR0 PROCESSING DONE AMSUCLOS DS 0H CLOSE (QSAMDCB) CLOSE QSAM DCB B AMSUIOR0 PROCESSING DONE SPACE , * *----------------------------------* * * PSEUDO GET PROCESSING(SYSIN) * * * ============================== * * * - PASS AMS COMMAND CTRL CARD * * *----------------------------------* AMSUGETR DS 0H L RF,NXTCARD LOAD PREVIOUS CARD POINTER LA RF,CARDLNG(,RF) LOCATE TO NEXT COMMAND CARD ST RF,NXTCARD UPDATE IT FOR NEXT COMMAND CLI 0(RF),X'FF' END OF CARD ? BE AMSUIOR4 YES, RETURN TO AMS WITH RC=4 SPACE , LM RE,RF,NXTCARD LOAD NEXT CARD PTR AND LENGTH STM RE,RF,0(R7) PASS IT TO AMS PROGRAM B AMSUIOR0 RETURN TO AMS WITH RC=0 SPACE , * *----------------------------------* * * PSEUDO PUT PROCESSING(SYSPRINT * * * ============================== * * * - RECEIVE AMS SYSPRINT RECORD * * * AND WRITE IT TO OUR DATASET * * *----------------------------------* AMSUPUTR DS 0H MVI LISTTXT,C' ' CLEAR RECORD TEXT AREA MVC LISTTXT+1(L'LISTTXT-1),LISTTXT LM RE,RF,0(R7) LOAD OUTPUT RECORD TEXT AND LNG BCTR RF,0 MAKE IT TO S/370 LENGTH EX RF,*+4+4 MOVE IDCAMS MSG TEXT B *+4+6 SKIP MODEL INSTRUCTION MVC LISTTXT(0),0(RE) (MSGTEXT MOVE INSTRUCTION) LA RF,4+6+1(,RF) ADD RDW FIELD, MSGNUM FIELD AND+ CORRECT ORIGIN TEXT LENGTH STH RF,LISTRDW SET WRITING RECORD LENGTH SPACE , LH R0,AMSMSGNO LOAD IDC MESSAGE NUMBER CVD R0,DOUBLE CONVERT IT TO PACK DECIMAL OI DOUBLE+7,X'0F' CORRECT SIGN FOR HUMAN REDABLE UNPK LISTMSG#,DOUBLE CONVERT IT TO ZONE DECIMAL SPACE , PUT QSAMDCB,LISTREC WRITE AMS SYSPRINT RECORD B AMSUIOR0 RETURN TO AMS WITH RC=0 DROP R6 FORGET IOFLAGS AREA SPACE , * *----------------------------------* * * RETURNM TO IDCAMS * * *----------------------------------* AMSUIORC DS 0H LA RF,12 SET RC=12 B AMSUIORR AMSUIOR8 DS 0H LA RF,8 SET RC=8 B AMSUIORR AMSUIOR4 DS 0H LA RF,4 SET RC=4 B AMSUIORR AMSUIOR0 DS 0H LA RF,0 SET RC=0 B AMSUIORR AMSUIORR DS 0H L RD,4(,RD) LOAD CALLER SAVEAREA L RE,12(,RD) LOAD CALLER GPRS LM R0,RC,20(RD) LOAD CALLER GPRS BSM 0,RE RETURN TO CALLER SPACE , CARDLNG EQU 80 AMS COMMAND CARD LENGTH NXTCARD DC A(AMSCARD-CARDLNG) NEXT PROCESSING CARD POINTER DC A(CARDLNG) NEXT CARD RECORD LENGTH AMSCARD DS 0H AMS COMMAND CARD TABLE DC CL80' DELETE MY.TEST.VSAMDS6' DC CL80' DEFINE CLUSTER -' DC CL80' (NAME(MY.TEST.VSAMDS6) VOL(WORKVL) RECORDS(+ 10000 1000) -' DC CL80' RECORDSIZE(128 128) KEYS(10 0) INDEXED)' DC CL80' LISTCAT ENTRY(MY.TEST.VSAMDS6) ALL' DC XL1'FF' EJECT , *********************************************************************** * DATA AREA (CONSTANTS) * *********************************************************************** DS 0D * *----------------------------------* * * MISCELLANEOUS * * *----------------------------------* MAINBASE DC A(&MDLNM) BASE ADDRESS OF OUR MODULE SPACE , *********************************************************************** * DATA AREA * *********************************************************************** * *----------------------------------* * * MISCELLANEOUS * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA QSAMDCB DCB DDNAME=OUTLIST,DSORG=PS,MACRF=PM, + RECFM=VB,LRECL=131,BLKSIZE=0 LISTREC DS 0H OUTLIST RECORD AREA LISTRDW DC AL2(0) RDW DC AL2(0) LISTMSG# DC CL5' ' IDC MESSAGE NUMBER DC CL1' ' LISTTXT DC CL121' ' RECORD TEXT SPACE , * *----------------------------------* * * IDCAMS SERVICE PARAMETERS * * * AND CONTROLS * * * ============================== * * * 1. OPTIONAL PARAMETER * * *----------------------------------* AMSNAME DC CL8'IDCAMS' IDCAMS MODULE NAME AIDCAMS DC A(0) IDCAMS ROUTINE ENTRY ADDRESS HWKZERO DC AL2(0) HALFWORD ZERO SPACE , IOLIST DS 0F IDCAMS I/O SIMULATER LIST DC F'2' NUMBER OF DDNAMES(1 OR 2) DC A(DDSYSIN) SIMLATE DDNAME(SYSIN) DC A(AMSUIOSR) I/O SIMULATER ENTRY(GET) DC A(0) PARM FOR I/O SIMULATER DC A(DDSYSPRT) SIMLATE DDNAME(SYSPRINT) DC A(AMSUIOSR) I/O SIMULATER ENTRY(PUT) DC A(0) PARM FOR I/O SIMULATER LOLIST EQU *-IOLIST (LENGTH OF IOLIST) SPACE , DDSYSIN DC CL10'DDSYSIN' DDNAME=SYSIN DDSYSPRT DC CL10'DDSYSPRINT' DDNAME=SYSPRINT SPACE , *---------------------------------------------------------------------* LTORG , USER LITERAL PLACE AT HERE *---------------------------------------------------------------------* DROP , FORGET ALL BASE REGISTER EJECT , *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * LOCAL DSECTS * *---------------------------------------------------------------------* * *----------------------------------* * * IDCAMS USER I/O ROUTINE PLIST * * *----------------------------------* AMSIOFLG DSECT , AMSIOTYP DC AL1(0) I/O TYPE CODE AMSIOOPN EQU 0 OPEN CALL AMSIOCLS EQU 4 CLOSE CALL AMSIOGET EQU 8 GET CALL AMSIOPUT EQU 12 PUT CALL AMSIOCTL DC AL1(0) I/O CONTROL FLAGS AMSINOPN EQU X'80' OPEN FOR INPUT AMSOTOPN EQU X'40' OPEN FOR OUTPUT AMSOPDDN EQU X'20' IOINFO CONTAIN DDNAME AT OPEN AMSOPDSN EQU X'10' IOINFO CONTAIN DSNAME AT OPEN AMSMSGNO DC AL2(0) IDC ERROR MSG NUMBER AT PUT + 0=NORMAL OUTPUT DATA RECORD *---------------------------------------------------------------------* * GLOBAL DSECTS * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * 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 R10 EQU 10 GENERAL REGISTER 10 R11 EQU 11 GENERAL REGISTER 11 R12 EQU 12 GENERAL REGISTER 12 R13 EQU 13 GENERAL REGISTER 13 R14 EQU 14 GENERAL REGISTER 14 R15 EQU 15 GENERAL REGISTER 15 *---------------------------------------------------------------------* * OS CONTROL BLOCKS * *---------------------------------------------------------------------* PRINT NOGEN END // //