//INSTALL JOB (,R4340),LANGSTON,NOTIFY= <====(0) /*JOBPARM FETCH <====(0) //*-------------------------------------------------------------------* //* This test stream is used to verify that the AMODE switching * //* feature of the MODULE routines works correctly. To use at your * //* site, change the usual JCL items, including the DUMP file and * //* TLTKLOAD program location (see the INSTALL program for more * //* information). * //* * //* Items marked may need to be changed: * //* * //* <====(0) JCL that is most likely different at your site * //* <====(1) SAS608 cataloged procedure change; change to name * //* of TLKTLOAD and DUMP locations * //* <====(2) unlikely changes: Assembler H (IEV90) * //*-------------------------------------------------------------------* //* //*-----instream procedure to handle link-editing---------------------* //* //DOLINK PROC MEMBER=,ATTR=0022 0000 // EXEC PGM=IEWL,PARM='XREF,LET,LIST,NCAL,&ATTR' //SYSUDUMP DD SYSOUT=A 0023 0000 //SYSPRINT DD SYSOUT=A 0024 0000 //SYSLIN DD DSN=&&LOADSET,DISP=SHR 0025 0000 //SYSLMOD DD DSN=&&LOAD(&MEMBER),DISP=SHR 0028 0000 //SYSUT1 DD DSN=&&SYSUT1,DISP=SHR 0033 0000 // PEND //* //*-----allocate all the temporary files needed-----------------------* //* // EXEC PGM=IEFBR14 //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(TRK,(10,10)), 0015 0009 // DISP=(NEW,PASS) //LOAD DD DSN=&&LOAD,UNIT=SYSDA,SPACE=(TRK,(10,10,10)), 0015 0009 // DISP=(NEW,PASS) //UNLOAD2 DD DSN=&&UNLOAD2,UNIT=SYSDA,SPACE=(TRK,(10,10)), 0015 0009 // DISP=(NEW,PASS //SYSLIN DD DSN=&&LOADSET,DISP=(NEW,PASS),UNIT=SYSDA, 0018 0000 // SPACE=(CYL,(5,5,1)),DCB=(BLKSIZE=3200) 0019 0002 //* //*-----assemble the function code using assembler H------------------* //* //ASM EXEC PGM=IEV90,PARM='OBJECT,NODECK' <====(2) 0010 0008 //SYSUDUMP DD SYSOUT=A 0011 0000 //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR 0012 0000 //SYSPUNCH DD DUMMY 0016 0000 //SYSPRINT DD SYSOUT=A 0017 0000 //SYSLIN DD DSN=&&LOADSET,DISP=SHR 0018 0000 //SYSUT1 DD DSN=&&SYSUT1,DISP=SHR //SYSIN DD * 0020 0001 *---------------------------------------------------------------------* * This assembler function expects two arguments: the address of an * * amode and the address of an rmode. The proper AMODE and RMODE values* * are determined by obtaining the current PSW. If the hi-order bit of * * the last 4 bytes of the PSW is set, we're in AMODE 31, otherwise * * we're in AMODE 24. If any of the remaining bits of the high-order * * byte are non-zero, we're residing above the line, so we're RMODE 31;* * otherwise we're RMODE 24. The values of AMODE and RMODE are saved * * at the two passed addresses. Also, we add the values of AMODE and * * RMODE and return their sum in R15 and R0 (the two standard return * * registers) and in floating point register FR0. * *---------------------------------------------------------------------* FR0 EQU 0 R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 AMODE EQU 3 RMODE EQU 4 ATEST CSECT USING *,R15 BASE REGISTER STM R14,R12,12(R13) SAVE REGS UPON ENTRY BASR R14,R0 COPY PSW INTO R14 LA AMODE,31 ASSUME AMODE 31 LA RMODE,31 ASSUME RMODE 31 L R0,=X'80000000' NR R0,R14 IS HIORDER BIT ON? (AMODE31) BNZ *+4+4 LA AMODE,24 NO - SET AMODE TO 24 N R14,=X'7F000000' ARE OTHER 7 BITS ON? (RMODE31) BNZ *+4+4 LA RMODE,24 NO - SET RMODE TO 24 LM R1,R2,0(R1) R1->AMODE R2->RMODE ST AMODE,0(R1) SAVE AMODE ST RMODE,0(R2) SAVE RMODE LA R0,0(AMODE,RMODE) R0=AMODE+RMODE ST R0,PART2 SDR FR0,FR0 AD FR0,DOUBLE FR0=AMODE+RMODE LR R15,R0 R15=AMODE+RMODE L R14,12(R13) RESTORE REGS LM R1,R12,24(R13) (EXCEPT R0 AND R15) BR R14 AND RETURN DOUBLE DS 0D DC X'4E000000' PART2 DS F LTORG END //* //*-----recreate the needed IEBCOPY dump file from the dump-----------* //* // EXEC SAS608 <====(1) //UNLOAD2 DD DSN=&&UNLOAD2,DISP=SHR //DUMPFILE DD DSN=SASRDL.MODULE.LASTEXP(DUMP),DISP=SHR <====(1) //SYSIN DD DSN=SASRDL.MODULE.LASTEXP(TLKTLOAD),DISP=SHR <====(1) // DD * %TLKTLOAD(INFILE=DUMPFILE,OUTFILE=UNLOAD2); //* //*-----Run IEBCOPY to recreate a load module library-----------------* //* // EXEC PGM=IEBCOPY //IN DD DSN=&&UNLOAD2,DISP=SHR //OUT DD DSN=&&LOAD,DISP=SHR //SYSUT1 DD DSN=&&SYSUT1,DISP=SHR //SYSUT2 DD UNIT=SYSDA,SPACE=(TRK,50) //SYSPRINT DD SYSOUT=A //SYSIN DD * COPY INDD=IN,OUTDD=OUT //* //*-----Create copies of the ASM function with AMODE/RMODE 24/31------* //* // EXEC DOLINK,MEMBER=A31RANYX,ATTR='AMODE(31),RMODE(ANY)' // EXEC DOLINK,MEMBER=A31R024X,ATTR='AMODE(31),RMODE(24)' // EXEC DOLINK,MEMBER=A24R024X,ATTR='AMODE(24),RMODE(24)' // EXEC DOLINK,MEMBER=A31RANYL,ATTR='AMODE(31),RMODE(ANY)' // EXEC DOLINK,MEMBER=A31R024L,ATTR='AMODE(31),RMODE(24)' // EXEC DOLINK,MEMBER=A24R024L,ATTR='AMODE(24),RMODE(24)' // EXEC DOLINK,MEMBER=A31RANYD,ATTR='AMODE(31),RMODE(ANY)' // EXEC DOLINK,MEMBER=A31R024D,ATTR='AMODE(31),RMODE(24)' // EXEC DOLINK,MEMBER=A24R024D,ATTR='AMODE(24),RMODE(24)' //* //*-----Test the MODULE routines using the various functions----------* //* // EXEC SAS608 <=====(1) //SASLIB DD DSN=&&LOAD,DISP=SHR //SASCBTBL DD * ROUTINE A31RANYX MINARG=2 MAXARG=2 CALLSEQ=BYADDR; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A31R024X MINARG=2 MAXARG=2 CALLSEQ=BYADDR; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A24R024X MINARG=2 MAXARG=2 CALLSEQ=BYADDR; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A31RANYL MINARG=2 MAXARG=2 CALLSEQ=BYADDR RETURNS=LONG; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A31R024L MINARG=2 MAXARG=2 CALLSEQ=BYADDR RETURNS=LONG; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A24R024L MINARG=2 MAXARG=2 CALLSEQ=BYADDR RETURNS=LONG; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A31RANYD MINARG=2 MAXARG=2 CALLSEQ=BYADDR RETURNS=DOUBLE; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A31R024D MINARG=2 MAXARG=2 CALLSEQ=BYADDR RETURNS=DOUBLE; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; ROUTINE A24R024D MINARG=2 MAXARG=2 CALLSEQ=BYADDR RETURNS=DOUBLE; ARG 1 UPDATE FORMAT=IB4.; ARG 2 UPDATE FORMAT=IB4.; //SYSIN DD * %macro invoke(member); data _null_; a_expect=input(substr("&member.",2,2),2.); x = substr("&member.",5,3); if x='ANY' then r_expect=31; else r_expect=24; if substr("&member.",8,1)='X' then do; sum=.; rc=.; end; else do; sum=a_expect+r_expect; rc=99; end; do i=1 to 10; amode=99; rmode=99; if sum=. then call &which("&member.",amode,rmode); else rc=modulen("&member.",amode,rmode); if amode=a_expect and rmode=r_expect and sum=rc then matched+1; else put 'nonmatch:' i= sum= rc= amode= rmode=; end; if matched=10 then put 'all expected values matched'; run; %mend; %let which=module; %invoke(A31RANYX); %invoke(A31R024X); %invoke(A24R024X); %invoke(A31RANYL); %invoke(A31R024L); %invoke(A24R024L); %invoke(A31RANYD); %invoke(A31R024D); %invoke(A24R024D); let which=cobolint; %invoke(A31RANYX); %invoke(A31R024X); %invoke(A24R024X); //