ASMB,R,L,C
      HED "IDGET" FTN/SPL FUNCTION TO FIND IDSEG ADDRESS OF PROG
*     SOURCE: 92067-18298 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   D.L.B.,C.M.M. 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 92067-1X298 REV.2013 790314 
      ENT IDGET,ID.A,IDSGA
      EXT .ZPRV 
*  CALLED:
*      IDSEG = IDGET(NAME)
*  WHERE: 
*      NAME   = THREE WORD ASCII (5 CHARS) BUFFER WITH NAME OF PROG 
*      IDSEG = THE ID SEGMENT ADDRESS OF THE NAME 
*  RETURN:
*      A-REG = ID SEGMENT ADDRESS OF NAME IF FOUND OR = 0 IF NOT FOUND
*      E-REG = 0 IF NAME FOUND OR = 1 IF NOT FOUND. 
*      B-REG = 0
* 
*  NOTE:  IF NAME IS NULL THEN FIND BLANK IDSEG ADDRESS.
      SPC 1 
IDGET NOP           ENTRY FTN CALLING SEQUENCE
IDSGA EQU IDGET 
ID.A  EQU IDGET 
* 
      JSB .ZPRV     DO THE $LIBR THING
      DEF LIBX
      ISZ IDGET     AVOID .ENTR,.DFER 
      LDB IDGET     GET NAME ADDRESS
      LDB B,I       GET NEXT LEVEL
      RBL,CLE,SLB,ERB TRACK DOWN INDIRECTS
      JMP *-2 
      STB NAME      AND SAVE FOR LATER USE
      INB           BUMP TO 2ND WORD IN NAME
      STB NAME+1    SAVE ADDRESS OF NAME(2) 
      INB           BUMP TO LAST CHAR 
      LDA B,I       PICK UP 
      AND OM400     NULL LAST CHAR
      STA NAME+2    SAVE VALUE OF NAME(3) 
      LDB KEYWD     GET KEYWORD POINTER ON BASE PAGE
      STB POINT     SAVE TEMP 
      RSS           SKIP THE ISZ 1ST TIME 
LOOP  ISZ POINT     BUMP TO NEXT IDSEG ADDRESS
      XLB POINT,I   GET IDSEG ADD OF NEXT PROG
      CCE,SZB,RSS   CHECK IF LAST ENTRY 
      JMP ENDTA     YES, NOT FOUND PROGRAM
      ADB D12       POINT TO PROGRAM NAME AREA
      XLA B,I       GET CHARS 1 & 2 
      CPA NAME,I    EQUAL ? 
      INB,RSS       YES, CHECK NEXT 2 
      JMP LOOP      NO, TRY NEXT PROGRAM
      XLA B,I       GET CHARS 3,4 
      CPA NAME+1,I  EQUAL?
      INB,RSS       YES, BUMP AGAIN 
      JMP LOOP      NO, TRY NEXT PROGRAM
      XLA B,I       GET LAST CHAR 
      AND OM400     MASK TO 5TH CHAR
      CPA NAME+2
      CLB,CLE,RSS   FOUND!!!! 
      JMP LOOP      TRY NEXT PROG 
ENDTA XLA POINT,I   RETURN A= IDSEG ADDRESS 
      ISZ IDGET     SET RETURN POINT E=FOUND FLAG 
LIBX  JMP IDGET,I   P+3 
      DEF IDGET     FOR JSB $LIBX 
      SPC 1 
NAME  REP 3 
      NOP 
POINT NOP 
OM400 OCT -400
D12   DEC 12
KEYWD EQU 1657B 
B     EQU 1 
      END 
            