**************************************************************** * AUTHOR - BILL SWEENEY * * SSC, INC. (703) 777-2771 * * WHSWEENEY@SSCMAINFRAME.COM * * WWW.SSCMAINFRAME.COM * * DATE - (C) COPYRIGHT 1997 * * * * THIS PROGRAM IS A REXX FUNCTION THAT WILL ISSUE A WTOR AND * * PASS THE REPLY BACK. * * * * THE VARIABLES THAT WILL BE PASSED THROUGH REGISTER 1 ARE: * * WTOR - WHICH WILL CONTAIN THE WTOR MESSAGE TO ISSUE * * REPLY_LENGTH = THE LENGTH OF THE WTOR REPLY * * * * THE VARIABLE VALUE THAT WILL BE RETURNED IS: * * REPLY_AREA = WHERE THIS PROGRAM WILL STORE THE OPERATOR * * REPLY * * * * REGISTERS: * * R1 - FIVE WORD PARAMETER LIST OF REXX VARIABLES * * WORD1 - RESERVED * * WORD2 - RESERVED * * WORD3 - RESERVED * * WORD4 - ADDRESS OF ARGUMENTS PASSED BY REXX * * WORD5 - ADDRESS OF THE EVALUATION BLOCK WHERE WE * * WILL RETURN THE REPLY * * * * I AM ONLY INTERESTED IN R1 BECAUSE IT WILL PASS THE ADDRESS * * PARAMETER LIST OF VARIABLES. EVERYTHING IS STANDARD * * USAGE AND NOTHING TO WRITE HOME ABOUT. * **************************************************************** ALXRWTOR CSECT ALXRWTOR AMODE 31 ALXRWTOR RMODE ANY PRINT ON,NOGEN,NODATA 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 NO_STORAGE EQU 20 STM R14,R12,12(R13) LR R7,R1 SAVE THE PARAMETER ADDRESS LR R12,R15 SET UP BASE REGISTER ADDRESS. USING ALXRWTOR,R12 GETMAIN RC,LV=STORAGE_SIZE LTR R15,R15 BZ GOOD_STORAGE LA R15,NO_STORAGE B RETURN2 GOOD_STORAGE EQU * ST R1,8(R13) ST R13,4(R1) LR R13,R1 USING STORAGE,R13 ****************************************************************** L R11,16(R7) LET'S GET OUR ARGUMENT CLC 0(8,R11),FFFLAG IS THERE ANY ARGUMENT BE BAD_WTOR NO, THEN DO DEFAULT ICM R3,15,4(R11) GET THE LENGTH OF ARGUMENT BZ BAD_WTOR IF NULL/ZERO THEN DO DEFAULT CH R3,HW122 VERIFY IT'S NOT TOO LONG BNH SAVELGTH NO, THEN CONTINUE LH R3,HW122 YES, THEN LOAD UP TO 122 BYTES SAVELGTH STH R3,WTOR_AREA_LENGTH SAVE THE LENGTH OF WTOR BCTR R3,0 DECREMENT FOR EXECUTE MOVE L R10,0(R11) AND ADDRESS THE ARGUMENT EX R3,MOVEWTOR MVC WTOR_AREA(0),0(R10) LA R4,WTOR_AREA_LENGTH ADDRESS FOR TEXT OF MESSAGE ****************************************************************** CLC 8(8,R11),FFFLAG HAVE THEY SPECIFIED A REPLY LENGTH BE SET_DEFAULT NO, THEN JUST SET TO 80 BYTES ICM R9,15,12(R11) GET THE LENGTH OF REPLY_LENGTH VALUE BZ SET_DEFAULT JUST SET TO 80 BYTES L R10,8(R11) POINT TO THE ARGUMENT BCTR R9,0 DECREMENT IT BY ONE LA R8,7 DOUBLE_WORD LENGTH - 1 FOR EX SLL R9,28 GET IT IN THE HI-ORDER BYTE SLDL R8,4 AND SHIFT IT TOGETHER W/ OTHER LENG EX R8,PACK_REPLYL PACK DOUBLE_WORD(0),0(0,R10) CVB R8,DOUBLE_WORD GET THE LENGTH OF REPLY IN R8 CH R8,HW119 CAN'T BE GT MAX BNH ISSUE_WTOR GO AND ISSUE THE WTOR LH R8,HW119 SET THE MAX B ISSUE_WTOR GO AND ISSUE THE WTOR SET_DEFAULT EQU * LH R8,HW80 SET THE DEFAULT ISSUE_WTOR EQU * LA R2,REPLY_AREA MVI 0(R2),C' ' MVC 1(118,R2),0(R2) BLANK OUT THE WHOLE REPLY AREA LA R3,ECB_ADDRESS WTOR TEXT=((4),(2),(8),(3)) WAIT ECB=(3) **************************************** SETRPLY L R10,20(R7) L R10,0(R10) USING EVALBLOCK,R10 ST R8,EVALBLOCK_EVLEN LA R14,16(R8) SRDL R14,32 LA R3,8 DIVISOR BY DOUBLE WORDS DR R14,R3 DIVIDE IT LTR R14,R14 BZ NO_INCREMENT LA R15,1(R15) NO_INCREMENT EQU * ST R15,EVALBLOCK_EVSIZE BCTR R8,0 EX R8,MOVERPLY FREESTOR EQU * LR R1,R13 L R13,4(R13) SO WE CAN GET OUT OF HERE FREEMAIN RC,A=(1),LV=STORAGE_SIZE RETURN1 SLR R15,R15 RETURN2 L R14,12(R13) LM R0,R12,20(R13) BR R14 BAD_WTOR EQU * MVC REPLY_AREA(33),ERROR_FUNCTION LA R8,33 B SETRPLY EJECT MOVEWTOR MVC WTOR_AREA(0),0(R10) MOVERPLY MVC EVALBLOCK_EVDATA(0),REPLY_AREA PACK_REPLYL PACK DOUBLE_WORD(0),0(0,R10) HW4 DC H'4' HW10 DC H'10' HW12 DC H'12' HW80 DC H'80' HW119 DC H'119' HW122 DC H'122' FFFLAG DC 8X'FF' ERROR_FUNCTION DC CL33'ERROR IN SPECIFYING WTOR FUNCTION' LTORG STORAGE DSECT SAVEAREA DS 18F DOUBLE_WORD DS D ECB_ADDRESS DS F REPLY_AREA DS CL119 WTOR_AREA_LENGTH DS H'0' WTOR_AREA DS CL122 ** STORAGE_SIZE EQU *-SAVEAREA IRXEVALB END