From: goathunter@wkuvx1.bitnet
Newsgroups: comp.os.vms
Subject: Re: System-Call for (DCL) SET PROMPT
Date: 26 Sep 92 23:21:46 GMT
Organization: Western Kentucky University, Bowling Green, KY

In article <1992Sep26.202041.8417@wega.rz.uni-ulm.de>, S_REHFELD@rzmain.rz.uni-ulm.de (Rehfeld Tobias) writes:
> How can one change the DCL-prompt from a highlevel programing language,
> like DCLs SET PROMPT does?
> 
It can only be done by going into executive mode.  The MACRO routine
included below will do it for you.

Hunter
------
Hunter Goatley, VMS Systems Programmer, Western Kentucky University
goathunter@WKUVX1.BITNET, 502-745-5251

	.TITLE	SET_DCL_PROMPT - Change the DCL prompt
	.IDENT	/01-001/
;========================================================================
;=									=
;=	Program:	PROMPT.MAR					=
;=									=
;=	Programmer:	Hunter Goatley					=
;=			Western Kentucky University			=
;=			Academic Computing, STH 226			=
;=			Bowling Green, KY 42101				=
;=			(502) 745-5251					=
;=			goathunter@WKUVX1.BITNET			=
;=									=
;=	Date:		December 7, 1988				=
;=									=
;=	Purpose:	Set the DCL prompt for a process.		=
;=									=
;========================================================================
;
;
;  This program also performs the functions:
;
;	$ SET MESSAGE/NOFAC/NOSEV/NOIDENT
;	$ SET NOVERIFY
;	$ SET PROMPT="May I help you? "
;
;  To build:
;
;	$ MACRO PROMPT
;	$ LINK PROMPT
;	$ RUN PROMPT
;
;  To make this callable, simply remove the label "SET_DCL_PROMPT" from the
;	last line (.END).
;
;	CALL SET_DCL_PROMPT()
;
;  To pass the new prompt as an argument, uncomment the lines between the lines
;	;*********.  This would look like CALL SET_DCL_PROMPT ("New Prompt").
;
;  DCL requires that the prompt be less than or equal to 32 characters.
;
;
;  Calling from FORTRAN:
;
;	PROGRAM X
;	EXTERNAL SET_DCL_PROMPT
;	CALL SET_DCL_PROMPT (%DESCR('Hello: '))
;	END
;

	.LIBRARY	/SYS$LIBRARY:LIB.MLB/		; Needed for $PHDDEF
;
;  Link to two of the system symbol tables (DCL and SYS)
;
	.LINK	"SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH
	.LINK	"SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH

	$CHFDEF					; Condition Handler symbols
	$PHDDEF					; Process Header symbols

	.PSECT	_SET_DCL_PROMPT_DATA,NOEXE,NOWRT,LONG

PROMPT:		.ASCID	/May I help you? /	; The new prompt

ASSUME	<.-PROMPT-8> LE 32			; Prompt must be less than 32


	.PSECT	_SET_DCL_PROMPT_EXE,EXE,NOWRT,LONG

	.ENTRY	SET_DCL_PROMPT,^M<>
;******
;	$CMKRNL_S -				; Need to go into kernel mode
;		ROUTIN=10$,-			; ... to do this stuff
;		ARGLST=(AP)			; ...
;******
	$CMKRNL_S -				; Need to go into kernel mode
		ROUTIN=10$			; ... to do this stuff
	RET					; Return to our caller

 10$:	.WORD	^M<R2,R3,R4,R5,R6>		; Entry mask - save registers
	MOVAL	KRNL_HANDLER,(FP)		; Set up ACCVIO handler
						;
	MOVB	#1,G^CTL$GB_MSGMASK		; Set MESSAGE mask
						;
	MOVAL	G^CTL$AG_CLIDATA,R6		; Get address of CLI data in P1
	MOVL	PPD$L_PRC(R6),R6		; Get address of PRC region
	BICW2	#PRC_M_VERIFY,PRC_W_FLAGS(R6)	; Turn VERIFY off
						;
;********					; To pass a prompt in
;	MOVL	4(AP),R0			; Move address of prompt to R0
;	CMPB	#32,(R0)			; Is it less than 32 characters?
;	BLSS	20$				; No - return to caller
;********

	MOVAL	PROMPT,R0			; Get address of prompt
	ADDB3	#3,(R0),PRC_B_PROMPTLEN(R6)	; Set length of prompt (need +3
						; ... to count <CR><LF>_)
	MOVC3	(R0),@4(R0),PRC_G_PROMPT(R6)	; Move prompt into PRC region
						;
 20$:	MOVL	#SS$_NORMAL,R0			; Return success
	RET					; Return to caller

	.SBTTL	KRNL_HANDLER condition handler
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Routine:	KRNL_HANDLER
;
;  Purpose:	Kernel mode access violation handler.  Declaring this routine
;		as a condition handler for a kernel mode routine will prevent
;		the system from crashing if something goes wrong in the routine
;		(most likely an access violation).
;
;		If an access violation occurs, this routine gains control, sets
;		up call frame to return SS$_ACCVIO, and unwinds to the previous
;		caller.
;
	.ENTRY	KRNL_HANDLER,^M<>
	MOVL	CHF$L_MCHARGLST(AP),R0		; Get mechanism array address
	CLRL	CHF$L_MCH_SAVR1(R0)		; Clear saved R1 in array
	MOVL	#SS$_ACCVIO,CHF$L_MCH_SAVR0(R0)	; Put ACCVIO status in saved R0
	$UNWIND_S				; Unwind to previous caller
	RET					; Return ACCVIO to caller

	.END	SET_DCL_PROMPT
Xref: sparky comp.os.vms:15701 alt.binaries.pictures.utilities:1132