ASMB,R,Q,C
*     NAME:   IDGET 
*     SOURCE: 92070-18198 
*     RELOC:  92070-1X198 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (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.        * 
*  **************************************************************** 
* 
* 
      NAM IDGET,6  92070-1X198  REV.1941  790926
      ENT IDGET,ID.A,IDSGA
* 
      EXT $ID#,$IDA,$IDSZ,.ENTP,.ZPRV 
* 
* 
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
      LDA $ID#      NUMBER OF ID SEGMENTS 
      CMA,CLE,INA 
      STA TEMP
      LDB $IDA      ADDRESS OF FIRST ID SEGMENT 
NLP   STB WORK
      ADB =D12
      LDA B,I 
      CPA N1.2,I
      INB,RSS 
      JMP NEXTP     NOT THIS ONE
      LDA B,I 
      CPA N3.4,I
      INB,RSS       SO FAR, SO GOOD 
      JMP NEXTP     NOT THIS ONE
      LDA B,I 
      AND =B177400
      CPA N5
      JMP FND       FOUND IT! 
NEXTP LDB WORK
      ADB $IDSZ 
      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 
                                                            