ASMB,R,L,C
      HED "ICLRW" CLASS READ/WRITE ROUTINE 4-78 (DLB) 
      NAM ICLRW,6 PRE-REL 780509 (DLB) RTE-IV 
      ENT ICLRW 
      EXT .ENTP,.XSB,.XLA,EXEC
      EXT $LIBR,$LIBX,KYBRD 
      SPC 1 
A     EQU 0 
B     EQU 1 
      SPC 1 
* PURPOSE:
*  THIS ROUTINE WILL DO FOOLPROOF CLASS I/O FOR A SET OF
*  PROGRAMS THAT TALK TO MULTIPLE TERMINALS IN A NON-STOP 
*  FASHION.  (I.E. MTM & THE LID SESSION MONITOR ETC.)
*  TO USE THIS SUBROUTINE, A TERMINAL AND A PRE-ASSIGNED
*  WORD IN SYSTEM MEMORY FOR SAVING CLASS NUMBER MUST BE
*  DEFINED.  THIS ROUTINE ESTABLISHES A CONSISTENT METHOD OF
*  PASSING PARAMETERS AND I/O AROUND A SET OF GLOBAL (NON-SESSION)
*  PROGRAMS FOR THE PURPOSE OF SUPPORTING A SESSION MONITOR 
*  IN AN RTE II, III & IV SYSTEM. 
* 
* FEATURES: 
*  1)  "ICNWD" IS THE PARAMETER THAT IS USED TO PASS THE TERMINAL 
*      LU OF A SESSION FROM PROGRAM TO PROGRAM & I/O DEVICE.
*  2)  "ISTBL" IS THE PARAMETER THAT IS USED TO PASS THE ADDRESS
*      IN THE SYSTEM MAP FOR A PETICULAR SESSION TABLE ENTRY. 
*  3)  THIS SUBROUTINE IS "NON-STOP".  THIS MEANS THERE IS
*      NO LACK OF A RESOURCE OR CONDITION OF AN I/O DEVICE
*      THAT CAN STOP OR PREVENT IMMEDIATE RETURN TO THE 
*      CALLER.  THE A-REG WILL RETURN 0 IF SUCCESSFUL EXECUTION 
*      OR A NEGATIVE NUMBER NOTING THE REASON FOR FAILURE.
* 
*  THIS ROUTINE WILL CHECK FOR THE FOLLOWING ERROR CONDITIONS:
* 
*  1)  NOT ENOUGH S.A.M TO PROCESS THE REQUEST
*  2)  DEVICE LU/EQT IS DOWN. 
*  3)  AN LU LOCK ON TERMINAL WILL NOT STOP THE I/O 
*  4)  GET A NEW CLASS NUMBER IF THE PASSED ADDRESS 
*      DOES NOT POINT TO A LEGAL ONE AND PUT THE NEWLY
*      ALLOCATED NUMBER IN THAT MEMORY LOCATION. (NOTE: 
*      THE ADDRESS MUST POINT TO MEMORY IN SYSTEM MAP!) 
*  5)  WILL NOT WAIT FOR A NEW CLASS NUMBER IF REQUIRED.
*  6)  TEST IF "ICNWD" IS A TERMINAL. 
* 
* CALLED: 
* 
*  BUFFER PASS   DEVICE READ     DEVICE WRITE   DEVICE CONTROL
*   JSB ICLRW     JSB ICLRW       JSB ICLRW      JSB ICLRW
*   DEF *+7       DEF *+7         DEF *+7        DEF *+5 OR 6 
*   DEF ZERO      DEF ONE         DEF TWO        DEF THREE
*   DEF CLADR     DEF CLADR       DEF CLADR      DEF CLADR
*   DEF ICNWD     DEF ICNWD       DEF ICNWD      DEF ICNWD
*   DEF ISTBL     DEF ISTBL       DEF ISTBL      DEF ISTBL
*   DEF IBUFR     DEF ZERO        DEF IBUFR      DEF IPARM (OPT)
*   DEF IBUFL     DEF IBUFL       DEF IBUFL      <RETURN> 
*   <RETURN>      <RETURN>        <RETURN>
* 
* WHERE:
*  ZERO  = WRITE TO CORE,  CLASS GET PROGRAM PROCESSES AS READ. 
*  ONE   = DEVICE READ,    CLASS GET PROGRAM PROCESSES AS READ. 
*  TWO   = DEVICE WRITE,   CLASS GET PROGRAM IGNORES. 
*  THREE = DEVICE CONTROL, CLASS GET PROGRAM IGNORES. 
*  CLADR = POINTER TO ADDRESS OF CLASS WORD IN SYSTEM MAP.
*          (CLASS WORD MUST BE IN SYSTEM MAP AND MAY BE BELOW FENCE.) 
*          (SOOOOOO BE VERY CAREFULL ABOUT WHERE THIS POINTS!!!!!!!!) 
*  ICNWD = LOGICAL UNIT OF SESSION + CONWD BITS IF DEVICE ACCESS. 
*          (ALSO PASSED AS 1ST OPTION WORD FOR CLASS GET CALL)
*          MUST!! BE KEYBOARD DEVICE (DVR00 OR DVR05) 
*  ISTBL = POINTER TO ADDRESS OF SESSION PROGENITOR PROGRAM.
*          (OR MORE SIMPLY, 2ND OPTION WORD FOR CLASS GET CALL) 
*  IBUFR = OUTPUT BUFFER OR OPTIONAL PARAMETER FOR DEVICE CONTROL 
*  IBUFL = OUTPUT BUFFER LENGTH OR MAX INPUT BUFFER LENGTH
* 
* ERRORS:   RETURN IN A-REG ONLY
* 
*   0 =  NO ERROR 
*  -1 = NO CLASS NUMBER AVAILABLE 
*  -2 = NO MEMORY NOW OR BUFFER LIMIT EXCEEDED
*  -7 = TERMINAL DEVICE IS DOWN 
*  -6 = SPECIFIED LU IS NOT A TERMINAL
*  -5 = ICODE IS NOT 0 TO 3 
      SPC 1 
TDB   NOP 
D14   DEC 14
      NOP 
RNUMB NOP           CURRENT LOCAL CLASS WORD
DCLAS NOP           ADDRESS OF CLASS WORD IN SYSTEM MAP 
ICWRD NOP           ADDRESS OF CURRENT CLASS LU 
LU    NOP           CURRENT LOGICAL UNIT NUMBER 
CLASS NOP           CURRENT CLASS NUMBER
      SPC 1 
ICODE NOP           REQUEST CODE 0 - 3
CLADR NOP           ADDRESS OF ADDRESS OF CLASS WORD
ICNWD NOP           I/O LU, SESSION LU & 1ST OPTION WORD
ISTBL NOP           ADDRESS OF ADDRESS OF PROGENITOR & 2ND OPTION WORD
IBUFR NOP           I/O BUFFER OR IPRAM IF EXEC(3.. 
IBUFL NOP           BUFFER LENGTH -CHARS, +WORDS
ICLRW NOP           ENTRY POINT 
      JSB $LIBR     MAKE THIS ROUTINE RE-ENTRENT
      DEF TDB       BUT IT CANNOT BE RE-ENTERED!! 
      JSB .ENTP     GET PARAMETER ADDRESSES 
      DEF ICODE     TOP OF LIST 
      JSB $LIBR     GO PRIVLEDGE TO PREVENT RE-ENTRY
      NOP 
      STA TDB+2     SAVE RETURN ADDRESS 
      LDA DZERO     GET A DEF TO A ZERO 
ICLR1 CPB DFENT     CHECK IF MORE UNPASSED PARAMS 
      JMP ICLR2     NO, CONTINUE
      STA B,I       STORE DEF'S TO ZERO 
      INB           IN UN-PASSED PARAMETERS 
      JMP ICLR1     CONTINUE
      SPC 1 
ICLR2 LDA ICODE,I   GET THE REQUEST CODE
      AND O3        CHECK IF IN BOUNDS
      CPA ICODE,I   CHECK IF CHANGED
      RSS           OK, 0 - 3 
      JMP RQERR     NO, REQUEST CODE ERROR
      LDB ICNWD     GET DEF TO CONTROL WORD 
      SZA,RSS       CHECK IF = 0
      LDA O4        CHANGE 0 TO 20
      CPA O4        CHECK IF WAS = 0
      LDB DZERO     GET A DEF TO ZERO 
      STB ICWRD     SAVE FOR CALL EXEC
      LDB DFCLA     GET A DEF TO CLASS
      CPA O3        CHECK IF CONTROL REQUEST
      STB IBUFL     YES, PUT CLASS WORD AT 4TH PARM 
      ADA NA16      FORM EXEC REQUEST CODE
      STA ICODE     AND SAVE FOR EXEC CALL
      JSB KYBRD     CHECK IF LEGAL TERMINAL?
      DEF *+3 
      DEF ICNWD,I 
      DEF RNUMB     ALSO EXTRACT LU LOCK OVERRIDE WORD
      SSA           CHECK IF ANY ERRORS?
      JMP LUERR     YES, ERROR EXIT 
      STA LU        SAVE LOGICAL UNIT NUMBER
      LDA CLADR,I   GET THE CLASS NUMBER ADDRESS
      STA DCLAS     SAVE FOR POSSIBLE STORE 
      JSB .XLA      GET THE POSSIBLE CLASS NUMBER 
      DEF DCLAS,I   FROM THE SYSTEM MAP 
      CCE,RSS       SKIP 1ST TIME 
BADCL CLA,CCE       BAD CLASS NUMBER, GET ANOTHER ONE 
      RAL,ERA       MERGE IN NO WAIT BIT
      STA CLASS     SAVE FOR LOCAL USE
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
      JSB EXEC
      DEF *+10
      DEF ICODE     NA17, NA18, NA19 OR NA20
      DEF ICWRD,I  LOGICAL UNIT OF I/O
      DEF IBUFR,I   BUFFER ADDRESS
      DEF IBUFL,I   BUFFER LENGTH 
      DEF ISTBL,I   ADDRESS OF PROGENITORS NAME 
      DEF LU        PASS TERMINAL LU THRU CLASS PARAMETERS
DFCLA DEF CLASS     THE IN LIBRARY ENTRY FOR HOLDING CLASS #
DZERO DEF ZERO      PLACE HOLDER FOR LU LOCK OVERRIDE 
      DEF RNUMB     RN NUMBER OF PUSH THRU
*  DESIGN IN A LITTLE AIR IN CASE ABORT EXIT IS NOT FROM A BAD CLASS #
      LDA NA16      BAD CLASS NUMBER, GET ANOTHER ONE 
      JSB $LIBR     TURN OFF INTERRUPTS 
      OCT 0 
      CPA NA16      CHECK IF BAD CLASS NUMBER 
      JMP BADCL     YES, GO TRY FRESH 
      LDB CLASS     NOW PUT CLASS NUMBER BACK 
      JSB .XSB      IN ITS PROPER PLACE 
      DEF DCLAS,I   IN THE SYSTEM MAP 
EEXIT JSB $LIBX     EXIT A=0 >> GOOD EXIT 
      DEF *+1 
      DEF *+1 
      JSB $LIBX 
      DEF TDB 
ZERO  DEC 0 
      SPC 1 
RQERR CLA,CCE       ERROR -5
LUERR ADA OM5       ERROR -6 OR -7
      JMP EEXIT     AND EXIT
      SPC 1 
O3    OCT 3 
O4    OCT 4 
OM5   OCT -5
NA16  ABS 16+100000B
DFENT DEF ICLRW 
      END 
                                                                                                                                                                                                                                                      