ASMB,C,Q
      NAM IBLU5,7 92425-16050 REV.2001 791204 
* 
*---------------------------------------------------------------
* 
*     RELOC.     92425-16050
*     SOURCE     92425-18050
* 
* 
*     HP 92425C TEST SYSTEM SOFTWARE IS THE PROPRIETARY 
*     MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND 
*     DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT. 
* 
*     (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 THE HEWLETT-PACKARD COMPANY. 
* 
*---------------------------------------------------------------
* 
* 
* 
* DESCRIPTION:
* 
* THIS IS A FORTRAN CALLABLE INTEGER FUNCTION USED TO RETURN THE LU NUMBER
* ASSIGNED TO EQT SUBCHANNEL 0 FOR ANY OTHER LU NUMBER ON THE SAME EQT. 
* 
* IT'S USE COULD BE TO FIND THE LU NUMBER OF AN HPIB CONTROL CARD 
* SO A REMOTE ENABLE CONTROL CALL COULD BE ISSUED TO THAT CARD. 
* 
* 
* PARAMETERS: 
* 
* THERE IS ONE INTEGER PARAMETER PASSED TO THE FUNCTION.
*    THIS PARAMETER IS THE AUTO-ADDRESS LU NUMBER OF AN HPIB DEVICE.
* THERE IS ONE INTEGER PARAMETER RETURNED BY THE FUNCTION.
*    THIS PARAMETER IS THE LU NUMBER FOR SUBCHANNEL 0 OF THE
*    EQT OF THE AUTO-ADDRESSED LU NUMBER. 
* BOTH PARAMETERS ARE SESSION LU'S IF IN SESSION OR SYSTEM LU'S 
*    IF NOT IN SESSION AS DETERMINED BY SYSTEM UTILITY SESSN (ID).
* 
* 
* ERRORS: 
* 
* THIS FUNCTION HAS ONE ERROR RETURN.  IF NO LU IS FOUND CORRESPONDING TO 
* SUBCHANNEL-0 OF THE EQT, OR THE PARAMETER LU IS OUTSIDE THE DRT RANGE,
* OR THE PROGRAM IS IN SESSION AND A SESSION LU CANNOT BE FOUND,
* ZERO IS RETURNED. 
* 
* 
* 
* CALLING SEQUENCE: 
* 
*     FORTRAN CALLING SEQUENCE: 
*         . 
*         . 
*         . 
*C     SET THE LU NUMBER OF AN HPIB AUTO-ADDRESS DEVICE 
*      LU1=33 
*C     GET THE NON-AUTO-ADDRESS LU NUMBER 
*C
*      LU0=IBLU0(LU1) 
*C
*C     CHECK FOR ERROR
*      IF(LU0.EQ.0) GOTO 900
*C     DO AN HPIB REMOTE ENABLE 
*      CALL EXEC(100003B,1600B+LU0) 
*C     ERROR RETURN 
*      GOTO 900 
*C     NORMAL RETURN
*        .
*        .
*        .
* 
* 
      HED IBLU0 
*     ASSEMBLER CALLING SEQUENCE: 
*         . 
*         . 
*      EXT IBLU0,EXEC 
*         . 
*      LDA =D33      GET THE AUTO-ADDRESS LU NUMBER 
*      STA LUNUM     SAVE IT. 
*      JSB IBLU0     JUMP SUB TO FUNCTION.
*      DEF *+2
*      DEF LUNUM     AUTO-ADDRESS LU NUMBER.
*      SZA,RSS       ERROR? 
*      JMP ERPNT     YES, PROCESS ERROR 
*      ADA =B1600    NO, ADD THE REMOTE ENABLE COMMAND. 
*      STA LUN00     SAVE THE SUBCHAN-0 LU NUMBER.
*      JSB EXEC 
*      DEF *+3
*      DEF CNWRD
*      DEF LUN00
*      JMP ERPNT     ERROR RETURN.
**                   NORMAL RETURN. 
*         . 
*         . 
*LUN00 NOP           TEMP STORAGE FOR HPIB LU NUMBER
*CNWRD OCT 100003    EXEC CONTROL COMMAND 
*LUNUM NOP           TEMP STORAGE FOR AUTO-ADDRESS DEVICE LU NUM
* 
      SKP 
      ENT IBLU0 
      EXT .ENTR,LUTRU,SESSN 
      SPC 1 
LU    NOP 
IBLU0 NOP 
      JSB .ENTR 
      DEF LU
* 
      JSB SESSN     CHECK IF IN SESSION.
      DEF *+2 
      DEF XEQT      INDICATE ID SEGMENT OF CURRENT PROGRAM. 
      STB SSTA      SAVE THE SWITCH TABLE ADDRESS.
      ERA 
      STA SESSF     SAVE THE IN SESSION FLAG. 
* 
      JSB LUTRU   GET SYSTEM LU 
      DEF *+2     THIS LU WILL BE USED TO SEARCH THE DRT. 
      DEF LU,I
      STA B 
      ADB M1        ADJUST LU FOR INDEXING INTO DRT.
      SSB           INDEX VALUE NEGATIVE? 
      JMP ERR         YES 
* 
      LDA 1653B     GET THE DRT TABLE LENGTH
      CMA,INA        NEGATE 
      STA LUMAX       AND SAVE IT.
      ADA B         SUBTRACT DRT LENGTH FROM INDEX. 
      SSA,RSS       INDEX TOO BIG?
      JMP ERR         YES 
* 
      LDA 1652B     GET THE DRT POINTER 
      STA DRT        AND SAVE IT. 
* 
      ADB A          GET THE EQT NUMBER OF LU 
      LDA B,I 
      AND =B77      MASK FOR EQT
      SZA,RSS       EQT ASSIGNED? (EQT.NE.0?) 
      JMP ERR         NOPE. 
* 
      STA EQT       THEN SAVE IT. 
* 
      CLB           SET STARTING INDEX FOR EQT SUB 0
      STB DRTIN      SEARCH TO ZERO.
* 
AGAIN LDA DRT,I     GET THE NEXT DRT ENTRY. 
      AND =B174077  MASK FOR EQT. 
      CPA EQT       EQT'S MATCH?
      JMP BINGO       YES.
SDRTC ISZ DRT       BUMP LU POINTER,
      ISZ DRTIN      DRT INDEX
      ISZ LUMAX       AND END OF LIST COUNT. SKIP ON END. 
      JMP AGAIN     ELSE...TRY, TRY AGAIN.
      JMP ERR       ERROR. NO SUBCHANNEL 0. 
* 
BINGO LDA DRTIN     MOVE DRT INDEX TO A REG.
* 
      LDB SESSF     GET SESSION FLAG. 
      SSB,RSS       IN SESSION? (SAVED E BIT = 0) 
      JMP SWSST     YES. GO SEARCH SWITCH TABLE.
* 
      INA           NO. CONVERT DRT INDEX TO LU.
      JMP IBLU0,I   RETURN TO CALLING PROGRAM 
* 
SWSST LDB SSTA      GET SWITCH TABLE ADDRESS. 
      STB SSTAP     INITIALIZE SWITCH TABLE POINTER 
      XLB SSTA,I    GET SWITCH TABLE LENGTH.
* 
      ALF,ALF       POSITION SYSTEM LU TO UPPER 8 BITS
      STA LUSYS      AND SAVE. (ACTUALLY LU - 1)
* 
SLOOP ISZ SSTAP     GO TO NEXT ENTRY IN SWITCH TABLE
      XLA SSTAP,I 
      AND B1774     MASK TO GET UPPER BYTE. 
* 
      CPA LUSYS     FOUND SYS LU? 
      JMP LUFND     YES. LU HAS BEEN FOUND
* 
SSCNT INB,SZB,RSS   END OF SWITCH TABLE?
      JMP SDRTC     YES. CONTINUE SEARCHING DRT.
* 
      JMP SLOOP     NO. CHECK NEXT ENTRY IN SST.
* 
LUFND XLA SSTAP,I   CHECK LEGALITY OF FOUND LU. 
      AND B377      SESSION LU IS LOWER BYTE. 
* 
      INA           INCREMENT TO GET TRUE LU. 
      STA LUSES 
* 
      JSB LUTRU 
      DEF *+2 
      DEF LUSES 
* 
      ADA M1       SUBTRACT 1 FROM SYSTEM LU. 
      CPA DRTIN    DOES SYS LU FROM DRT MATCH LUTRU?
      RSS          YES. 
      JMP SDRTC    NO. CONITINUE SEARCH IN DRT. 
* 
      LDA LUSES    GET SESSION LU.
      JMP IBLU0,I  RETURN TO CALLING PROGRAM. 
ERR   CLA           OOPS...ERROR RETURN.
      JMP IBLU0,I    FOUND LU NUMBER. 
      SPC 2 
LUMAX NOP 
LUSYS NOP 
LUSES NOP 
DRT   NOP 
DRTIN NOP 
EQT   NOP 
SSTA  NOP 
SSTAP NOP 
SESSF NOP 
B377  OCT 377 
B1774 OCT 177400
M1    DEC -1
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      END 
                                                                                                                                                                                                                            