From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM"  6-MAY-1994 11:36:44.07
To:	EVERHART
CC:	
Subj:	Re: DCL parameters

Date: 6 May 94 08:43:00 CST
From: "SL1001::I000005" <I000005%SL1001.decnet@mdcgwy.mdc.com>
Subject: Re: DCL parameters
To: "INFO-VAX" <INFO-VAX@SRI.COM>


Found the following procedure in the DECUS [VMS93A.GCE93A.NET93A] 
while rooting for something else.

Hope it does what you seem to want to do...

John Hartfield ( i000005%10504.decnet@mdcgwy.mdc.com )

+	-	+	-	+	-	+	-	+

From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM" 14-MAY-1993 14:54:36.63
To:	EVERHART
CC:	
Subj:	RE: DCL calling procedure name

Date: Thu, 13 May 93 16:00:52 -0700
Message-Id: <9305132300.AA02940@atc.boeing.com>
From: @atc.boeing.com:mdc8567@28.721 (M.D.Clay)
To: "webosk@itwol.bhp.com.au"@BCSAIC
Cc: "INFO-VAX@sri.com"@BCSAIC, D.Clay@M
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


