From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM"  7-SEP-1993 09:16:23.91
To:	EVERHART
CC:	
Subj:	Re: Getting Name Of Parent Procedure

Message-Id: <9309041551.AA24975@uu7.psi.com>
From: simons/G=Colin/S=Sewell/O=H.A.Simons.Ltd/OU=PACIFIC@mhs.attmail.com
Date: 3 Sep 93 16:59:54 GMT
To: info-vax@sri.com
Transport-Options: /STANDARD/REPORT
Subject: Re: Getting Name Of Parent Procedure
Importance: Normal
Content-Type: text

i grabbed this from infovax a while back. i don't believe it needs
CMKRNL priv as stated.

>   From: M.D.Clay ("M. Clay"@"*ID\internet(b)28.721(b)mdc8567"@"8=MD"@"2=ATTMAIL"@"1=US"@ATTMAIL@MORGAN)
>Subject: RE: DCL calling procedure name
>
>Ken Bosward (webosk@itwol.bhp.com.au) asks:
>
>> Hi. Is there any way in a DCL procedure to determine the name of the
>> calling procedure? I know that _f$environment("PROCEDURE")_ returns the
>> name of the current procedure - I want to know the name of the procedure
>> which *called* the current procedure.
>
>Ken, 
>
> After digging around in the VMS listings I came up with the following DCL
> procedure which writes a traceback of called .COM procedures.  I've tested it
> and verified that it works under VAX/VMS V5.4 and V5.5-1.
>
>Enjoy,
>	Michael Clay
>	claym@bcsaic.boeing.com    (206)234-7153
>	Boeing Computer Services   Seattle, WA
>
$!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
$!
$! PROCEDURE: GET_CALLER.COM
$!
$! ABSTRACT:
$!
$!    This code fragment obtains the name of the procedure which called this
$!    procedure.  (Requires CMKRNL privilege.)
$!
$! HISTORY:
$!
$!    15-MAY-1993  MDC  Written by Michael Clay
$!
$!-----------------------------------------------------------------------------
$
$  vms =  f$getsyi("version")
$  fac =  f$parse(f$environment("procedure"),,,"name")
$  pid =  f$getjpi(0,"pid")
$!
$!
$! Define known symbol values ...
$!
$  ctl$ag_clidata =  %x7FFE2A5C   ! From SYS$SYSTEM:SYS.STB
$  ppd$l_prc      =  %x00000008   ! From SYS$SYSTEM:DCLDEF.STB
$  idf_l_lnk      =  %x00000000   ! From SYS$SYSTEM:DCLDEF.STB
$  idf_l_filename =  %x00000068   ! From SYS$SYSTEM:DCLDEF.STB
$!
$!
$! Get value of PRC_L_IDFLNK from DCLDEF.STB (changes with version of VMS) ...
$!
$  temp_file =  "sys$scratch:''fac'_''pid'.tmp"
$  search sys$system:dcldef.stb prc_l_idflnk /format=passall /output='temp_file'
$  close/nolog temp_file
$  open/read temp_file 'temp_file'
$  read temp_file symbols
$  close temp_file
$  delete/nolog 'temp_file';*
$  loc_sym =  f$locate("PRC_L_IDFLNK",symbols)
$  prc_l_idflnk =  f$cvui((loc_sym-5)*8,32,symbols)
$!
$! Traverse IDF list
$!
$  ppd =  ctl$ag_clidata
$  prc =  f$cvui(0,32,f$fao("!AD",4,ppd+ppd$l_prc))
$  idf =  f$cvui(0,32,f$fao("!AD",4,prc+prc_l_idflnk))
$  next_filename:
$     if idf .eq. 0 then goto last_filename
$     filename_ascic =  f$cvui(0,32,f$fao("!AD",4,idf+idf_l_filename))
$     filename_len   =  f$cvui(0,8,f$fao("!AD",1,filename_ascic))
$     filename       =  f$fao("!AD",filename_len,filename_ascic+1)
$     write sys$output " -> ",filename
$     idf =  f$cvui(0,32,f$fao("!AD",4,idf+idf_l_lnk))
$     goto next_filename
$  last_filename:
$  exit