****************************************************************
*  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 WTO       *
*                                                              *
*   THE VARIABLES THAT WILL BE PASSED THROUGH REGISTER 1 ARE:  *
*    WTO  - WHICH WILL CONTAIN THE WTO  MESSAGE TO ISSUE       *
*    DESCRIPTOR   = WHETHER IT IS A ROLL OR NO-ROLL WTO        *
*                                                              *
*   THE VARIABLE VALUE THAT WILL BE RETURNED IS:               *
*    REPLY_AREA = WE WILL PUT AN OK                            *
*                                                              *
*    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.                       *
****************************************************************
ALXRWTO  CSECT
ALXRWTO  AMODE 31
ALXRWTO  RMODE ANY
         PRINT ON,GEN,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 ALXRWTO,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_WTO             NO, THEN DO DEFAULT
         ICM   R3,15,4(R11)        GET THE LENGTH OF ARGUMENT
         BZ    BAD_WTO             IF NULL/ZERO THEN JUST QUIT
         CH    R3,HW126            VERIFY IT'S NOT TOO LONG
         BNH   SAVELGTH            NO, THEN CONTINUE
         LH    R3,HW126            YES, THEN LOAD UP TO 122 BYTES
SAVELGTH STH   R3,WTO_AREA_LENGTH SAVE THE LENGTH OF WTO
         BCTR  R3,0                DECREMENT FOR EXECUTE MOVE
         L     R10,0(R11)          AND ADDRESS THE ARGUMENT
         EX    R3,MOVEWTO          MVC   WTO_AREA(0),0(R10)
         LA    R4,WTO_AREA_LENGTH ADDRESS FOR TEXT OF MESSAGE
******************************************************************
         CLC   8(8,R11),FFFLAG     ARE WE AT THE END
         BE    ISSUE_WTO           YES, THEN JUST LET IT ROLL
         ICM   R9,15,12(R11)       GET THE LENGTH OF DESCRIPTOR
         BZ    ISSUE_WTO           ZERO, THEN JUST LET IT ROLL
         L     R10,8(R11)          POINT TO THE ARGUMENT
         CLC   0(6,R10),NOROLL_KW  IS THIS A NO-ROLL MESSAGE
         BNE   ISSUE_WTO           ZERO, THEN JUST LET IT ROLL
         WTO   TEXT=((4)),DESC=11
         B     SETOKAY
ISSUE_WTO      EQU    *
         WTO   TEXT=((4))
SETOKAY  EQU   *
         MVC   REPLY_AREA(2),GOOD_WTO
         LA    R8,2
****************************************
SETREPLY 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_WTO        EQU   *
         MVC   REPLY_AREA(33),ERROR_FUNCTION
         LA    R8,33
         B     SETREPLY
         EJECT
MOVERPLY        MVC   EVALBLOCK_EVDATA(0),REPLY_AREA
MOVEWTO         MVC   WTO_AREA(0),0(R10)
HW126           DC    H'126'
FFFLAG   DC    8X'FF'
ERROR_FUNCTION  DC    CL33'ERROR IN SPECIFYING WTO FUNCTION'
NOROLL_KW       DC    CL6'NOROLL'
ROLL_KW         EQU   NOROLL_KW+2
GOOD_WTO        DC    CL2'OK'
         LTORG
STORAGE  DSECT
SAVEAREA          DS   18F
REPLY_AREA        DS   CL33
WTO_AREA_LENGTH   DS   H
WTO_AREA          DS   CL126
**
STORAGE_SIZE      EQU  *-SAVEAREA
         IRXEVALB
         END