.title uwdimgsta - UWD to call sys$imgsta
	.library 'sys$share:lib'
	.link 'sys$system:sys.stb'/selective_search
;
; Program:	UWDIMGSTA.MAR
;
; Author:	David G. North, CCP
;		1333 Maywood Ct
;		Plano, Texas  75023-1914
;		(214) 902-3957
;
; Date:		90.11.16
;
; Revisions:
;   Who		Date	Description
;   D.North	901116	DECUS release (Fall 90)
;   D.North	911113	DECUS release (Fall 91)
;
; License:
;    Ownership of and rights to these programs is retained by the author(s).
;    Limited license to use and distribute the software in this library is
;    hereby granted under the following conditions:
;      1. Any and all authorship, ownership, copyright or licensing
;         information is preserved within any source copies at all times.
;      2. Under absolutely *NO* circumstances may any of this code be used
;         in any form for commercial profit without a written licensing
;         agreement from the author(s).  This does not imply that such
;         a written agreement could not be obtained.
;      3. Except by written agreement under condition 2, source shall
;         be freely provided with all binaries.
;      4. Library contents may be transferred or copied in any form so
;         long as conditions 1, 2, and 3 are met.  Nominal charges may
;         be assessed for media and transferral labor without such charges
;         being considered 'commercial profit' thereby violating condition 2.
;
; Warranty:
;    These programs are distributed in the hopes that they will be useful, but
;    WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;    or FITNESS FOR A PARTICULAR PURPOSE.
;

	$ifddef
	$clidef
;
;  This module offers the user a method to call SYS$IMGSTA correctly
;  from an image which is targeted for INSTALL with /PRIV=, or
;  /EXECUTE_ONLY.  This is accomplished by *NOT ALLOWING* the address
;  of SYS$IMGSTA to appear in the image transfer address array.  To
;  get the linker to properly construct the transfer array, you must
;  link your target image using /DEBUG=UWDIMGSTA.  The transfer array will
;  then vector first to this routine and then (indirectly) to your
;  module's main entry point via SYS$IMGSTA.  Note that this is accomplished
;  very delicately by evaporating the initial call frame, creating an
;  RSB address on the stack and re-calling SYS$IMGSTA with the original
;  arguments passed by $IMGACT.  Additionally, the args from $IMGACT are
;  chewed upon such that the user must now do a $ RUN/DEBUG <pgm> in order
;  to actually invoke the debugger.  (Note also that this behaviour is blocked
;  for install/priv=... images because of potential security issues).
;
	$sfdef
	.psect	$CODE,pic,usr,con,rel,lcl,shr,exe,nowrt,novec
;
; Following is the code to hack up the stack & redirect to SYS$IMGACT
;
imgsta:	bbs	#SF$V_CALLS,SF$W_SAVE_MASK(FP),docls
	brw	doclg
docls:	movl	(AP),r0			;get arg count
	clrl	(AP)			;set null arglist
	movl	SF$L_SAVE_PC(FP),r1	;extract & save return PC
	movab	b^10$,SF$L_SAVE_PC(FP)	;set bogus return address
	ret				;pop off frame for re-build
10$:	pushl	r0			;restore argument count to stack
20$:	xorl	(SP)[r0],r1		;XOR swap a->b
	xorl	r1,(SP)[r0]		;XOR swap b<-a
	xorl	(SP)[r0],r1		;XOR swap a->b (completed)
	tstl	r0			;is this last item in arglist?
	beql	30$			;just did last one
	sobgeq	r0,20$			;swap down thru arglist
30$:	calls	r1,g^SYS$IMGSTA		;Poof! All is now well
	rsb				;return to original saved PC
doclg:	moval	(AP),r0			;get arglist address
	movl	SF$L_SAVE_PC(FP),r1	;extract & save return PC
	movab	b^10$,SF$L_SAVE_PC(FP)	;set bogus return address
	ret				;pop off frame for re-build
10$:	pushl	r1			;set up RSB for return to original PC
	callg	(r0),g^SYS$IMGSTA	;Poof! All is now well
	rsb				;return to original saved PC
;
; following will hack up the arguments to indicate that the user said /NODEBUG
; Note: value 0 is the default (no debug qualifier at all)
;       value 1 is passed if the user said /NODEBUG
;       value 3 is passed if the user said /DEBUG
;
fixdbg:	bisl	#CLI$M_DEBUG,24(AP)	;flag /debug as present (dflt negated)
	movl	g^CTL$GL_IMGHDRBF,r0	;grab pointer to HDRBF array
	moval	@4(r0),r1		;actual IFD address
	bbs	#IFD$V_PRIV,IFD$W_FLAGS(r1),10$		;bounce instal/priv
	bbc	#IFD$V_EXEONLY,IFD$W_FLAGS(r1),20$	;bounce instal/exec_o
10$:	bicl	#CLI$M_DBGTRU,24(AP)	;shut off /DEBUG for install & priv'd
20$:	rsb
;
; This is the UWD's main entry point
;
.entry	uwdimgsta_start,^m<>
	bsbw	fixdbg			;allows user to 'fixup' $IMGACT args
	bsbw	imgsta
	ret
;
	.end	uwdimgsta_start