ASMB,R,Q,C
      HED GRPM 91750-16214 REV 2013 * (C) HEWLETT-PACKARD CO. 1979
      NAM GRPM,17,4 91750-16124 REV 2013 800616 ALL 
      SPC 1 
******************************************************************
*  * (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 HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 2 
      EXT EXEC,#RSAX,#RQUE,#RTRY
      EXT #NODE,#GRPM,$TIME,#PLOG 
      EXT #NULL,#LDEF,#QCLM,#BREJ 
      EXT #TBRN,#QRN,#LEVL,#RSM,#MHCT 
      EXT PGMAD,RNRQ,DTACH
      EXT #INCV,#OTCV,#NRVS,#GETR,#PUTR,#PUTD 
      EXT #MAPP,#UP,#UPDA,#DOWN 
      ENT #GBUF 
* 
      SUP 
* 
* NAME:   GRPM
* SOURCE: 91750-18124 
* RELOC:  91750-16124 
* PGMR:   CHUCK WHELAN
* DATE:   17 DEC 76 
* MODIFICICATION FOR 91750: 
* MODIFIED BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S 
* MODIFIED BY JDH [790216] FOR DS REQUEST EQUATED OFFSETS.
* MODIFIED BY CCH [790328] TO ELIMINATE REFERENCE TO <DRTEQ>. 
* MODIFIED BY DWT [790416] FOR PHASE ONE (#INCV). 
* MODIFIED BY DWT [790424] FOR PHASE TWO (#NRVS). 
* MODIFIED BY DWT [790430] FOR PHASE THREE (DRIVER STATUS CHANGE &
*                                           DEBUG LOGGING)
* MODIFIED BY DWT [790606] FOR PHASE FIVE (REMOVE O/S DEPENDENCE).
* MODIFIED BY LAW [790614] TO FIX 'QCLM' CLASS-WRITE CODE.
* MODIFIED BY DWT [790727] TO SUPPORT REMOTE SESSION MONITOR. 
* MODIFIED BY DWT [790803] TO SUPPORT MESSAGE ACCOUNTING. 
* MODIFIED BY DWT [790803] TO SUPPORT REROUTING.
* 
* 
* 
*   GRPM IS THE GENERAL REQUEST PRE-PROCESS MODULE FOR DS/1000. 
*   IT PROCESSES INCOMING REQUESTS AND OUTGOING COMPLETIONS.
* 
*     I  INCOMING REQUESTS
* 
*      1. HANGS ON A GET ON ITS CLASS NUMBER, AND WHEN
*         SATISFIED, MOVES THE REQUEST INTO ITS LOCAL BUFFER. 
*      2. IF THE REQUEST IS NOT DESTINED FOR THE LOCAL NODE,
*         THE REQ/DATA IS RETHREADED FOR OUTPUT TO THE
*         APPROPRIATE LU ON "GRPM"S CLASS NUMBER. 
*      3. IF LOCAL AND A NEW REQUEST, DOES THE FOLLOWING: 
*          A) IF NO TCBS ARE AVAILABLE, SETS THE REPLY FLAG 
*             AND REMOTE BUSY FLAG AND RETURNS THE REQUEST TO 
*             THE ORIGINATOR BY RETHREADING THE REPLY FOR OUTPUT ON 
*             "GRPM"S CLASS.
*          B) IF SYSTEM IS GOING QUIESCENT, OR THE MONITOR IS 
*             IN AVAILABLE MEMORY SUSPEND (STATE 4), THE "BUSY" 
*             FLAG IS SET IN THE REQUEST AND THE ENTIRE TRANSACTION 
*             IS RETURNED TO THE ORIGINATOR.
*          C) OTHERWISE, CALLS "#RSAX" TO CREATE THE SLAVE TCB. 
*          D) DETERMINES THE MONITORS CLASS NUMBER FROM "RES" 
*             TABLE AND RETHREADS THE REQ/DATA TO THAT CLASS. 
*             IF THE MAXIMUM QUEUE DEPTH LIMIT FOR THAT MONITOR IS
*             EXCEEDED BY THIS RE-THREAD, THE ENTIRE REQUEST IS RETURNED
*             TO THE ORIGINATOR (AS DESCRIBED ABOVE), WITH A "DS08" 
*             ERROR.
*      4. IF LOCAL AND A REPLY, DOES THE FOLLOWING: 
*          A) IF "BUSY" FLAG IS SET, CLEARS IT AND RETHREADS
*             THE REQUEST TO RTRY SO AFTER A DELAY IT CAN 
*             BE REATTEMPTED.  HOWEVER, IF IT IS A LOCAL
*             REQUEST, DS08 IS RETURNED IMMEDIATELY.
*          B) CALLS #RSAX TO SEARCH FOR THE MASTER TCB. 
*          C) IF FOUND, RETHREADS THE REQ/DATA ON THE MASTER'S
*             CLASS #.
*      5. IF #PLOG IS NON-ZERO, COMPLETED WRITE CLASS BUFFERS 
*         ARE RETHREADED TO PLOG, OTHERWISE THEY ARE DEALLOCATED. 
*      6. WHEN DONE, "GRPM" RETURNS TO ITS GET. 
* 
*     II  OUTGOING LINE COMPLETIONS 
* 
*      GRPM PROCESSES COMPLETION STATUS OF ALL COMMUNICATION REQUEST/DATA 
*      WRITE OPERATIONS (EXCEPT PROGL).  IF AN OPERATION IS SUCCESSFUL
*      AND PLOG IS ENABLED, THE REQUEST IS RETHREADED TO PLOG'S CLASS,
*      IF NOT, THE CLASS BUFFER IS DEALLOCATED. 
*      ON REMOTE OR LOCAL BUSY ERRORS, GRPM CHECKS THE RETRY COUNT IN 
*      THE STREAM WORD OF THE REQUEST.  IF ALL RETRIES HAVE BEEN
*      EXHAUSTED, IT IS TREATED AS A LINE ERROR AND A DS08 IS RETURNED. 
*      IF ANOTHER RETRY IS POSSIBLE, THE ABSOLUTE SYSTEM TIME AT WHICH
*      THE RETRY SHOULD BE ATTEMPTED IS COMPUTED AND STORED IN THE
*      EQT5 STATUS SAVE AREA IN THE CLASS HEADER.  THE CLASS BUFFER IS
*      THEN RETHREADED ON "RTRY"S CLASS.
*      PARITY OR LINE TIMEOUT ERRORS ARE RETRIED 3 TIMES BY RETHREADING 
*      TO "RTRY".  IF ALL 4 TRIES FAIL, A DS02 ERROR IS RETURNED.  IF 
*      A "STOP RECEIVED" CONDITION IS DETECTED, A DS01 ERROR IS RETURNED. 
*      ALL LINE ERRORS HAVE THE ERROR CODE AND THE LOCAL NODE NUMBER
*      STORED IN THE ERROR FIELD IN THE REQUEST.
*      IF THE REQUEST WAS A REPLY, THE CLASS BUFFER IS SIMPLY 
*      CLEARED OR THE REQUEST IS RETHREADED TO PLOG (IF ENABLED). 
*      IF A NON-REPLY, AND THE ORIGINATOR IS NOT THE LOCAL NODE, THE
*      REPLY FLAG IS SET, AND THE REQUEST IS SENT BACK TO THE ORIGINATOR. 
*      IF THE ORIGINATOR IS LOCAL, THE REPLY IS RETHREADED ON THE 
*      MASTER REQUESTORS CLASS. 
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV XXXX 790531      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  LSTEN, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*                                                                *
******************************************************************
* 
***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!***
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
* 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
* GLBLK-END 
      SKP 
GRPM  EQU * 
      JSB DTACH     DETACH FROM DINIT'S SESSION 
       DEF *+1       IF NECESSARY 
* 
*  WAIT ON #GRPM
* 
GRGET JSB #GETR 
       DEF *+8
       DEF #GRPM
@RQBF  DEF RQBUF
       DEF MINHE    MIN HEADER LEN NEEDED BY GRPM 
       DEF K0 
       DEF K0 
       DEF STATS
       DEF LLU
       JSB ERR1 
      STA RQLEN     STORE ACTUAL HEADER LEN 
      STB DALEN     STORE DATA LENGTH 
      ISZ MSGCT     UP MESSAGE COUNT
      NOP           (AFTER 65K MSGS, THIS INSTR SKIPPED)
* 
*  CHECK DEBUG LOGGING OPTION 
* 
      LDA #PLOG 
      SZA,RSS       LOGGING ENABLED?
      JMP PRGET      NO, GO PROCESS GET 
      LDA #PLOG+2    YES, LOAD TYPE OF LOGGING
      AND DEBUG     DEBUG LOGGING?
      SZA,RSS 
      JMP PRGET      NO, GO PROCESS GET 
      JSB #GETR      YES, GET THE WHOLE HEADER
       DEF *+4
       DEF #GRPM
       DEF RQBUF
       DEF MAXHE    MAX HEADER LENGTH 
       JSB ERR1     ERROR RETURN
      ADA C#LSZ     ADD APPANDAGE LENGTH
      STA TEMP       SO PLOG WILL GET IT
      ADA @RQBF     OFFSET TO BUF AREA
      LDB STATS     GET I/O STATS 
      STB 0,I       SAVE IT 
      INA           UP OFFSET 
      LDB MSGCT     GET MESSAGE COUNT 
      STB 0,I       SAVE IT 
      INA           UP OFFSET 
      LDB =A<<      GET DEBUG SYMBOL
      STB 0,I       SAVE IT AT END OF BUF 
      LDA TEMP      ADD DEBUG LEN 
      ADA K3         (STATUS, MSGCT, & SPECIAL SYMBOL)
      STA TEMP
      JSB EXEC      MAILBOX WRITE/READ TO PLOG
       DEF *+8
       DEF K20N 
       DEF B10K     SET Z BIT 
       DEF K0 
       DEF K0 
       DEF RQBUF
       DEF TEMP 
       DEF #PLOG
       NOP          IGNORE ERROR RETURN 
* 
PRGET EQU * 
      LDA LLU       GET LAST LU WORD
      AND B400      CHECK NOT FROM DRIVER BIT 
      SZA           IS IT SET?
      JMP READC      YES, MUST NOT BE FROM THE COMM. DRIVER 
      LDA STATS     GET I/O COMPLETION STATUS 
      RAR,SLA       ANY DRIVER ERRORS 
      JMP ERCHK     YES 
      RAR 
      SLA,RSS       WAS THIS A WRITE COMPLETION?
      JMP READC     .NO, GO TO READ COMPLETION
* 
*  SUCCESSFUL WRITE COMPLETION
* 
      CLA,INA       SET WRITE COMPL FLAG FOR MA 
      LDB LLU       PASS LLU WORD TO MA 
      JSB #MAPP     CALL MESSAGE ACCOUNTING 
       JMP GRGET    MA RETURN 
* 
*  RELEASE THE MESSAGE
* 
RELSE LDA #PLOG     PLOG CLASS NUMBER 
      SZA           LOGGING?
      JMP THRED     YES, RETHREAD TO PLOG 
*  JUST DEALLOCATE THIS CLASS BUFFER
CLSAM LDA #GRPM 
      ALR,RAR       CLEAR "SAVE BUFFER" FLAG
      STA CLASS 
* 
      JSB EXEC      DO DUMMY GET TO CLEAR CLASS BUFFER
      DEF *+5 
      DEF K21 
      DEF CLASS 
      DEF RQBUF 
      DEF K0
* 
      JMP GRGET     BACK TO GET 
      SKP 
* 
*  SUCCESSFUL READ COMPLETION LOGIC FOLLOWS 
* 
READC EQU * 
      LDA RQLEN 
      SZA           RQUEST LEN = 0? 
      JMP CKST0     .NO, CHECK IF STREAM 0
      LDA LLU       .YES, UP INDICATION 
      AND B377      PASS LU 
      CLB 
      JSB #UP       CALL REROUTING
       JMP RELSE    NORMAL RETURN 
       LDA #GRPM    NO SAM RETURN 
       JMP THRED     SEND IT BACK FOR RETRY 
* 
*  CHECK FOR STREAM ZERO MESSAGE
* 
CKST0 EQU * 
      LDA STREM     GET STREAM WORD 
      AND STRM0     MASK ALL EXCEPT STREAM # & LEVEL BIT
      CPA B10K      STREAM ZERO?
      RSS 
      JMP CKNOD     .NO, CHECK NODE 
      LDA RQBUF+#REQ .YES, CHECK MSG TYPE 
      SZA,RSS       RR MSG? 
      JMP RRMSG     .YES
      CPA K1        DSCHK MSG?
      RSS 
      JMP CKNOD     .NO 
      LDA DALEN     .YES, GET DATA LEN
      SZA           ZERO? 
      CPA RQBUF+#REQ+1 NO MORE ROOM?
      JMP NRETN     .YES, SEND IT BACK
      LDA #NODE 
      LDB #LEVL 
      DST BSS2
      JSB #PUTD     SAVE NODE # AND LEVEL IN DATA AREA
       DEF *+4
       DEF RQBUF+#REQ+1 OFFSET INTO DATA AREA 
       DEF BSS2     NODE # AND LEVEL
       DEF K2       2 WORD SAVE 
       JSB ERR1     ERROR RETURN
      ISZ RQBUF+#REQ+1 UP OFFSET
      ISZ RQBUF+#REQ+1
      LDA STREM 
      AND RPBIT 
      SZA           REPLY?
      JMP CKNOD     .YES, GO TO CHECK NODE
      LDA DESTN     .NO 
      SSA,RSS       ALWAYS LOCAL? 
      CPA #NODE     LOCAL?
      RSS           .YES
      JMP CKNOD     .NO 
NRETN LDA STREM     TIME TO SEND IT BACK
      AND RTYCT     CLEAR BUSY RETRY COUNT
      IOR RPBIT     SET REPLY BIT 
      IOR #BREJ     INIT BUSY RETRY 
      STA STREM 
      LDA =B10100 
      STA CONWD+1 
      JMP RPLYR 
RRMSG EQU * 
      LDA LLU 
      AND B377
      JSB #UPDA 
       JMP RELSE    NORMAL RETURN 
       JMP GRGET    MESSAGE HAS BEEN REQUEUED 
* 
*  CHECK IF REQ/REP IS DESTINATED FOR THIS NODE 
* 
CKNOD EQU * 
      LDA STREM 
      AND LEMSK     CLEAR COMM. LINE RETRY COUNT
      STA STREM 
      LDA STREM     LOAD STREAM WORD
      LDB SRC#      LOAD SOURCE NODE #
      AND RPBIT     CHECK STREAM WORD 
      SZA,RSS       REPLY?
      LDB DESTN      NO, LOAD DESTN NODE # INSTEAD
      STB TEMP2     SAVE NODAL ADDRESS
      SSB,RSS       SKIP IF ALWAYS LOCAL
      CPB #NODE     IS IT US? 
      JMP LOCAL     YES 
      SKP 
* 
*  STORE & FORWARD TO ANOTHER NODE
* 
      LDA STREM     GET STREAM WORD 
      AND B10K
      SZA,RSS       LEVEL ZERO? 
      JMP NRVS      .YES, LOOK UP LU
      ISZ RQBUF+#HCT  .NO, UPDATE HOP COUNT 
      RSS           HOP COUNT O.K.
      JMP HOPER     SEND HOP COUNT EXCEEDED MSG 
* 
*  CONVERT NODE # TO LU 
* 
NRVS  EQU * 
      JSB #NRVS     SEARCH NRV
       DEF *+2
       DEF TEMP2    CPU NUMBER
       JMP ERETN    ERR RETURN--CANNOT FIND NODE
RETRY EQU * 
      SZA,RSS       LU = 0? 
      JMP NPATH     IF ZERO, NO PATH ERROR
      IOR =B100000  SET 2 WORD CONWD BIT
      STA CONWD 
      LDA =B10100   SET Z & WRITE BIT 
      STA CONWD+1   SAVE IT FOR REQU CALL 
* 
*  RETHREAD MESSAGE FOR OUTPUT
* 
SNDRP EQU * 
      LDA MINHE     GET MIN HEADER LEN
      LDB MINHE 
      CMB,INB 
      ADB RQLEN 
      SSB           RQLEN > MINHE?
      LDA RQLEN     .NO, USE RQLEN
      STA OVLHE     STORE IT AS OVERLAY LEN 
      JSB #RQUE     RETHREAD BUF FOR OUTPUT 
       DEF *+9
       DEF K20N 
       DEF CONWD
       DEF K0 
       DEF K0 
       DEF RQBUF    OVERLAY PORTION OF HEADER 
       DEF OVLHE    LEN OF OVERLAY
       DEF #GRPM
       DEF #GRPM
       JSB ERR1     ERROR RETURN
      JMP GRGET     BACK TO GET 
      SKP 
* 
*  THIS REQ/REPLY IS DESTINED LOCALLY 
LOCAL EQU * 
      LDA STREM     GET STREAM WORD 
      AND B10K      LEVEL FIELD PRESENT?
      SZA 
      LDA RQBUF+#LVL .YES, LOAD LEVEL FIELD 
      AND B17       MASK OFF ALL BUT LEVEL #
      CPA #LEVL     SAME LEVEL AS THIS NODE?
      JMP NOCON     .YES, NO CONVERSION NECESSARY 
      LDA #INCV     .NO, RETHREAD TO #INCV
      SZA           IS IT SCHEDULED?
      JMP THRED     .YES
      JMP CONER     .NO, ERROR
* 
NOCON EQU * 
      LDA STREM 
      AND STRM0 
      CPA B10K      STREAM ZERO?
      RSS           .YES, MUST BE MA MESSAGE
      JMP NOTMA     .NO 
      CLA 
      LDB LLU 
      JSB #MAPP 
       JMP GRGET
NOTMA EQU * 
      LDA RQBUF     GET STREAM WORD 
      AND RPBIT     TEST REPLY FLAG 
      SZA 
      JMP REPLY     IT'S A REPLY
* 
*  HERE WHEN LOCAL REQUEST IS RECEIVED
* 
      LDB #NULL 
      SZB,RSS       ANY TCBS AVAILABLE? 
      JMP QRJCT     NO, SEND IT BACK FOR AWHILE 
* 
      LDA RQBUF 
      AND B77       ISOLATE STREAM
      ADA #LDEF 
      ADA K2        POINT TO LIST HEADER PNTR 
      LDB 0,I       POINT TO LIST HEADER 
      INB 
      STB TEMP      SAVE ADDRESS OF CLASS # 
      INB 
      LDA 1,I       GET 1ST WORD OF MONITOR NAME
      RAL,CLE,ERA   CLEAR "NO ABORT" FLAG 
      SZA,RSS       IS THIS MONITOR ENABLED?
      JMP ILLRQ     NO, RETURN A "DS06" 
      STA NAME      SAVE THE FIRST WORD 
      INB 
      DLD 1,I       LOAD THE NEXT TWO WORD
      DST NAME+1    SAVE IT AS NAME 
      JSB PGMAD 
       DEF *+2
       DEF NAME 
      SZA,RSS       WAS ID SEGMENT ADDR FOUND?
      JMP ILLRQ     .NO, RETURN DS ERROR
      CPB K4        AVAILABLE MEMORY SUSPEND? 
      JMP QRJCT     YES, REJECT REQUEST 
* 
      JSB RNRQ      "LOOK" AT QUIESCENT LOCK
       DEF *+4
       DEF LCNW     LOCK,CLEAR,NO WAIT,NO ABORT 
       DEF #QRN 
       DEF TEMP2
       NOP
      LDA TEMP2     GET LOCK STATUS 
      CPA K1        QUIESCING?
      RSS            NO 
      JMP QRJCT      YES, SEND IT BACK
* 
*  THIS REQUEST CAN NOW BE PASSED TO THE REQUIRED MONITOR 
* 
      JSB #RSAX     BUILD TCB FOR THIS STREAM 
      DEF *+5 
      DEF K3
      DEF RQBUF+1   PASS ORIGINATORS SEQ #
      DEF RQBUF      & STREAM 
      DEF RQBUF+2     & ORIGIN NODE NO. 
* 
      SSB           OK? 
      JMP ILLRQ     NO, GIVE DS06 ERROR 
* 
      STA SEQ#      STORE LOCAL SEQ # 
      LDB #NULL     NUMBER OF TCB'S LEFT
      SZB           DID WE USE THE LAST ONE?
      JMP MONIT     NO
* 
      JSB RNRQ      YES! LOCK THE TABLE ACCESS RN 
      DEF *+4 
      DEF LGNW      GLOBAL LOCK, NO WAIT, NO ABORT
      DEF #TBRN 
      DEF TEMP2 
      NOP 
MONIT EQU * 
      CLA 
      LDB LLU 
      JSB #MAPP 
       JMP GRGET
      LDA RQBUF+#SID LOAD SESSION WORD
      AND B377      GET DESTINAION SESSION ID 
      SZA           = ZERO? 
      JMP *+3       .YES, JUST THREAD TO MONITOR
      LDA #RSM      IF SESSION MONITOR NODE,
      SZA,RSS        THREAD TO RSM
* 
      LDA TEMP,I    GET MONITOR'S CLASS 
      SPC 2 
* 
*  ENTER HERE TO RETHREAD THE CLASS BUFFER FROM #GRPM TO THE CLASS
*  NUMBER PASSED IN THE A REGISTER. 
* 
THRED EQU * 
      STA CLASS 
* 
      LDA MINHE     GET MIN HEADER LEN
      LDB MINHE 
      CMB,INB 
      ADB RQLEN 
      SSB           RQLEN > MINHE?
      LDA RQLEN     .NO, USE RQLEN
      STA OVLHE     STORE IT AS OVERLAY LEN 
      JSB #RQUE 
       DEF *+9
       DEF K20N 
       DEF B10K     REQUE WITH Z BIT SET
       DEF K0 
       DEF K0 
       DEF RQBUF    OVERLAY PORTION OF HEADER 
       DEF OVLHE    LEN OF OVERLAY
       DEF CLASS
       DEF #GRPM
       RSS          ERROR RETURN
      JMP GRGET     BACK TO GET 
* 
      CPA ASCDS     LOOK FOR DS08 ERROR 
      RSS 
      JSB ERR1
      CPB ASC08 
      JMP RQERR     IF DS08, REQUEUE ERROR
      JSB ERR1
      SKP 
* 
*  HERE WHEN LOCAL REPLY RECEIVED 
* 
REPLY LDA RQBUF 
      AND BZBIT     IS THIS A QUIESCENT/BUSY REJECT?
      SZA,RSS 
      JMP REPOK     NO
      LDA RQBUF     YES 
      AND CLMSK     CLEAR REPLY & BUSY FLAGS & LINE ERR CNTR
      STA RQBUF     WORD GETS STORED IN SAM LATER 
      LDB RQBUF+3   GET DESTINATION NODE
      CPB #NODE     WAS THIS A LOCAL REQUEST? 
      JMP BZYER     YES! GIVE A DS08 NOW
      JMP RMBZY     RETHREAD TO RTRY
* 
REPOK EQU * 
      CLA 
      LDB LLU 
      JSB #MAPP 
       JMP GRGET
      JSB #RSAX     SEARCH FOR MASTER TCB 
      DEF *+3 
      DEF K4
      DEF RQBUF+1 
      SSB,RSS       FOUND?
      JMP THRED     .YES, RETHREAD IT (A REG = MASTER CLASS #)
      LDA K2        .NO, SEND ERROR 
      STA ETYPE      MESSAGE TO QCLM
      JMP ERR2
* 
QRJCT LDA RQBUF 
      AND LEMSK     CLEAR LINE ERROR COUNT
      IOR RPBZY     SET "BUSY" & "REPLY" FLAGS
      STA STREM 
      LDA =B10100 
      STA CONWD+1 
      JMP RPLYR     SEND REPLY
      SKP 
* 
*  ERROR OCCURRED 
* 
ERCHK LDA STATS     GET DRIVER RETURNED STATUS
      RAR,RAR       ROTATE TO GET READ/WRITE BIT (BIT 2)
      SLA,RSS       IS THIS A WRITE ERROR?
      JMP EREAD      NO, JUMP TO READ ERROR 
      LDA STATS 
      AND DVRXX 
      CPA DVA66     NEW DVA66 DRIVER? 
      JMP RR        .YES, NO RETRY ABOVE DRIVER NECESSARY 
* 
*  OLD DVA65 DRIVER, DO RETRY IF NECESSARY
* 
      LDA STATS 
      AND B360
      CPA B20       LINE ERROR? 
      JMP LNERR 
      CPA B40       LINE TIMEOUT? 
      JMP LNERR 
      CPA B60       LOCAL BUSY? 
      JMP LCBZY 
      CPA B120      REMOTE BUSY?
      JMP RMBZY 
      JMP RR        ALL OTHER ERRORS WILL TRY REROUTE 
* 
*  LINE ERROR OR LINE TIMEOUT, CHECK RETRY COUNT
* 
LNERR LDA STREM     STREAM WORD 
      AND B300      ISOLATE RETRY COUNT 
      CPA B300      ALL RETRIES EXHAUSTED?
      JMP RR        YES, TRY REROUTE
* 
      LDB LERR#     LINE ERROR DELAY FACTOR 
      STB TEMP2     SAVE IT FOR DELAY 
      LDA B100      BUMP BITS 7-6 
      JMP RBUMP 
* 
*  REMOTE BUSY REJECT 
* 
RMBZY LDA STREM     STREAM WORD 
      AND B7400     BITS 11-8 HAVE RETRY COUNT
      CPA B7400     ALL RETRIES EXHAUSTED?
      JMP BZYER     YES, GIVE ERROR 
      LDA B400      BUMP BITS 11-8
      LDB RBZY#     DELAY FOR REMOTE BUSY (1 SEC) 
      STB TEMP2     SAVE OFFSET (10'S OF MSECS) 
* 
RBUMP ADA STREM     BUMP RETRY COUNT
      STA STREM     STORE NEW VALUE BACK
      JMP DELAY 
* 
*  LOCAL BUSY REJECT
* 
LCBZY LDB LBZY# 
      STB TEMP2 
* 
DELAY CLE 
      DLD $TIME     CURRENT SYSTEM TIME 
      ADA TEMP2     ADD DELAY TIME
      SEZ,RSS       CARRY?
      JMP *+3       NO
      INB,SZB,RSS   WILL DAY ROLL OVER? 
      ADA B25K      YES, COMPENSATE FOR IT
      STA TEMP2     SAVE DELAY VALUE
      JSB #PUTR     JUMP TO "STUFF" DELAY VALUE 
       DEF *+3        IN MESSAGE
       DEF RQLEN    OFFSET IN MESSAGE TO STORE DELAY VALUE
       DEF TEMP2    DELAY VALUE 
       JSB ERR1     ERROR RETURN
      LDA #RTRY     GET RETRY'S CLASS # 
      SZA           RTRY SCHEDULED? 
      JMP THRED     .YES, RETHRED TO IT 
      LDA STREM     .NO, RETRY IT IN GRPM INSTEAD 
      LDB SRC#      LOAD SOURCE NODE #
      AND RPBIT     REPLY?
      LDB DESTN     .NO, LOAD DESTN NODE #
      STB TEMP2     SAVE NODE ADDR
      SSB,RSS       NEGATIVE LU?
      JMP NRVS      .NO, SEARCH FOR LU
      CMB,INB       .YES, MAKE IT POSITIVE
      LDA BREG      PUT IT IN A REG.
      JMP RETRY 
      SKP 
* 
*    CHECK IF REROUTING IS NECESSARY
* 
RR    EQU * 
      LDB RQBUF+#REQ
      LDA STREM 
      AND STRM0     MASK ALL EXCEPT STREAM # & LEVEL BIT
      CPA B10K      STREAM ZERO?
      SZB           RR MSG? 
      RSS 
      JMP RELSE     .YES, JUST RELEASE
      LDB SRC#      PASS SOURCE NODE #
      LDA STREM 
      AND RPBIT     REPLY?
      SZA,RSS 
      LDB DESTN     .YES, PASS DEST. NODE # 
      LDA LLU 
      AND B377      PASS LU 
      JSB #DOWN     CALL REROUTING
       RSS          NON RR LINK RETURN
       JMP CKNOD    RR LINK RETURN
* 
      LDA STATS     NO RR, RETURN ERROR TO USER 
      AND B360      ISOLATE ERROR TYPE
      CPA B40       WAS IT DRIVER TIMEOUT?
      JMP TOERR     .YES
      CPA B120      WAS IT REMOTE BUSY? 
      JMP BZYER     .YES
* 
*  LINE FAILURE ERROR--DS01 
* 
      LDB ASC01     O/W, RETURN LINE ERROR
      JMP ERETN 
* 
*  DRIVER TIMEOUT ERROR--DS02 
* 
TOERR EQU * 
      LDB ASC02 
      JMP ERETN 
* 
*  ALL ROUTES TO DESTINATION ARE DOWNED--DS04/1 
* 
NPATH EQU * 
      LDB ASC04 
      LDA STREM     GET STREAM WORD 
      AND B10K      LEVEL ZERO? 
      SZA,RSS 
      JMP ERETN     .YES, NO ERROR QUALIFIER
      LDA ECQ1      .NO, GET ERROR QUALIFIER 1
      IOR RQBUF+#ECQ
      STA RQBUF+#ECQ  STORE IT
      JMP ERETN 
* 
*  HOP COUNT EXCEEDED--DS04/2 
* 
HOPER EQU * 
      LDB ASC04 
      LDA ECQ2
      IOR RQBUF+#ECQ
      STA RQBUF+#ECQ
      JMP ERETN 
* 
*  NO MONITOR FOR REQUESTED STREAM IS PRESENT--DS06 
* 
ILLRQ LDB ASC06 
      JMP ERETN 
* 
*  NO MESSAGE CONVERTER--DS07/1 
* 
CONER EQU * 
      LDB ASC07 
      JMP NPATH+1 
* 
*  BUSY RETRY COUNT EXHAUSTED--DS08 
* 
BZYER EQU * 
      LDB RQBUF+#REQ
      LDA STREM 
      AND STRM0 
      CPA B10K      STREAM ZERO?
      SZB           RR MSG? 
      RSS 
      JMP RELSE     .YES, JUST RELEASE
      LDB ASC08 
      JMP ERETN 
* 
*  REQUEUE ERROR--DS08/4
* 
RQERR EQU * 
      LDA STREM 
      AND B10K      LEVEL ZERO? 
      SZA,RSS 
      JMP ERETN     .YES, NO ERROR QUALIFIER
      LDA ECQ4      .NO, GET QUALIFIER 4
      IOR RQBUF+#ECQ
      STA RQBUF+#ECQ
* 
ERETN EQU * 
      STB TEMP
      LDB RQBUF+#REQ
      LDA STREM 
      AND STRM0     MASK ALL BUT STREAM # & LEVEL BIT 
      CPA B10K      STREAM ZERO?
      SZB           RR MSG? 
      RSS 
      JMP RELSE     .YES, RELEASE ERROR RR MSG
      LDA STREM 
      AND B10K
      SZA,RSS       LEVEL ONE OR ABOVE MSG? 
      JMP CKRPE     .NO, GO CHECK REPLY ERROR 
      LDA RQBUF+#ECQ CHECK NO REPLY FLAG
      SSA           IS IT SET?
      JMP CLSAM     .YES, GO CLEAN SAM
      CCB           ELSE SET ERROR FLAG FOR MA
      STB RQBUF+#MAR
CKRPE EQU * 
      LDA RQBUF     GET STREAM WORD 
      RAL 
      CCE,SSA       REPLY?
      JMP ERRFL     YES, NO RECOVERY POSSIBLE 
* 
      LDB TEMP
      STB EC2       STORE THE PASSED VALUE
      LDA #NODE     GET LOCAL NODAL ADDRESS 
      RAL,ERA       INDICATE THERE'S AN ASCII ERROR 
      STA ENO       STORE IT IN ERROR LOCATION WORD 
      LDA ASCDS     GET "DS"
      STA EC1       STORE IT
      LDA STREM 
      AND LEMSK     CLEAR COMM. LINE RETRY COUNT
      AND RTYCT 
      IOR RPBIT     SET REPLY FLAG
      IOR #BREJ     INITIALIZE BUSY RETRY COUNTERS
      STA STREM 
      LDA =B12100   SET Z, NO DATA, & WRITE BIT 
      STA CONWD+1 
* 
RPLYR EQU * 
      LDA SRC#      LOAD ORIGINIAL NODE NO. 
      SSA,RSS       SKIP IF ALWAYS LOCAL
      CPA #NODE     IS IT LOCAL?
      JMP LOCAL     .YES, PASS ERROR TO UPPER S/W 
      JSB #NRVS     SEARCH FOR THE REPLY NODE 
       DEF *+4
       DEF SRC#     USE ORIGINIAL NODE NUMBER 
       DEF TEMP     RETURN T/O VALUE
       DEF TEMP2    RETURN UPGRADE VALUE
       JMP ERETN    ERROR RETURN
      SZA,RSS       LU ZERO?
      JMP NPATH     .YES, NO PATH ERROR 
      IOR =B100000
      STA CONWD 
* 
      LDB #MHCT     GET MAX HOP COUNT 
      LDA STREM     GET STREAM WORD 
      AND B10K      LEVEL FIELD PRESENT?
      SZA 
      LDA RQBUF+#LVL .YES, LOAD LEVEL FIELD 
      AND B17       MASK OFF ALL BUT LEVEL #
      SZA           LEVEL ZERO? 
      STB RQBUF+#HCT  .NO, RESET HOP COUNT
      CPA TEMP2     SAME AS THE DESTINATION'S LEVEL?
      JMP SNDRP     .YES, JUST SEND THE REPLY 
      LDA #OTCV     .NO, RETHREAD TO #OTCV
      SZA 
      JMP THRED 
      JMP CONER 
      SKP 
*     FORMAT OF BUFFER PASSED TO QCLM:
*     --------------------------------
* 
*     ****************************************
*  1  * STREAM WORD                          *  NOTE: ON SOME MESSAGES, 
*     *--------------------------------------*  WORD 1 AND WORD 2 MAY 
*  2  * SEQUENCE NUMBER                      *  HAVE DIFFERENT MEANINGS.
*     *--------------------------------------*
*  3  * SOURCE (ORIGINATING) NODE NUMBER     *
*     *--------------------------------------*
*  4  * DESTINATION NODE NUMBER              *
*     *--------------------------------------*
*  5  * P-REGISTER WHEN ERROR DETECTED       *
*     *--------------------------------------*
*  6  * A-REGISTER WHEN ERROR DETECTED       *
*     *--------------------------------------*
*  7  * B-REGISTER WHEN ERROR DETECTED       *
*     *--------------------------------------*
*  8  * TIME OF DAY WHEN ERROR DETECTED      *
*  9  *    (2 WORDS)                         *
*     *--------------------------------------*
* 10  * PROGRAM NAME WHERE                   *
* 11  *    ERROR IS DETECTED                 *
* 12  *    (3 WORDS)                         *
*     ****************************************
* 
ERRFL EQU * 
      CLA           FIRST GIVE IT TO
      LDB LLU 
      JSB #MAPP      MA TO SEE IF IT WANTS
       JMP GRGET     TO HOLD ON FOR RETRY 
      LDA ASCDS 
      LDB TEMP      GET PASSED ERROR CODE 
      DST AREG
      LDA K1        ERROR SENDING REPLY, ENCODE 
      STA ETYPE      SO QCLM PRINTS "REPLY FLUSHED..."
      JMP ERR2
* 
EREAD EQU * 
      LDA STATS     GET I/O COMPLETION STATUS 
      AND B360      ISOLATE ERROR TYPE (BITS 4-7) 
      CPA B120      REMOTE BUSY?
      JMP BZYER      YES
      LDA STATS      NO, MOVE I/O STATUS TO 
      STA RQBUF+1     REQUEST BUFFER
      LDA LLU       GET THE LAST LU WORD
      AND B377      MASK OFF ALL BITS EXCEPT LU 
      STA RQBUF     STORE IT IN THE FIRST WORD
      LDA K3        ENCODE SO 'QCLM' PRINTS 
      STA ETYPE      "COMMUNICATIONS READ ERROR"
      JMP ERR2
* 
*  THIS REQUEST IS NON-RECOVERABLE, CLEAR, LOG, THEN IGNORE IT
ERR1  NOP           HERE TO REPORT IRRECOVERABLE ERROR
      DST AREG      SAVE REGS FOR QCLM
      CLA 
      STA ETYPE 
      LDA @GRPM     GET BASE ADDRESS
      CMA,INA       MAKE IT NEGATIVE
      ADA ERR1      ADD POINT OF ERR TO GET RELATIVE ADDR 
      ADA M1
      STA PREG      PASS ERROR ADDR TO QCLM 
      LDA PNAME     PASS PROGRAM NAME 
      STA PGM 
      DLD PNAME+1 
      DST PGM+1 
* 
ERR2  EQU * 
      DLD $TIME     RECORD TIME OF ERROR
      DST TOD 
      LDA #QCLM 
      SZA,RSS       QCLM AVAILABLE? 
      JMP CLSAM     .NO, FORGET MESSAGE 
      JSB EXEC      MAILBOX WRITE/READ TO QCLM
      DEF *+8 
      DEF K20N
      DEF K0
      DEF RQBUF 
      DEF K12 
      DEF ETYPE 
      DEF K0
      DEF #QCLM 
      NOP 
* 
      JMP CLSAM     GO DEALLOCATE CLASS BUFFER
      SKP 
* 
*     CONSTANTS AND STORAGE 
* 
RPBIT OCT 40000 
BZBIT OCT 20000 
RPBZY OCT 60000 
TEMP  NOP 
TEMP2 NOP 
BSS2  BSS 2 
CONWD BSS 2 
CLASS NOP 
ETYPE NOP 
LLU   NOP           LAST LU WORD
STATS NOP           I/O COMPLETATION STATUS 
DEBUG OCT 1000      DEBUG LOGGING MASK
MSGCT NOP           MESSAGE ENCOUNTED BY GRPM 
RQLEN NOP           ACTUAL LENGTH OF HEADER 
DALEN NOP           DATA LENGTH 
OVLHE NOP           OVERLAY LEN NEEDED BY GRPM
MINHE ABS #MHD+3    MIN HEADER LEN (+3 FOR STREAM 0 MSG)
MAXHE ABS #MXR+#LSZ  MAX HEADER LEN NEEDED BY GRPM
RTYCT OCT 170077    STREAM WORD RETRY COUNT MASK
LEMSK OCT 177477    MASK TO CLEAR LINE ERROR COUNT
LGNW  OCT 140002
LCNW  OCT 140005
CLMSK OCT 117477
STRM0 OCT 010077    MASK FOR STREM & LEVEL BIT
ECQ1  OCT 20        DS ERROR QUALIFIER ONE
ECQ2  OCT 40        DS ERROR QUALIFIER TWO
ECQ4  OCT 100       DS ERROR QUALIFIER FOUR 
DVRXX OCT 37400     MASK FOR DRIVER TYPE
DVA66 OCT 33000     DRIVER 66 
PNAME ASC 3,GRPM
NAME  ASC 3 
@GRPM DEF GRPM
* 
M1    DEC -1
K0    DEC 0 
K1    DEC 1 
K2    DEC 2 
K3    DEC 3 
K4    DEC 4 
K12   DEC 12
K21   DEC 21
K20N  OCT 100024
B17   OCT 17
B20   OCT 20
B40   OCT 40
B60   OCT 60
B77   OCT 77
B100  OCT 100 
B120  OCT 120 
B300  OCT 300 
B360  OCT 360 
B377  OCT 377 
B400  OCT 400 
B7400 OCT 007400
B10K  OCT 010000
B25K  OCT 025000
* 
*  TIME DELAY CONSTANTS 
LBZY# DEC 50        LOCAL BUSY DELAY = .5 SECOND
RBZY# DEC 100       REMOTE BUSY DELAY = 1 SECOND
LERR# DEC 80        LINE ERROR RETRY DELAY = .8 SECOND
* 
ASC01 ASC 1,01
ASC02 ASC 2,02
ASC04 ASC 1,04
ASC06 ASC 1,06
ASC07 ASC 1,07
ASC08 ASC 1,08
ASCDS ASC 1,DS
* 
C#LSZ ABS #LSZ
* 
RQBUF BSS #MXR+#LSZ+3      +3 FOR DEBUG LOGGING 
#GBUF EQU RQBUF 
* 
STREM EQU RQBUF 
SEQ#  EQU RQBUF+1 
SRC#  EQU RQBUF+2 
DESTN EQU RQBUF+3 
PREG  EQU RQBUF+4 
AREG  EQU RQBUF+5 
BREG  EQU RQBUF+6 
TOD   EQU RQBUF+7 
PGM   EQU RQBUF+9 
* 
EC1   EQU RQBUF+4 
EC2   EQU RQBUF+5 
ENO   EQU RQBUF+6 
* 
SIZE  BSS 0 
* 
      END GRPM