ASMB,R,L
* 
*     DATE: MARCH 15, 1979
*     NAME: XXTD2 
*     SOURCE: 91711-18031 
*     RELOC:  NONE
*     PGMR:  R.T.A. 
* 
*  *******************************************************************
*  * (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 HEWLETT-PACKARD COMPANY.           *
*  *******************************************************************
* 
* 
* 
*ASMB,R,L 
* 02.05.79
* THIS ROUTINE LOADS THE B-REGISTER WITH THE EQT WORD 4 THEN
* CALLS ROUTINE TRMLU TO FIND ITS SYSTEM LU NUMBER. 
* 
* FORTRAN IV      CALL LDARG(INUMB) 
* 
* WHERE           INUMB = 1 WORD
* 
      NAM XXTD2 91711-1X031  REV 1926  791120 
* 
* 
* 
* 
      ENT LDARG 
      ENT X13 
      ENT SHF15 
      ENT SHFT
      ENT SHF14 
      EXT .ENTR 
      EXT TRMLU 
      EXT XLUEX 
EQT4  OCT 0 
ITT   OCT 0 
BYTE  OCT 0 
* 
LDARG NOP 
      JSB .ENTR 
      DEF EQT4
      LDB EQT4,I          GET THE WORD
      JSB TRMLU           FIND SYSTEM LU FOR EQT4 
      DEF *+1 
      STA EQT4,I          SAVE THE INTEGER LU VALUE 
      STB ITT,I           SAVE THE ASCII LU VALUE 
      JMP LDARG,I         RETURN
*     END 
*ASMB,R,L 
* 11.04.79
* THIS ROUTINE REQUESTS STATUS, BYPASSING THE SWITCH TABLE
* 
* FORTRAN IV     CALL X13(ITLU,IE5,IE4,IST) 
* 
* WHERE          ITLU = LU UNDER TEST 
*                IE5  = EQT WORD 5 RETURNED 
*                IE4  = EQT WORD 4 RETURNED 
*                IST  = DRT WORD 1
* 
* 
* 
ITEST NOP 
IEQT5 NOP 
IEQT4 NOP 
IEQST NOP 
* 
X13   NOP 
      JSB .ENTR 
      DEF ITEST 
* 
      LDA ITEST,I 
      STA I2
      LDA .A               SET BIT 15 OF LU UNDER TEST
      IOR I2
      STA I2
* 
      JSB XLUEX            REQUEST STATUS, BYPASSING SST
      DEF RTN 
      DEF I1
      DEF I2
      DEF I3
      DEF I4
      DEF I5
RTN   LDA I3
      STA IEQT5,I 
      LDA I4
      STA IEQT4,I 
      LDA I5               RETURN VALUES ARE FILLED 
      STA IEQST,I 
* 
      JMP X13,I 
I1    DEC 13
I2    OCT 0 
      NOP 
I3    OCT 0 
I4    OCT 0 
I5    OCT 0 
.A    OCT 100000
*     END 
*ASMB,R,L 
* 11.04.79
* THIS ROUTINE CLEARS BITS 14-0, THEN ROTATES BIT 15 TO BIT 0.
* 
* FORTRAN IV      CALL SHF15(INUMB) 
* 
* WHERE           INUMB = 1 WORD
* 
* 
SHF15 NOP 
      JSB .ENTR 
      DEF BYTE
      LDA BYTE,I          GET THE WORD
      AND MSK0            DELETE BITS 14-0.  BIT 15 IS LEFT.
      RAL                 BRING BIT 15 TO BIT 0 
      STA BYTE,I
      JMP SHF15,I 
MSK0  OCT 100000
*     END 
*ASMB,R,L 
* 16.04.79
* THIS ROUTINE MOVES THE UPPER 8 BITS TO THE LOWER 8 BITS IN BYTE.
* THE UPPER 8 BITS ARE THEN CLEARED.
* 
* FORTRAN IV       CALL SHFT(INUMB) 
* 
* WHERE            INUMB = 1 WORD 
* 
* 
SHFT  NOP 
      JSB .ENTR 
      DEF BYTE
* 
      LDB .B         INITIALIZE B REGISTER TO ZERO
      LDA BYTE,I     GET THE UPPER BYTE TO BE SHIFTED 
      LSR 8          MOVE 8 ZEROS FROM B REG TO UPPER 8 BITS OF 
*                    A REGISTER.
      STA BYTE,I     SAVE BYTE
      JMP SHFT,I
.377  OCT 377 
.B    OCT 0 
*     END 
*ASMB,R,L 
* 12.04.79
* THIS ROUTINE MOVES BIT 14 TO BIT 0, FILLING 0'S FROM THE LEFT.
* 
* FORTRAN IV      CALL SHF14(INUMB) 
* 
* WHERE           INUMB = 1 WORD
* 
* 
SHF14 NOP 
      JSB .ENTR 
      DEF BYTE
      LDA BYTE,I          GET THE WORD
      AND MSK1            DELETE BITS 13-0.  BITS 15,14 ARE LEFT. 
      RAL                 BRING BIT 15 TO BIT 0 
      RAL                 BRING BIT 14 TO BIT 0 
      STA BYTE,I
      JMP SHF14,I 
MSK1  OCT 140000
      END 
    