ASMB,R,L,C
      HED RTRY 91750-16173 REV 2013 * (C) HEWLETT-PACKARD CO. 1979* 
      NAM RTRY,17,20 91750-16173 REV 2013 800107 ALL
      SPC 2 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 4 
****************************************************************
* 
*     NAME:   RTRY
*     SOURCE: 91750-18173 
*     RELOC:  91750-16173 
*     PGMR:   CHUCK WHELAN
*     DATE WRITTEN  DEC 1976
* 
*     MODIFIED BY: LYLE WEIMAN, JAN. '78
*     MODIFIED BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S 
*     MODIFIED BY CCH [790330] TO ELIMINATE REFERENCE TO <DRTEQ>. 
*     MODIFIED BY DWT [790424] FOR PHASE TWO (#NRVS). 
*     MODIFIED BY DWY [790606] FOR PHASE FIVE (REMOVE O/S DEPENDENCE).
* 
*************************************************************** 
      SPC 3 
      EXT EXEC,$TIME,DTACH
      EXT #RDLY,#GETR,#PUTR 
      EXT #RQUE,#QCLM,#RTRY,#GRPM,#NRVS 
* 
* 
      SPC 3 
*     RTRY PERFORMS WRITE RETRIES IN THE DS/1000 SYSTEM 
* 
*     WHEN A WRITE OPERATION FAILS, "GRPM" RETHREADS THE CLASS BUFFER 
*     ON "RTRY"S CLASS AND STORES THE ABSOLUTE TIME AT WHICH THE RETRY
*     IS TO OCCUR IN THE EQT5 STATUS SAVE WORD IN THE CLASS HEADER. 
*     WHEN "RTRY"S GET IS SATISFIED, IF THE ABSOLUTE TIME HASN'T BEEN 
*     REACHED, "RTRY" COMPUTES THE NECESSARY TIME OFFSET AND PUTS 
*     ITSELF IN THE TIME-LIST.  WHEN IT IS RESCHEDULED, IT OUTPUTS
*     THE CLASS BUFFER, RETHREADING IT ON "GRPM"S CLASS.  IF AN 
*     ERROR OCCURS, RTRY WRITES AN ERROR NOTIFICATION TO QCLM 
*     AND DEALLOCATES THE CLASS BUFFER. 
* 
      SKP 
* 
RTRY  EQU * 
      JSB DTACH 
       DEF *+1
GET   EQU * 
      JSB #GETR 
       DEF *+9
       DEF #RTRY
       DEF QBUF 
       DEF K4 
       DEF K0 
       DEF K0 
       DEF DUMMY
       DEF LLU      RETURN LAST LU WORD 
       DEF ABTIM    RETURN DELAY TIME 
       JSB ERR1 
      STA RQLEN 
* 
      LDA ABTIM     LOAD ABSOLUTE START TIME
      CMA,INA 
      ADA $TIME     SUBTRACT START TIME FROM CURR. TIME 
      SSA,RSS       TIME REACHED? 
      JMP THRED     YES, RETHREAD NOW 
      STA OFSET     SET OFFSET UNTIL IT CAN GO
      DLD $TIME     GET CURRENT SYSTEM TIME 
      SSA 
      INB,SZB       DAY ABOUT TO ROLL OVER? 
      JMP SUSPD     NO
      LDA ABTIM     YES 
      SSA           DID PASSED TIME ROLL OVER?
      JMP SUSPD     NO
      LDA OFSET     COMPENSATE FOR INITIAL TIME IN
      ADA B2500      $TIME FOR NEW DAY (25000B) 
      STA OFSET 
* 
SUSPD EQU * 
      LDA OFSET     BE SURE OFFSET ISN'T TOO BIG
      CMA,INA       MAKE IT POSITIVE
      ADA #RDLY       SUBTRACT  LARGEST OFFSET. 
      SSA           TOO BIG?
      JMP SUSP.     NO, USE WHAT WE HAVE. 
      LDA #RDLY     YES, IT'S TOO BIG!
      STA OFSET        USE SMALLER VALUE. 
SUSP. EQU * 
      JSB EXEC      PUT SELF IN TIME LIST 
      DEF *+6 
      DEF D12N
      DEF K0
      DEF K1
      DEF K0
      DEF OFSET 
      JSB ERR1      ERROR 
* 
THRED EQU * 
      LDA STREM     LOAD STREAM WORD
      LDB SRC#
      AND RPBIT     CHECK STREAM WORD 
      SZA,RSS       REPLY?
      LDB DESTN     .NO, LOAD DESTN NODE # INSTEAD
      STB VECTR     SAVE NODE # FOR LU CONVERSION 
      SSB,RSS       NEGATIVE LU?
      JMP NRVS      .NO, SEARCH NRV FOR LU
      CMB,INB       .YES, MAKE IT POSITIVE
      LDA 1         PUT IT IN A REG.
      JMP FNDLU 
* 
*  CONVERT DESTINATION NODE TO LU 
* 
NRVS  EQU * 
      JSB #NRVS     SERACH NRV
       DEF *+2
       DEF VECTR    NODE ADDRESS
       JSB ERR1      ERROR RETURN, CANNOT FIND NODE 
FNDLU EQU * 
      SZA,RSS       LU = 0? 
      JSB NPATH     YES, NO PATH ERROR
      IOR =B100000
      STA CONWD     SAVE RETRUNED LU
* 
      JSB #RQUE     OUTPUT BUFFER 
       DEF *+9  
       DEF K20N 
       DEF CONWD
       DEF K0 
       DEF K0 
       DEF K0 
       DEF K0 
       DEF #GRPM
       DEF #RTRY
       JSB ERR1 
      JMP GET 
* 
*  IF NO PATH ERROR, SETUP TO REQUEUE BACK TO GRPM TO ISSUE ERROR 
* 
NPATH NOP 
      LDA LLU       GET LAST LU WORD
      IOR =B400     SET NOT FROM DRIVER BIT 
      STA LLU 
      ISZ RQLEN     SET UP OFFSET OF LLU WORD IN SAM
      JSB #PUTR     GO TO "STUFF" LLU BACK TO THE MESSAGE 
       DEF *+3
       DEF RQLEN
       DEF LLU
       JSB ERR1 
      CLA 
      JMP NPATH,I   RETURN
* 
*  IRRECOVERABLE REQUEST ERROR OCCURRED, CLEAR CLASS BUFFER & LEAVE 
ERR1  NOP 
      DST AREG      SAVE REGS FOR QCLM
      LDA ERR1
      STA PREG      SAVE ERROR ADDR 
      DLD $TIME 
      DST TOD 
      LDA PNAME 
      STA PGM 
      DLD PNAME+1 
      DST PGM+1 
      LDA #RTRY 
      ALR,RAR 
      STA CLASS 
* 
* 
      JSB EXEC      DO DUMMY GET TO RETURN CLASS BUFFER 
      DEF *+5 
      DEF K21 
      DEF CLASS 
      DEF K0        DUMMY BUFFER
      DEF K0        ZERO LENGTH 
* 
      LDA #QCLM 
      STA CLASS 
      JSB EXEC      WRITE ERROR NOTICE TO QCLM
      DEF *+6 
      DEF K20N
      DEF K0
      DEF QBUF
      DEF K12 
       DEF CLASS
K0    NOP 
       NOP
* 
      JMP GET       BACK TO GET 
      SPC 3 
* 
*  DATA AREA
* 
DUMMY NOP 
VECTR NOP 
OFSET NOP 
CLASS NOP 
ABTIM NOP 
RQLEN NOP 
LLU   NOP 
* 
* 
K1    DEC 1 
K4    DEC 4 
K12   DEC 12
K21   DEC 21
K20N  OCT 100024
B2500 OCT 2500
D12N  OCT 100014
RPBIT OCT 40000 
CONWD NOP 
      OCT 10100 
PNAME ASC 3,RTRY
* 
* 
QBUF  BSS 12        BUFFER TO SEND TO 'QCLM'
* 
STREM EQU QBUF
SEQ#  EQU QBUF+1
SRC#  EQU QBUF+2
DESTN EQU QBUF+3
PREG  EQU QBUF+4
AREG  EQU QBUF+5
BREG  EQU QBUF+6
TOD   EQU QBUF+7
PGM   EQU QBUF+9
* 
* 
SIZE  BSS 0 
* 
      END RTRY
                                              