JCL:
//ADCDCHK Here's mine running on z/OS 1.10 and above.... JCL: //ADCDCHK JOB SYSTEMS,MSGLEVEL=(1,1),MSGCLASS=X,CLASS=A,PRTY=8, // NOTIFY=&SYSUID,REGION=4096K //AL PROC LMOD='SFORD.LINKLIB', // LMEM=MISSINGMEMBERNAME, // REG=4096K,LNKPARM='LIST,XREF,TEST' //ASM EXEC PGM=ASMA90,REGION=®,PARM=(OBJECT,LIST) //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=SYS1.MODGEN // DD DISP=SHR,DSN=SYS1.AMODGEN // DD DISP=SHR,DSN=TCPIP.SEZACMAC // DD DISP=SHR,DSN=CAI.CAIMAC //SYSUT1 DD UNIT=SYSDA,SPACE=(1700,(400,400)) //SYSUT2 DD UNIT=SYSDA,SPACE=(1700,(400,400)) //SYSUT3 DD UNIT=SYSDA,SPACE=(1700,(400,400)) //SYSLIN DD DISP=(NEW,PASS),DSN=&&LOADSET,UNIT=SYSDA, // SPACE=(3120,(100,10)) //SYSPRINT DD SYSOUT=* //LNK EXEC PGM=IEWL,COND=(4,LT,ASM),PARM='&LNKPARM',REGION=® //SYSLIB DD DISP=SHR,DSN=CEE.SCEELKED // DD DISP=SHR,DSN=SYS1.CSSLIB // DD DISP=SHR,DSN=&LMOD //SYSLMOD DD DISP=SHR,DSN=&LMOD(&LMEM) //SYSUT1 DD UNIT=SYSDA,DCB=BLKSIZE=1024,SPACE=(1024,(200,20)) //SYSPRINT DD SYSOUT=* //SYSLOUT DD SYSOUT=* //SYSLIN DD DISP=(OLD,DELETE),DSN=&&LOADSET // DD DDNAME=SYSIN // PEND //DOIT EXEC AL,LMEM=CARDPRT //ASM.SYSIN DD DSN=SFORD.ASSEMBLE.SOURCE(CARDPRT),DISP=SHR Source: CARDPRT CSECT CARDPRT AMODE 24 CARDPRT RMODE 24 YREGS USING CARDPRT,R12 STM 14,12,12(R13) LR R12,R15 ST R13,SAVEAREA+4 LA R10,SAVEAREA ST R10,8(R13) LR R13,R10 XR R5,R5 XR R4,R4 OPEN (PRTOUT,OUTPUT) OPEN (CARDIN,INPUT) READREC DS 0H GET CARDIN,INAREA MVI OUTAREA,C' ' MVC OUTAREA+1(132),OUTAREA MVC NAMEOUT,NAMEIN MVC ADDROUT,ADDRIN MVC ADDR2OUT,ADDR2IN PUT PRTOUT,OUTAREA AP RECS,=P'1' B READREC EXIT DS 0H CLOSE CARDIN MVC OUTAREA,C' ' MVC OUTAREA+1(132),OUTAREA MVC OUTAREA+2(14),=CL14'RECORDS READ: ' MVC OUTAREA+17(4),=X'40202120' ED OUTAREA+17(4),RECS PUT PRTOUT,OUTAREA CLOSE PRTOUT L R13,SAVEAREA+4 L R14,12(R13) LM R0,R12,20(R13) XR R15,R15 BR R14 LTORG SAVEAREA DS 18F CARDIN DCB DSORG=PS,LRECL=80,DDNAME=CARDIN,EODAD=EXIT, X MACRF=GM INAREA DS 0CL80 NAMEIN DS CL20 ADDRIN DS CL30 ADDR2IN DS CL30 PRTOUT DCB DSORG=PS,DDNAME=PRTOUT, X MACRF=PM,LRECL=133,BLKSIZE=133,RECFM=FB OUTAREA DS 0CL133 NAMEOUT DS CL20 ADDROUT DS CL30 ADDR2OUT DS CL30 DS CL53 RECS DC PL2'0' END CARDPRT Regards, Scott J Ford www.identityforge.com ________________________________ From: "Veilleux, Jon L" <veilleu...@aetna.com> To: IBM-MAIN@bama.ua.edu Sent: Tue, May 10, 2011 1:24:33 PM Subject: Re: S0C4-04 Assembler The original post linked the module as reentrant. If it must be reentrant then your example would need to get storage for the save area. If it doesn't need to be reentrant then that is not an issue. -----Original Message----- From: IBM Mainframe Discussion List [mailto:IBM-MAIN@bama.ua.edu] On Behalf Of Dan Skomsky, PSTI Sent: Tuesday, May 10, 2011 12:59 PM To: IBM-MAIN@bama.ua.edu Subject: Re: S0C4-04 Assembler Why are we over complicating a simple WTO test program? Yes, we all know there are some Assembler Guru's on board. But damn, just keep it simple. Why complicate matters with reentrant code and adding DSECTS? Let's just correct the original problem. With that said, this should make a simple program work and not require going back to refer to the latest POPS and Supervisor Services manuals (comments added for clarity): //PROGRAMA JOB MSGCLASS=X,MSGLEVEL=(1,1),REGION=0M,NOTIFY=&SYSUID //ASM EXEC PGM=ASMA90 //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(3,1)) //SYSLIN DD DSN=&&OBJ,UNIT=SYSDA, // SPACE=(CYL,(1,1)),DISP=(,PASS) //SYSIN DD * ASSHELLO CSECT USING *,R15 R15 ALREADY SET FROM CALLER STM R14,R12,12(R13) SAVE ALL REGISTERS CNOP 0,4 GET ON FULLWORD BOUNDARY BAL R14,*+4+72 HOP OVER NEW SAVE AREA AND SET PTR MYSAVE DC 18F'-1' OUR NEW SAVE AREA SET TO ALL X'FF' **** BALR 12,0 PREPARE A BASE REGISTER **** USING *,12 ESTABLISH BASE REGISTER ST R14,8(R13) CHAIN OLD SAVE AREA TO NEW SAVE AREA ST R13,4(R14) CHAIN NEW SAVE AREA TO OLD SAVE AREA LR R13,R14 POINT R13 TO NEW SAVE AREA USING MYSAVE,R13 SET IT AS PROGRAM BASE ALSO DROP R15 AND FINALLY DROP ORIGINAL BASE * * WTO 'TEST' THIS WORKED OPEN (SALIDA,(OUTPUT)) PUT SALIDA,HELLOMSG CLOSE (SALIDA) L R13,4(R13) GET POINTER TO OLD SAVE AREA LM R14,R12,12(R13) RESTORE ALL REGISTERS MVI 12(R13),X'FF' MARK OLD SAVE AREA AS INACTIVE * * LA R15,0 * SET RETURN-CODE TO ZERO SR R15,R15 USE A 2 BYTE INSTRUCTION NOT 4 BYTE BR 14 * RETURN TO CALLER R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 HELLOMSG DC CL80'I AM AN OLD FREAK' <= SET STRING LENGTH TO LRECL SALIDA DCB DSORG=PS,MACRF=PM,DDNAME=SALIDA, X RECFM=FB,LRECL=80,BLKSIZE=80 LTORG , <= JUST TO BE KOSHER END I apologies to those who may be offended. ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to lists...@bama.ua.edu with the message: GET IBM-MAIN INFO Search the archives at http://bama.ua.edu/archives/ibm-main.html This e-mail may contain confidential or privileged information. If you think you have received this e-mail in error, please advise the sender by reply e-mail and then delete this e-mail immediately. Thank you. Aetna ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to lists...@bama.ua.edu with the message: GET IBM-MAIN INFO Search the archives at http://bama.ua.edu/archives/ibm-main.html ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to lists...@bama.ua.edu with the message: GET IBM-MAIN INFO Search the archives at http://bama.ua.edu/archives/ibm-main.html
