****************************************************************
*  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 STIMER    *
* MACRO TO SLEEP FOR A REQUESTED PERIOD OF TIME.              '*
*                                                              *
*   THE VARIABLES THAT WILL BE PASSED THROUGH REGISTER 1 ARE:  *
*    TIME     = THE NUMBER OF SECONDS TO WAIT                  *
*                                                              *
*   THE VARIABLE VALUE THAT WILL BE RETURNED IS:               *
*    EVDATA = A RETURN OF OKAY WHEN TIME HAS PASSED            *
*                                                              *
*    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              *
*                                                              *
****************************************************************
ALXRDOZE CSECT
         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
****************************************************************
****************************************************************
         B     72(R15)
         DS    17F
         STM   R14,R12,12(R13)
         ST    R15,8(R13)
         ST    R13,4(R15)
         LR    R13,R15
         USING ALXRDOZE,R13
         LR    R12,R1              SAVE THE PARAMETER ADDRESS
****************************************************************
         L     R11,16(R12)         LET'S GET OUR ARGUMENT
         CLC   0(8,R11),FFFLAG     IS THERE ANY ARGUMENT
         BE    DOSTIMER            NO, THEN DO DEFAULT
         ICM   R3,15,4(R11)        GET THE LENGTH OF ARGUMENT
         BZ    DOSTIMER            IF NULL/ZERO THEN DO DEFAULT
         L     R10,0(R11)          AND ADDRESS THE ARGUMENT
GOODPARM CH    R3,HW3              VERIFY NOT GT 999
         BH    SETMAX              YES, THEN JUST SET THE MAX
         BCTR  R3,0                DECREMENT FOR LATER EXECUTE INSTR
         EX    R3,TRTTIME          VERIFY IT IS NUMERIC
         BZ    DOSTIMER            NO, THEN DO DEFAULT
         A     R3,FW112           THIS WILL ADD X'70' FOR L1 OF PACK
         EX    R3,PACKTIME           MOVE IN THE TIME
         CVB   R15,DOUBLE              AND CONVERT TO BINARY
         MH    R15,HW100             MULTIPLY FOR BINARY TIME
         ST    R15,BINARY          SAVE FOR STIMER
         B     DOSTIMER           ISSUE STIMER
****************************************************************
SETMAX   MVC   BINARY(4),FW60000  YES, SET UPPER LIMIT VALUE
DOSTIMER EQU   *
         STIMER WAIT,,BINTVL=BINARY
         L     R10,20(R12)
         L     R10,0(R10)
         USING EVALBLOCK,R10
         LA    R15,3
         ST    R15,EVALBLOCK_EVSIZE
         LA    R15,4
         ST    R15,EVALBLOCK_EVLEN
         MVC   EVALBLOCK_EVDATA(4),EVDATA
RETURN   L     R13,4(R13)
         LM    R14,R12,12(R13)
         SLR   R15,R15
         BR    R14
PACKTIME PACK  DOUBLE(0),0(0,R10)
TRTTIME  TRT   0(0,R10),NUMTABL
DOUBLE   DC    D'0'
BINARY   DC    F'500'
FW60000  DC    F'60000'
FW112    DC    F'112'
NUMTABL  DC    256X'00'
         ORG   NUMTABL+C'0'
         DC    CL10'0123456789'
         ORG
HW100    DC    H'100'
HW10     DC    H'10'
HW3      DC    H'3'
EVDATA   DC    CL4'OKAY'
FFFLAG   DC    8X'FF'
         IRXEVALB
         END