!<BLF/REQUIRE 'USR_LIBRARY:PRETTY'>
%TITLE 'Convert virtual address to physical address'
MODULE convert (IDENT = 'V001-2',		! File: CONVERT_VA.BLI
		MAIN = MAIN
		) =
BEGIN

!++
!
! FACILITY:	     DECUS pre-symposium seminar 'BLISS for Macro users' examples
!
!		    This routine will show the use of:
!
!		    Condition handling
!		    Run-time library routines
!		    System services
!		    Conditional macro
!		    Keyword macro
!		    Simple macros
!		    Calling a routine in kernel mode
!		    ENABLE
!		    BLOCK
!		    VECTOR
!		    BLOCKVECTOR
!		    ASCID
!
! ABSTRACT:	     This program will ask the user for the virtual address, in
!		    hexadecimal, and respond with the physical address that the
!		    virtual address maps to.
!
!		     The page that contains the virtual address will be first
!		    locked down (using SYS$LCKPAG), this will tell us whether the
!		    address is valid, as SYS$LCKPAG will return error status if
!		    it isn't, and it will keep the page in memory so the physical
!		    address that we return will have some meaning.
!
!		    NOTE: Since this main routine is run in user mode, the user will
!			  not have read access to most of system space, and will not
!			  be able to convert protected system space addresses. This
!			  is not a restriction of the convert routine, but of the
!			  main routine running in user mode.
!
!		     The address can be found simply by extracting the Virtual Page
!		    Number from the virtual address given, and using it as an index
!		    into the appropriate page table (P0, P1, or system), and retreiving
!		    the Page Frame Number.
!
!
! ENVIRONMENT:	    VAX/VMS, kernel mode
!
! AUTHOR:	    Brian K Catlin
!
! CREATED:	    11-MAY-1988
!
! MODIFICATION
! HISTORY:
!
!	V001-2	Brian K Catlin	    12-MAY-1988
!		Add a condition handler to record the worst
!		error detected. This isn't really necessary in
!		this program, but I need to put it somewhere
!		as an example.
!
!	V001-1	Brian K Catlin	    11-MAY-1988
!		Original version
!
!--


%SBTTL 'Declarations'

!+
! SWITCHES:
!-

SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);

!+
! LINKAGE/GLOBAL REGISTERS:
!-

!	None.

!+
! LINKAGES:
!-

!	None.

!+
! TABLE OF CONTENTS:
!
!   MAIN	    Main entry point, called by VMS
!   ERROR_HANDLER   Condition handler called when an error is signaled
!   GET_PHY_ADDR    Translate a virtual address to a physical address
!
!-

FORWARD ROUTINE
    MAIN,
    error_handler,
    get_phy_addr;

!+
! INCLUDE FILES:
!-

LIBRARY 'SYS$LIBRARY:LIB';			! VMS executive macros/symbols.

!+
! MACROS:
!-

MACRO
    _match (key, item) [] =

!+
!
! FUNCTIONAL DESCRIPTION:
!
!	This macro recursively matches a given KEY lexeme to each lexeme
!	in a lexeme list.  If a match occurs then the macro expands to a
!	1 (TRUE).  If no match occurs then the macro expands to 0 (FALSE).
!
!	By default, lexemes are converted to uppercase unless the caller
!	encloses each lexeme in quotes.
!
! FORMAL PARAMETERS:
!
!	KEY			Lexeme to be matched.
!	ITEM			List of lexemes to match KEY against.
!
! COMPLETION VALUE:
!
!	0			No match was found.
!	1			Match was found.
!
!-

	!+
	! If KEY is identical to the first argument of the argument list
	! then a match has been made.  Expand to 1 (TRUE).
	!-

	%IF %IDENTICAL (key, item)
	%THEN
	    1 %EXITMACRO
	%ELSE

	    !+
	    ! If there are no more arguments then no match was found.  Exit
	    ! this recursive level with 0 (FALSE).  This will be the expansion
	    ! of the entire recursive structure.
	    !-

	    %IF %NULL (%REMAINING)
	    %THEN
		0 %EXITMACRO

		!+
		! If more arguments exist then recursively call _MATCH.
		!-

	    %ELSE
		_match (key, %REMAINING)
	    %FI

	%FI

    %;

KEYWORDMACRO
    _string_desc (
	    class = s,
	    dtype = t,
	    length = 0,
	    pointer = 0 ) =

!+
!
! FUNCTIONAL DESCRIPTION:
!
!	This macro initializes a string descriptor previously declared
!	using the PRESET attribute.
!
!	The CLASS and DTYPE entries are checked to see if they correspond
!	to valid system defined string type codes.  If not a compiler
!	warning message is given.  Macro expansion continues assuming that
!	the caller has defined his own string type.
!
!	LENGTH and POINTER fields are check to ensure that they are given
!	link-time-constant-expressions as actuals.  If not, the an error
!	is issued, thus terminating all macro expansion.
!
!	The default field specifiers define a null static string.
!
!	A discussion of descriptors and their fields can be found in the
!	"VAX-11 ARCHITECTURE HANDBOOK" starting on page 409.
!
! FORMAL PARAMETERS:
!
!	CLASS		Single lexeme referring to a string descriptor
!			CLASS code.  (Defaults to S)
!	DTYPE		Single lexeme referring to a string descriptor
!			DATA TYPE field.  (Defaults to T)
!	LENGTH		Word expression used to initialize the descriptor
!			LENGTH field.  (Defaults to 0)
!	POINTER		Address expression used to initialize the descriptor
!			POINTER field.  (defaults to 0)
!
!-

	!+
	! Declare the string descriptor as a block structure of the appropriate
	! size as specified by the CLASS code.
	!-

	BLOCK [%NAME ('dsc$k_', class, '_bln'), BYTE]

	!+
	! Preset the fields.
	!-

	PRESET(

	!+
	! If the CLASS or DTYPE fields do not correspond to system defined
	! codes then issue a WARNING.
	!-

	%IF _match (class, s, d, vs)
	%THEN
	%ELSE
	    %WARN ('_STRING_DESC - ', class, ' not a system defined string', ' descriptor class')
	%FI

	[dsc$b_class] = %NAME ('dsc$k_class_', class),

	%IF _match (dtype, t, nu, nl, nlo, nr, nro, nz, p)
	%THEN
	%ELSE
	    %WARN ('_STRING_DESC - ', dtype, ' not a system defined string', ' data type')
	%FI

	[dsc$b_dtype] = %NAME ('dsc$k_dtype_', dtype), [dsc$w_length] = length, [dsc$a_pointer] = pointer)
						! Close off the PRESET.
    %;

MACRO
    _severity_level (status) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This macro extracts the severity level from the supplied condition code
!	and then remaps the severity level such that algabraic comparasions can
!	be made.
!
! FORMAL PARAMETERS:
!
!	status			condition code
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! EXPANSION VALUE:
!
! Returns the severity level of a condition value modified so that a
! binary comparision yields the normal order of importance/severity.
! Undefined (as of the date of the writing of this macro) severity levels
! are included so as to maintain compatability with all future versions
! of VMS.
!
!	Severity	Original Value	Returned Value
!	success		1		0
!	infomational	3		1
!	(undefined)	5		2
!	(undefined)	7		3
!	warning		0		4
!	error		2		5
!	severe/fatal	4		6
!	(undefined)	6		7
!
! SIDE AFFECTS:
!
!	None.
!
!--

	!+
	! Check (at compile time) that the definition of the severity field in
	! a condition value is consistant with this macro.  That is, that the
	! success bit is the low order bit in the severity field.
	!-

	%IF ($byteoffset (sts$v_severity) NEQU $byteoffset (sts$v_success)) OR ($bitposition (sts$v_severity)
	    NEQU $bitposition (sts$v_success)) OR ($fieldwidth (sts$v_success) NEQU 1)
	%THEN
	    %ERROR ('Definition of either STS$V_SEVERITY or STS$V_SUCCESS not compatible with macro expansion'
	    )
	%FI

	BEGIN

	LOCAL
	    condition_code;

	!+
	! Make a local copy of the condition value.  This is done since in some
	! cases the condition value passed will be a constant.
	!-

	condition_code = status;

	!+
	! Convert the passed value into the returned value by right justifying
	! the severity field (less the success field) and subtracting the
	! success bit (after shifting left by the size of the severity field.
	!-

	.condition_code<$bitposition (sts$v_success) + $fieldwidth (sts$v_success),
	    $fieldwidth (sts$v_severity) - $fieldwidth (sts$v_success), 0> + ((1 - .condition_code<
	    $bitposition (sts$v_success), $fieldwidth (sts$v_success), 0>)^($fieldwidth (sts$v_severity) -
	$fieldwidth (sts$v_success)))
	END
    %;

!+
! FIELDS:
!-

!	None.

!+
! STRUCTURES:
!-

!	None.

!+
! PROGRAM SECTION DECLARATIONS:
!-

!	None.

!+
! EQUATED SYMBOLS:
!-

!	None.

!+
! OWN (R/O) STORAGE:
!-

!	None.

!+
! OWN (R/W) STORAGE:
!-

OWN
    l_worst_error : INITIAL (ss$_normal);		! Worst error detected so far

!+
! BUILTIN DECLARATIONS:
!-

!	None.

!+
! EXTERNAL ROUTINES:
!
!   OTS$CVT_TZ_L		Convert a hexadecimal text string to a longword
!   LIB$SYS_FAO			Format an ASCII string, using dynamic strings
!   LIB$GET_INPUT		Get a string from the terminal
!   LIB$PUT_OUTPUT		Write a string to the terminal
!
!-

EXTERNAL ROUTINE
    ots$cvt_tz_l,
    lib$sys_fao,
    lib$get_input,
    lib$put_output;

!+
! EXTERNAL REFERENCES:
!-

EXTERNAL
    mmg$gl_sptbase,				! Address of the system page table
    ctl$gl_pcb : REF BLOCK [, BYTE];		! Address of the PCB for the current process


%SBTTL 'MAIN - Main entry point for this program'
ROUTINE MAIN =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	 This routine will ask the user for the virtual address to be converted,
!	create an argument block to pass this address to the convert routine
!	(get_phy_addr), call the convert routine in kernel mode (requires CMKRNL
!	privilege), and display the physical address on the user's terminal. The
!	convert routine will return the physical address that the virtual address
!	maps to.
!
! ENVIRONMENT:
!
!	All access modes, AST reentrant.
!
! CALLING SEQUENCE:
!
!	main ()		    Called by VMS as the entry point of this program
!
! LINKAGE:
!
!	CALL
!
! FORMAL PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	Worst error detected by condition handler
!
! SIDE EFFECTS:
!
!	Kernel mode call made to convert routine
!
!--

    BEGIN

    LOCAL
	al_lock_range : VECTOR [2, LONG],		! Range of addresses to lock down
	l_status : LONG,				! Generic status variable
	l_virtual_addr : LONG,				! Virtual address to convert
	dsc_descriptor : _string_desc (class = d),	! Generic string descriptor
	al_arg_block : VECTOR [3, LONG];		! Argument block used by SYS$CMKRNL

    !+
    ! Define a condition handler to intercept any signaled errors
    !-

    ENABLE
	error_handler;

    !+
    ! Ask the user for the address to convert
    !-

    IF (l_status = lib$get_input (dsc_descriptor [0, 0, 0, 0], %ASCID'Virtual address in HEX ',
	    dsc_descriptor [dsc$w_length]))
    THEN
	BEGIN

	!+
	! Convert the address from hexadecimal text to a longword
	!-

	IF (l_status = ots$cvt_tz_l (dsc_descriptor [0, 0, 0, 0], l_virtual_addr))
	THEN
	    BEGIN

	    !+
	    ! Try and lock the page into memory. If this isn't a valid page, then
	    ! SYS$LCKPAG will complain, so we'll signal the error and let the system
	    ! tell the user about it
	    !-

	    al_lock_range [0] = .l_virtual_addr;
	    al_lock_range [1] = .l_virtual_addr;

	    IF (l_status = $lckpag (inadr = al_lock_range [0]))
	    THEN
		BEGIN

		!+
		! Create an argument block to pass the virtual address to the convert routine
		! which will be called in KERNEL mode
		!-

		al_arg_block [0] = 1;
		al_arg_block [1] = .l_virtual_addr;
		al_arg_block [2] = 0;
		$cmkrnl (routin = get_phy_addr, arglst = al_arg_block [0]);

		!+
		! Since this is just a demo program, the page containing the virtual
		! address doesn't need to be locked down any longer
		!-

		IF (l_status = $ulkpag (inadr = al_lock_range [0]))
		THEN
		    BEGIN

		    !+
		    ! Format the output string. The convert routine will return the physical address
		    ! in the second parameter of the argument block
		    !-

		    IF (l_status = lib$sys_fao (%ASCID'Physical address = !XL',
			    dsc_descriptor [dsc$w_length], dsc_descriptor [0, 0, 0, 0], .al_arg_block [2]))
		    THEN
			BEGIN

			!+
			! Write the output string to the user's terminal
			!-

			IF NOT (l_status = lib$put_output (dsc_descriptor [0, 0, 0, 0]))
			THEN
			    SIGNAL (.l_status);

			END
		    ELSE
			BEGIN

			!+
			! Error formating output
			!-

			SIGNAL (.l_status);
			END;

		    END
		ELSE
		    BEGIN

		    !+
		    ! Error unlocking pages
		    !-

		    SIGNAL (.l_status);
		    END;

		END
	    ELSE
		BEGIN

		!+
		! Error locking pages into memory
		!-

		SIGNAL (.l_status);
		END;

	    END
	ELSE
	    BEGIN

	    !+
	    ! Error converting input from the user
	    !-

	    SIGNAL (.l_status);
	    END

	END
    ELSE
	BEGIN

	!+
	! Error getting input from the user
	!-

	SIGNAL (.l_status);
	END;

    RETURN (.l_worst_error);			! Routine value
    END;					! End of routine MAIN

%SBTTL 'ERROR_HANDLER - Intercept all signaled errors'
ROUTINE error_handler (r_signal_args, r_mechanism_args) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	 This routine is a condition handler, it will be called by VMS when
!	an error is signaled. If the condition value that was signaled is an
!	error, and the error is more severe than the previous worst error,
!	then save this error as the worst error
!
! ENVIRONMENT:
!
!	All access modes, any IPL
!
! CALLING SEQUENCE:
!
!	status.wlc.v = error_handler (r_signal_args, r_mechanism_args)
!
! LINKAGE:
!
!	CALL
!
! FORMAL PARAMETERS:
!
!	r_signal_args	    Signal argument vector, defined by CHF$x_SIG_xxx structure
!
!	r_mechanism_args    Mechanism argument vector, defined by CHF$x_MCH_xxx structure
!
! IMPLICIT INPUTS:
!
!	worst_error	    Worst error detected so far
!
! IMPLICIT OUTPUTS:
!
!	worst_error	    Worst error detected so far
!
! COMPLETION CODES:
!
!	SS$_CONTINUE	    No further action required
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	r_signal_args : REF BLOCK [, BYTE],
	r_mechanism_args : REF BLOCK [, BYTE];

    BIND
	r_error = r_signal_args [chf$l_sig_name] : BLOCK [, LONG],	! Condition code
	l_psl = r_signal_args [.r_signal_args [chf$l_sig_args]*%UPVAL, 0, 0, 0] : BLOCK [, LONG];

    !+
    ! Update worst error detected so far
    !-

    IF ( NOT .r_error) AND (_severity_level (.r_error) GTRU _severity_level (.l_worst_error))
    THEN
	l_worst_error = .r_error OR sts$m_inhib_msg;

    !+
    ! If the error occured in kernel mode, continue, otherwise look for another
    ! condition handler by resignaling the error
    !-

    IF (.l_psl [psl$v_curmod] EQLU psl$c_kernel)
    THEN
	ss$_continue
    ELSE
	ss$_resignal

    END;					! End of routine ERROR_HANDLER

%SBTTL 'GET_PHY_ADDR - Look up the passed virtual address, and pass back its physical address'
ROUTINE get_phy_addr (r_virt_addr, l_phy_addr) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	 This routine will look up the corresponding physical address for
!	a given virtual address. This is done by extracting the Virtual
!	Page Number (VPN) from the virtual address (bits 10 through 31),
!	and using this as an index into the appropriate page table (P0,
!	P1, or system, selected by looking at bits 30 and 31), and
!	returning the Page Frame Number (PFN) for that page.
!
!	NOTE: This routine assumes that the given virtual address is
!	      within range, and in memory, so no checking is done as
!	      to whether this a valid page
!
! ENVIRONMENT:
!
!	Kernel access mode
!
! CALLING SEQUENCE:
!
!	get_phy_addr (r_virt_addr, l_phy_addr)
!
! LINKAGE:
!
!	CALL
!
! FORMAL PARAMETERS:
!
!	r_virt_addr		Virtual address to convert
!	l_phy_addr		Physical address of passed virtual address
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	SS$_NORMAL	Normal successful completion.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	r_virt_addr : BLOCK [, BYTE];		! Make the r_virt_addr look like a block so we

    						! can reference bit fields within it

    LOCAL
	r_page_table : REF BLOCKVECTOR [, pte$s_ptedef, BYTE];

    !+
    ! Determine which page table to use. If bit 31 (va$v_system) is set, then this
    ! is a system space (above 80000000) address
    !-

    IF .r_virt_addr [va$v_system]
    THEN
	r_page_table = .mmg$gl_sptbase		! Use the system page table
    ELSE

    !+
    ! Since this isn't a system space address, we now have to decide which
    ! process page table to use, P0, or P1. If bit 30 (va$v_p1) is set, then
    ! this is a P1 space (40000000 to 7fffffff) address, otherwise it is a
    ! P0 space (00000000 to 3fffffff) address
    !-

	BEGIN

	LOCAL
	    r_proc_hdr : REF BLOCK [, BYTE];

	r_proc_hdr = .ctl$gl_pcb [pcb$l_phd];	! Get the address of our process header

	IF .r_virt_addr [va$v_p1]
	THEN
	    r_page_table = .r_proc_hdr [phd$l_p1br]	! Use process P1 page table
	ELSE
	    r_page_table = .r_proc_hdr [phd$l_p0br];	! Use process P0 page table

	END;

    !+
    ! Now that we have the correct page table, look up the address of the page
    ! that the virtual page is mapped to, and then add in the offset within that
    ! page (va$v_byte) so we get the address of the byte the user is requesting
    !-

    l_phy_addr = (.r_page_table [.r_virt_addr [va$v_vpn], pte$v_pfn]^va$s_byte) + .r_virt_addr [va$v_byte];
!
    ss$_normal					! Routine value
    END;					! End of routine GET_PHY_ADDR
END						! End of module CONVERT

ELUDOM