ASMB,R,Q,C
*     NAME:   IDGET 
*     SOURCE: 92071-18198 
*     RELOC:  92071-1X198 
*     PGMR:   HLC,DJN 
* 
* 
*  **************************************************************** 
*  * (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.        * 
*  **************************************************************** 
* 
* 
      NAM IDGET,6  92071-1X198  REV.2041  800428
      ENT IDGET,ID.A,IDSGA
* 
      EXT $ID#,$IDA,$IDSZ,.ENTP,.ZPRV 
      EXT .XLA,.XLB 
* 
* 
A     EQU 0 
B     EQU 1 
* 
N1.2  NOP           SEARCH ID SEGMENTS
IDGET NOP 
IDSGA EQU IDGET 
ID.A  EQU IDGET 
      JSB .ZPRV     SHARABLE ROUTINE
      DEF EXIT
      JSB .ENTP     GET PARAMETER ADDRESS 
      DEF N1.2
      LDB N1.2
      INB 
      STB N3.4
      INB 
      LDA B,I 
      AND =B177400
      STA N5
      JSB .XLA      NUMBER OF ID SEGMENTS 
      DEF $ID#
      CMA,CLE,INA 
      STA TEMP
      JSB .XLB      ADDRESS OF FIRST ID SEGMENT 
      DEF $IDA
NLP   STB WORK
      ADB =D12
      JSB .XLA
      DEF B,I 
      CPA N1.2,I
      INB,RSS 
      JMP NEXTP     NOT THIS ONE
      JSB .XLA
      DEF B,I 
      CPA N3.4,I
      INB,RSS       SO FAR, SO GOOD 
      JMP NEXTP     NOT THIS ONE
      JSB .XLA
      DEF B,I 
      AND =B177400
      CPA N5
      JMP FND       FOUND IT! 
NEXTP JSB .XLB
      DEF $IDSZ     GET SIZE
      ADB WORK
      ISZ TEMP
      JMP NLP       TRY NEXT ID 
      CLA,CCE,RSS   INDICATE NOT FOUND
FND   LDA WORK     ID SEGMENT ADDRESS IN A
      CLB 
EXIT  JMP IDGET,I 
      DEF IDGET 
* 
N3.4  NOP 
N5    NOP 
WORK  NOP 
TEMP  NOP 
      END 
                                                                                                                                                                                      