NetNews Usenet Archive 1993 #1/NN_1993_1.iso/spool/comp/os/vms/20483

Internet Message Format | 1993-01-06 | 13.3 KB

Path: sparky!uunet!portal!cup.portal.com!Chris_F_Chiesa
From: [e-mail]
Newsgroups: comp.os.vms
Subject: Long-awaited $IMGACT example program: part 2 of 2
Message-ID: <[e-mail]>
Date: Wed,  6 Jan 93 18:54:45 PST
Organization: The Portal System (TM)
Distribution: world
References: <[e-mail]> <[e-mail]>
Lines: 373

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X`09IAC$V_WRITABLE`09If set, the image is writeable
X`09IAC$V_SHAREABLE`09If set, the specified image is a shareable image`20
X`09`09`09that is being activated as a piece of an executable
X`09`09`09image. This flag can only be used in a recursive call
X`09`09`09to the image activator
X`09IAC$V_PRIVILEGE`09If set, the executable image has amplified privileges.
X`09`09`09If this flag is set, the shareable image being
X`09`09`09activated must be installed as a known file. The flag
X`09`09`09IAC$V_SHAREABLE must also be set.
X`09IAC$V_MERGE`09If set, the image activator is directed to merge one
X`09`09`09executable image into the address space of another.
X`09`09`09When this flag is set, the user stack, the image I/O
X`09`09`09segment, and the privilege amplification flag are
X`09`09`09to be ignored. This flag must be set if the image
X`09`09`09activator is called from user mode.
X`09IAC$V_EXPRG`09If set, the _inadr_ argument does not give an actual
X`09`09`09address range, but merely indicates the address space
X`09`09`09(P0 space or P1 space) into which the image is to be
X`09`09`09mapped. This flag is only used during a merged image
X`09`09`09activation.
Xinadr`09Address of a two-longword array containing the virtual address range
X`09into which the image is to be mapped. This argument is usually omitted,
X`09in which case the address ranges designated by the image section
X`09descriptors in the image header are used.
Xretadr`09Address of a two-longword array to receive the starting and ending
X`09addresses into which the image was actually mapped.
Xident`09Address of a quadword containing the version number and matching
X`09criteria for a shareable image.
XThe last 3 arguments are similiar to the input argumetns for various other
Xmemory management system services that are described in Chapter 16.
X--- End VVI quote ---
X
X----- INCLUDED TEXT ENDS -----
$ CALL UNPACK README.TXT;7 606893441
$ create 'f'
X;+
X; TRYIT.MAR - Christopher F. Chiesa, 9-NOV-1992 (commented 17-DEC-1992)
X;
X;    Accept DCL command line, nibble off TRYIT verb and replace with`20
X;    COPY, and call the VMS COPY utility as a subroutine.  Based on`20
X;    Internet posting from Garry Wiegand ([e-mail])
X;    on March 28, 1988 in comp.os.vms newsgroup.
X;
X;-
X;===========================================================================
X; MACRO LIBRARIES`20
X;===========================================================================
X;
X`09.LIBRARY`09\SYS$LIBRARY:LIB\
X;
X;===========================================================================
X; LOCAL MACROS
X;===========================================================================
X;+
X;   CHKSTS dest
X;     Branch to "dest" if R0 contains a non-success severity condition`20
X;     value
X;-
X`09.MACRO`09CHKSTS,DEST,?LABEL`09; W.Dick
X`09BLBS`09R0,LABEL
X`09.IF`09NOT_BLANK,<DEST>
X`09BRW`09DEST
X`09.IF_FALSE
X`09RET
X`09.ENDC
XLABEL:
X`09.ENDM`09CHKSTS
X;+
X;   GEN_ASCID size
X;    Declare an "empty" descriptor of "size" characters
X;-
X`09.MACRO`09GEN_ASCID`09SIZE`09; C.Chiesa after R. & L. Utter
X`09x = .
X`09.ASCID`09\ \
X`09.BLKB`09<SIZE-1>
X`09y = .
X`09. = x
X`09.WORD`09<SIZE>
X`09. = y
X`09.ENDM`09GEN_ASCID
X;===========================================================================
X; SYMBOLIC CONSTANTS
X;===========================================================================
X`09cr = 13`09`09`09`09; Carriage Return character
X`09lf = 10`09`09`09`09; Line Feed character
X`09$SSDEF`09`09`09`09; Completion status values
X`09$UAIDEF`09`09`09`09; $GETUAI item codes
X`09$IACDEF`09`09`09`09; Image Activator symbols
X`09$IHDDEF`09`09`09`09; Image Header symbols
X;===========================================================================
X; WRITEABLE DATA
X;===========================================================================
X`09.PSECT`09DATA`09WRT,NOEXE
X;+
X; Item List (item_list_3) for $GETJPI
X;-
Xjpi_items:
X`09.word`0912`09`09`09; buffer length
X`09.word`09JPI$_USERNAME`09`09; $GETJPI item code
X`09.address username_data`09`09; buffer address
X`09.address username_desc`09`09; return length address
X`09.long`090
X;+
X; Item List (item_list_3) for $GETUAI
X;-
Xuai_items:
X`09.word`0932`09`09`09; buffer length
X`09.word`09UAI$_CLITABLES`09`09; $GETJPI item code`20
X`09.address cli_table_filename`09; buffer address
X`09.address cli_table_desc`09`09; return length address
X`09.long`090
X;+
X; Descriptor for username - LENGTH field receives $GETJPI buffer-length retu
Vrn
X;-
Xusername_desc:
X`09.long`0912`09`09`09; Username has 12 characters max
X`09.address username_data`09`09; Pointer to data buffer
Xusername_data:
X`09.blkb`0912`09`09`09; Data buffer
X;+
X; Descriptor for CLI table file name - LENGTH field receives $GETUAI`20
X; buffer-length return
X;-
Xcli_table_desc:
X`09.blkl
X`09.address`09cli_table_filename
Xcli_table_filename:
X`09.blkb`0932
X;+
X; Descriptor for COPY command constructed from TRYIT command that got us
X; into this program
X;-
Xcopy_command:`09`09`09`09; Receives entire command
X`09gen_ascid`09255
Xcopy:`09.ascid`09\COPY \`09`09`09; Actual COPY verb for DCL parse`09
X;+
X; Pointers to address range SYS$SYSTEM:COPY.EXE "wants" to reside in, i.e.
X; where it would find itself if invoked normally by DCL.  Note that this
X; is the same range where TRYIT.EXE would reside if linked without the`20
X; BASE=%XA000 statement in TRYIT.OPT; that statement and file exist solely
X; to "move TRYIT up out of the way" so that COPY can reside where it be-
X; longs. This is necessary because $IMGACT/$IMGFIX don't resolve address
X; references COMPILED INTO static descriptors...
X;-
Xcopy_home_range:`09`09`09; Address range COPY.EXE "wants"`20
X`09.address `5Ex00000200`09`09; to inhabit
X`09.address `5Ex00009DFF
X;+
X; Receives "actual" address range into which COPY.EXE gets mapped at run`20
X; time
X;+
Xvm_actual:
X`09.blka
X`09.blka
X;+
X; Receives address of DCL command table
X;-
Xcli_table_ptr:
X`09.blka
X;+
X; Buffer to contain header of COPY.EXE when $IMGACT'ed into memory
X;-
Ximg_header_buf:
X`09.blkb`09512
X;+
X; Messages - output BEFORE and AFTER calling COPY.EXE, to prove that TRYIT
X; is in control throughout!
X;-
Xafter_msg:`09.ascid`09<CR><LF>\* After calling COPY *\<CR><LF>
Xbefore_msg:`09.ascid`09<CR><LF>\* Before calling COPY *\<CR><LF>
X;+
X; Universal Symbol pointing to start of DCL Command Table in a DCL Command`2
V0
X; Table image file such as DCLTABLES.EXE:
X;-
Xcli_table_symbol:
X`09`09.ascid`09\DCL$AL_TAB_VEC\
X;+
X; CLI$ parameter name that gets us the "entire command line" from DCL:
X;-
Xline_parm:`09.ascid`09\$LINE\
X;+
X; Buffer to contain actual command line from DCL...
X;-
Xcommand_line:`09gen_ascid 255
X;+
X; Name of image file we're going to activate... the VMS Copy Utility!
X;-
Xcopy_image_name:
X`09`09.ascid`09\SYS$SYSTEM:COPY.EXE\
X;===========================================================================
X; EXECUTABLE CODE
X;===========================================================================
X`09.PSECT`09CODE`09NOWRT,EXE
X`09.DISABLE`09LOCAL_BLOCK
X`09.ENTRY`09TRYIT,`5EM<>
X;+
X; Issue "before" message
X;-
X`09pushaq`09before_msg
X`09calls`09#1,g`5ELIB$PUT_OUTPUT
X`09chksts`09try_fail
X;+
X; Get TRYIT command line...
X;-
X`09pushaw `09command_line
X`09pushaq`09command_line
X`09pushaq`09line_parm
X`09calls`09#3,g`5ECLI$GET_VALUE
X`09chksts`09try_fail
X`09subw2`09#1,command_line
X;+
X; "... nibble off the command verb..." (in this case, "TRYIT") ...
X;-
X`09.ENABLE`09LOCAL_BLOCK
X`09movl`09#SS$_BADPARAM,r0`09`09; Assume failure to nibble verb
X`09movaq`09command_line,r6`09`09`09; R6 <- line descr base
X`09locc`09#`5Ea\ \,DSC$W_LENGTH(r6),-`09; Find first blank if any
X`09`09@DSC$A_POINTER(r6)
X`09bneq`0910$
X`09brw`09try_fail
X10$:
X`09addl3`09#1,r1,DSC$A_POINTER(r6)
X`09bgtr`0920$
X`09brw`09try_fail
X20$:
X;+
X; Replace former TRYIT verb with COPY:
X;-
X`09addw3`09<command_line+DSC$W_LENGTH>,-
X`09`09<copy+DSC$W_LENGTH>,-
X`09`09<copy_command+DSC$W_LENGTH>
X`09pushaq`09command_line`09`09`09; ... tail of TRYIT command...
X`09pushaq`09copy`09`09`09`09; "COPY"
X`09pushaq`09copy_command`09`09`09; Receives concatenated string
X`09calls`09#3,g`5ESTR$CONCAT
X`09chksts`09try_fail
X;+
X; Look up username currently running this program
X;-
X`09$GETJPI_S -`09`09`09`09; username_desc gets filled in
X`09`09itmlst=jpi_items`09`09; with current username string
X`09chksts`09try_fail
X;+
X; Look up DCL command table file name for the username currently running thi
Vs
X; program; $GETUAI looks up this information in the system UAF (User Authori
V-
X; zation File):
X;-
X`09$GETUAI_S -`09`09`09`09; cli_table_desc gets filled in
X`09`09usrnam=username_desc,-`09`09; with command-table-filename
X`09`09itmlst=uai_items`09`09; string, with prefixed LENGTH
X`09`09`09`09`09`09; byte!
X`09chksts`09try_fail
X`09movzbw`09cli_table_filename,-`09`09; Copy filename length byte from
X`09`09cli_table_desc`09`09`09; string to descriptor
X`09movab`09<cli_table_filename+1>,-`09; Adjust valid filename string
X`09`09<cli_table_desc+DSC$A_POINTER>`09; data start address
X;+
X; Find the Universal Symbol "DCL$AL_TAB_VEC" in the named DCL command table
X; file, and merge that command table into process memory space and obtain`20
X; the address where the table is merged...
X;-
X`09pushal`09cli_table_ptr`09`09`09; Receives address of table
X`09pushaq`09cli_table_symbol`09`09; "DCL$AL_TAB_VEC"
X`09pushaq`09cli_table_desc`09`09`09; DCL command table filespec
X`09calls`09#3,g`5ELIB$FIND_IMAGE_SYMBOL
X`09chksts`09try_fail
X;+
X; Activate COPY using $IMGACT -- *THIS IS TOTALLY UNSUPPORTED BY DIGITAL!*
X;-
X`09$IMGACT_S -
X`09`09NAME=copy_image_name,-
X`09`09HDRBUF=img_header_buf,-
X`09`09IMGCTL=#<IAC$M_MERGE>,-
X`09`09INADR=copy_home_range,-
X`09`09RETADR=vm_actual
X`09chksts`09try_fail
X;+
X; Perform address fixups?  It's not clear what this does, but it seems to
X; be necessary.
X;-
X`09$IMGFIX_S
X;+
X; $IMGACT places COPY.EXE's Image Header in img_header_buf, and maps the`20
X; executable etc. portion(s) of the image at their "natural" addresses.
X; We have to traverse through the Image Header to find the address of the
X; entry mask of the entry point of COPY.EXE.  This is in one of the three
X; Transfer Vector fields, probably the first or second, but I tried to be
X; thorough and check for Debugger startup (SYS$IMGSTA), missing (0), and
X; other "wrong" Transfer Vector field contents...
X;-
X`09moval`09img_header_buf,r2`09`09; R2 => header buffer base
X`09movl`09(r2),r2`09`09`09`09; R2 => Image Header base
X;+
X; Look up offset, and compute actual address, of Transfer Vector array:
X;-
X`09movzwl`09IHD$W_ACTIVOFF(r2),r3`09`09; R3 <-- xfer array offset
X`09movab`09(r2)`5Br3`5D,r3`09`09`09; R3 <-- xfer array address
X;+
X; Look for first non-zero, non-SYS$IMGSTA transfer address, which we'll
X; assume is the proper start address for COPY.EXE:
X;-
X`09movl`09#0,r4`09`09`09`09; R4 <-- array index
Xloop:
X`09movab`09(r3)`5Br4`5D,r5`09`09`09; R5 <-- xfer address address
X`09movl`09(r5),r6`09`09`09`09; R6 <-- xfer address itself
X`09tstl`09r6`09`09`09`09; Is xfer address 0?
X`09beql`09next_entry`09`09`09;   YES: try next entry if any
X`09cmpl`09r6,#SYS$IMGSTA`09`09`09;    NO: is it $IMGSTA ?
X`09bneq`09go_for_it`09`09`09;       NO: try running image!
X;+
X; Repeat checks for all three entries in Transfer Vector array; if no usable
X; Transfer Address is found, indicate generic error (R0 = 0) and exit!
X;-
Xnext_entry:
X`09addl2`09#4,r4
X`09cmpl`09r4,#12`09`09`09`09; Past end of entries?
X`09blss`09loop`09`09`09`09;   NO: try again
X`09movl`09#0,r0`09`09`09`09;  YES: fail
X`09brw`09try_fail
X;+
X; Now that we know where COPY.EXE's entry point is, we can parse the COPY
X; command we constructed from the TRYIT command line, to make COPY.EXE`20
X; think IT is running directly from the command line!
X;-
Xgo_for_it:
X;+
X; Parse fake, "constructed" COPY command
X;-
X`09pushl`09cli_table_ptr
X`09pushaq`09copy_command
X`09calls`09#2,g`5ECLI$DCL_PARSE
X`09chksts`09try_fail
X;+
X; Call COPY.EXE as a subroutine!
X;-
X`09calls`09#0,(r6)`09`09`09`09; call COPY!
X`09movl`09r0,r5`09`09`09`09; R5 <- saved status from COPY
X;+
X; Show the world that TRYIT is still in control
X;-
X`09pushaq`09after_msg
X`09calls`09#1,g`5ELIB$PUT_OUTPUT`09`09; Generates its own status in
X`09`09`09`09`09`09; R0, which we ignore
X`09movl`09r5,r0`09`09`09`09; Restore saved COPY status
X;+
X; At this point, I am not aware that I need do anything special in order`20
X; to "unwind" anything I've done: there's no '$IMGDAC' (Image De-Activate)
X; operation, for example.  Everything gets unmapped, I presume, by the defau
Vlt
X; image rundown procedure(s).  As the original 1988 posting says, "trapping
X; possible $EXIT_S calls..." from COPY.EXE "... is left as an exercise for
X; the reader."
X;-
Xtry_fail:
X`09ret`09`09`09`09`09; Return to DCL with status
X`09.end`09tryit
$ CALL UNPACK TRYIT.MAR;22 863771829
$ create 'f'
XBASE=%XA000
$ CALL UNPACK TRYIT.OPT;1 67855631
$ create 'f'
Xdefine verb tryit
X  image testdir:tryit
X  parameter p1
X`09value(type=$rest_of_line)
$ CALL UNPACK TRYIT.CLD;7 1175010657
$ v=f$verify(v)
$ EXIT