!<BLF/REQUIRE 'USR$LIBRARY:PRETTY'>
%TITLE 'LIBEXT - Extensions to LIB.REQ'

!++
!
! FACILITY:	LIBEXT
!
! ABSTRACT:	Extensions to the VMS library LIB.REQ; i.e. macros which appear in LIB.MAR
!		but not in LIB.REQ.
!
! ENVIRONMENT:	VMS 4.4 or later.
!
! RESTRICTIONS:	Macros not currently planned for implementation are:
!			CASE		CPUDISP
!			PFN_DISP_ELSE	PFN_DISP_ENDIF	PFN_DISP_IF_BIGPFN_THEN
!
!		Macros implemented by other different macros are:
!			PFN_REFERENCE	by	_PFN_DECREMENT
!
! AUTHOR:	James A. Gray
!
! CREATED:	4 September 1984
!
! MODIFICATION HISTORY:
!
!	V001	4 September 1984, James A. Gray
!		Original version.
!
!--

%SBTTL 'Include files'

LIBRARY 'SYS$LIBRARY:LIB';


%SBTTL '_ACCEPT'

!+
!-

KEYWORDMACRO
    _accept (
	    msgadr = 0,
	    dgadr = 0,
	    erradr,
	    initcr = 0,
	    minscr = 0,
	    initdg = 0,
	    blkpri = 0,
	    condat = 0,
	    auxstr = 0,
	    badrsp = 0,
	    retadr) =
	BEGIN
	ROUTINE call_accept : NOVALUE =
	    BEGIN

	    BUILTIN
		FP;

	    LINKAGE
		accept_linkage = JSB;

	    EXTERNAL ROUTINE
		scs$accept : accept_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    LOCAL
		al_params : VECTOR [2, LONG];

	    BIND
		r_stack_frame = .FP : BLOCK [, BYTE],
		aw_params = al_params [0] : VECTOR [, WORD],
		w_initcr = aw_params [0] : WORD,
		w_minscr = aw_params [1] : WORD,
		w_initdg = aw_params [2] : WORD,
		w_blkpri = aw_params [3] : WORD;

	    w_initcr = initcr;
	    w_minscr = minscr;
	    w_initdg = initdg;
	    w_blkpri = blkpri;

	    %IF %NULL (erradr)
	    %THEN
		%ERROR ('Error address (ERRADR) is required')
	    %FI

	    %IF %NULL (retadr)
	    %THEN
		scs$accept (msgadr, dgadr, erradr, .al_params [0], .al_params [1], condat, auxstr, badrsp,
		    .r_stack_frame [sf$l_save_pc]);
	    %ELSE
		scs$accept (msgadr, dgadr, erradr, .al_params [0], .al_params [1], condat, auxstr, badrsp,
		    retadr);
	    %FI

	    END;
	call_accept ();
	END
    %;


%SBTTL '_ALLOC_DG_BUF'

!+
!-

KEYWORDMACRO
    _alloc_dg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_allocdg])
	END
    %;


%SBTTL '_ALLOC_MSG_BUF'

!+
!-

KEYWORDMACRO
    _alloc_msg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_allocmsg])
	END
    %;


%SBTTL '_ALLOC_RSPID'

!+
!-

MACRO
    _alloc_rspid =
	BEGIN

	LINKAGE
	    alloc_rspid_linkage = JSB;

	EXTERNAL ROUTINE
	    scs$alloc_rspid : alloc_rspid_linkage ADDRESSING_MODE (GENERAL);

	scs$alloc_rspid ()
	END
    %;


%SBTTL '_BT_TIMEWAIT'

!+
!-

KEYWORDMACRO
    _bt_timewait (
	    rpb,
	    time,
	    tst_field,
	    sense = 1,
	    units = sec ) =
	NOT
	BEGIN

	BIND
	    r_rpb = rpb : BLOCK [, BYTE],
	    al_iovec = .r_rpb [rpb$l_iovec] : BLOCK [, BYTE];

	DECR i FROM (time

		%IF %IDENTICAL (units, 'USEC')
		%THEN
		    /10
		%ELSE

		    %IF %IDENTICAL (units, 'MSEC')
		    %THEN
			*100
		    %ELSE

			%IF %IDENTICAL (units, 'SEC')
			%THEN
			    *1000*100
			%FI

		    %FI

		%FI

		)*.al_iovec [bqo$l_tenusec] - 1 TO 1 DO
	    BEGIN

	    IF sense XOR tst_field THEN EXITLOOP NOT ss$_normal;

	    DECR j FROM .al_iovec [bqo$l_ubdelay] - 1 TO 1 DO
		_nothing;

	    END

	END
    %;


%SBTTL '_BT_TIMEDWAIT'

!+
!-

KEYWORDMACRO
    _bt_timedwait (
	    rpb,
	    time,
	    codblk,
	    units = sec ) =
	NOT
	BEGIN

	BIND
	    r_rpb = rpb : BLOCK [, BYTE],
	    al_iovec = .r_rpb [rpb$l_iovec] : BLOCK [, BYTE];

	DECR i FROM (time

		%IF %IDENTICAL (units, 'USEC')
		%THEN
		    /10
		%ELSE

		    %IF %IDENTICAL (units, 'MSEC')
		    %THEN
			*100
		    %ELSE

			%IF %IDENTICAL (units, 'SEC')
			%THEN
			    *1000*100
			%FI

		    %FI

		%FI

		)*.al_iovec [bqo$l_tenusec] - 1 TO 1 DO
	    BEGIN

	    %IF NOT %NULL (codblk)
	    %THEN

		IF codblk THEN EXITLOOP NOT ss$_normal;

	    %FI

	    DECR j FROM .al_iovec [bqo$l_ubdelay] - 1 TO 1 DO
		_nothing;

	    END

	END
    %;


%SBTTL '_BUGCHK'

!+
!-

KEYWORDMACRO
    _bugchk (
	    subsystem,
	    error,
	    type = cont,
	    callop = op$_bsbw,
	    mode = WORD_RELATIVE ) =
	BEGIN

	COMPILETIME
	    string_size = %CHARCOUNT (subsystem) + 1 + %CHARCOUNT (error) + 1;

	MACRO
	    __asciz (fld_off, str_text) =
		__ascii (fld_off, %EXPLODE (str_text)), [fld_off + string_size - 1, 0, 8, 0] = 0 %QUOTE %;

	MACRO
	    __ascii (fld_off) [character] =
		[fld_off + %COUNT, 0, 8, 0] = character %QUOTE %;

	LINKAGE
	    bugchk_linkage = JSB;

	%IF %IDENTICAL (type, 'FATAL')
	%THEN

	    EXTERNAL ROUTINE
		exe$bugchkfatal;

	%ELSE

	    EXTERNAL ROUTINE
		exe$bugchkcont;

	%FI

	OWN
	    call_code : BLOCK [16 + string_size, BYTE] PRESET ( [0, 0, 8, 0] = op$_movl, [1, 0, 8, 0] = %X'8E'
		, 				! (SP)+
		[2, 0, 8, 0] = %X'AF', 		! B^
		[3, 0, 8, 0] = call_code [11 + string_size, 0, 32, 0] - call_code [4, 0, 0, 0], 	! D
		[4, 0, 8, 0] = callop,

		%IF %IDENTICAL (type, 'FATAL')
		%THEN
		    [5, 0, 32, 0] = exe$bugchkfatal,
		%ELSE
		    [5, 0, 32, 0] = exe$bugchkcont,
		%FI

		! [9, 0, 16, 0] =			! BUGCHECK string (ASCIZ); handled below
		__asciz (9, %STRING (subsystem, '_', error)), 	! BUGCHECK string (ASCIZ)
		[9 + string_size, 0, 8, 0] = op$_jmp, [10 + string_size, 0, 8, 0] = %X'9F', 	! @#
		[11 + string_size, 0, 32, 0] = 0);	! location

	JSB (call_code [0, 0, 0, 0]);
	END
    %;


%SBTTL '_BUG_CHECK'

!+
!-

KEYWORDMACRO
    _bug_check (
	    error,
	    type = cont ) =
	BEGIN

	BUILTIN
	    BUGW;

	EXTERNAL LITERAL %NAME ('BUG$_', error);

	%IF %IDENTICAL (type, 'FATAL')
	%THEN
	    BUGW (%NAME ('BUG$_', error) OR sts$k_severe)
	%ELSE
	    BUGW(%NAME ('BUG$_', error))
	%FI

	END
    %;


%SBTTL '_CONFIG_PTH'

!+
!-

KEYWORDMACRO
    _config_pth (
	    staadr = 0,
	    outbuf = 0 ) =
	BEGIN

	LINKAGE
	    scs_linkage = JSB (REGISTER = 1, REGISTER = 2);

	EXTERNAL ROUTINE
	    scs$config_pth : scs_linkage ADDRESSING_MODE (GENERAL);

	scs$config_pth (staadr, outbuf)
	END
    %;


%SBTTL '_CONFIG_SYS'

!+
!-

KEYWORDMACRO
    _config_sys (
	    sysadr = 0,
	    outbuf = 0 ) =
	BEGIN

	LINKAGE
	    scs_linkage = JSB (REGISTER = 1, REGISTER = 2);

	EXTERNAL ROUTINE
	    scs$config_pth : scs_linkage ADDRESSING_MODE (GENERAL);

	scs$config_pth (sysadr, outbuf)
	END
    %;


%SBTTL '_CONNECT'

!+
!-

KEYWORDMACRO
    _connect (
	    msgadr = 0,
	    dgadr = 0,
	    erradr,
	    rsysid = 0,
	    rstadr = 0,
	    rprnam = 0,
	    lprnam = 0,
	    initcr = 0,
	    minscr = 0,
	    initdg = 0,
	    blkpri = 0,
	    condat = 0,
	    auxstr = 0,
	    badrsp = 0,
	    retadr) =
	BEGIN
	ROUTINE call_connect : NOVALUE =
	    BEGIN

	    BUILTIN
		FP;

	    LINKAGE
		connect_linkage = JSB;

	    EXTERNAL ROUTINE
		scs$connect : connect_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    LOCAL
		al_params : VECTOR [2, LONG],
		l_status;

	    BIND
		r_stack_frame = .FP : BLOCK [, BYTE],
		aw_params = al_params [0] : VECTOR [, WORD],
		w_initcr = aw_params [0] : WORD,
		w_minscr = aw_params [1] : WORD,
		w_initdg = aw_params [2] : WORD,
		w_blkpri = aw_params [3] : WORD;

	    w_initcr = initcr;
	    w_minscr = minscr;
	    w_initdg = initdg;
	    w_blkpri = blkpri;

	    %IF %NULL (erradr)
	    %THEN
		%ERROR ('Error address (ERRADR) is required')
	    %FI

	    %IF %NULL (retadr)
	    %THEN
		l_status = scs$connect (msgadr, dgadr, erradr, rsysid, rstadr, rprnam, lprnam,
		    .al_params [0], .al_params [1], condat, auxstr, badrsp, .r_stack_frame [sf$l_save_pc]);
	    %ELSE
		l_status = scs$connect (msgadr, dgadr, erradr, rsysid, rstadr, rprnam, lprnam,
		    .al_params [0], .al_params [1], condat, auxstr, badrsp, retadr);
	    %FI

	    END;
	call_connect ();
	END
    %;


%SBTTL '_DDTAB'

!+
! This macro generates a driver-dispatch table labeled devnam$DDT.
!
! DEVNAM
!	The generic name of the device.
!
! [START = 0]
!	The address of the start-I/O routine.  0 => IOC$RETURN.
!
! [UNSOLIC = 0]
!	The address of the unsolicited-interrupt-servicing routine.  0 => IOC$RETURN.
!
! FUNCTB
!	The address of the function-decision table.
!
! [CANCEL = 0]
!	The address of the cancel-I/O routine.  0 => IOC$RETURN.
!
! [REGDMP = 0]
!	The address of the register-dumping routine.  0 => IOC$RETURN.
!
! [DIAGBF = 0]
!	The length, in bytes, of the diagnostic buffer.
!
! [ERLGBF = 0]
!	The length, in bytes, of the error-logging buffer.
!
! [UNITINIT = 0]
!	The address of the unit-initialization routine.  0 => IOC$RETURN.
!
! [ALTSTART = 0]
!	The address of the alternate start-I/O routine.  0 => IOC$RETURN.
!
! [MNTVER = IOC$MNTVER]
!	The address of the mount-verification routine; the default is suitable
!	for all single-stream disk drives.
!
! [CLONEDUCB = 0]
!	The address of the routine called when a UCB is cloned by the $ASSIGN
!	system service.  0 => IOC$RETURN.
!
! [MNTV_SSSC = 0]
!	0 => IOC$RETURN.
!
! [MNTV_FOR = 0]
!	0 => IOC$RETURN.
!
! [MNTV_SQD = 0]
!	0 => IOC$RETURN.
!-

KEYWORDMACRO
    _ddtab (
	    devnam,
	    start = 0,
	    unsolic = 0,
	    functb,
	    cancel = 0,
	    regdmp = 0,
	    diagbf = 0,
	    erlgbf = 0,
	    unitinit = 0,
	    altstart = 0,
	    mntver = ioc$mntver,
	    cloneducb = 0,
	    mntv_sssc = 0,
	    mntv_for = 0,
	    mntv_sqd = 0 ) =

	MACRO
	    __genraddr (address) =
		_genraddr (address, %NAME (devnam, '$DDT')) %QUOTE %;

	%IF %IDENTICAL (mntver, ioc$mntver)
	%THEN

	    %IF NOT %DECLARED (ioc$mntver)
	    %THEN

		EXTERNAL ROUTINE
		    ioc$mntver : ADDRESSING_MODE (GENERAL);

	    %FI

	%FI

	GLOBAL
	    %NAME (devnam, '$DDT') : BLOCK [ddt$k_length, BYTE] PSECT ($$$115_driver)	!
		PRESET (			!
		[ddt$l_start] = __genraddr (start), 	! Address of driver start I/O routine
		[ddt$l_unsolint] = __genraddr (unsolic), 	! Address of unsolicited interrupt routine
		[ddt$l_fdt] = __genraddr (functb), 	! Address of function decision table
		[ddt$l_cancel] = __genraddr (cancel), 	! Address of cancel I/O entry point
		[ddt$l_regdump] = __genraddr (regdmp), 	! Address of device register dump routine
		[ddt$w_diagbuf] = diagbf, 	! Size of diagnostic buffer in bytes
		[ddt$w_errorbuf] = erlgbf, 	! Size of error log buffer in bytes
		[ddt$l_unitinit] = __genraddr (unitinit), 	! Unit initialization entry point
		[ddt$l_altstart] = __genraddr (altstart), 	! Alternate start I/O entry point
		[ddt$l_mntver] = __genraddr (mntver), 	! Address of mount verification routine
		[ddt$w_fdtsize] = functab_len, 	! Size of FDT in bytes
		[ddt$l_cloneducb] = __genraddr (cloneducb), 	! Address of cloned UCB entry point
		[ddt$l_mntv_sssc] = __genraddr (mntv_sssc), 	! Address of shadow set state change MV entry
		[ddt$l_mntv_for] = __genraddr (mntv_for), 	! Address of foreign device MV entry
		[ddt$l_mntv_sqd] = __genraddr (mntv_sqd)	! Address of sequential device MV entry
		);

	UNDECLARE %QUOTE %QUOTE
	    __genraddr;

    %;


%SBTTL '_DEALLOC_DG_BUF'

!+
!-

KEYWORDMACRO
    _dealloc_dg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_deallocdg])
	END
    %;


%SBTTL '_DEALLOC_MSG_BUF'

!+
!-

KEYWORDMACRO
    _dealloc_msg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_deallomsg])
	END
    %;


%SBTTL '_DEALLOC_MSG_BUF_REG'

!+
!-

KEYWORDMACRO
    _dealloc_msg_buf_reg (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_dealrgmsg])
	END
    %;


%SBTTL '_DEALLOC_RSPID'

!+
!-

MACRO
    _dealloc_rspid =
	BEGIN

	LINKAGE
	    deall_rspid_linkage = JSB;

	EXTERNAL ROUTINE
	    scs$deall_rspid : deall_rspid_linkage ADDRESSING_MODE (GENERAL);

	scs$deall_rspid ()
	END
    %;


%SBTTL '_DECREF'

!+
!-

KEYWORDMACRO
    _decref (
	    pfn,
	    pfn_mode = GENERAL,
	    rtn_mode = GENERAL ) =
	BEGIN

	EXTERNAL
	    pfn$aw_refcnt : REF VECTOR [, WORD] ADDRESSING_MODE (pfn_mode);

	EXTERNAL ROUTINE
	    mmg$refcntneg : ADDRESSING_MODE (rtn_mode);

	IF (pfn$aw_refcnt [pfn] = .pfn$aw_refcnt [pfn] - 1) LSS 0 THEN mmg$refcntneg ();

	.pfn_aw_refcnt [pfn]
	END
    %;


%SBTTL '_DECSHR'

!+
!-

KEYWORDMACRO
    _decshr (
	    pfn,
	    bigpfn_mode = GENERAL,
	    pfn_mode = GENERAL,
	    rtn_mode = GENERAL,
	    image_flag = nosys ) =
	BEGIN

	LOCAL
	    pfn_l_shrcnt;

	EXTERNAL ROUTINE
	    mmg$shrcntneg : ADDRESSING_MODE (rtn_mode);

	pfn_l_shrcnt = _pfn_decrement (pfn);

	IF (.pfn_l_shrcnt) LSS 0 THEN mmg$shrcntneg ();

	.pfn_l_shrcnt
	END
    %;


%SBTTL '_DISCONNECT'

!+
!-

KEYWORDMACRO
    _disconnect (
	    distyp) =
	BEGIN

	LINKAGE
	    disconnect_linkage = JSB;

	EXTERNAL ROUTINE
	    scs$disconnect : disconnect_linkage (

		    REGISTER
		    = 0) ADDRESSING_MODE (GENERAL);

	scs$disconnect (distyp)
	END
    %;


%SBTTL '_DPTAB'

!+
! This macro generates a driver-prologue table in a program section
! called $$$105_PROLOGUE.
!
! DRVREND
!	The address of the end of the driver.
!
! ADAPTER
!	The type of adapter, e.g. UBA, MBA, DR, NULL.
!
! [FLAGS = 0]
!	The flags used in loading the driver.
!
! UCBSIZE
!	The size, in bytes, of the unit-control block required by each
!	device that this driver will drive.
!
! [UNLOAD]
!	The address of the routine in the driver that SYSGEN is to call
!	before unloading the driver and loading a new version of the driver.
!
! [MAXUNITS = 8]
!	The maximum number of device units that can be connected to the
!	controller.
!
! [DEFUNITS = 1]
!	The maximum number of UCBs to be created by SYSGEN's AUTOCONFIGURE
!	command (one for each device unit to be configured).
!
! [DELIVER]
!	The address of the routine in the driver that determines whether a
!	unit should be configured automatically, the unit-delivery routine.
!
! [VEC]
!	Reserved to DIGITAL; the address of a driver-specific transfer vector.
!
! NAME
!	The name of the device driver.
!-

KEYWORDMACRO
    _dptab (
	    drvrend,
	    adapter,
	    flags = 0,
	    ucbsize,
	    unload,
	    maxunits = 8,
	    defunits = 1,
	    deliver,
	    vec,
	    name) =

	MACRO
	    __ascic (fld_off, fld_pos, fld_siz, fld_ext, str_siz, str_text) =

		%IF fld_pos NEQ 0
		%THEN
		    %ERROR ('String does not begin on a BYTE boundary')
		%FI

		%IF str_siz LSS (1 + %CHARCOUNT (str_text))
		%THEN
		    %ERROR ('Insufficient space for string')
		%FI

		[fld_off, 0, 8, 0] = %CHARCOUNT (str_text), __ascii (fld_off + 1, %EXPLODE (str_text)) %QUOTE
	    %;

	MACRO
	    __ascii (fld_off) [character] =
		[fld_off + %COUNT, 0, 8, 0] = character %QUOTE %;

	MACRO
	    __reladdr (address) =

		%IF NOT %NULL (address)
		%THEN
		    address - dpt_tab
		%ELSE
		    0
		%FI

		%QUOTE %;

	FORWARD
	    dpt_initab : VECTOR [0, BYTE],
	    dpt_reinitab : VECTOR [0, BYTE];

	OWN
	    dpt_tab : BLOCK [dpt$k_length, BYTE] PSECT ($$$105_prologue)	!
		PRESET (			!
		[dpt$w_size] = drvrend - dpt_tab, 	! Size of driver
		[dpt$b_type] = dyn$c_dpt, 	! Structure type
		[dpt$b_refc] = 0, 		! Count of DDB's that reference driver
		[dpt$b_adptype] = %NAME ('AT$_', adapter), 	! Adapter type code
		[dpt$b_flags] = flags, 		! Driver loader flags
		[dpt$w_ucbsize] = ucbsize, 	! Size of UCB
		[dpt$w_inittab] = dpt_initab - dpt_tab, 	! Offset to init table
		[dpt$w_reinittab] = dpt_reinitab - dpt_tab, 	! Offset to re-init table
		[dpt$w_unload] = __reladdr (unload), 	! Offset to unload action routine
		[dpt$w_maxunits] = maxunits, 	! Maximum units that can be connected
		[dpt$w_version] = dpt$c_version, 	! Driver prologue version number
		[dpt$w_defunits] = defunits, 	! Default number of units
		[dpt$w_deliver] = __reladdr (deliver), 	! Offset to driver unit delivery routine
		[dpt$w_vector] = __reladdr (vec), 	! Offset to vector table (in TTDRIVER)
		__ascic (dpt$t_name, dpt$s_name, name),
		![Dpt$t_name]=, 		! Driver name (counted string); handled below
		![Dpt$q_linktime]=, 		! Link date and time from image header; is zero anyway
		[dpt$l_ecolevel] = 0		! ECO level from image header
		);

	UNDECLARE %QUOTE %QUOTE
	    __ascic,
	    %QUOTE %QUOTE __reladdr;

    %;


%SBTTL '_DPT_STORE'

!+
! This macro, used within a driver, instructs the system's driver-loading
! procedure to store values in a table of data structure.
!
! STR_TYPE
!	The type of control block into which the data is to be stored (DDB,
!	UCB, ORB, CRB or IDB) or a table marker (INIT, REINIT or END).
!
! STR_OFF
!	The offset, in bytes, from the begining of the data structure at
!	which the data is to be stored.
!
! STR_POS
!	The offset, in bits, from the position specified by STR_OFF at
!	which the data is to be stored.  Not used; only present so field
!	macros may be used.
!
! STR_SIZ
!	The size, in bits, of the field at which the data is to be stored.
!	Only used if OPER='V'.
!
! STR_EXT
!	The sign extension flag of the field at which the data is to be
!	stored.  Only used if OPER='V'.
!
! OPER
!	The type of storage operation, one of the following:
!		'B'	Byte
!		'W'	Word
!		'L'	Longword
!		'D'	Address relative to the begining of the driver
!		'V'	Bit field
!	If an at-sign character (@) precedes the OPER argument, then the
!	EXP argument describes the address of the data with which to
!	initialize the field, e.g. '@B'.
!
! EXP
!	The value with which to initialize the field; if OPER is preceded
!	by an at-sign (@), then the address at which to find the value
!	with which to initialize the field.
!-

MACRO
    _dpt_store (str_type, str_off, str_pos, str_siz, str_ext, oper, exp) =

	%IF %IDENTICAL (str_type, 'INIT')
	%THEN

	    OWN
		dpt_initab : VECTOR [0, BYTE] PSECT ($$$105_prologue);

	%ELSE

	    %IF %IDENTICAL (str_type, 'REINIT')
	    %THEN

		OWN
		    dpt_reinitab : VECTOR [0, BYTE] PSECT ($$$105_prologue);

	    %ELSE

		%IF %IDENTICAL (str_type, 'END')
		%THEN

		    OWN
			dpt : ALIGN (0) VECTOR [1, BYTE] PSECT ($$$105_prologue) INITIAL (BYTE (0));

		    UNDECLARE
			dpt;

		%ELSE

		    OWN
			dpt : ALIGN (0) VECTOR [2, BYTE] PSECT ($$$105_prologue)	!
			    INITIAL (BYTE (%NAME ('DYN$C_', str_type), str_off));

		    UNDECLARE
			dpt;

		    %IF %IDENTICAL (oper, 'B')
		    %THEN

			OWN
			    dpt : ALIGN (0) BLOCK [2, BYTE] PSECT ($$$105_prologue)	!
				PRESET ( [0, 0, 8, 0] = 0, [1, 0, 8, 0] = exp);

			UNDECLARE
			    dpt;

		    %ELSE

			%IF %IDENTICAL (oper, 'W')
			%THEN

			    OWN
				dpt : ALIGN (0) BLOCK [3, BYTE] PSECT ($$$105_prologue)	!
				    PRESET ( [0, 0, 8, 0] = 1, [1, 0, 16, 0] = exp);

			    UNDECLARE
				dpt;

			%ELSE

			    %IF %IDENTICAL (oper, 'D')
			    %THEN

				OWN
				    dpt : ALIGN (0) BLOCK [3, BYTE] PSECT ($$$105_prologue)	!
					PRESET ( [0, 0, 8, 0] = 2, [1, 0, 16, 0] = exp - dpt_tab);

				UNDECLARE
				    dpt;

			    %ELSE

				%IF %IDENTICAL (oper, 'L')
				%THEN

				    OWN
					dpt : ALIGN (0) BLOCK [5, BYTE] PSECT ($$$105_prologue)	!
					    PRESET ( [0, 0, 8, 0] = 3, [1, 0, 32, 0] = exp);

				    UNDECLARE
					dpt;

				%ELSE

				    %IF %IDENTICAL (oper, 'V')
				    %THEN

					OWN
					    dpt : ALIGN (0) BLOCK [7, BYTE] PSECT ($$$105_prologue)	!
						PRESET ( [0, 0, 8, 0] = 4, [1, 0, 32, 0] = exp, [5, 0, 8, 0] =
						str_pos, [6, 0, 8, 0] = str_siz);

					UNDECLARE
					    dpt;

				    %FI

				%FI

			    %FI

			%FI

		    %FI

		    %IF %IDENTICAL (oper, '@B')
		    %THEN

			OWN
			    dpt : ALIGN (0) BLOCK [5, BYTE] PSECT ($$$105_prologue)	!
				PRESET ( [0, 0, 8, 0] = %X'80' + 0, [1, 0, 32, 0] = exp);

			UNDECLARE
			    dpt;

		    %ELSE

			%IF %IDENTICAL (oper, '@W')
			%THEN

			    OWN
				dpt : ALIGN (0) BLOCK [5, BYTE] PSECT ($$$105_prologue)	!
				    PRESET ( [0, 0, 8, 0] = %X'80' + 1, [1, 0, 32, 0] = exp);

			    UNDECLARE
				dpt;

			%ELSE

			    %IF %IDENTICAL (oper, '@D')
			    %THEN

				OWN
				    dpt : ALIGN (0) BLOCK [5, BYTE] PSECT ($$$105_prologue)	!
					PRESET ( [0, 0, 8, 0] = %X'80' + 2, [1, 0, 32, 0] = exp - dpt_tab);

				UNDECLARE
				    dpt;

			    %ELSE

				%IF %IDENTICAL (oper, '@L')
				%THEN

				    OWN
					dpt : ALIGN (0) BLOCK [5, BYTE] PSECT ($$$105_prologue)	!
					    PRESET ( [0, 0, 8, 0] = %X'80' + 3, [1, 0, 32, 0] = exp);

				    UNDECLARE
					dpt;

				%ELSE

				    %IF %IDENTICAL (oper, '@V')
				    %THEN

					OWN
					    dpt : ALIGN (0) BLOCK [7, BYTE] PSECT ($$$105_prologue)	!
						PRESET ( [0, 0, 8, 0] = %X'80' + 4, [1, 0, 32, 0] = exp, [5,
						    0, 8, 0] = str_pos, [6, 0, 8, 0] = str_siz);

					UNDECLARE
					    dpt;

				    %FI

				%FI

			    %FI

			%FI

		    %FI

		%FI

	    %FI

	%FI

    %;


%SBTTL '_DSBINT'

!+
!-

KEYWORDMACRO
    _dsbint (
	    ipl = %REF ( ipl$_power ),
	    dst) =
	BEGIN

	BUILTIN
	    MFPR,
	    MTPR;

	%IF %NULL (dst)
	%THEN
	    BEGIN

	    BUILTIN
		SP;

	    SP = .SP - 4;
	    MFPR (pr$_ipl, .SP);
	    END;
	%ELSE
	    MFPR (pr$_ipl, dst);
	%FI

	MTPR (ipl, pr$_ipl);
	END;
    %;


%SBTTL '_ENBINT'

!+
!-

KEYWORDMACRO
    _enbint (
	    src) =
	BEGIN

	BUILTIN
	    MTPR;

	%IF %NULL (src)
	%THEN
	    BEGIN

	    BUILTIN
		SP;

	    MTPR (.SP, pr$_ipl);
	    SP = .SP + 4;
	    END;
	%ELSE
	    MTPR (src, pr$_ipl);
	%FI

	END;
    %;


%SBTTL '_FIELD_OP'

!+
! This macro provides the ability perform some operation on two fields.  The most
! common usage would be to add the offsets of two field references resulting in a
! field reference.
!
! FLD1_OFF
!	The offset, in bytes, to the first field.
!
! FLD1_POS
!	The offset, in bits, to the first field from the byte offset.
!
! FLD1_SIZ
!	The size, in bits, of the first field.  Not used.
!
! FLD1_EXT
!	The sign extension flag of the first field.  Not used.
!
! OPER
!	The operation to be performed, e.g. +.
!
! FLD2_OFF
!	The offset, in bytes, to the second field.
!
! FLD2_POS
!	The offset, in bits, to the second field from the byte offset.
!
! FLD2_SIZ
!	The size, in bits, of the second field.
!
! FLD2_EXT
!	The sign extension flag of the second field.
!-

MACRO
    _field_op (fld1_off, fld1_pos, fld1_siz, fld1_ext, oper, fld2_off, fld2_pos, fld2_siz, fld2_ext) =
	fld1_off oper fld2_off, fld1_pos oper fld2_pos, fld2_siz, fld2_ext %;


%SBTTL '_FIELD_TEST'

!+
!-

MACRO
    _field_test (fld1_off, fld1_pos, fld1_siz, fld1_ext, oper, fld2_off, fld2_pos, fld2_siz, fld2_ext) =
	(fld1_off oper fld2_off) AND (fld1_pos oper fld2_pos) AND (fld1_siz oper fld2_siz) AND (fld1_ext oper
	fld2_ext) %;


%SBTTL '_FORK'

!+
! Drivers use this macros to create, by calling EXE$FORK, a fork process, in which
! context the code following the macro invocation executes.
!
! FBK
!	The address of the fork block.
!
! FR3
!	The content's of the fork's R3.
!
! FR4
!	The content's of the fork's R4.
!
! Note:	The stack pointer must point to a longword containing the address of the
!	caller's caller when the macro is invoked.
!-

KEYWORDMACRO
    _fork (
	    fbk,
	    fr3 = 0,
	    fr4 = 0 ) =
	BEGIN

	LINKAGE
	    fork_linkage = JSB (REGISTER = 3, REGISTER = 4, REGISTER = 5) : NOTUSED (6, 7, 8, 9, 10, 11)
		PRESERVE (0, 1, 2, 3, 4, 5);

	EXTERNAL ROUTINE
	    exe$fork : fork_linkage ADDRESSING_MODE (GENERAL);

	exe$fork (fr3, fr4, fbk)
	END
    %;


%SBTTL '_FUNCTAB'

!+
! This macro generates an entry for a function descision table.
!
! ACTION
!	The routine to call when the function code specified in the I/O request
!	matches the code argument to this macro; if this is to be the first or
!	second entry in the table, this argument must not be supplied.
!
! CODES
!	The code or codes for which the routine specified in the first argument
!	to this macro is to be called; the codes are specified as the I/O-function
!	codes of the form, IO$_xxx, but without the IO$_ prefix; if more than one
!	code is specified then they must be enclosed within angle brackets (<>).
!-

KEYWORDMACRO
    _functab (
	    action,
	    codes) =

	MACRO
	    __setbit [CODE] =
		[%quotename ('IO$_', CODE)] = 1 %QUOTE %;

	%IF NOT %DECLARED (functab_len)
	%THEN

	    COMPILETIME
		functab_len = 0;

	%FI

	OWN
	    functable : BITVECTOR [64] PSECT ($$$115_driver) PRESET (__setbit (%REMOVE (codes)));

	%ASSIGN (functab_len, functab_len + 8)

	%IF NOT %NULL (action)
	%THEN

	    OWN
		actaddr : PSECT ($$$115_driver) INITIAL (_genraddr (action, actaddr + 8));

	    %ASSIGN (functab_len, functab_len + 4)

	    UNDECLARE
		actaddr;

	%FI

	UNDECLARE
	    functable,
	    %QUOTE %QUOTE __setbit;

    %;


%SBTTL '_GENRADDR'

!+
! This is an internal macro which generates relocatable addresses.
!
! ADDRESS
!	If zero then IOC$RETURN is result.  If a string then string is result.
!	Otherwise ADDRESS - BASE is result.
!
! BASE
!	Base address to use in generating offset if ADDRESS is not zero or
!	a string.
!-

MACRO
    _genraddr (address, base) =

	%IF %IDENTICAL (address, 0)
	%THEN
	    BEGIN

	    LINKAGE
		return_linkage = JSB : NOTUSED (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11);

	    EXTERNAL ROUTINE
		ioc$return : return_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    ioc$return
	    END
	%ELSE

	    %IF %ISSTRING (address)
	    %THEN
		%NAME (address)
	    %ELSE
		address - base
	    %FI

	%FI

    %;


%SBTTL '_IFNORD'

!+
!-

KEYWORDMACRO
    _ifnord (
	    siz,
	    adr,
	    mode = 0 ) =
	BEGIN

	BUILTIN
	    PROBER;

	NOT PROBER (mode, siz, adr)
	END
    %;


%SBTTL '_IFNOWRT'

!+
!-

KEYWORDMACRO
    _ifnowrt (
	    siz,
	    adr,
	    mode = 0 ) =
	BEGIN

	BUILTIN
	    PROBEW;

	NOT PROBEW (mode, siz, adr)
	END
    %;


%SBTTL '_IFNPRIV'

!+
!-

KEYWORDMACRO
    _ifnpriv (
	    priv,
	    dest,
	    pcb) =
	BEGIN

	LOCAL
	    privmsk : REF BLOCK [, BYTE],
	    ref_pcb : REF BLOCK [, BYTE],
	    ref_phd : REF BLOCK [, BYTE];

	ref_pcb = pcb;
	ref_phd = .ref_pcb [pcb$l_phd];
	privmsk = ref_phd [phd$q_privmsk];
	NOT .privmsk [%NAME ('PRV$V_', priv)]
	END
    %;


%SBTTL '_IFPRIV'

!+
!-

KEYWORDMACRO
    _ifpriv (
	    priv,
	    dest,
	    pcb) =
	BEGIN

	LOCAL
	    privmsk : REF BLOCK [, BYTE],
	    ref_pcb : REF BLOCK [, BYTE],
	    ref_phd : REF BLOCK [, BYTE];

	ref_pcb = pcb;
	ref_phd = .ref_pcb [pcb$l_phd];
	privmsk = ref_phd [phd$q_privmsk];
	.privmsk [%NAME ('PRV$V_', priv)]
	END
    %;


%SBTTL '_IFRD'

!+
!-

KEYWORDMACRO
    _ifrd (
	    siz,
	    adr,
	    mode = 0 ) =
	BEGIN

	BUILTIN
	    PROBER;

	PROBER (mode, siz, adr)
	END
    %;


%SBTTL '_IFWRT'

!+
!-

KEYWORDMACRO
    _ifwrt (
	    siz,
	    adr,
	    mode = 0 ) =
	BEGIN

	BUILTIN
	    PROBEW;

	PROBEW (mode, siz, adr)
	END
    %;


%SBTTL '_INVALID'

!+
!-

KEYWORDMACRO
    _invalid (
	    addr,
	    reg) =
	BEGIN

	BUILTIN
	    MTPR;

	%IF %NULL (addr)
	%THEN
	    MTPR (%REF (0), pr$_tbia);
	%ELSE

	    %IF %NULL (reg)
	    %THEN
		MTPR (addr, pr$_tbis);
	    %ELSE
		reg = addr;
		MTPR (reg, pr$_tbis);
	    %FI

	%FI

	END
    %;


%SBTTL '_IOFORK'

!+
!-

KEYWORDMACRO
    _iofork (
	    fbk,
	    fr3 = 0,
	    fr4 = 0 ) =
	BEGIN

	LINKAGE
	    fork_linkage = JSB (REGISTER = 3, REGISTER = 4, REGISTER = 5) : NOTUSED (6, 7, 8, 9, 10, 11)
		PRESERVE (0, 1, 2, 3, 4, 5);

	EXTERNAL ROUTINE
	    exe$iofork : fork_linkage ADDRESSING_MODE (GENERAL);

	exe$iofork (fr3, fr4, fbk)
	END
    %;


%SBTTL '_LDP0LR'

!+
!-

KEYWORDMACRO
    _ldp0lr (
	    src) =
	BEGIN

	BUILTIN
	    MTPR;

	MTPR (src, pr$_p0lr);
	END
    %;


%SBTTL '_LDP1LR'

!+
!-

KEYWORDMACRO
    _ldp1lr (
	    src) =
	BEGIN

	BUILTIN
	    MTPR;

	MTPR (src, pr$_p1lr);
	END
    %;


%SBTTL '_LISTEN'

!+
!-

KEYWORDMACRO
    _listen (
	    msgadr = 0,
	    erradr,
	    lprnam = 0,
	    prinfo = 0,
	    retadr) =
	BEGIN
	ROUTINE call_listen : NOVALUE =
	    BEGIN

	    BUILTIN
		FP;

	    LINKAGE
		accept_linkage = JSB;

	    EXTERNAL ROUTINE
		scs$accept : accept_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    LOCAL
		l_status;

	    BIND
		r_stack_frame = .FP : BLOCK [, BYTE];

	    %IF %NULL (erradr)
	    %THEN
		%ERROR ('Error address (ERRADR) is required')
	    %FI

	    %IF %NULL (retadr)
	    %THEN
		l_status = scs$listen (msgadr, erradr, lprnam, prinfo, .r_stack_frame [sf$l_save_pc]);
	    %ELSE
		l_status = scs$listen (msgadr, erradr, lprnam, prinfo, retadr);
	    %FI

	    END;
	call_listen ();
	END
    %;


%SBTTL '_LOADMBA'

!+
!-

KEYWORDMACRO
    _loadmba (
	    ucb,
	    csr) =
	BEGIN

	LINKAGE
	    loadmba_linkage = JSB (REGISTER = 4, REGISTER = 5) : NOPRESERVE (0, 1, 2)
		NOTUSED (6, 7, 8, 9, 10, 11)
		PRESERVE (3, 4, 5);

	EXTERNAL ROUTINE
	    ioc$loadmbamap : loadmba_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$loadmbamap (csr, ucb);
	END
    %;


%SBTTL '_LOADUBA'

!+
!-

KEYWORDMACRO
    _loaduba (
	    ucb) =
	BEGIN

	LINKAGE
	    loadubamap_linkage = JSB (REGISTER = 5) : PRESERVE (5)
		NOPRESERVE (0, 1, 2)
		NOTUSED (3, 4, 6, 7, 8, 9, 10, 11);

	EXTERNAL ROUTINE
	    ioc$loadubamap : loadubamap_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$loadubamap (ucb);
	END
    %;


%SBTTL '_LOADUBAA'

!+
!-

KEYWORDMACRO
    _loadubaa (
	    ucb) =
	BEGIN

	LINKAGE
	    loadubamapa_linkage = JSB (REGISTER = 5) : PRESERVE (5)
		NOPRESERVE (0, 1, 2)
		NOTUSED (3, 4, 6, 7, 8, 9, 10, 11);

	EXTERNAL ROUTINE
	    ioc$loadubamapa : loadubamapa_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$loadubamapa (ucb);
	END
    %;


%SBTTL '_LOCK'

!+
!-

KEYWORDMACRO
    _lock (
	    bit_field) =
	NOT
	BEGIN

	EXTERNAL
	    exe$gl_locktry : ADDRESSING_MODE (GENERAL);

	DECR i FROM .exe$gl_locktry TO 1 DO
	    BEGIN

	    BUILTIN
		TESTBITSSI;

	    LOCAL
		old_ipl;

	    _dsbint (dst = old_ipl);

	    IF NOT TESTBITSSI (bit_field) THEN EXITLOOP 0;

	    _enbint (src = old_ipl);
	    END

	END
    %;


%SBTTL '_MAP'

!+
!-

KEYWORDMACRO
    _map (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_map])
	END
    %;


%SBTTL '_MAP_BYPASS'

!+
!-

KEYWORDMACRO
    _map_bypass (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_mapbypass])
	END
    %;


%SBTTL '_MAP_IRP'

!+
!-

KEYWORDMACRO
    _map_irp (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_mapirp])
	END
    %;


%SBTTL '_MAP_IRP_BYPASS'

!+
!-

KEYWORDMACRO
    _map_irp_bypass (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_mapirpbyp])
	END
    %;


%SBTTL '_MRESET'

!+
!-

KEYWORDMACRO
    _mreset (
	    pdt,
	    rstadr,
	    flag = 1,
	    start = 0 ) =
	BEGIN

	LINKAGE
	    pdt_linkage = JSB (REGISTER = 0, REGISTER = 1, REGISTER = 2);

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	pdt_linkage (.ref_pdt [pdt$l_mreset], flag, rstadr, start)
	END
    %;


%SBTTL '_MSTART'

!+
!-

KEYWORDMACRO
    _mstart (
	    pdt,
	    rstadr,
	    flag = 1,
	    start = 0 ) =
	BEGIN

	LINKAGE
	    pdt_linkage = JSB (REGISTER = 0, REGISTER = 1, REGISTER = 2);

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	pdt_linkage (.ref_pdt [pdt$l_mstart], flag, rstadr, start)
	END
    %;


%SBTTL '_NOTHING'

!+
!-

MACRO
    _nothing =
    %;


%SBTTL '_PFN_DECREMENT'

!+
!-

MACRO
    _pfn_decrement (pfn, image) =

	%IF %IDENTICAL (image, 'SYS_NONPAGED')
	%THEN
	    %ERRORMACRO ('SYS_NONPAGED image flag not currently supported')

	    FORWARD ROUTINE
		fix_instruction : NOVALUE;

	    OWN
		pfn_fixup_table : BLOCK [6, BYTE] PSECT (z$init$pfn_fixup_table)	!
		    PRESET ( [0, 0, 32, 0] = fix_instruction, [4, 0, 8, 0] = %NAME ('OP$_', word_opcode), [5,
			0, 8, 0] = %NAME ('OP$_', long_opcode));

	%FI

	BEGIN

	EXTERNAL
	    mmg$gw_bigpfn : WORD ADDRESSING_MODE (bigpfn_mode);

	IF .mmg$gw_bigpfn EQLU 0
	THEN
	    BEGIN

	    EXTERNAL
		pfn$ax_shrcnt : REF VECTOR [, WORD] ADDRESSING_MODE (pfn_mode);

	    pfn$ax_shrcnt [pfn] = .pfn$ax_shrcnt [pfn] - 1
	    END
	ELSE
	    BEGIN

	    EXTERNAL
		pfn$ax_shrcnt : REF VECTOR [, LONG] ADDRESSING_MODE (pfn_mode);

	    IF (pfn$ax_shrcnt [pfn] = .pfn$ax_shrcnt [pfn] - 1) LSS 0 THEN mmg$shrcntneg ();

	    .pfn_ax_shrcnt [pfn]
	    END

	END
    %;


%SBTTL '_PURDPR'

!+
!-

KEYWORDMACRO
    _purdpr (
	    ucb,
	    dpr,
	    mapreg,
	    crb) =
	BEGIN

	LINKAGE
	    purgdatap_linkage = JSB (REGISTER = 5; REGISTER = 1, REGISTER = 2, REGISTER = 3) : NOPRESERVE (0,
		    1, 2, 3)
		NOTUSED (4, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	EXTERNAL ROUTINE
	    ioc$purgdatap : purgdatap_linkage ADDRESSING_MODE (GENERAL);

	ioc$purgdatap (ucb; dpr, mapreg, crb)
	END
    %;


%SBTTL '_QRETRY'

!+
!-

KEYWORDMACRO
    _qretry (
	    field1,
	    relop,
	    field2) =
	NOT
	BEGIN

	EXTERNAL ROUTINE
	    exe$gl_lockrtry : ADDRESSING_MODE (GENERAL);

	INCR i FROM 0 TO .exe$gl_lockrtry - 1 DO
!<BLF/SYNONYM relop = EQL>

	    IF field1 relop field2 THEN EXITLOOP 0

	END
    %;


%SBTTL '_QUEUE_DG_BUF'

!+
!-

KEYWORDMACRO
    _queue_dg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (ref_pdt [pdt$l_queuedg])
	END
    %;


%SBTTL '_QUEUE_MULT_DGS'

!+
!-

KEYWORDMACRO
    _queue_mult_dgs (
	    pdt,
	    numbuf) =
	BEGIN

	LINKAGE
	    pdt_linkage = JSB (REGISTER = 1);

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	pdt_linkage (.ref_pdt [pdt$l_queuemdgs], numbuf)
	END
    %;


%SBTTL '_READ_COUNTERS'

!+
!-

KEYWORDMACRO
    _read_counters (
	    pdt,
	    rstadr = 0,
	    lprnam) =
	BEGIN

	LINKAGE
	    pdt_linkage = JSB (REGISTER = 0, REGISTER = 1);

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	pdt_linkage (.ref_pdt [pdt$l_readcount], rstadr, lprnam)
	END
    %;


%SBTTL '_RECYCH_MSG_BUF'

!+
!-

KEYWORDMACRO
    _recych_msg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (ref_pdt [pdt$l_rchmsgbuf])
	END
    %;


%SBTTL '_RECYCL_MSG_BUF'

!+
!-

KEYWORDMACRO
    _recycl_msg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (ref_pdt [pdt$l_rclmsgbuf])
	END
    %;


%SBTTL '_REJECT'

!+
!-

KEYWORDMACRO
    _reject (
	    pdt,
	    rejtyp) =
	BEGIN

	LINKAGE
	    pdt_linkage = JSB (REGISTER = 0);

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	pdt_linkage (.ref_pdt [pdt$l_reject], rejtyp)
	END
    %;


%SBTTL '_RELCHAN'

!+
!-

KEYWORDMACRO
    _relchan (
	    ucb) =
	BEGIN

	LINKAGE
	    relchan_linkage = JSB (REGISTER = 5) : NOPRESERVE (0, 1, 2)
		NOTUSED (3, 4, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	EXTERNAL ROUTINE
	    ioc$relchan : relchan_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$relchan (ucb);
	END
    %;


%SBTTL '_RELDPR'

!+
!-

KEYWORDMACRO
    _reldpr (
	    ucb) =
	BEGIN

	LINKAGE
	    reldatap_linkage = JSB (REGISTER = 5) : NOPRESERVE (0, 1, 2)
		NOTUSED (3, 4, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	EXTERNAL ROUTINE
	    ioc$reldatap : reldatap_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$reldatap (ucb);
	END
    %;


%SBTTL '_RELMPR'

!+
!-

KEYWORDMACRO
    _relmpr (
	    ucb) =
	BEGIN

	LINKAGE
	    relmapreg_linkage = JSB (REGISTER = 5) : NOPRESERVE (0, 1, 2)
		NOTUSED (3, 4, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	EXTERNAL ROUTINE
	    ioc$relmapreg : relmapreg_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$relmapreg (ucb);
	END
    %;


%SBTTL '_RELSCHAN'

!+
!-

KEYWORDMACRO
    _relschan (
	    ucb) =
	BEGIN

	LINKAGE
	    relschan_linkage = JSB (REGISTER = 5) : NOPRESERVE (0, 1, 2)
		NOTUSED (3, 4, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	EXTERNAL ROUTINE
	    ioc$relschan : relschan_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$relschan (ucb);
	END
    %;


%SBTTL '_REQCOM'

!+
!-

KEYWORDMACRO
    _reqcom (
	    ucb,
	    sts1,
	    sts2 = 0 ) =
	BEGIN

	LINKAGE
	    reqcom_linkage = JSB (REGISTER = 0, REGISTER = 1, REGISTER = 5) : NOPRESERVE (2, 3)
		NOTUSED (4, 6, 7, 8, 9, 10, 11)
		PRESERVE (0, 1, 5);

	EXTERNAL ROUTINE
	    ioc$reqcom : reqcom_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	ioc$reqcom (sts1, sts2, ucb);
	END
    %;


%SBTTL '_REQDPR'

!+
!-

KEYWORDMACRO
    _reqdpr (
	    ucb) =
	BEGIN

	LINKAGE
	    reqdatap = JSB (REGISTER = 5) : NOPRESERVE (0)
		NOTUSED (1, 2, 3, 4, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	EXTERNAL ROUTINE
	    ioc$reqdatap : reqdatap_linkage ADDRESSING_MODE (GENERAL);

	ioc$reqdatap (ucb)
	END
    %;


%SBTTL '_REQMPR'

!+
!-

KEYWORDMACRO
    _reqmpr (
	    ucb) =
	BEGIN

	LINKAGE
	    reqmapreg = JSB (REGISTER = 5) : NOPRESERVE (0, 1, 2)
		NOTUSED (3, 4, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	EXTERNAL ROUTINE
	    ioc$reqmapreg : reqmapreg_linkage ADDRESSING_MODE (GENERAL);

	ioc$reqmapreg (ucb)
	END
    %;


%SBTTL '_REQPCHAN'

!+
!-

KEYWORDMACRO
    _reqpchan (
	    ucb,
	    pri,
	    csr) =
	BEGIN

	LINKAGE
	    reqpchan_linkage = JSB (REGISTER = 5; REGISTER = 4) : NOPRESERVE (0, 1, 2, 4)
		NOTUSED (3, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	%IF ( NOT %NULL (pri)) AND (%IDENTICAL (pri, 'HIGH'))
	%THEN

	    EXTERNAL ROUTINE
		ioc$reqpchanh : reqpchan_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    ioc$reqpchanh (ucb; csr);
	%ELSE

	    EXTERNAL ROUTINE
		ioc$reqpchanl : reqpchan_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    ioc$reqpchanl (ucb; csr);
	%FI

	END
    %;


%SBTTL '_REQSCHAN'

!+
!-

KEYWORDMACRO
    _reqschan (
	    ucb,
	    pri,
	    csr) =
	BEGIN

	LINKAGE
	    reqschan_linkage = JSB (REGISTER = 5; REGISTER = 4) : NOPRESERVE (0, 1, 2, 4)
		NOTUSED (3, 6, 7, 8, 9, 10, 11)
		PRESERVE (5);

	%IF ( NOT %NULL (pri)) AND (%IDENTICAL (pri, 'HIGH'))
	%THEN

	    EXTERNAL ROUTINE
		ioc$reqschanh : reqschan_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    ioc$reqschanh (ucb; csr);
	%ELSE

	    EXTERNAL ROUTINE
		ioc$reqschanl : reqschan_linkage NOVALUE ADDRESSING_MODE (GENERAL);

	    ioc$reqschanl (ucb; csr);
	%FI

	END
    %;


%SBTTL '_REQUEST_DATA'

!+
!-

KEYWORDMACRO
    _request_data (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	_alloc_rspid;
	ref_pdt = pdt;
	JSB (ref_pdt [pdt$l_allocmsg]);
	JSB (ref_pdt [pdt$l_reqdata])
	END
    %;


%SBTTL '_RLS_COUNTERS'

!+
!-

KEYWORDMACRO
    _rls_counters (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (ref_pdt [pdt$l_rlscount])
	END
    %;


%SBTTL '_RPTEVT'

!+
!-

KEYWORDMACRO
    _rptevt (
	    name,
	    mode = GENERAL ) =
	BEGIN

	LINKAGE
	    rse_linkage = JSB;

	EXTERNAL ROUTINE
	    sch$rse : rse_linkage ADDRESSING_MODE (mode);

	OWN
	    call_code : BLOCK [16, BYTE] PRESET ( [0, 0, 8, 0] = op$_movl, [1, 0, 8, 0] = %X'8E',
						! (SP)+
		[2, 0, 8, 0] = %X'AF', 		! B^
		[3, 0, 8, 0] = call_code [12, 0, 32, 0] - call_code [4, 0, 0, 0], 	! D
		[4, 0, 8, 0] = op$_jsb, [5, 0, 32, 0] = sch$rse, [9, 0, 8, 0] = %NAME ('EVT$_', name), [10,
		    0, 8, 0] = op$_jmp, [11, 0, 8, 0] = %X'9F', 	! @#
		[12, 0, 32, 0] = 0);		! location

	JSB (call_code [0, 0, 0, 0]);
	END
    %;


%SBTTL '_SAVIPL'

!+
!-

KEYWORDMACRO
    _savipl (
	    dst) =
	BEGIN

	BUILTIN
	    MFPR;

	MFPR (pr$_ipl, dst);
	END
    %;


%SBTTL '_SCAN_RDT'

!+
!-

KEYWORDMACRO
    _scan_rdt (
	    action) =
	BEGIN

	LINKAGE
	    lkp_rdtcdrp_linkage = JSB;

	EXTERNAL ROUTINE
	    scs$lkp_rdtcdrp : lkp_rdtcdrp_linkage (

		    REGISTER
		    = 0) ADDRESSING_MODE (GENERAL);

	scs$lkp_rdtcdrp (action)
	END
    %;


%SBTTL '_SCAN_RSPID_WAIT'

!+
!-

KEYWORDMACRO
    _scan_rspid_wait (
	    action) =
	BEGIN

	LINKAGE
	    lkp_rdtwait_linkage = JSB;

	EXTERNAL ROUTINE
	    scs$lkp_rdtwait : lkp_rdtwait_linkage (

		    REGISTER
		    = 0) ADDRESSING_MODE (GENERAL);

	scs$lkp_rdtwait (action)
	END
    %;


%SBTTL '_SEND_CNT_MSG_BUF'

!+
!-

KEYWORDMACRO
    _send_cnt_msg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (ref_pdt [pdt$l_sndcntmsg])
	END
    %;


%SBTTL '_SEND_DATA'

!+
!-

KEYWORDMACRO
    _send_data (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	_alloc_rspid;
	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_allocmsg]);
	JSB (.ref_pdt [pdt$l_senddata])
	END
    %;


%SBTTL '_SEND_DG_BUF'

!+
!-

KEYWORDMACRO
    _send_dg_buf (
	    pdt,
	    flag) =
	BEGIN

	LINKAGE
	    pdt_linkage = JSB (REGISTER = 0);

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	pdt_linkage (.ref_pdt [pdt$l_senddg], flag)
	END
    %;


%SBTTL '_SEND_MSG_BUF'

!+
!-

KEYWORDMACRO
    _send_msg_buf (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_sendmsg])
	END
    %;


%SBTTL '_SETIPL'

!+
! This macro sets the current IPL by moving the specified value into the
! processor register PR$_IPL.
!
! [IPL = 31]
!	The level at which to set the current IPL;  the default is IPL 31.
!-

KEYWORDMACRO
    _setipl (
	    ipl = ipl$_power ) =
	BEGIN

	BUILTIN
	    MTPR;

	MTPR (ipl, pr$_ipl);
	END;
    %;


%SBTTL '_SEVERITY_LEVEL'

!+
!-

MACRO

    !+
    ! 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
    !-

    __severity_level (status) =

	!+
	! 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
    %;


%SBTTL '_SOFTINT'

!+
!-

KEYWORDMACRO
    _softint (
	    ipl) =
	BEGIN

	BUILTIN
	    MTPR;

	MTPR (ipl, pr$_sirr);
	END
    %;


%SBTTL '_TIMEWAIT'

!+
!-

KEYWORDMACRO
    _timewait (
	    time,
	    tst_field,
	    sense = 1,
	    units = sec ) =
	NOT
	BEGIN

	EXTERNAL
	    exe$gl_tenusec : ADDRESSING_MODE (GENERAL),
	    exe$gl_ubdelay : ADDRESSING_MODE (GENERAL);

	DECR i FROM (time

		%IF %IDENTICAL (units, 'USEC')
		%THEN
		    /10
		%ELSE

		    %IF %IDENTICAL (units, 'MSEC')
		    %THEN
			*100
		    %ELSE

			%IF %IDENTICAL (units, 'SEC')
			%THEN
			    *1000*100
			%FI

		    %FI

		%FI

		)*.exe$gl_tenusec - 1 TO 1 DO
	    BEGIN

	    IF sense XOR tst_field THEN EXITLOOP NOT ss$_normal;

	    DECR j FROM .exe$gl_ubdelay - 1 TO 1 DO
		_nothing;

	    END

	END
    %;


%SBTTL '_TIMEDWAIT'

!+
!-

KEYWORDMACRO
    _timedwait (
	    time,
	    codblk,
	    units = sec ) =
	NOT
	BEGIN

	EXTERNAL
	    exe$gl_tenusec : ADDRESSING_MODE (GENERAL),
	    exe$gl_ubdelay : ADDRESSING_MODE (GENERAL);

	DECR i FROM (time

		%IF %IDENTICAL (units, 'USEC')
		%THEN
		    /10
		%ELSE

		    %IF %IDENTICAL (units, 'MSEC')
		    %THEN
			*100
		    %ELSE

			%IF %IDENTICAL (units, 'SEC')
			%THEN
			    *1000*100
			%FI

		    %FI

		%FI

		)*.exe$gl_tenusec - 1 TO 1 DO
	    BEGIN

	    %IF NOT %NULL (codblk)
	    %THEN

		IF codblk THEN EXITLOOP NOT ss$_normal;

	    %FI

	    DECR j FROM .exe$gl_ubdelay - 1 TO 1 DO
		_nothing;

	    END

	END
    %;


%SBTTL '_UNLOCK'

!+
!-

KEYWORDMACRO
    _unlock (
	    flag,
	    lock_field) =
	BEGIN

	BUILTIN
	    TESTBITCCI;

	TESTBITCCI (lock_field);
	enbint ();
	END
    %;


%SBTTL '_UNMAP'

!+
!-

KEYWORDMACRO
    _unmap (
	    pdt) =
	BEGIN

	LINKAGE
	    JSB = JSB;

	LOCAL
	    ref_pdt : REF BLOCK [, BYTE];

	ref_pdt = pdt;
	JSB (.ref_pdt [pdt$l_unmap])
	END
    %;


%SBTTL '_WFIKPCH'

!+
!-

KEYWORDMACRO
    _wfikpch (
	    excpt,
	    time) =
	BEGIN

	LINKAGE
	    JSB = JSB,
	    wfikpch_linkage = JSB;

	EXTERNAL ROUTINE
	    ioc$wfikpch : wfikpch_linkage ADDRESSING_MODE (GENERAL);

	OWN
	    call_code : BLOCK [17, BYTE] PRESET ( [0, 0, 8, 0] = op$_movl, [1, 0, 8, 0] = %X'8E',
						! (SP)+
		[2, 0, 8, 0] = %X'AF', 		! B^
		[3, 0, 8, 0] = call_code [13, 0, 32, 0] - call_code [4, 0, 0, 0], 	! D
		[4, 0, 8, 0] = op$_jsb, [5, 0, 32, 0] = ioc$wfikpch, [9, 0, 16, 0] = excpt - call_code [9, 0,
		    16, 0], [11, 0, 8, 0] = op$_jmp, [12, 0, 8, 0] = %X'9F', 	! @#
		[13, 0, 32, 0] = 0);		! location

	%IF %NULL (time)
	%THEN
	    JSB (call_code [0, 0, 0, 0], 1^16);
	%ELSE
	    JSB (call_code [0, 0, 0, 0], time);
	%FI

	END
    %;


%SBTTL '_WFIRLCH'

!+
!-

KEYWORDMACRO
    _wfirlch (
	    excpt,
	    time) =
	BEGIN

	LINKAGE
	    JSB = JSB,
	    wfirlch_linkage = JSB;

	EXTERNAL ROUTINE
	    ioc$wfirlch : wfirlch_linkage ADDRESSING_MODE (GENERAL);

	OWN
	    call_code : BLOCK [17, BYTE] PRESET ( [0, 0, 8, 0] = op$_movl, [1, 0, 8, 0] = %X'8E',
						! (SP)+
		[2, 0, 8, 0] = %X'AF', 		! B^
		[3, 0, 8, 0] = call_code [13, 0, 32, 0] - call_code [4, 0, 0, 0], 	! D
		[4, 0, 8, 0] = op$_jsb, [5, 0, 32, 0] = ioc$wfirlch, [9, 0, 16, 0] = excpt - call_code [9, 0,
		    16, 0], [11, 0, 8, 0] = op$_jmp, [12, 0, 8, 0] = %X'9F', 	! @#
		[13, 0, 32, 0] = 0);		! location

	%IF %NULL (time)
	%THEN
	    JSB (call_code [0, 0, 0, 0], 1^16);
	%ELSE
	    JSB (call_code [0, 0, 0, 0], time);
	%FI

	END
    %;


%SBTTL '_XDELTA_BREAKPOINT'

!+
!-

MACRO
    _xdelta_breakpoint =
	BEGIN

	LINKAGE
	    ini$brk_linkage = JSB : NOTUSED (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11);

	EXTERNAL ROUTINE
	    ini$brk : 				! XDELTA breakpoint.
		NOVALUE ini$brk_linkage ADDRESSING_MODE (GENERAL);

	ini$brk ();
	END
    %;