Article 154775 of comp.os.vms:
In article <32361A8F.FB3@pacbell.net>,\
 Gino Yambao <gino-y@pacbell.net> writes...
> I am trying to retreive the file specification of a command
> procedure from a program that is invoked in said command procedure
> (equivalent to the DCL F$ENVIRONMENT("PROCEDURE") lexical function).

     If I were to do this today, I'd probably do things
differently.  But it used to work....  [You'd want to replace
everything from ``; Test code for...'' on with just ``.end''.]

-----< cmd_proc_name.mar >-----
    .title DCL_CmdProc
;                                                       Pat Rankin, Feb'90
;       Retreive the current process-permanent definition of SYS$INPUT.
;       If called by a program executing from within a command procedure,
;       the result will be the name of that procedure.  This routine is
;       approximately equivalent to the DCL lexical function
;       f$environment("PROCEDURE").
;
;       note:  CMEXEC or CMKRNL privilege must be enabled.
;
    .link "sys$system:Sys.Stb"/selective_search
    .link "sys$system:DCLdef.Stb"/selective_search

    .psect _data, long, rd, wrt, noexe, pic, noshr
nambufsiz = 256                         ;arbitrary maximum length
prcnambuf:  .blkb       nambufsiz
prcnamdsc:                              ;descriptor for static string buffer
prcnamlen:  .word       . - prcnambuf
	    .byte       0,0             ;type & class 'unspecified'
prcnamadr:  .address    prcnambuf

    .psect _code, long, rd, nowrt, exe, pic, shr
;;;;;;
;;    integer*4 function  DCL_CmdProc_Name( cmdproc_name )
;;      character*(*)  cmdproc_name     !output buffer
;;+-+
    .entry  DCL_CmdProc_Name, ^m<r2,r3,r4,r5,r6>
	$CMEXEC_S  routin=100$          ;call the retreival code in EXEC mode
	blbc    r0, 090$                ;quit if problem (nopriv)
	movaq   @4(ap), r1              ;caller's arg == descriptor for result
	movaq   prcnamdsc, r0           ;static string containing result
	jsb     g^LIB$SCOPY_DXDX6       ;copy static string into caller's arg
090$:   ret                             ;done
    .align long 1
;
100$:   .word   ^m<r2,r3,r4,r5>         ;entry mask
	movaw   g^LIB$SIG_TO_RET, (fp)  ;establish condition handler
	moval   g^ctl$ag_clidata, r1    ;get address of process's cli area
	moval   @ppd$l_prc(r1), r1      ;pointer to process permanent data
	moval   @prc_l_idflnk(r1), r1   ;   "    to indirect command file
	movab   @idf_l_filename(r1), r1 ;   "    to command proc name
	movzbw  (r1), prcnamlen         ;save length of name
	movc5   prcnamlen, 1(r1), -     ;copy name--padded with blanks--
		#^a' ', #nambufsiz, prcnambuf   ; into our static name buffer
	movzwl  #1, r0                  ;success
	ret ;end of DCL_CmdProc_Name
;;-+-
;;;;;;
    .align long 1

;                                                               ;
;               Test code for DCL_CmdProc_Name                  ;
;                                                               ;
$DSCDEF
entry Tst_CmdProc_Name, ^m<>
	clrq    -(sp)                   ;create a dynamic string descriptor
	movb    #DSC$K_DTYPE_T, DSC$B_DTYPE(sp)
	movb    #DSC$K_CLASS_D, DSC$B_CLASS(sp)
	pushaq  (sp)                    ;pass pointer to it to our routine
	calls   #1, DCL_CmdProc_Name
	blbc    r0, 09$                 ;quit now if problem
	pushaq  (sp)                    ;string now contains the cmd proc name
	calls   #1, g^LIB$PUT_OUTPUT    ;display it
09$:    ret
    .end Tst_CmdProc_Name
-----


