IBM Mainframe Forum

WAIT1SEC TITLE '                                       WAIT FOR ONE SEC>
               OND'
         SPACE 5
WAIT1SEC CSECT                     ESTABLISH CSECT
WAIT1SEC AMODE ANY                 DEFINE THE AMODE
WAIT1SEC RMODE ANY                 DEFINE THE RMODE
W        DSECT                     DEFINE THE WORK AREA
TPARMS   STIMERM SET,MF=L          STIMERM PARM LIST
TPARM    EQU   TPARMS,*-TPARMS     DEFINE THE FULL STORAGE AREA FOR   ->
                                    STIMERM PARM LIST
PARMWORD DS    A                   PARAMETER PASSED TO THE EXIT ROUTINE
ECB      DS    F                   EVENT CONTROL BLOCK POSTED BY THE  ->
                                    EXIT ROUTINE
S        DS    9D                  OS/360 SAVE AREA
WL       EQU   *-W                 LENGTH OF THE WORK AREA
WAIT1SEC CSECT                     RETURN TO THE CSECT
         USING *,12                ESTABLISH WAIT1SEC ADDRESSABILITY
         USING W,11                ESTABLISH WORK AREA ADDRESSABILITY
         SAVE  (14,12),,WAIT1SEC-&SYSDATE-SYSTIME  SAVE REGISTERS
         LR    12,15               COPY THE ENTRY POINT ADDRESS TO    ->
                                    REG 12
         LHI   0,WL                LOAD THE LENGTH OF THE WORK AREA
         GETMAIN RU,LV=(0),LOC=(ANY,ANY)  ALLOCATE THE WORK AREA
         LR    11,1                COPY THE WORK AREA ADDRESS TO REG 11
         LA    15,S                LOAD THE ADDR OF THE NEW SAVE AREA
         ST    13,4(,15)           ADD THE NEW SAVE AREA
         ST    15,8(,13)            TO THE SAVE AREA CHAIN
         LR    13,15               ESTABLISH THE NEW SAVE AREA POINTER
         MVI   ECB,0               SET THE ECB AS NOT WAITING,        ->
                                    NOT POSTED
         ST    11,PARMWORD         STORE THE WORK AREA ADDRESS IN     ->
                                    PARMWORD
         MVC   TPARM,TPARMM        COPY THE MASTER STIMERM PARM LIST  ->
                                    TO THE WORK AREA
         STIMERM SET,BINTVL==F'100',WAIT=NO,EXIT=ITIMEUP,  ESTABLISH  ->
               ID=TIMEID,PARM=PARMWORD,MF=(E,TPARM)    A TIMER INTERVAL
WAITMAC  WAIT  1,ECB=ECB           WAIT FOR THE TIMER INTERVAL TO     ->
                                    COMPLETE
         L     13,4(,13)           LOAD THE ADDRESS OF THE PREVIOUS   ->
                                    SAVE AREA
         LHI   0,WL                LOAD THE LENGTH OF THE WORK AREA
         FREEMAIN RU,A=(11),LV=(0) FREE THE WORK AREA
         RETURN (14,12),T,RC=0     RESTORE REGS & RETURN
         DC    0D'0'               FORCE DOUBLE WORD ALIGNMENT
         USING *,12                ESTABLISH STIMERM EXIT ROUTINE     ->
                                    ADDRESSABILITY (WORK AREA         ->
                                     ADDRESSABILITY IS INHERITED      ->
                                      BECAUSE IT WAS NEVER DROPPED)
ITIMEUP  SAVE  (14,12),,ITIMEUP    SAVE REGISTERS IN THE SAVE AREA    ->
                                    AREA PROVIDED BY THE TIMER        ->
                                     INTERRUPT ROUTINE
         LR    12,15               COPY THE ADDRESS OF ITIMEUP TO     ->
                                    REG 12
         L     11,4(,1)            LOAD THE ADDRES OF THE WAIT1SEC    ->
                                    WORK AREA
         POST  ECB,0               POST THE COMPLETTION ECB
         RETURN (14,12)            RESTORE REGISTERS & RETURN TO THE  ->
                                    MVS TIMER INTERRUPT FUNCTION
TPARMM   STIMERM SET,MF=L          MASTER STIMERM PARM LIST
TIMEID   DC    CL4'TIME'           TIMER ID
         DC    0D'0'               FORCE DOUBLE WORD ALIGNMENT
         LTORG ,                   DEFINE THE WAIT1SEC LITERAL POOL
         END   WAIT1SEC