ASMB,R,Q,C
      HED RTRY 91740-16015 REV 2026 * (C) HEWLETT-PACKARD CO. 1980* 
      NAM RTRY,17,20 91740-16015 REV 2026 800417
      SPC 2 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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 
****************************************************************
* 
*     RTRY
* 
*     SOURCE PART # 91740-18015 
* 
*     REL PART #    91740-16015 
* 
*     WRITTEN BY:   CHUCK WHELAN
* 
*     DATE WRITTEN  DEC 1976
* 
*     MODIFIED BY: LYLE WEIMAN, JAN. '78
*        "     "    "     "      APR '80
*************************************************************** 
      SPC 3 
      EXT EXEC,$TIME,$OPSY,DRTEQ
      EXT #RDLY 
      EXT #REQU,#QCLM,#RTRY,#GRPM,#NCNT 
* 
* 
      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  JSB EXEC      DO GET, AWAITING WRITE RETRIES FROM GRPM
      DEF *+6 
      DEF K21 
      DEF #RTRY     RTRY CLASS NUMBER 
      DEF K0        DUMMY BUFFER
      DEF K0        ZERO LENGTH 
      DEF RQADR     REQ ADDRESS IN SAM
* 
      STA ABTIM     SAVE ABSOLUTE RETRY TIME
* 
*  A REG HAS 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 LDB RQADR     ADDR OF REQ BUFFER
      JSB LODWD     GET STREAM WORD 
      ADB K2        POINT TO ORIGIN NODE
      RAL 
      SSA,RSS       REPLY?
      INB           NO, POINT TO DESTINATION NODE 
      JSB LODWD     GET NODAL ADDRESS 
      STA VECTR     SAVE NODE FOR LU CONVERSION 
* 
*  CONVERT DESTINATION NODE TO LU 
* 
      SSA           ABSOLUTE DESTINATION CODE ? (NEIGHBOR)
      JMP ABS       YES, GET LU AND RETURN
      DLD #NCNT     NO, GET ADDR & SIZE OF TABLE
      CAX           USE X AS COUNTER
* 
LOOP  JSB LODWD     GET A CPU # 
      INB           POINT TO CORRESPONDING LU 
      CPA VECTR     IS IT THE GOOD ONE ?
      JMP LUFND     YES 
      INB           POINT TO NEXT NODE # IN TABLE 
      ISX           END OF TABLE ?
      JMP LOOP      NO, CONTINUE
* 
      JSB ERR1      NODAL ADDRESS NOT FOUND, ERROR
* 
ABS   CMA,INA       MAKE IT >0
      JMP LUOK
* 
LUFND JSB LODWD     FETCH LU
      AND B77       ISOLATE IT
* 
LUOK  STA VECTR 
* 
      JSB DRTEQ    GET THE LOGICAL UNIT 
      DEF *+2        SUBCHANNEL BITS
      DEF VECTR        FROM THE DRT 
      ALF,CLE,ELA  POSITION SUBCHANNEL LSB TO <E> 
      LDA ICNWD    REMOVE THE PREVIOUS SUBCHANNEL LSB 
      AND N5         FROM THE CONTROL WORD
      SEZ          IF THE OUTPUT LU SPECIFIES AN ODD SUBCHANNEL,
      IOR K4         THEN SET BIT # 2 
      STA ICNWD      IN THE CONFIGURED CONTROL WORD 
      JSB #REQU     RETHREAD TO EQT ON GRPM CLASS 
      DEF *+5 
      DEF #RTRY 
      DEF #GRPM 
      DEF VECTR 
      DEF ICNWD     NEW CONTROL WORD
* 
      SZA           OK? 
      JSB ERR1      NO
      JMP RTRY      GO WAIT FOR MORE
* 
*  IRRECOVERABLE REQUEST ERROR OCCURRED, CLEAR CLASS BUFFER & LEAVE 
ERR1  NOP 
      DST AREG      SAVE REGS FOR QCLM
      LDA ERR1
      STA PREG      SAVE ERROR ADDR 
      LDB RQADR 
      INB           B= ADDR OF SEQ # IN REQUEST 
      JSB LODWD     GET SEQ # 
      STA SEQ#      SAVE IT 
* 
      LDA #RTRY     CLEAR BUFFER-SAVE 
      ALR,RAR          FLAG 
      STA VECTR 
* 
      JSB EXEC      DO DUMMY GET TO RETURN CLASS BUFFER 
      DEF *+5 
      DEF K21 
      DEF VECTR 
      DEF K0        DUMMY BUFFER
      DEF K0        ZERO LENGTH 
* 
      JSB EXEC      WRITE ERROR NOTICE TO QCLM
      DEF *+8 
      DEF K20N
      DEF K0
      DEF QBUF
      DEF K9
      DEF XEQT
      DEF K0
      DEF #QCLM 
K0    NOP 
* 
      JMP RTRY      BACK TO GET 
      SPC 3 
*     LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM 
LODWD NOP 
      LDA $OPSY     OPERATING SYSTEM TYPE 
      RAR,SLA,ERA   SKIP IF NON-DMS 
      JMP *+3       DMS. GO EXECUTE XLA 
      LDA 1,I       NON-DMS. PICK UP SAM WORD 
      JMP LODWD,I   RETURN
      XLA 1,I       CROSS-LOAD SAM WORD 
      JMP LODWD,I   RETURN
* 
*  DATA AREA
* 
RQADR NOP 
VECTR NOP 
OFSET NOP 
ABTIM NOP 
* 
* 
B77   OCT 77
K1    DEC 1 
K2    DEC 2 
K4    DEC 4 
K9    DEC 9 
K21   DEC 21
K20N  OCT 100024
B2500 OCT 2500
D12N  OCT 100014
N5    DEC -5
ICNWD OCT 150101
* 
* 
*     FORMAT OF BUFFER PASSED TO QCLM:
*     --------------------------------
* 
*     ****************************************
*  1  * STREAM WORD                          *  NOTE: ON 'READ' ERRORS, WORD
*     *--------------------------------------*  1 IS LINE EQT ADDRESS, WORD 
*  2  * SEQUENCE NUMBER                      *  2 CONTAINS I O STATUS.
*     *--------------------------------------*
*  3  * SOURCE (ORIGINATING) NODE NUMBER     *
*     *--------------------------------------*
*  4  * DESTINATION NODE NUMBER              *
*     *--------------------------------------*
*  5  * P-REGISTER WHEN ERROR DETECTED       *
*     *--------------------------------------*  NOTE: CERTAIN COMBINATIONS
*  6  * A-REGISTER WHEN ERROR DETECTED       *  OF A- AND B-REGISTER VALUES 
*     *--------------------------------------*  ARE USED TO FLAG SUCH CONDI-
*  7  * B-REGISTER WHEN ERROR DETECTED       *  TIONS AS "COMMUNICATIONS
*     *--------------------------------------*  READ ERROR", "TCB NOT FOUND,
*  8  * TIME OF DAY WHEN ERROR DETECTED      *  ETC.
*  9  *    (2 WORDS)                         *
*     ****************************************
* 
*   FIRST OPTIONAL PARAMETER = ID SEGMENT ADDRESS OF SENDER 
* 
*      **************************************** 
QBUF  BSS 9         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
* 
XEQT  EQU 1717B 
* 
SIZE  BSS 0 
* 
      END RTRY
                                                                                                                                                