From: system@SendSpamHere.ORG
Sent: Friday, January 28, 2000 8:03 AM
To: Info-VAX@Mvb.Saic.Com
Subject: RE: Finding out the filename of the calling DCL procedure.

In article <2000Jan27.115353.1@eisner>, briggs@eisner.decus.org writes:
>In article <F150836441C5D311A11700508B6FF01A051427@bdant024.bda.bobda.com>, "Boyle, Darren" <boyledj@bankofbermuda.com> writes:
>> Not sure if this will give you what you want, but you may want to
>> investigate the lexicals   F$ENVIRONMENT with either "PROCEDURE" as the item
>> or DEPTH to see how many levels of "@" you are really in, short of that do a
>> SET PROC/NAME='F$ENVIRONMENT("PROCEDURE")' and obtain this with F$GETJPI.
>> 
>> Just a pointer, not sure if it's what you want but you should be able to
>> figure it out from there.
>> - Darren
>
>He's after the name of the caller of the current procedure, not the name
>of the current procedure.
>
>Internally, DCL closes out the calling command procedure beforing
>opening the called procedure.  So you can't get the caller name by
>looking at open files or PPF logical names.  What you'd have to do
>would be to chase through DCL data structures to find where the
>calling file name (or volume name/file ID) is cached.  Clearly it's
>buried in there somewhere because the calling procedure has to be
>re-activated when the called procedure terminates.
>
>A sufficiently recent version of SYMBOL might do it for you.  Brian,
>you out there?
>
>	John Briggs		briggs@eisner.decus.org

Took me a while but I located the procedure Mr. Cantor posted and I
modified it to use the latest and greatest version of SYMBOL; thus,
is can be used on VAX and Alpha without modification if SYMBOL has
been installed.  Here is what this porcedure would look like using
SYMBOL.  Note, if you can find the original Dave posted, there is
no more need for temporary files, etc.

$!
$! PROCEDURE: GET_CALLER.COM
$!
$! ABSTRACT:
$!
$!    This code fragment obtains the name of the procedure which called this
$!    procedure.
$!
$!From: Ken Bosward <bosward.ken.kw@bhp.com.au>
$!Newsgroups: comp.os.vms
$!Subject: DCL Tricks
$!Date: Fri, 01 Nov 1996 12:35:58 +1000
$!Message-ID: <3279620E.3091@bhp.com.au>
$!
$! HISTORY:
$!
$!    15-MAY-1993  MDC  Written by Michael Clay
$!     1-Nov-1996  Ken Bosward, clean up temporary file
$!    06-Nov-1996  Dave Cantor, shorten report code using !AC
$!                      Added nesting level
$!
$!-----------------------------------------------------------------------------
$
$  fac =  f$parse(f$environment("procedure"),,,"name")
$  pid =  f$getjpi(0,"pid")
$!
$!
$! Define known symbol values ...
$!
$  SYMBOL/SET/LOCAL/EXECUTIVE CTL$AG_CLIDATA
$  SYMBOL/SET/LOCAL/EXECUTIVE PPD$L_PRC
$  SYMBOL/SET/LOCAL/EXECUTIVE IDF_L_LNK
$  SYMBOL/SET/LOCAL/EXECUTIVE IDF_L_FILENAME
$  SYMBOL/SET/LOCAL/EXECUTIVE PRC_L_IDFLNK
$ 
$!
$! 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))
$  lev =  f$environment("depth")
$  next_filename:
$     if idf .eq. 0 then goto FINISH
$     write sys$output -
       f$fao(" !2UL ->!AC",lev,f$cvui(0,32,f$fao("!AD",4,idf+idf_l_filename)))
$     idf =  f$cvui(0,32,f$fao("!AD",4,idf+idf_l_lnk))
$     lev = lev - 1
$     goto next_filename
$!
$FINISH:


--
VAXman- OpenVMS APE certification number: AAA-0001           VAXman@TMESIS.COM