ASMB,R,L,C
      HED (FMGR) P.NAM: RETURN PROGRAM'S NAME 
*     NAME:   P.NAM 
*     SOURCE: 92071-18362 
*     RELOC:  92071-1X362 
*     PGMR:   E.D.B.
* 
*  **************************************************************** 
*  * (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 P.NAM,7 92071-1X362 REV.2041 800430 
* 
      ENT P.NAM 
* 
      EXT $IDA, $ID#, $IDSZ 
      EXT .ENTR, .XLD 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     CALLING SEQUENCE: 
* 
*     CALL P.NAM(IBUF,IDSEG)
* 
*     WHERE:
* 
*     IBUF   WILL BE THE PROGRAM NAME (3-WORD ARRAY) FROM 
*            THE SPECIFIED ID SEGMENT 
* 
*     IDSEG  IS THE ID SEGMENT NUMBER 
      SKP 
* 
*     ENTRY 
* 
IBUF  NOP 
IDSEG NOP 
* 
P.NAM NOP 
      JSB .ENTR 
      DEF IBUF
* 
      CCA           GET A -1
      ADA IDSEG,I    ADD ID SEGMENT NUMBER
      STA TMP 
      JSB .XLD      GET NUMBER OF ID SEGMENTS 
      DEF $ID#+0
      CMA,INA        NEGATE 
      ADA TMP         ADD ID SEGMENT NUMBER 
      SSA,RSS       IF OUT OF RANGE,
      JMP BADID      THEN TREAT AS BAD SEGMENT NUMBER 
* 
      JSB .XLD      GET ID SEGMENT SIZE 
      DEF $IDSZ+0 
      MPY TMP       CALCULATE OFFSET
      ADA .12        TO PROGRAM NAME
      STA TMP         AND SAVE
      JSB .XLD      GET SEGMENT TABLE STARTING ADDRESS
      DEF $IDA+0
      ADA TMP        ADD OFFSET 
      STA TMP         AND SAVE
* 
      JSB .XLD      GET FIRST TWO CHARACTERS
      DEF A,I 
      STA IBUF,I     SAVE IN USER BUFFER
      ISZ IBUF
      ISZ TMP 
* 
      LDA TMP 
      JSB .XLD      GET MIDDLE TWO CHARACTERS 
      DEF A,I 
      STA IBUF,I     SAVE IN USER BUFFER
      ISZ IBUF
      ISZ TMP 
* 
      LDA TMP 
      JSB .XLD      GET LAST CHARACTER
      DEF A,I 
      AND C377       ISOLATE IT 
      IOR B40         MERGE WITH BLANK
      STA IBUF,I       SAVE IN USER BUFFER
* 
      CLA           SET FOR GOOD RETURN 
      JMP P.NAM,I 
* 
BADID CCA           SET FOR BAD RETURN
      JMP P.NAM,I 
* 
*     STORAGE AREA
* 
.12   DEC 12
* 
B40   OCT 40
C377  OCT 177400
* 
TMP   NOP           TEMPORARY STORAGE 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
    