| Here's a routine that I wrote ages ago (check the date). It's not the
best code in the world, but it has worked on VMS versions 1 through 5
inclusive, needing nothing worse than a re-compile.
The "system programmer notes" referred to in the comments were the
class notes from the original VMS System Programmer course (now called
the VMS Internals course). Kenah & Bate more than supercedes these
notes. "F4V" was what we called the original VAX Fortran compiler.
Jon
.Title JDC_GET_VERSION : Get ident & link time
.Ident /V1.01/
.Sbttl Opening Remarks & Comments
;
;
; Written by J. D. Callas 1-Jun-1979
;
;*******************************************************************************
; Change Log:
;*******************************************************************************
;
;
; The subroutine JDC_GET_VERSION will obtain the ident & link
;time of the program that calls it.The procedure it uses is:
;When VMS starts a program, it actually calls it as a subroutine,
;passing it 6 arguments via the AP. The 3rd argument points to the
;DCL header, which contains (among other things) the ident and link
;time of the image. This subroutine obtains these from the DCL header
;by declaring an initialization procedure which stores the
;whole argument list in a global psect called JDC_IMG_ARGLIST.
;the DCL header is grabbed by GET_VERSION from this block
;of storage & returns the ident & link time to its caller.
;A map of the DCL header can be found in the system programmer notes,
;volume 2. The initialization procedure has the global name JDC_IA_SAVE.
;
; Calling Sequence (F4V):
;
; CALL JDC_GET_VERSION(ident,date)
;
; ident = the address of a CHARACTER*15 descriptor to receive the
; ident of the executable image
;
; date = the address of a CHARACTER*24 descriptor to recive the
; link time of the executable image
;
;
; A sample call is:
;
;
; CHARACTER IDENT*15,DATE*24
; CALL JDC_GET_VERSION(IDENT,DATE)
; TYPE*, IDENT,' ',DATE
;
;Version-3.17 20-JUN-1995 15:34:12.38
;
.page
.sbttl EQUIVALENCE SYMBOLS & ERROR MSGS
.psect $pdata pic,usr,con,rel,lcl,shr,noexe,rd,nowrt
.library /SYS$LIBRARY:LIB/
$ihddef
$ihidef
ident_error_msg:
.ascii /*Ident*Error***/
first_2_args = 4 ;offset from AP to 1st 2 args (via MOVQ)
;We will use:
;ihd$w_imgidoff -- offset from the beginning of the DCL header to
; the word containing the image ident offset
;ihi$t_imgid -- offset from the image header to the ident
;ihi$q_linktime -- offset from the DCLH to the link time
.page
.sbttl Main Subroutine
.psect $code pic,usr,con,rel,lcl,shr,exe,rd,nowrt
jdc_get_version:: ;entry point
.word ^X0FFC ;save R2 => R11
cmpb (AP),#2 ;Are there the right # of args?
blss no_args ;BRif too few, ignore extra
;
;This routine is pure-procedure. The regesters are:
; R0 = temporary, condition flags, & status back to caller
; R1 = temporary
; R2 = "
; R3 = "
; R4 = "
; R5 = "
; R6 = address of the ident descriptor
; R7 = address of the date descriptor
; R8 = Unused
; R9 = Unused
; R10 = address of the DCL header
; R11 = temporary for offsets & addresses into the DCL header
;
movq first_2_args(AP),r6 ;move descriptors in r6 & r7
movl jdc_img_arglist+12,r10 ;get pointer to the DCL header
movc5 #0,(r6),#^A/ /,(r6),@4(r6) ;clear ident string
movzwl ihd$w_imgidoff(r10),r11 ;r11=address of image header
addl r10,r11
movzbl ihi$t_imgid(r11),r2 ;get # of bytes to transfer
movc3 r2,ihi$t_imgid+1(r11),@4(r6) ;transfer the ident back to
;the caller
$asctim_s - ;convert the link date &
timbuf=(r7),timadr=ihi$q_linktime(r11) ;transfer
ret ;return
.page
.sbttl No_args: error handling
no_args:
movl #24,r0 ;load in ss$_insfargs
blbc (ap),10$ ;exit if 0 args
movl 4(AP),r2 ;load in the descriptor for the error msg
movc3 (r2),ident_error_msg,@4(r2) ;load in ident error if 1 arg
10$: ret ;exit
.page
.sbttl JDC_IA_SAVE & JDC_IMG_ARGLIST - initiailization
;
;
; This entry is callaed before the mainprogram executes
; (because of the LIB$INITIALIZE .psect ).
; The arguments to the initial AP are saved in JDC_IMG_ARGLIST for use
; by later users.
;
jdc_ia_save:: .word ^m<> ;enter, we use no regs
movq (ap),jdc_img_arglist ;store the argument list
movq 8(ap),jdc_img_arglist+8
movq 16(ap),jdc_img_arglist+16
movq 24(ap),jdc_img_arglist+24
movl #1,r0 ;return with a success code
ret
.extrn lib$initialize ;force loading of initialization proc
.psect lib$initialize nopic,usr,con,rel, -
gbl,noexe,rd,nowrt,long
.long jdc_ia_save
.psect $local pic,usr,con,rel,lcl,noshr,noexe,rd,wrt
jdc_img_arglist::
.blkl 8
.end
|