ASMB,R,L,C
      HED QUEUE 91750-16153 (C) HEWLETT-PACKARD CO. 1980
      NAM QUEUE,17,2 91750-16153 REV.2013 800424 (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 
      ENT QUEUE 
      EXT EXEC,RNRQ,XLUEX 
      EXT #GRPM,#QCLM,#ST09,#ST08,RMPAR 
* 
* 
*    NAME: QUEUE
*  SOURCE: 91750-18153
*   RELOC: 91750-16153
*    PGMR: JOHN LAMPING 
* 
*    WRITTEN BY CHUCK WHELAN [DECEMBER 1976]
*    MODIFIED BY PETER BRICKEY
*    MODIFIED BY JOHN LAMPING [NOVEMBER 1979] 
* 
* 
*     QUEUE IS THE DS/1000 PROGRAM SCHEDULED BY COMMUNICATIONS
*     DRIVERS WHEN A NEW REQUEST IS TO BE READ FROM A COMMUNICATIONS
*     LINE.  THE REQUEST AND DATA BUFFER LENGTHS ARE PASSED TO QUEUE
*     IN THE CALLING PARAMETERS. IF THE PASSED LENGTHS
*     ARE NOT WITHIN THE ALLOWABLE RANGE (6<REQ.LENG.<64) OR
*     (DATA LENG.<=4096), QUEUE SENDS A STOP VIA THE DRIVER.
*     IF ALL IS OK, QUEUE DOES A CLASS I/O READ TO EITHER PROGRAM 
*     GRPM'S CLASS OR PROGL'S CLASS (IF IT IS AN CBL DOWNLOAD 
*     REQUEST) OR VCPMN'S CLASS (IF IT IS A VCP REQUEST). 
*     IF AN IMMEDIATE REJECT OF THE REQUEST OCCURS DUE
*     TO INSUFFICIENT SYSTEM AVAILABLE MEMORY, QUEUE SENDS A STOP 
*     VIA THE DRIVER. 
* 
* 
*     ERRORS:  THE FOLLOWING ERROR CONDITIONS CAN OCCUR:
* 
*     1.  INTERRUPT NOT FROM DVR65 - IGNORE IT
*     2.  INTERRUPT NOT FROM INITIALIZED COMM LINE - CLEAR THE
*                   DRIVER
*     3.  INTERRUPT FROM NON-EXISTANT LU - IGNORE IT
*     4.  LENGTHS OUT OF RANGE - SEND A STOP
*     5.  GRPM'S CLASS IS BAD - REPORT CATASTROPHIC ERROR 
*     6.  NOT ENOUGH SYS. AVAIL. MEM. - SEND STOP 
* 
      SKP 
QUEUE JSB RMPAR     GET PARAMETERS PASSED BY DVR65
      DEF *+2 
      DEF PRAMS 
      LDA SCODE     IS THIS INTERRUPT FROM
      CPA CODE      A DS DRIVER?
      RSS           YES, CONTINUE 
      JSB ERR       NO - IGNORE IT
      LDA LU1       ALSO, HAS DVA65 
      SZA,RSS       BEEN INITIALIZED? 
      JSB ERR       NO, THE LU IS STILL ZERO
      RAL,CLE,ERA   IN CASE THIS IS A HDLC LINK CLEAR 
      STA LU1       BIT 15 BEFORE SAVING LU NUMBER
      SEZ           IS THIS A HDLC NODE?
      INA           YES, USE UPPER LU NUMBER
      IOR BIT15     WITH SIGN BIT SET 
      STA LU2       FOR CLASS READ REQUEST
      ADA F256      NOW IT MUST BE SMALLER THAN 256 
      SSA,RSS       IS IT?
      JSB ERR       NO, AN ERROR MUST BE REPORTED 
* 
* 
*  GET AND VERIFY DATA AND REQUEST LENGTHS PASSED IN PARAMETERS 
      LDA RLEN      REQUEST LENGTH
      SSA           POSITIVE? 
      JMP SSTP1     NO, ERROR 
      SZA,RSS       LENGTH = 0? 
      JMP LENOK     YES, THAT IS ALWAYS OK
      ADA N64 
      SSA,RSS       REQ LENGTH > 64?
      JMP SSTP1     YES, CAN'T ACCEPT IT
      ADA D57       IS REQUEST LNTH 
      SSA             LESS THAN 7?
      JMP SSTP1     YES, ERROR!  SEND 'STOP'
* 
LENOK EQU * 
      LDA DLEN      NOW CHECK DATA LENGHT 
      SSA 
      JMP SSTP1     LENGTH ERROR
      ADA N4097 
      SSA,RSS       DATA LENGTH > 4096? 
      JMP SSTP1     YES, CAN'T ACCEPT IT
* 
      LDB TYPE      LENGTHS ARE OK, NOW 
      LDA TYPE      BUILD THE 
      ALF,RAL       CONTROL WORD
      RAL,RAL       WITH THE CORRECT MESSAGE TYPE 
      SZB,RSS       DS TYPE 1 REQUEST?
      XOR ZBIT      YES, MUST SAY DOUBLE BUFFERED 
      STA CONWD     IN EITHER CASE, CONWD IS BUILT
      LDA RLEN      ALSO, IF THIS IS A DS TYPE
      ADA K2        MESSAGE THE REQUEST LENGTH
      STA RLEN      MUST BE INCREMENTED BY 2
* 
      LDA #GRPM     ASSUME THIS REQUEST IS DS MODE
      SZB,RSS       IS ASSUMPTION CORRECT?
      JMP GRPCL     GOOD GUESS!, SCHEDULE GRPM
      STB RLEN      PROGL REQUEST, PASS TYPE IN RLEN
      LDA #ST09+1   USE PROGL'S CLASS NUMBER
      LDB TYPE      IS THIS A 
      CPB K2          RFP TYPE MESSAGE? 
      LDA #ST08+1   YES, USE VCPMN'S CLASS
GRPCL CCE,SZA,RSS 
      JMP SSTP2     SEND STOP IF NO CLASS ALLOCATED 
      RAL,ERA       SET NO-WAIT BIT IN CLASS WORD.
      STA CLASS     SAVE LOCALLY
* 
      JSB XLUEX     READ THE REQUEST TO GRPM'S CLASS
      DEF *+8 
      DEF K17N      NO ABORT
      DEF LU2 
      DEF ZERO
      DEF DLEN      RECEIVED DATA LENGTH
      DEF LU1 
      DEF RLEN      RECEIVED REQUEST LENGTH/REQUEST TYPE
      DEF CLASS 
      JMP WHY       HERE IF CLASS READ FAILS
* 
      SZA           SUCCESS?
      JMP SSTP0     NO, PROBABLY NO SAM, SEND STOP VIA DRIVER 
* 
EXIT  JSB EXEC      TERMINATE QUEUE 
      DEF *+2 
      DEF K6
* 
WHY   CPA AIO       IS ERROR
      RSS             AN IO ERROR?
      JSB ERR       NO
      CPB A04       IO04? 
      JMP SSTP0     YES SEND STOP 
      JSB ERR       NO, BAD ERROR 
      SKP 
* 
*     ERROR PROCESSING SECTION
* 
ERR   NOP           PASS ERROR INFO TO QCLM & GIVE UP 
      DST AREG      PASS REGS TO QCLM 
      LDA ERR       PICK UP ORIGINATION ADDRESS 
      STA PREG      PASS TO QCLM
      LDA #QCLM     QCLM CLASS
      SZA,RSS       IS CLASS NUMBER DEFINED?
      JMP ERR2      NO--SEND A 'STOP' 
      STA CLASS     SAVE LOCALLY
* 
      JSB EXEC      MAILBOX CLASS WRITE/READ TO QCLM
      DEF *+8 
      DEF K20N
      DEF ZERO
      DEF QBUF
      DEF K12 
      DEF ZERO
      DEF ZERO
      DEF CLASS 
ZERO  NOP           ERROR RETURN
ERR2  EQU * 
      LDA LU1 
      SZA,RSS       WAS LU DETERMINED?
      JMP EXIT      NO, CAN'T SEND STOP 
* 
SSTP2 LDA K2        GET SYSTEM ERROR CODE 
      LDB TYPE      GET MESSAGE TYPE
      SZB,RSS       DS/1000 TYPE? 
      JMP SSTP      YES, TELL DRIVER TO WAIT
SSTP1 CLA,INA,RSS   GET ILLEGAL SIZE ERROR CODE 
SSTP0 CLA           GET NO SAM ERROR CODE 
* 
*  CALL DRIVER TO SEND A STOP 
* 
SSTP  STA TEMP      SAVE ERROR CODE 
      LDA B600      STOP REQUEST
      STA CONWD 
      JSB XLUEX 
      DEF *+6 
      DEF K1
      DEF LU2 
      DEF ZERO
      DEF ZERO      DATA LENGTH 
      DEF TEMP      ERROR CODE
      JMP EXIT
* 
      SKP 
* 
*     CONSTANTS AND STORAGE 
* 
* 
*     FORMAT OF BUFFER PASSED TO QCLM:
*     --------------------------------
* 
*     ****************************************
*  1  * STREAM WORD                          *  NOTE: ON 'READ' ERRORS, WORD
*     *--------------------------------------*  1 IS LU NUMBER, 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)                         *
*     ----------------------------------------
* 10  * NAME OF CALLING PROGRAM              *
* 11  *    (3 WORDS)                         *
* 12  *                                      *
*     ****************************************
* 
      SUP 
QBUF  DEC 0,0,0,0,0,0,0,0,0  ERROR BUFFER TO QCLM 
      ASC 3,QUEUE            ALONG WITH CALLERS NAME
* 
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
* 
TEMP  NOP 
CLASS NOP 
* THE NEXT TWO WORDS MUST BE IN SEQUENCE FOR XLUEX CALLS
LU2   NOP 
CONWD NOP 
B600  OCT 600 
K1    DEC 1 
K2    DEC 2 
K6    DEC 6 
K12   DEC 12
N64   DEC -64 
D57   DEC 57
F256  OCT 77400 
N4097 DEC -4097 
K17N  OCT 100021
K20N  OCT 100024
CODE  OCT 70736 
ZBIT  OCT 10000 
BIT15 OCT 100000
AIO   ASC 2,IO
A04   ASC 2,04
* 
PRAMS EQU * 
SCODE OCT 0         SECURITY CODE 
LU1   OCT 0         LOGICAL UNIT
DLEN  BSS 1         DATA LENGTH 
RLEN  BSS 1         REQUEST LENGTH
TYPE  BSS 1         ACTION INDICATOR
* 
SIZE  BSS 0 
* 
      END QUEUE 
                                                                                                                                                                                                                                        