;.-----------------------------------------------------------------------------.
;|  ***** LOADABLE IMAGE (Example #1.  The sequel...)                          |
;|  This program demonstrates use of the loadable image listhead to locate a   |
;|  segment of code or data.  Use with loadable image example #1.  Remember,   |
;|  this program can only determine emulated instructions if the instruction   |
;|  has been excercised in code. (That code is up to you!!!...)                |
;|  Author: Brian Schenkenberger/Indep. Consult./TMESIS Consulting/Jackson NJ  |
;`-----------------------------------------------------------------------------'

	.TITLE	SHOW_EMULATED_INST	Read marker in Loadable image EMULTRAP
	.IDENT	'VMS 5.4-2%2.251'
;------------------------------------------------------------------------------
	.LINK	 "SYS$SYSTEM:SYS.STB"	; Link w/ SYS.STB (LDR$GQ_IMAGE_LIST)
	.LIBRARY /SYS$LIBRARY:LIB/	; Search this library during assembly.
	$LDRIMGDEF			; Loadable executive image block defs.
	$OPDEF				; VAX Opcode definitions
;------------------------------------------------------------------------------
	.MACRO	CHECK_INST,INST,?LABEL
	.IF DEFINED OP$_'INST		; is arg a valid VAX instruction???
	.IF_TRUE			; if so ...
	.SAVE_PSECT			; save current program seciton
	.PSECT	DATA,RD,WRT,NOEXE,LONG	; concat with the DATA psect
INST':	.ASCID	/'INST' was emulated/	; create report string for instruction
	.RESTORE_PSECT			; back to the CODE psect...
	BBC	#OP$_'INST,-		; check if EMULTRAP loadable image
		@EMULTRAP_MARKER,LABEL	; ==- set the marker bit...
	PUSHAB	INST			; push the message string
	CALLS	#1,G^LIB$PUT_OUTPUT     ; tell user which inst was emulated
	BLBS	R0,LABEL		; check call status
	RET				; bad news, time to return
LABEL:					; got here... ok
	.IF_FALSE			; if not a valid VAX inst in arg
	.ERROR ; Invalid instruction specified in macro	; tell the user
	.ENDC				; all done
	.ENDM	CHECK_INST
;------------------------------------------------------------------------------
	.PSECT	DATA,RD,WRT,NOEXE,LONG
EMULTRAP_MARKER:	.LONG	0

EMULTPNAM:	.ASCII	/<SYS$LDR>EMULTRAP.EXE/
EMULTRAPLEN=	.-EMULTPNAM
;------------------------------------------------------------------------------
	.PSECT	CODE,RD,NOWRT,EXE,LONG
	.ENTRY	SHOWEMUL,0

	$CMEXEC_S	ROUTIN=FIND_MARKER
	BLBS	R0,10$
	RET
	
10$:	CHECK_INST	ADDP4	; packed decimal string and character 
	CHECK_INST	ADDP6	; instructions are only instructions
	CHECK_INST	ASHP	; marked by EMULTRAP loadable image
	CHECK_INST	CMPC3
	CHECK_INST	CMPC5	;;  (BTW... MOVC3 and MOVC5 are 
	CHECK_INST	CMPP3	;;  "_NEVER_"  emulated...)
	CHECK_INST	CMPP4	
	CHECK_INST	CVTLP	;; In addition to the information this 
	CHECK_INST	CVTPL   ;; example provides concerning Loadable
	CHECK_INST	CVTPS   ;; executive images, this program should
	CHECK_INST	CVTPT	;; help to dispell a great many of the
	CHECK_INST	CVTSP	;; commonly held 'Myth'conceptions 
	CHECK_INST	CVTTP	;; about VAX instruction emulation.	
	CHECK_INST	DIVP	;; eg., A 'Faux Pax' in the reader letter 	
	CHECK_INST	EDITPC	;; published in VAX Prof. Vol.9,#1, pg.46 
	CHECK_INST	LOCC
	CHECK_INST	MATCHC
	CHECK_INST	MOVP
	CHECK_INST	MOVTC
	CHECK_INST	MOVTUC
	CHECK_INST	MULP
	CHECK_INST	SCANC
	CHECK_INST	SKPC
	CHECK_INST	SPANC
	CHECK_INST	SUBP4
	CHECK_INST	SUBP6
	RET
;------------------------------------------------------------------------------
	.ENTRY	FIND_MARKER,^M<R2,R3,R4,R5>
	MOVAB	@#LDR$GQ_IMAGE_LIST,R4	; get loadable image listhead address
	MOVL	R4,R5			; put in r5 so we can walk-the-list
10$:	MOVL	(R5),R5			; get an entry from the list
	CMPL	R4,R5			; check if its the 'end-of-the-line'
	BEQL	20$			; list exhausted? ('end-of-the-line')
	CMPB	LDRIMG$B_IMGNAMLEN(R5),-; could this be the one? check if the
		#EMULTRAPLEN		; ==- image name is the right size
	BNEQU	10$			; better luck next time around
	CMPC3	#EMULTRAPLEN,EMULTPNAM,-; length checked out ok! now check if
		LDRIMG$T_IMGNAM(R5)	; ==- the image name is correct
	BNEQU	10$			; better luck next time around	
	MOVL	LDRIMG$L_NONPAG_W_BASE(R5),- ; get the address of marker mask
		EMULTRAP_MARKER				
	MOVL	#1,R0			; return with success.
	RET
20$:	MOVL	#<SS$_NONXPAG&-2>,R0	; return warning! non-existant page
	RET				; ==- image not loaded ??!!!

	.END	SHOWEMUL


$ X=F$verify(1)
$ MACRO/OBJECT=EMULTRAP/LIST=EMULTRAP SYS$INPUT
;.-----------------------------------------------------------------------------.
;|  ***** LOADABLE IMAGE (Example #1.)                                         |
;|  This program demonstrates use of a loadable image to intercept an emulated |
;|  instruction fault by modifying the SCB vector with a new routine vector.   |
;|  Author: Brian Schenkenberger/Indep. Consult./TMESIS Consulting/Jackson, NJ |
;`-----------------------------------------------------------------------------'

	.TITLE	MARK_EMULATED_TRAP	Hook to mark emulated char intructions
	.IDENT	'VMS 5.4-2%2.251'
;------------------------------------------------------------------------------
	.LIBRARY /SYS$LIBRARY:LIB/	; Search this library during assembly.
	$SYSVECTORDEF			; Define system service vector offsets.
	$LDRIMGDEF			; Loadable executive image block defs.
	$PRTDEF				; Page protection codes
;------------------------------------------------------------------------------
SCBVEC.EMUL_TRAP	= ^xC8
;------------------------------------------------------------------------------
	DECLARE_PSECT	EXEC$INIT_CODE
	INITIALIZATION_ROUTINE	MARK_EMULATED_TRAP_INIT

MARK_EMULATED_TRAP_INIT:
	PUSHR	#^M<R2,R3,R4,R5>	; save registers trashed by routine
	MOVL	#PRT$C_UW,R0		; make code & data user writeable
	MOVL	#2,R1			; both pages
	MOVAB	MARK_EMULATED_TRAP,R2	; starting VA for protection change
	JSB	G^EXE$SET_PAGE_PROTECTION	; go change protection
	POPR	#^M<R2,R3,R4,R5>		; restore saved registers

	MOVL	@#EXE$GL_SCB,R0			; get base address of SCB
	MOVL	SCBVEC.EMUL_TRAP(R0),-		; get/save emulator address
		CHARSTRING_EMULATOR		; ==- in the SCB slot
	MOVL	LDRIMG$L_NONPAG_R_BASE(R4),-	; put marker routine address
		SCBVEC.EMUL_TRAP(R0)		; ==- in the SCB slot

	PUSHR	#^M<R2,R3,R4,R5>	; save registers trashed by routine
	MOVL	#PRT$C_UR,R0		; make marker routine user readable
	MOVL	#1,R1			; only one page
	MOVAB	MARK_EMULATED_TRAP,R2	; starting VA for protection change
	JSB	G^EXE$SET_PAGE_PROTECTION	; go change protection
	POPR	#^M<R2,R3,R4,R5>		; restore saved registers
	BBSS	#INIRTN$V_NO_RECALL,-	; invoke init routine one time only!
		(R5),10$		
10$:	MOVL	#1,R0			; return with success.
	RSB

;------------------------------------------------------------------------------
	DECLARE_PSECT	EXEC$NONPAGED_DATA
INSTRUCTION_MARKBLK:	.LONG	<256/32>; 256 1 byte opcodes/(32 bits/longword)
;------------------------------------------------------------------------------
	DECLARE_PSECT	EXEC$NONPAGED_CODE
MARK_EMULATED_TRAP:
	BBSS	(SP),INSTRUCTION_MARKBLK,10$	; set instruction marker bit
10$:	JMP	@CHARSTRING_EMULATOR		; invoke original EMULATOR code
	.ALIGN	LONG 
CHARSTRING_EMULATOR:	.LONG
	.END
;------------------------------------------------------------------------------

$ LINK	/NOSYSSHR/NOTRACEBACK/SHAREABLE=SYS$LOADABLE_IMAGES:EMULTRAP -
	/MAP=EMULTRAP/FULL/CROSS_REFERENCE/SYMBOL_TABLE=EMULTRAP -
	SYS$INPUT/OPTION

EMULTRAP,SYS$LIBRARY:STARLET/INCLUDE:(SYS$DOINIT),-
SYS$SYSTEM:SYS.STB/SELECTIVE

VECTOR_TABLE=SYS$SYSTEM:SYS.STB
COLLECT=NONPAGED_READONLY_PSECTS/ATTRIBUTES=RESIDENT,EXEC$NONPAGED_CODE
COLLECT=NONPAGED_READWRITE_PSECTS/ATTRIBUTES=RESIDENT,EXEC$NONPAGED_DATA
COLLECT=PAGED_READONLY_PSECTS,EXEC$PAGED_CODE
COLLECT=PAGED_READWRITE_PSECTS,EXEC$PAGED_DATA
COLLECT=INITIALIZATION_PSECTS/ATTRIBUTES=INITIALIZATION_CODE,-
	EXEC$INIT_CODE,-
	EXEC$INIT_000,EXEC$INIT_001,EXEC$INIT_002,-
	EXEC$INIT_PFNTBL_000,EXEC$INIT_PFNTBL_001,EXEC$INIT_PFNTBL_002,-
	EXEC$INIT_SSTBL_000,EXEC$INIT_SSTBL_001,EXEC$INIT_SSTBL_002

$ MCR SYSMAN 	SYS_LOADABLE ADD _TMESIS_ EMULTRAP.EXE -
		/LOAD_STEP = SYSINIT 	/SEVERITY  = WARNING -
		/MESSAGE   = "Failure to load EMULTRAP.EXE" 
$
$ @SYS$UPDATE:VMS$SYSTEM_IMAGES.COM
$
$! REBOOT THE SYSTEM


$ X=F$verify(1)
$ MACRO/OBJECT=PMTDDIR/LIST=PMTDDIR SYS$INPUT
;.-----------------------------------------------------------------------------.
;|  ***** LOADABLE IMAGE (Example #2.)                                         |
;|  This program demonstrates use of a loadable image as a means of enhancing  |
;|  the functionality of a VMS system service.                                 |
;|  Author: Brian Schenkenberger/Indep. Consult./TMESIS Consulting/Jackson NJ  |
;`-----------------------------------------------------------------------------'
	.TITLE	SETDDIR_WTH_PROMPT	Define $SETDDIR to change DCL prompt
	.IDENT	'VMS 5.4-2%2.251'
;------------------------------------------------------------------------------
	.LIBRARY /SYS$LIBRARY:LIB/	; Search this library during assembly.
	$SYSVECTORDEF			; Define system service vector offsets.
	$LDRIMGDEF			; Loadable executive image block defs.
	$CCBDEF				; Channel Control Block definitions
	$IHDDEF				; Image header descriptor definitions
	$IHSDEF				; Image debug/symbol table definitions
	$OBJDEF				; Symbol table record definitions
	$PSLDEF				; Processor Status definitions
	$WCBDEF				; Window control block definitions
;------------------------------------------------------------------------------
; This image and its initialization routine assume that it is being called
; in the SYSINIT phase of the system's bootstrap.  Ergo, the image RMS.EXE
; has been loaded just prior to the loading and invocation of this image by 
; LDR$ALTERNATE_LOAD.  
;------------------------------------------------------------------------------
	DECLARE_PSECT	EXEC$INIT_CODE

	INITIALIZATION_ROUTINE	SETDDIR_WTH_PROMPT_INIT

SETDDIR_WTH_PROMPT_INIT:
	PUSHR	#^M<R2,R3,R4,R5>	; save registers trashed by init rtn.
	MOVAB	@#LDR$GQ_IMAGE_LIST,R4	; get loadable image listhead address
	MOVL	R4,R5			; put in r5 so we can walk-the-list
10$:	MOVL	(R5),R5			; get an entry from the list
	CMPL	R4,R5			; check if its the 'end-of-the-line'
	BEQL	40$			; list exhausted? ('end-of-the-line')
	CMPB	LDRIMG$B_IMGNAMLEN(R5),-; could this be the one? check if the
		#RMSIMGNMLEN		;==- image name is the right size
	BNEQU	10$			; better luck next time around
	CMPC3	#RMSIMGNMLEN,RMSIMGNAM,-; length checked out ok! now check if
		LDRIMG$T_IMGNAM(R5)	;==- the image name is correct
	BNEQU	10$			; better luck next time around	
	BSBB	GET_IMGVAL		; get image value of RMS$SETDDIR
	BLBC	R0,20$			; branch 20$ if bad news
	MOVL	LDRIMG$L_BASE(R5),R5	; get the base address of RMS.EXE
	MOVAB	(R5)[R3],-		; put the address of RMS$SETDDIR into
		RMS$SETDDIR_ENTRY_PT	;==- RMS$SETDDIR_ENTRY_PT
	MOVL	#1,R0			; return with success.
20$:	POPR	#^M<R2,R3,R4,R5>	; restore saved registers
	BBSS	#INIRTN$V_NO_RECALL,-	; invoke init routine one time only!
		(R5),30$		
30$:	RSB
40$:	CLRL	R0
	BRB	20$
;------------------------------------------------------------------------------
; At the point within the SYSINIT process where the alternate loader loads
; this image, the system has not yet been initialized to the point where a 
; full checking $ASSIGN service will function.  The following instructions
; perform the 'bare-bones' task of building a CCB and assigning a channel 
; number.  (First 9 instructions) (Consult the VAX/VMS v5.2 IDSM Ch. 30,31
; for more intimate details of the system initialization process.)
;------------------------------------------------------------------------------
GET_IMGVAL:
	JSB	@#IOC$FFCHAN		; get hold of a free CCB
	BLBS	R0,.+2			; if ok??? go build the CCB
	RSB				; bad news again!

	MOVL	@#EXE$GL_SYSUCB,-	; put system device UCB address in
		CCB$L_UCB(R2)		;==- CCB$L_UCB (*thank EXE$INIT*)
	CLRL	CCB$L_WIND(R2)		; no associated WCB
	MOVB	#CCB$M_RDCHKDON,-	; signify reads on this channel
		CCB$B_STS(R2) 		;==- should be ok
	ADDB3	#1,#PSL$C_KERNEL,-	; mark channel as a kernel mode
		CCB$B_AMOD(R2)		;==- accessed channel
	CLRL	CCB$L_DIRP(R2)		; no deaccess i/o

	MOVW	R1,CHAN			; channel # (we'll need this again)

	MOVL	LDRIMG$L_WCB(R5),R4	; get window control block address
	CMPW	WCB$W_NMAP(R4),#1	; is file mapped in 1 extent?
	BEQL	10$			; branch 10$ if a single extent
	CLRL	R0			; looks like trouble
	RSB				
					; - let's get the image header -
10$:	MOVL	WCB$L_P1_LBN(R4),R3	; get LBN of the start of RMS.EXE
	MOVAB	IMGDATA,R2		; get address of local data store
	$QIOW_S	FUNC=#IO$_READLBLK,-	; read the image header at LBN=R3
		CHAN=CHAN,IOSB=IOSB,-	;==- into the local data storage
		P1=(R2),P2=#512,P3=R3	; 
	BLBS	R0,.+2			; check the ss completion status
	RSB
	MOVZWL	IOSB,R0			; extract the i/o completion status
	BLBS	R0,.+2			; check the i/o completion status
	RSB
					; - let's find those goodies -
	MOVZWL	IHD$W_SYMDBGOFF(R2),R2	; get offset to symbol table header
	MOVAB	IMGDATA[R2],R2		; get base of symbol table header
	MOVL	IHS$L_GSTVBN(R2),R2	; get VBN of the Global Symbol table    
	ADDL2	R2,R3			; calculate the GST's LBN 
	SUBW3	R2,WCB$W_P1_COUNT(R4),R2; how big is it? <IMGLEN - GST LBN>
	CMPL	R2,#8			; is the IMGDATA area big enough?
	BLSSU	20$			; branch 20$ if it is
	MOVL	#8,R2			; limit to 8 pgs. hope symbol's there   
20$:	ASHL	#9,R2,R2		; turn blocks into bytes. (alchemy!)

	$QIOW_S	FUNC=#IO$_READLBLK,-	; read the GST starting at LBN=R3
		CHAN=CHAN,IOSB=IOSB,-	;==- into the local store
		P1=IMGDATA,P2=R2,P3=R3
	BLBS	R0,.+2			; check the ss completion status
	RSB
	MOVZWL	IOSB,R0			; extract the i/o completion status
	BLBS	R0,.+2			; check the i/o completion status
	RSB
					; - time to make the doughnuts! -
	MATCHC	#SETDDIR_LEN,SETDDIR,-	; look for the symbol name in the
		R2,IMGDATA		;==- retrieved table data
	BEQL	30$			; branch 30$ if we found it
	CLRL	R0			; bad news!!
	RSB

30$:	MOVAB	-<SETDDIR_LEN+1>(R3),R3	; backup to beginning of symbol name
	MOVL	-<OBJ$T_EPMV_NAME-OBJ$L_EPMV_VALUE>(R3),- ; backup from symbol
		R3			;==- name to start of symbol value
	MOVL	#1,R0			; ...and there was great rejoicing!
	RSB
		
		.ALIGN	LONG	; start data on a LONG boundary. 
CHAN:		.WORD	0
		.WORD	0 	; filler to align the IOSB on a LW
IOSB:		.QUAD	0

RMSIMGNAM:	.ASCII	/[SYS$LDR]RMS.EXE/
RMSIMGNMLEN=	.-RMSIMGNAM
SETDDIR:	.ASCII	/RMS$SETDDIR/
SETDDIR_LEN=	.-SETDDIR

		.ALIGN	LONG	; start data on a LONG boundary.  using init
IMGDATA:	.BLKB	512*8	; psect for work, deleted after image loaded.
;------------------------------------------------------------------------------
	DECLARE_PSECT	EXEC$PAGED_DATA

RMS$SETDDIR_ENTRY_PT:	.LONG	0
;------------------------------------------------------------------------------
	DECLARE_PSECT	EXEC$PAGED_CODE

	SYSTEM_SERVICE	SETDDIR, <R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>,-
			MODE=EXEC, NARG=3, PREFIX=RMS$

	CALLG	(AP),@RMS$SETDDIR_ENTRY_PT  ; invoke original SETDDIR code
	BLBS	R0,10$			; modify DCL prompt if all is well
	RET				; something went wrong! tell caller

10$:	MOVAB	@#CTL$AG_CLIDATA,R7	; get base of the CLI data area
	IFNORD	#4,PPD$L_PRC(R7),30$	; is the PPD area accessible!?  
	MOVL	PPD$L_PRC(R7),R7	; get base of proc. perm. data area  
	IFNOWRT	#PRC_S_PROMPT,-		; is prompt string area writeable??
		PRC_G_PROMPT(R7),30$	;==- if not, get outta here!

	MOVAB	@#PIO$GT_DDSTRING,R8	; get the def dir (ascic) string 
	
	MOVZBL	(R8)+,R6		; get the length of the ddstring
	CMPL	R6,#PRC_S_PROMPT-1	; will it fit in the prompt? 
	BLSSU	20$			; branch 20$ if it fits
	SUBL2	#PRC_S_PROMPT-1,R6	; how much wont fit in the prompt?
	ADDL2	R6,R8			; chop that much off the beginning
	MOVL	#PRC_S_PROMPT-1,R6	; output all that we got.
20$:	MOVC3	R6,(R8),PRC_G_PROMPT(R7)	; copy ddstring to prompt
	ADDB3	#4,R6,PRC_B_PROMPTLEN(R7)	; update the prompt length
	MOVB	#^a/ /,PRC_G_PROMPT(R7)[R6]	; add space to end of prompt
30$:	MOVL	#RMS$_NORMAL,R0		; tell caller everything's alright
	RET

	.END
;------------------------------------------------------------------------------

$ LINK	/NOSYSSHR/NOTRACEBACK/SHAREABLE=SYS$LOADABLE_IMAGES:PMTDDIR -
	/MAP=PMTDDIR/FULL/CROSS_REFERENCE/SYMBOL_TABLE=PMTDDIR -
	SYS$INPUT/OPTION

PMTDDIR,SYS$LIBRARY:STARLET/INCLUDE:(SYS$DOINIT),-
SYS$SYSTEM:SYS.STB/SELECTIVE,SYS$SYSTEM:DCLDEF.STB/SELECTIVE

VECTOR_TABLE=SYS$SYSTEM:SYS.STB
COLLECT=NONPAGED_READONLY_PSECTS/ATTRIBUTES=RESIDENT,EXEC$NONPAGED_CODE
COLLECT=NONPAGED_READWRITE_PSECTS/ATTRIBUTES=RESIDENT,EXEC$NONPAGED_DATA
COLLECT=PAGED_READONLY_PSECTS,EXEC$PAGED_CODE
COLLECT=PAGED_READWRITE_PSECTS,EXEC$PAGED_DATA
COLLECT=INITIALIZATION_PSECTS/ATTRIBUTES=INITIALIZATION_CODE,-
	EXEC$INIT_CODE,-
	EXEC$INIT_000,EXEC$INIT_001,EXEC$INIT_002,-
	EXEC$INIT_PFNTBL_000,EXEC$INIT_PFNTBL_001,EXEC$INIT_PFNTBL_002,-
	EXEC$INIT_SSTBL_000,EXEC$INIT_SSTBL_001,EXEC$INIT_SSTBL_002

$
$ MCR SYSMAN 	SYS_LOADABLE ADD _TMESIS_ PMTDDIR.EXE -
		/LOAD_STEP = SYSINIT 	/SEVERITY  = WARNING -
		/MESSAGE   = "Failure to load PMTDDIR.EXE" 
$
$ @SYS$UPDATE:VMS$SYSTEM_IMAGES.COM
$
$! REBOOT THE SYSTEM
$!----------------------------------------------------------------------------
$! FYI... For anyone actually wishing to use this loadable.  The LOGINOUT.EXE
$! image builds the P1 region itself.  To have the prompt reflect the process
$! default at login, a SET DEFAULT or SHOW DEFAULT command should be executed 
$! in SYLOGIN.COM or LOGIN.COM.
$!----------------------------------------------------------------------------

