         PCC      0                                                             
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
*                                                                               
*        OVERLAY MADE UP OF CAL PROCESSORS                                      
*                                                                               
*        WAITALL  TMWALL                                                        
*        WAITANY, TEST                                                          
*        WAIT                                                                   
*        TIME                                                                   
*                                                                               
         DEF      A:WAIT                                                        
         DEF      TMWALL                                                        
         DO       #ECB                                                          
         DEF      WAITALL                                                       
         DEF      WAITANY,TEST                                                  
         FIN      #ECB                                                          
         DEF      TIME                                                          
         DEF      TMXBAD,TMXABT,TMXCALX,TMXAB,WAITXR8                           
OLAYFLAG EQU      'WAIT'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** WAIT **'                                                  
         TITLE    '** WAIT - OVERLAY REFS AND EXITS **'                         
TMXBAD   B        BADCAL                                                        
TMXABT   B        ABORT                                                         
TMXCALX  B        CALEXIT                                                       
TMXAB    B        TMABORT           ERROR EXIT                                  
WAITXR8  B        *R8                                                           
         TITLE    '** WAIT - WAITALL CAL PROCESSOR AND SUBROUTINE **'           
*                                                                               
*        WAITALL  CAL PROCESSOR                                                 
*                                                                               
         DO       #ECB                                                          
WAITALL  RES      0                                                             
         LB,R5    STILMID,R4        R5 = CURRENT TASK LMID                      
         BAL,R8   TMWALL                DO THE WAIT ALL                         
         B        TMXCALX                                                       
         FIN      #ECB                                                          
         SPACE    5                                                             
*******************                                                             
*    TMWALL       *    SUBROUTINE TO DO WAITALL ON SECBS                        
*******************                                                             
*                                                                               
* ENTRY  R4       TASK ID                                                       
*        BAL,R8   TMWALL                                                        
* EXIT   +1                                                                     
*                                                                               
* REGISTERS USED: R0-R3,R5-R7,R9-R15                                            
*           SAVED: R4,R8                                                        
* STACK WORDS: 1                                                                
* SUBROUTINES:    CHKBAL                                                        
*                                                                               
TMWALL   PUSH     R8                SAVE THE EXIT                               
         DO1      #ECB                                                          
         BIFSEC   TMWALLS           SECONDARY?                                  
*                                                                               
TMWALL1  DISABLE                                                                
         DO       #ECB                                                          
         LW,R2    LMISECB,R5        FETCH THE ECBS ONE AT A                     
TMWALL2  AND,R2   M24                   TIME AND CALL THE CHECK                 
         BEZ      TMWALLX               SUBROUTINE FOR ALL THOSE                
*                                       ECBS WHICH QUALIFY                      
         LW,R0    ECBFPT,R2             CHECK ECB STATUS                        
         CW,R0    XECBCKDP              CHECK OR DELETE ON POST?                
         BANZ     TMWALL4               YES                                     
         LW,R0    ECBCTL,R2             TYPE=0?                                 
         AND,R0   XECBTYPE                                                      
         BEZ      TMWALL4               YES, PREMATURE IGNORE                   
         ELSE     #ECB                                                          
         LB,R2    IOQ4              IOQ COUNT                                   
TMWALL3A LW,R0    IOQECB,R2         GET LMID,FPT/DCB                            
         LB,R0    R0                JUST LMID                                   
         CB,R0    STILMID,R4        BELONG TO THIS ONE                          
         BE       TMWALL3           YES                                         
         BDR,R2   TMWALL3A          GO THROUGH                                  
         B        TMWALLX           NONE                                        
TMWALL3  LW,R2    IOQECB,R2         GET LMID,CUP,FPT/DCB                        
         FIN      #ECB                                                          
         ENABLE                                                                 
         BAL,R8   CHKBAL                CALL THE CHECK SUBR.                    
         NOP                                                                    
*                                                                               
         B        TMWALL1           REDO ECB CHAIN NOW                          
*                                                                               
         DO       #ECB                                                          
TMWALL4  LW,R2    ECBSECB,R2        GET THE NEXT MEMBER                         
         B        TMWALL2               AND CONTINUE                            
         FIN      #ECB                                                          
*                                                                               
TMWALLX  ENABLE                     DONE                                        
         PULL     R8                                                            
         B        WAITXR8                                                       
*                                                                               
         DO       #ECB                                                          
TMWALLS  RES      0                                                             
         DISABLE                                                                
         LW,R2    LMISECB,R5        SECONDARY TASKS WAITALL                     
*                                       NO NEW SECBS CAN OCCUR                  
*                                       NOR SHOULD ANY BE NON                   
*                                       CHECKABLE                               
TMWALLA  AND,R2   M24               END OF CHAIN?                               
         BEZ      TMWALLD               YES                                     
         LH,R0    LMISTAT,R5                                                    
         CI,R0    LMIT                                                          
         BANZ     TMWALLB                                                       
         LW,R0    ECBFPT,R2         IF THE ECB IS POSTED, CALL                  
         CW,R0    XECBBUSY              THE CHECK SUBROUTINE                    
         BANZ     TMWALLC                                                       
*                                       NO CHECK IT                             
TMWALLB  LW,R7    ECBSECB,R2            SAVE THE FWD CHAIN                      
         ENABLE                                                                 
         PUSH     3,R5              SAVE R5-R7                                  
         BAL,R8   CHKBAL                CHECK SUBR.                             
         B        TMWALLZ               ERROR?                                  
TMWALLJ  PULL     3,R5              RESTORE R5-R7                               
         LW,R2    R7                    R2-NEXT ECB IN CHAIN                    
         DISABLE                                                                
         B        TMWALLA                                                       
*                                                                               
TMWALLC  LW,R2    ECBSECB,R2        GET THE NEXT ECB AND LOOP.                  
         B        TMWALLA                                                       
*                                                                               
TMWALLD  ENABLE                                                                 
         LW,R9    XSTICA            SET R9=FLAGS TO 'OR' INTO                   
         DO       #ROLL                 (IF ROLLOUT ONLY)                       
         LW,R0    0,R3                  STITCB WORD. CHAIN                      
         CW,R0    XFPTP0                AND LONG WAIT                           
         BAZ      TMWALLD1              NO LONG WAIT                            
         LW,R0    1,R3                  F0 SET                                  
         CI,R0    FPTF0                                                         
         BAZ      TMWALLD1              NO                                      
         OR,R9    XSTILW                YES, ADD LONG WAIT                      
         LI,R6    MMTID                 R6=MEM EXEC TID                         
         LW,R7    STITCB,R6             R7=TCB ADDRESS                          
         LW,R11   STCBRDL,R7            R11=INT GRP&LEVEL                       
         LH,R12   R11                   R12=GROUP                               
         LI,R7    STISTRT               R7=START BIT                            
         FIN      #ROLL                                                         
TMWALLD1 LW,R2    LMISECB,R5        DONE THE FIRST PASS,                        
         LI,R10   0                     R10=COUNT OF ECBS WAITING               
         DISABLE                                                                
TMWALLE  AND,R2   M24               END OF CHAIN?                               
         BEZ      TMWALLF               YES                                     
         LW,R0    ECBFPT,R2             POSTED SINCE FIRST PASS?                
         CW,R0    XECBBUSY                                                      
         BAZ      TMWALLB               YES, CHECK IT                           
         CW,R0    XECBDP            NOT POSTED, IS IT DP                        
         BANZ     TMWALLE2          YES, DON'T COUNT IT                         
         OR,R0    XECBWD                NO, SET WAIT DECREMENT                  
         STW,R0   ECBFPT,R2                                                     
TMWALLE1 AI,R10   1                     ADD 1 TO THE NUMBER OF                  
TMWALLE2 RES      0                                                             
*                                       ECBS WAITING.                           
         LW,R2    ECBSECB,R2            GET NEXT ECB                            
         B        TMWALLE                                                       
*                                                                               
TMWALLF  CI,R10   0                 DONE?                                       
         BE       TMWALLX               YES                                     
         STB,R10  STICOUNT,R4           NO, SET THE COUNT                       
         STS,R9   STITCB,R4         SET 'CA' AND 'LW'                           
         DO       #ROLL                                                         
         PUSH     3,R3              SAVE REGS                                   
         CW,R9    XSTILW                LONG WAIT                               
         BAZ      TMWALLF1              NO                                      
         MTW,1    ROLL99                YES, SET CTR                            
         STS,R7   STIPRIO,R6            START BIT                               
         WD,R11   *R12                  TRIGGER THE INTERRUPT                   
         ENABLE                         MAY EXIT NOW                            
         LB,R0    STICOUNT,R4       WAIT SATISFIED                              
         BEZ      TMWAITF2              YES                                     
         FIN      #ROLL                                                         
TMWALLF1 ENABLE                                                                 
         BAL,R8   TMRDLTRG              RETURN TO THE DISPATCHER                
         DO       #ROLL                 SEE IF ROLL-IN REQD                     
         B        TMWALLH                                                       
TMWAITF2 LI,R0    0                     FIRST RESET 'WD'                        
         LW,R1    XECBWD                ON TASK ECBS                            
         DISABLE                                                                
         LW,R2    LMISECB,R5                                                    
TMWALLG  AND,R2   M24                   DONE                                    
         BEZ      TMWALLH               YES                                     
         STS,R0   ECBFPT,R2             RESET 'WD'                              
         LW,R2    ECBSECB,R2                                                    
         B        TMWALLG                                                       
TMWALLH  ENABLE                                                                 
         PULL     3,R3                  ROLL-IN                                 
         FIN      #ROLL                                                         
         B        TMWALLS           CHECK NOW POSTED ECBS                       
*                                                                               
*                                                                               
TMWALLZ  LI,R15   TYCABORT          SEC ERROR, ECB CHK OR 0                     
         LW,R0    STITCB,R4         TERMINATING ALREADY?                        
         CW,R0    XSTIT                                                         
         BAZ      TMWALLJ               NO, EXIT AND CONTINUE                   
         CRASH    'INVALID S-ECB AT TERMINATION'                                
         FIN      #ECB                                                          
         TITLE    '** WAIT - WAITANY/TEST CAL PROCESSORS **'                    
*                                                                               
*        WAITANY  CAL1 PROCESSOR                                                
*        TEST     CAL1 PROCESSOR                                                
*                                                                               
         DO       #ECB                                                          
         BOUND    4                                                             
TEST     EQU      %                                                             
WAITANY  RES      0                                                             
         LI,R11   K1FFFF                                                        
         LI,R10   0                 PRESET R10 TO NO FPT CHECKED                
         STS,R10  0,R3              ZERO FPT POINTER IN TEST FPT                
         BIFSEC   TMWANYA           GO TO SECONDARY TASK LOGIC                  
         LB,R5    STILMID,R4        R5=LMID                                     
*                                                                               
TMWANY0  DISABLE                                                                
*                                                                               
         LI,R12   0                 SET R12=LEGAL WAIT ECB FOUND                
         LW,R2    LMISECB,R5        FETCH THE FIRST S-ECB                       
         BEZ      TMWANYW               NONE                                    
*                                                                               
TMWANY1  AND,R2   M24                   ANY MORE S-ECB'S                        
         BEZ      TMWANY8               NO                                      
*                                                                               
TMWANY2  LW,R10   ECBFPT,R2         IS THE ECB POSTED?                          
         CW,R10   XECBCKDP              IS THE ECB IN CHECK OR DP?              
         BANZ     TMWANY4               YES, IGNORE IT                          
         LW,R6    ECBCTL,R2             IS THE ECB TYPE STILL 0                 
         AND,R6   XECBTYPE                                                      
         BEZ      TMWANY4               YES,IGNORE IT                           
*                                                                               
         LW,R11   ECBSECB,R2            SAVE THE FORWARD CHAIN                  
*                                       CHAIN                                   
         LW,R1    R6                IS THE ECB TYPE LEGAL FOR                   
         SLS,R1   -3                    PRIMARY TASK WAITS?                     
         LB,R0    EMWAITF,R1                                                    
         AND,R6   M3                                                            
         LB,R0    EMWAITM,R6                                                    
         BANZ     TMWANY3               NO                                      
         AI,R12   1                     YES, SET A FLAG                         
*                                                                               
TMWANY3  PUSH     3,R10             SAVE FPT ID, NEXT ECB AND                   
*                                       FLAG                                    
         BAL,R8   CHKBALA           CALL THE CHECKING SUBROUTINE                
         LI,R15   0                     FORCE ERRORS ON BUSY PATH               
*                                                                               
         PULL     3,R10             FETCH FPT ID, NEXT ECB                      
*                                       AND FLAG                                
         CI,R15   0                     BUSY, OR COMPLETED?                     
         BEZ      TMWANY5               BUSY                                    
*                                                                               
TMWANYW  ENABLE                     EXITS, R10=FPT ADDRESS                      
TMWANYX  LW,R11   M17               COMPLETED FPT FOUND, STORE                  
         STS,R10  0,R3                  THE FPT ADDRESS INTO                    
*                                       THE CALLER WAITANY FPT.                 
         B        TMXCALX                                                       
*                                                                               
TMWANY4  LW,R2    ECBSECB,R2        ECB NOT CHECKABLE, CONTINUE                 
         B        TMWANY1               SCAN                                    
*                                                                               
TMWANY5  LB,R5    STILMID,R4        SEARCH THE SECB CHAIN                       
         LI,R10   0                     PRESETTING NO FPT FOUND,                
         AND,R11  M24                   FOR THE NEXT ECB TO MAKE                
         BEZ      TMWANY8               SURE IT IS STILL IN THE                 
         DISABLE                        CHAIN, IF IT WAS THE END                
         LW,R2    LMISECB,R5            OF THE CHAIN, GO SEE WHAT               
*                                       FOUND                                   
TMWANY6  AND,R2   M24                   END OF THE CHAIN?                       
         BEZ      TMWANY7               YES                                     
         CW,R11   R2                    IS THIS THE ONE AFTER                   
         BE       TMWANY2               THE ONE CHECKED?  YES                   
         LW,R2    ECBSECB,R2            NO, CHAIN ON                            
         B        TMWANY6                                                       
*                                                                               
TMWANY7  ENABLE                     IF THE ECB AFTER THE ONE                    
         B        TMWANY0               CHECKED IS NO LONGER                    
*                                       THERE, START OVER AND                   
*                                       TRY THE WHOLE CHAIN                     
*                                       AGAIN.                                  
*                                                                               
TMWANY8  ENABLE                                                                 
         LI,R10   0                                                             
         LB,R0    *R3               IF THE CALL IS TEST, EXIT                   
         CI,R0    X'42'                 WITH THE FPT ADDR                       
         BE       TMWANYX               IN THE TEST FPT=0                       
*                                                                               
         CI,R12   0                     LEGAL ECB FOUND?                        
         BE       TMWANYX               NO, EXIT NO CHECK                       
*                                                                               
         B        TMWANY0           RETRY WAIT UNTIL SOMETHING                  
*                                        IS POSTED.                             
*                                       LOOP                                    
*                                                                               
*        SECONDARY WAITANY AND TEST LOGIC                                       
*                                                                               
TMWANYA  LI,R10   0                 LOOP TO SET MULTI-ECB SECONDARY             
         LB,R5    STILMID,R4            WAIT CONTROLS, RESET R5=LMID            
         LB,R0    *R3               IS THE CALL TEST?                           
         AND,R0   M7                    REMOVE HIGH ORDER BIT                   
         LI,R13   0                     SET NO WAIT DECR. BIT                   
         CI,R0    X'42'                                                         
         BE       TMWANYB               YES                                     
         LW,R13   XECBWD                SET SWITCH TO DO WAIT                   
*                                       DECREMENT SETTING                       
         LW,R9    XSTICA                R9='CA' ON, 'LW' OFF                    
         DO       #ROLL                                                         
         LW,R0    0,R3                  LEAVE R9   IF NOT LONG                  
         CW,R0    XFPTP0                WAIT, R9=LW BIT IF                      
         BAZ      TMWANYB               IT IS LONG WAIT                         
         LW,R0    1,R3                                                          
         CI,R0    FPTF0                 CHECK FPT FOR F0                        
         BAZ      TMWANYB               NOT SET                                 
         OR,R9    XSTILW                R9=LONG WAIT ON                         
         LI,R6    MMTID                 R6=MEM EXEC TID                         
         LW,R7    STITCB,R6             R7=STCB FOR MEM EXEC                    
         LW,R11   STCBRDL,R7            R11=LEVEL BITS                          
         LH,R12   R11                   R12=GRP BITS                            
         LI,R7    STISTRT               R7=START BIT                            
         FIN      #ROLL                                                         
*                                                                               
TMWANYB  RES      0      SCAN ECBS AND SET UP WAITANY                           
         DISABLE                        CONTROLS                                
*                                                                               
         LW,R2    LMISECB,R5            FETCH CHAIN HEAD                        
         BEZ      TMWANYW           NONE IN CHAIN, EXIT                         
         LI,R0    0                 SET # CHECKABLE ECBS TO 0                   
*                                                                               
TMWANYC  AND,R2   M24               DONE?                                       
         BEZ      TMWANYD               YES                                     
         LW,R10   ECBFPT,R2         GET ECB FLAGS, FPT ADDRESS                  
         CW,R10   XECBDP            IS IT DELETE-ON-POST                        
         BANZ     TMWANYB1          YES, GET NEXT                               
         CW,R10   XECBBUSY          HAS THE ECB BEEN POSTED                     
         BAZ      TMWANYE           YES, GO CHECK IT                            
         STS,R13  ECBFPT,R2         SET 'WD' IF WAITANY                         
         AI,R0    1                 INCREMENT # CHECKABLE ECBS                  
TMWANYB1 LW,R2    ECBSECB,R2            NEXT SECB                               
         B        TMWANYC                                                       
*                                                                               
TMWANYD  LI,R10   0                 SET NO FPT FOUND                            
         CI,R13   0                 WAS IT A TEST CAL?                          
         BE       TMWANYW               YES EXIT W/FPT ADDR=0                   
         CI,R0    0                 ARE THERE ANY CHECKABLE ECBS                
         BE       TMWANYW           NO, BRANCH TO EXIT                          
*                                                                               
*   NOW FINISH PROCESSING OF WAITANY CALL.  WD HAS BEEN SET IN                  
*   ALL ELIGIBLE ECBS.  STICOUNT WILL BE SET AND THE DISPATCHER                 
*   WILL BE TRIGGERED TO ALLOW A SERVICE TO COMPLETE.                           
         MTB,1    STICOUNT,R4           WAITANY, GO A WAIT                      
         STS,R9   STITCB,R4             SET 'CA' AND 'LW'                       
         DO       #ROLL                                                         
         PUSH     2,R3              SAVE REGS                                   
         CW,R9    XSTILW            SETTING LONG WAIT?                          
         BAZ      TMWANYD1              NO                                      
         MTW,1    ROLL99                                                        
         STS,R7   STIPRIO,R6            START BIT                               
         WD,R11   *R12                  TRIGGER MEM EXEC                        
         ENABLE                                                                 
         LB,R0    STICOUNT,R4       WAIT SATISFIED                              
         BEZ      TMWANYD2              YES                                     
         FIN      #ROLL                                                         
TMWANYD1 ENABLE                                                                 
         BAL,R8   TMRDLTRG              AND TRIGGER THE DISP                    
TMWANYD2 LI,R0    0                 RESET  ALL WD                               
         LW,R1    XECBWD                BITS                                    
         LB,R5    STILMID,R4            R5=LMID RESET                           
         DISABLE                                                                
         LW,R2    LMISECB,R5                                                    
TMWANYG  AND,R2   M24                   DONE?                                   
         BEZ      TMWANYH               YES, EXIT                               
         STS,R0   ECBFPT,R2             NO, RESET WD                            
         LW,R2    ECBSECB,R2            AND CHAIN ON                            
         B        TMWANYG                                                       
*                                                                               
         DO       #ROLL                                                         
TMWANYH  EQU      %                                                             
         PULL     2,R3                  RESTORE REGSITERS                       
         B        TMWANYA               RETRY                                   
         ELSE                                                                   
TMWANYH  EQU      TMWANYA               NO LONG WAIT LOGID REQD                 
         FIN      #ROLL                                                         
TMWANYE  ENABLE                     CHECK THE NON-BUSY ECB                      
         PUSH     R10                   SAVE THE FPT ADDRESS                    
         BAL,R8   CHKBALA           CALL THE CHECKING LOGIC                     
         B        TMXAB                 ILLEGAL TO BE UNCHECKABLE               
         PULL     R10                   FETCH FPT JUST DONE                     
         CI,R15   0                     BUSY STILL?                             
         BE       TMWANYA               YES, LOOK FOR A NON-BUSY                
*                                       ECB/FPT.                                
         B        TMWANYW           EXIT SETTING FPT ADDR                       
*                                                                               
*        ECB WAIT LEGALITY TABLE    ONE BIT/ ECB TYPE                           
*                                                                               
EMWAITM  DATA,1   X'80',X'40',X'20',X'10',X'08',X'04',X'02',X'01'               
*        1 BIT MEANS ILLEGAL TYPE   0,1,2,3,4,5,6,7,8,SPARE                     
EMWAITF  GEN,1,1,1,1,1,1,1,1,1,7    1,0,1,0,1,1,1,1,1,0                         
         FIN      #ECB                                                          
         TITLE    '** WAIT - WAIT CAL PROCESSOR **'                             
************                                                                    
*   WAIT   *                                                                    
************                                                                    
*                                                                               
*   THIS ROUTINE PROCESSES ALL WAIT SYSTEM CALLS                                
*                                                                               
WAIT     BIFFGD   WAITF             FOREGROUND                                  
A:WAIT   EQU      WAIT                                                          
         LW,R7    K:JCP1                                                        
         CI,R7    2                 IS THIS AN ATTENDED RUN                     
         BAZ      TMXABT            GO THE 'ABORT' CAL                          
         LCI      WAITFPT%-WAITFPT                                              
         LM,R4    WAITFPT           LOAD FPT INTO REGISTERS                     
         LI,R1    4+WAITMESS-WAITFPT LOC OF MESSAGE                             
         STW,R1   4+WMPTR-WAITFPT   FPT POINTER TO MESSAGE                      
         CAL1,2   R4                TYPE MESSAGE                                
         LW,R7    Y01               'BKG IDLE' BIT                              
         STS,R7   K:CTST            SET IT                                      
         CAL1,7   BKGSTOP                                                       
         B        TMXCALX           EXIT TO CALEXIT                             
*                                                                               
WAITFPT  GEN,8,24 X'02',0                                                       
         DATA     X'80000010'                                                   
WMPTR    DATA     WAITMESS                                                      
WAITMESS TEXTC    '!!BACKGROUND WAIT'                                           
WAITFPT% EQU      %                 END + 1 OF FPT AND MESSAGE                  
*                                                                               
WAITF    EQU      %                 FORGEGROUND WAIT                            
         BIFPRIM  TMXBAD            ILLEGAL FOR PRIMARIES                       
         LB,R4    TCBPOINT          TASK ID                                     
         LI,R15   TYCNORM           PRELOAD ERROR CODE                          
         DISABLE                                                                
         LB,R5    STILMID,R4        GET LMID                                    
         LI,R2    LMISECB-2         SET UP TO SEARCH CHAIN                      
         AW,R2    R5                                                            
WAITF1   LW,R2    2,R2              GET NEXT SECB                               
         AND,R2   M24                                                           
         BEZ      WAITFR            NO MORE                                     
         LW,R0    ECBFPT,R2         HAS IT BEEN POSTED                          
         CW,R0    XECBBUSY                                                      
         BAZ      WAITFX            YES, RETURN                                 
         B        WAITF1                                                        
*                                                                               
WAITFR   LI,R2    LMIRECB-3         SET UP TO SEARCH CHAIN                      
         AW,R2    R5                                                            
WAITFR1  LW,R2    3,R2              GET NEXT RECB                               
         AND,R2   M24                                                           
         BEZ      WAITFS            NO MORE                                     
         LW,R0    ECBFPT,R2         HAS IT BEEN POLLED                          
         CW,R0    XECBINP                                                       
         BAZ      WAITFX            NO,RETURN                                   
         B        WAITFR1                                                       
*                                                                               
WAITFS   LW,R0    STIPRIO,R4        START PENDING                               
         CW,R0    XSTISTRT                                                      
         BAZ      WAITFBK           NO,CHECK BREAK                              
         EOR,R0   XSTISTRT          RESET START                                 
         STW,R0   STIPRIO,R4                                                    
         B        WAITFX            RETURN                                      
*                                                                               
WAITFBK  LH,R0    LMISTAT,R5        CHECK FOR                                   
         CW,R0    XLMIBRK           BREAK                                       
         BANZ     WAITFX            YES, RETURN                                 
         CW,R0    XLMICTL           OR CONTROL                                  
         BAZ      WAITFSS           NO, SUPER STOP                              
         B        WAITFX            RETURN                                      
*                                                                               
WAITFX   ENABLE                                                                 
         B        TMXCALX           GOOD RETURN                                 
*                                                                               
*                                                                               
WAITFSS  EQU      %                                                             
         LB,R0    STISTAT,R4        SET SUPER STOP                              
         OR,R0    XSTISUSP                                                      
         STB,R0   STISTAT,R4                                                    
         ENABLE                                                                 
         BAL,R8   TMRDLTRG          TRIGGER DISPATCHER                          
*                                                                               
         B        TMXCALX           DISPATCHER RETURN                           
*                                                                               
*                                                                               
         TITLE    '** WAIT - TIME CAL PROCESSOR **'                             
*                                                                               
*                                                                               
*                                                                               
         DO       #JOBACCT                                                      
TIME     EQU      %                                                             
         LW,R1    *R3                                                           
         AND,R1   M17               R1=ADDRESS TO STORE TIME DATA               
         CI,R1    12                4-WORD BLOCK INTO REGISTERS ?               
         BG       TIME2             NO                                          
*                                   YES                                         
         LB,R7    TCBPOINT          STI INDEX                                   
         LD,R7    STIRTSB,R7        STACK ADDRESS                               
         AW,R1    R7                PLUS REGISTER ADDRESS                       
         AI,R1    -CAL1PUSH         MINUS OFFSET                                
*                                   EQUALS ADDRESS IN STACK                     
TIME2    EQU      %                                                             
         LW,R9    R1                                                            
         BAL,R8   TMVADR            VAL1DATE R9 ADR                             
         B        TMXBAD            ERROR                                       
         LW,R0    K:DATE2           WAS DATE EVER INPUT                         
         BEZ      TMXCALX           NO, EXIT AND DON'T CHANGE 4 WD BLK          
         LW,R7    XFPTP0            SAME BIT AS F1                              
         CW,R7    *R3               CHECK FOR SPECIAL FORMAT                    
         BANZ     TIME10            SP FORMAT REQUEST                           
*                                                                               
         LI,R10   0                                                             
         LW,R11   K:TIME            GET TIME OF DAY IN SEC.                     
         DW,R10   XD3600            CHANGE TO HRS, SEC.                         
         STW,R10  R6                SAVE SEC IN R6                              
         BAL,R8   BINBCD            GO CHANGE HRS TO BCD                        
         STH,R0   R3                SAVE HRS IN R3                              
         LI,R10   0                                                             
         LW,R11   R6                GET SEC. LEFT                               
         DW,R10   XD60              GET MIN. OF DAY                             
         BAL,R8   BINBCD            CHANGE MIN. TO BCD                          
         AND,R0   M16                                                           
         SCS,R0   -8                                                            
         AW,R0    TIME90            ADD IN BLANK, COLON IN BCD                  
         LI,R2    1                                                             
         STH,R0   R3,R2                                                         
         STW,R3   0,R1              STORE FIRST WORD OF 4                       
         STW,R0   R3                SAVE LH OF WORD 2                           
         LW,R11   K:DATE2           R11=DAY OF YEAR                             
         LI,R5    0                                                             
TIME3    LB,R0    K:MONTH,R5        CHANGE DAY OF YEAR TO MONTH, DAY            
         SW,R11   R0                                                            
         BLEZ     %+3               FOUND PROPER MONTH                          
         AI,R5    4                                                             
         B        TIME3                                                         
         AW,R11   R0                R11=DAY OF MONTH                            
         SLS,R5   -2                CHANGE TO WORD INDEX                        
         LW,R0    K:MONTH,R5        GET BCD CHAR. OF MONTH                      
         AND,R0   M24                                                           
         SCS,R0   -8                                                            
         AW,R0    TIME91            ADD IN BLANK                                
         STH,R0   R3,R2             STORE FIRST 2 CHAR. OF MONTH                
         STW,R3   1,R1              STORE 2ND WORD OF 4                         
         STW,R0   R3                SAVE LH OF WORD 3                           
         BAL,R8   BINBCD            GO CHANGE DAY OF MONTH TO BCD               
         STH,R0   R3,R2                                                         
         STW,R3   2,R1              STORE 3RD WORD OF 4                         
         LI,R0    ','''             GET COMMA,APOSTROPHE                        
         STH,R0   R3                                                            
         LW,R11   K:DATE1                                                       
         AND,R11  M16               R11=YEAR IN BINARY                          
         BAL,R8   BINBCD            CHANGE YEAR TO BCD                          
         STH,R0   R3,R2                                                         
         STW,R3   3,R1              STORE LAST WORD                             
         B        TMXCALX                                                       
*                                                                               
TIME10   EQU      %                 RETURN 2-WORD PACKED FORMAT                 
         LW,R6    K:DATE1                                                       
         AND,R6   M16               CURRENT YEAR - 1900                         
         AI,R6    1900              WHOLE YEAR                                  
*                                                                               
         LW,R7    K:DATE2           CURRENT JULIAN DAY                          
         LI,R4    0                                                             
TIME13   EQU      %                 CALCULATE MONTH INDEX                       
         LB,R0    K:MONTH,R4                                                    
         SW,R7    R0                                                            
         BLEZ     %+3               B IF CORRES. MONTH                          
         AI,R4    4                 NOT YET, LOOK AT NEXT ENTRY                 
         B        TIME13                                                        
*                                                                               
         AW,R7    R0                RESTORE TO DAY-OF-MONTH                     
         SLS,R4   -2                CONVERT TO MONTH #                          
         AI,R4    1                 SINCE WE DON'T START AT ZERO                
         XW,R4    R7                R4=DAY-OF-MONTH,R7=MONTH #                  
         SLS,R7   24                LEFT JUSTIFY                                
         SLD,R6   8                 PACK WITH YEAR IN R6                        
         STW,R6   0,R1              STUFF IT                                    
*                                                                               
         LW,R5    Y00FF             BYTE 1 MASK                                 
*  R4 HAS DAY-OF-MONTH                                                          
         SLS,R4   24                LEFT JUSTIFY                                
         LI,R6    0                                                             
         LW,R7    K:TIME            CURRENT SEC OF DAY                          
         DW,R6    XD3600            R7= HOUR OF TODAY                           
         SLS,R7   16                BYTE 1 POSITION                             
         LS,R4    R7                PACK HOUR IN R4                             
         SLS,R5   -8                BYTE 2 POSITION                             
         LW,R7    R6                REMAINING SECONDS                           
         LI,R6    0                                                             
         DW,R6    XD60              MINUTES IN R7                               
         SLS,R7   8                 BYTE 2 POSITION                             
         LS,R4    R7                PACK IN R4                                  
         SLS,R5   -8                BYTE 3 POSITION                             
         LS,R4    R6                PACK IN SECONDS                             
         STW,R4   1,R1              STUFF IT                                    
         B        TMXCALX                                                       
*                                                                               
TIME90   DATA     X'407A00'         BLANK,COLON IN BCD                          
TIME91   DATA     X'400000'                                                     
*                                                                               
*                                   CONVERT BINARY TO BCD                       
*                                   CALL IS   BAL,R8  BINBCD                    
*                                    WHERE                                      
*                                     R11=VALUE TO BE CONVERTED IN RHW          
*                                   EXITS                                       
*                                      R0=VALUE IN BCD, RT. JUSTIF.             
*                                         WITH LEADING ZEROS                    
*                                   USES R0,R7,R10,R11                          
*                                                                               
BINBCD   LI,R0    0                                                             
         LI,R7    4                 SET FOR 4 CHARS.                            
BINBCD1  LI,R10   0                                                             
         SLS,R0   -8                                                            
         DW,R10   XA                                                            
         AI,R10   X'F0'             CHANGE TO BCD                               
         STB,R10  R0                                                            
         BDR,R7   BINBCD1                                                       
         B        *R8               EXIT                                        
         ELSE                                                                   
TIME     B        TMXCALX           NO ACTION                                   
         FIN                                                                    
         OLAYEND                                                                
         END                                                                    
