ASMB
  HED  FLUSH A CLASS I/O  (RTE-III/IV)  F. GAULLIER   15/APR/77 
      NAM KLCLS,7 . 92903-16001 REV.1805  780112
* 
*     SOURCE 92903-18036
* 
      SPC 2 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
      SPC 2 
* 
*     THIS ROUTINE DO A COMPLETE CLEAN UP OF A CLASS I/O
*     AND TERMINATE BY RELEASING THE CLASS. 
*     WHEN SOME I/O DEVICE HAVE NOT COMPLETED THEIR OPERATIONS
*     A TIMEOUT OF 10 MSEC IS FORCED TO THESE PERIPHERALS IN
*     ORDER TO GET THE CLASS BUFFER AND RELEASE THE SAM.
* 
*     CALLING SEQUENCE: 
* 
*        IF ( KLCLS(ICLAS) )  GOTO ERROR
*             ICLAS IS THE CLASS NUMBER 
* 
  SPC 2 
A     EQU 0 
B     EQU 1 
      SUP PRESS EXTENDED LISTING
  SPC 1 
      EXT EXEC,$LIBR,$LIBX,.ENTR
      ENT KLCLS 
  SPC 2 
$OFF  NOP 
      JSB $LIBR 
      OCT 0         PRIVILEDGE ROUTINE
      JMP $OFF,I
  SPC 1 
$ON   NOP 
      JSB $LIBX     EXIT FROM PRIVILEDGE ROUTINE
      DEF $ON 
  SPC 2 
.CL#  NOP           CLASS I/O WORD
KLCLS NOP 
      JSB .ENTR 
      DEF .CL#
* 
      LDA .CL#,I
      AND MSK       CLEAR  BITS 15-14-13
      SZA,RSS 
      JMP OKRTN 
      STA CLASW     SAVE CLASS I/O WORD 
      JSB EXEC      DO A WRITE/READ CLASS I/O 
      DEF *+8 
      DEF NAB20     WRITE/READ - NO ABORT 
      DEF D0
      DEF *         DUMMY BUF 
      DEF D1        DUMMY LEN 
      DEF *         DUMMY PARAMETERS
      DEF *         DUMMY PARAMETERS
      DEF CLASW     CLASS WORD
      JMP REL50     ERROR ! CHECK IT IS "IO 00" 
* 
      LDA CLASW     RECALL CLASS WORD 
      IOR BIT15     SET "NO WAIT BIT" 
      STA CLASS 
  SPC 1 
RELC3 JSB EXEC      GET TO DE-ALLOCATE
      DEF *+5 
      DEF NAB21     GET CLASS - NO ABORT
      DEF CLASS     CLASS WORD
      DEF TEMP      DUMMY BUFFER
      DEF D1
      JMP REL50     ERROR RETURN CHECK CODE 
      SSA,RSS 
      JMP RELC3     LOOP UNTIL END OF CLASS 
  SPC 1 
      STA #RQ       SAVE -(N-1) REQUEST IN QUEUE
      CMA,SZA,RSS   # OF REQUEST IN QUEUE 
      JMP OKRTN     CLASS IS EMPTY, EXIT. 
  SPC 1 
      LDA EQTA      GO THROUGH ALL EQT TO FORCE A TO
      STA EQTPT     ON ALL DEVICES WAITTING ON THIS CLASS 
      LDA EQT#
      CMA,INA 
      STA EQTCT 
  SPC 1 
REL20 XLA EQTPT,I   GET EQT1
      SZA,RSS       EQT BUSY ?
      JMP REL24     NO, GOTO NEXT ONE 
      SSA 
      HLT 
      INA           GET 2ND WORD OF SAM BUFFER
      STA TEMP
  SPC 1 
**********************************  PRIVILEDGE MODE 
      JSB $OFF
      XLA TEMP,I    GET WORD 2
      RAL 
      SSA,SLA,RSS   T FIEL = 3 ?
      JMP REL22     NO, FORGET IT 
      LDA TEMP      YES, IT IS A CLASS REQUEST
      ADA D3        GO CHECK CLASS WORD 
      XLA A,I       GET CLASS WORD FROM SAM BUFFER
      AND MSK 
      CPA CLASW     BELONG TO THIS CLASS ?
      RSS           YES, GO SET A TIME OUT
      JMP REL22     NO, SKIP SET TIME OUT CODE
      LDA EQTPT     RECALL EQT1 
      ADA D14 
      CCB           SET A TIMEOUT OF
      STB A,I       10 MSEC INTO EQT15
      ISZ #RQ       UPDATE # OF PENDING RQ (NEVER SKIP !!)
REL22 JSB $ON 
**********************************  PRIVILEDGE MODE $END
  SPC 1 
REL24 LDA #RQ       RECALL -(N-1) REQUEST LEFT IN THE QUEUE 
      CMA,SZA,RSS   ALL PENDING REQUEST FOUNDED ? 
      JMP REL30     YES, GO GET THEM
* 
      LDA EQTPT     GOTO NEXT EQT 
      ADA D15 
      STA EQTPT 
      ISZ EQTCT     MORE EQT ?
      JMP REL20     YES, CONTINUE 
* 
REL30 LDA =D-12000  NO, WAIT ABOUT
      ISZ A         30 MS ON XE 
      JMP *-1       BEFORE
      JMP RELC3     GETTING CLASS REQUESTS
  SPC 2 
REL50 CPA ASCIO     CHECK THAT IT IS "IO 00"
      RSS 
      JMP ERRTN     ERROR RETURN
      CPB ASC00 
      JMP OKRTN     OK, RETURN TO USER
ERRTN CCA           ERROR RETURN
      JMP KLCLS,I 
  SPC 1 
OKRTN CLA           EXIT WITH A = 0 
      JMP KLCLS,I 
   SPC 3
NAB20 OCT 100024
NAB21 OCT 100025
ASCIO ASC 1,IO
ASC00 ASC 1,00
EQTA  EQU 1650B 
EQT#  EQU EQTA+1
  SPC 1 
D0    DEC 0 
D1    DEC 1 
D3    DEC 3 
D14   DEC 14
D15   DEC 15
BIT15 OCT 100000
MSK   OCT 17777 
CLASS EQU .CL#
CLASW NOP 
TEMP  EQU $ON 
#RQ   NOP 
EQTPT NOP 
EQTCT NOP 
      END 
      