Google
 

Trailing-Edge - PDP-10 Archives - BB-F494Z-DD_1986 - 10,7/rmsusr.r36
There are 30 other files named rmsusr.r36 in the archive. Click here to see a list.
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
! OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
! COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION 1982, 1985.
! ALL RIGHTS RESERVED.

![11] Nourse - Fix mismatched parens in $RMS$DEFINE_CALL
![10] Nourse - Define new XABKEY datatypes for RMS v2.
![7] Nourse - Add fields DAP may want
![6] Nourse - LIST function codes
![5] Nourse - TYP block
![4] Nourse - Invent the NAM block
![3] LCampbell - Conform to XDUMP conventions
![2] Nourse - Add new fields for network access
![1] LUSK  8-Jul-81 13:40:28 "Initial library load"

%SBTTL 'Internal macro definitions'

%IF NOT %DECLARED(%QUOTE $XPO_IOB)
%THEN
LIBRARY 'BLI:XPORT';
%FI;

!++
!
!	The following internal macros support the 
!	RMS argument block definition macros.
!--

MACRO

!++
!
! $RMS_BITFLD (and its support macros ...)
!
!	Internal macro.  Allows the initialization
!	of a field with the OR of one or more (named) bits
!
!--

    $RMS_BITS(A,B)[] =
	%NAME(A,B)	$RMS_OR(%REMAINING) $RMS_BITS(A,%REMAINING) %,

    $RMS_OR[] =
	OR %,

    $RMS_BITFLD(PREFIX, VALUE)=
	%IF %NULL(VALUE)
	%THEN 0
	%ELSE $RMS_BITS(PREFIX, %REMOVE(VALUE))
	%FI %,

!++
!
!  $RMS_CODFLD
!
!	Internal macro.  Allows the initialization
!	of a field with a named value.
!
!--

    $RMS_CODFLD(PREFIX, VALUE)=
	%NAME(PREFIX, %REMOVE(VALUE)) %,

!+
!
!  $RMS_STRFLD
!
!	$RMS_STRFLD initializes a string address 
!	field with either an address passed
!	as an argument or the value of an UPLIT
!	containing a string passed as an argument.
!-

    $RMS_STRFLD(VALUE) =
	%IF %ISSTRING(VALUE)
	%THEN UPLIT(%ASCIZ VALUE)
	%ELSE VALUE
	%FI %;

!+
!
!   $RMS_POSITION
!   $RMS_SIZE
!
!	$RMS_POSITION and its companion $RMS_SIZE
!	with their supporting macros
!	are used in the $XABKEY macro for initializing
!	the segment position and size fields
!
!-

MACRO
    $RMS_POSITION [POSITION] =
	[%NAME(XABKEY$H_POS, %COUNT)] = POSITION %,

    $RMS_SIZE [SIZE] =
	[%NAME(XABKEY$H_SIZ, %COUNT)] = SIZE %;

!+
!
!   $RMS_POSITION_INI
!   $RMS_SIZE_INI
!
!	$RMS_POSITION_INI and its companion $RMS_SSIZE_INI
!	are used in the $XABKEY_INIT macro for initializing
!	the segment position and size fields dynamically
!
!-

MACRO
    $RMS_POSITION_INI(BLK)[POSITION] =
	BLK [%NAME(XABKEY$H_POS, %COUNT)] = POSITION %,

    $RMS_SIZE_INI(BLK)[SIZE] =
	BLK [%NAME(XABKEY$H_SIZ, %COUNT)] = SIZE %;



%SBTTL 'FAB definitions'
!+
!
!	FAB symbols and macros
!
!-


LITERAL
    FAB$K_BLN		= 16,
    FAB$K_BID		= 1;

! FAB structure

$FIELD
    $FAB_BLOCK_FIELDS =
	SET
	FAB$H_BLN	= [$BYTES(2)],	! Block length field
	FAB$H_BID	= [$BYTES(2)],	! Block type field
            $OVERLAY(FAB$H_BID)         ! **FTS**
            FAB$B_BID_1=[$BYTE],        ! **FTS**
            FAB$V_DEV_REMOTE=[$BIT],    ! **FTS**
            $CONTINUE                   ! **FTS**
	FAB$H_STV	= [$BYTES(2)],	! Secondary status field
	FAB$H_STS	= [$BYTES(2)],	! Primary status field
	FAB$G_CTX	= [$BYTES(4)],	! User context word
	FAB$H_JFN	= [$BYTES(2)],	! User's JFN, if offered
	FAB$A_IFI	= [$ADDRESS],		! Address of FST
	FAB$H_SHR	= [$BITS(18)],		! SHR field of FAB
	    $OVERLAY(FAB$H_SHR)
	    FAB$V_SHR_GET = [$BIT],
	    FAB$V_SHR_UPD = [$BIT],
	    FAB$V_SHR_PUT = [$BIT],
	    FAB$V_SHR_DEL = [$BIT],
	    FAB$V_SHR_TRN = [$BIT],
            FAB$V_SHR_BIO = [$BIT],     ! Block mode I/O **FTS** ** Reserved **
            FAB$V_SHR_BRO = [$BIT],     ! Block and Record I/O ** Reserved **
            FAB$V_SHR_APP = [$BIT],     ! Append Only ** Reserved **
	    $CONTINUE
	FAB$H_FAC	= [$BITS(18)],		! User's desired access
	    $OVERLAY(FAB$H_FAC)
	    FAB$V_FAC_GET = [$BIT],
	    FAB$V_FAC_UPD = [$BIT],
	    FAB$V_FAC_PUT = [$BIT],
	    FAB$V_FAC_DEL = [$BIT],
	    FAB$V_FAC_TRN = [$BIT],
            FAB$V_FAC_BIO = [$BIT],     ! Block mode I/O **FTS**
            FAB$V_FAC_BRO = [$BIT],     ! Block and Record I/O ** Reserved **
            FAB$V_FAC_APP = [$BIT],     ! Append Only ** Reserved **
	    $CONTINUE
	FAB$Z_BLS	= [$BITS(8)],		! Block size for tape
	FAB$Z_BSZ	= [$BITS(6)],		! File byte-size
	FAB$Z_ORG	= [$BITS(4)],		! File organization
	FAB$H_FOP	= [$BITS(18)],		! File options
	    $OVERLAY(FAB$H_FOP)
	    FAB$V_FOP_WAT = [$BIT],
	    FAB$V_FOP_CIF = [$BIT],
	    FAB$V_FOP_DRJ = [$BIT],
	    FAB$V_FOP_DFW = [$BIT],
	    FAB$V_FOP_SUP = [$BIT],
            FAB$V_FOP_SPL = [$BIT],             ! print on close **FTS**
            FAB$V_FOP_SCF = [$BIT],             ! Submit on close **FTS**
            FAB$V_FOP_DLT = [$BIT],             ! Delete on close **FTS**
            FAB$V_FOP_NAM = [$BIT],             ! open by NAM blk **Reserved**
            FAB$V_FOP_CTG = [$BIT],             ! File is contiguous **FTS**
            FAB$V_FOP_LKO = [$BIT],             ! Override lock ** Reserved **
            FAB$V_FOP_TMP = [$BIT],             ! Temporary file ** Reserved **
            FAB$V_FOP_MKD = [$BIT],             ! Mark for delete ** Reserved *
            FAB$V_FOP_OFP = [$BIT],             ! Output file parse ** FTS **
	    $CONTINUE
	FAB$A_FNA	= [$POINTER],		! Pointer to filename
	FAB$H_MRS	= [$SHORT_INTEGER],	! Maximum record size
	FAB$H_RAT	= [$BITS(18)],		! Record attributes
	    $OVERLAY(FAB$H_RAT)
	    FAB$V_RAT_BLK = [$BIT],
            FAB$V_RAT_MACY11= [$BIT],           ! MACY11 format ** reserved **
            FAB$V_RAT_FTN = [$BIT],             ! FORTRAN carr.ctl. ** Reserved
            FAB$V_RAT_CR = [$BIT],              ! Implied CRLF ** Reserved **
            FAB$V_RAT_PRN = [$BIT],             ! Print file (VMS) ** Reserved
            FAB$V_RAT_EMB = [$BIT],             ! Embedded carr.ctl ** Reserved
            FAB$V_RAT_CBL = [$BIT],             ! COBOL carr.ctl ** Reserved **
	    $CONTINUE
	FAB$G_MRN	= [$INTEGER],		! Maximum record number
	FAB$Z_RFM	= [$BITS(5)],		! Record format
	FAB$Z_BKS	= [$BITS(8)],		! Default bucket size
        FAB$Z_FSZ       = [$BITS(5)],           ! Fixed hdr size ** Reserved **
	FAB$H_UNUSED_0	= [$BITS(18)],		! Reserved
	FAB$A_XAB	= [$ADDRESS],		! Address of XAB chain
	FAB$A_JNL	= [$ADDRESS],		! Address of log block
	FAB$H_SDC	= [$BITS(18)],		! Spooling dev. characteristics
	FAB$H_DEV	= [$BITS(18)],		! Device characteristics
	    $OVERLAY(FAB$H_DEV)
	    FAB$V_DEV_REC = [$BIT],
	    FAB$V_DEV_CCL = [$BIT],
	    FAB$V_DEV_TRM = [$BIT],
	    FAB$V_DEV_MDI = [$BIT],
	    FAB$V_DEV_SQD = [$BIT],
	    $CONTINUE
        FAB$A_NAM = [$ADDRESS],                 ! Address of NAM block **FTS**
        FAB$A_TYP = [$ADDRESS],                 ! Address of TYP block **FTS**
	FAB$G_ALQ = [$BYTES(4)],                ! Allocation quantity
        FAB$G_UNUSED_3  = [$BYTES(4)],          ! Reserved
	FAB$G_UNUSED_4	= [$BYTES(4)]		! reserved
	TES;

! End of FAB

! definitions of FAB-related values and constants.

LITERAL
    FAB$K_SIZE = $FIELD_SET_SIZE;

LITERAL
    FAB$M_FAC_NIL	= 0,			! FB$NIL -- quick'n'dirty read
    FAB$M_FAC_GET	= 1 ^ 0,		! FB$GET -- read access
    FAB$M_FAC_UPD	= 1 ^ 1,		! FB$UPD -- update access
    FAB$M_FAC_PUT	= 1 ^ 2,		! FB$PUT -- write access
    FAB$M_FAC_DEL	= 1 ^ 3,		! FB$DEL -- delete access
    FAB$M_FAC_TRN	= 1 ^ 4,		! FB$TRN -- truncate access
    FAB$M_FAC_BIO       = 1 ^ 5,                ! FB$BIO -- Block I/O ** FTS **
    FAB$M_FAC_BRO       = 1 ^ 6,                ! FB$BRO -- Blk/rec ** Reserved
    FAB$M_FAC_APP       = 1 ^ 7;                ! Append only ** Reserved **

LITERAL
    FAB$M_SHR_NIL	= 0,			! FB$NIL -- exclusive access
    FAB$M_SHR_GET	= 1 ^ 0,		! FB$GET -- read access
    FAB$M_SHR_UPD	= 1 ^ 1,		! FB$UPD -- update access
    FAB$M_SHR_PUT	= 1 ^ 2,		! FB$PUT -- write access
    FAB$M_SHR_DEL	= 1 ^ 3,		! FB$DEL -- delete access
    FAB$M_SHR_TRN	= 1 ^ 4,		! FB$TRN -- truncate access
    FAB$M_SHR_BIO       = 1 ^ 5,                ! FB$BIO -- Block I/O ** FTS **
    FAB$M_SHR_BRO       = 1 ^ 6,                ! FB$BRO -- Blk/rec ** Reserved
    FAB$M_SHR_APP       = 1 ^ 7;                ! Append only ** Reserved **

LITERAL
    FAB$M_FOP_WAT	= 1 ^ 0,		! wait for file access
    FAB$M_FOP_CIF	= 1 ^ 1,		! create if non-existent
    FAB$M_FOP_DRJ	= 1 ^ 2,		! do not release JFN
    FAB$M_FOP_DFW	= 1 ^ 3,		! deferred write to file
    FAB$M_FOP_SUP	= 1 ^ 4,		! supersede existing file *FTS*
    FAB$M_FOP_SPL       = 1 ^ 5,                ! Spool (print) on close *FTS*
    FAB$M_FOP_SCF       = 1 ^ 6,                ! Submit on close **FTS**
    FAB$M_FOP_DLT       = 1 ^ 7,                ! Delete on close **FTS**
    FAB$M_FOP_NAM       = 1 ^ 8,                ! Open by NAM block **FTS**
    FAB$M_FOP_CTG       = 1 ^ 9,                ! File is contiguous **FTS**
    FAB$M_FOP_LKO       = 1 ^ 10,               ! Override lock ** Reserved **
    FAB$M_FOP_TMP       = 1 ^ 11,               ! Temporary file ** Reserved *
    FAB$M_FOP_MKD       = 1 ^ 12,               ! Mark for delete ** Reserved *
    FAB$M_FOP_OFP       = 1 ^ 13;               ! Output file parse ** FTS **

LITERAL
    FAB$K_ORG_SEQ	= 1,			! Sequential organization
    FAB$K_ORG_REL	= 2,			! Relative file organization
    FAB$K_ORG_IDX	= 3,			! Indexed file organization
    FAB$K_ORG_HSH       = 4,                    ! Hashed file org ** Reserved *
    FAB$K_ORG_DIRECTORY = 5;                    ! File is a directory **FTS**

LITERAL
    FAB$K_RFM_VAR	= 0,			! Variable record format
    FAB$K_RFM_STM	= 1,			! Stream ASCII records
    FAB$K_RFM_LSA	= 2,			! Line sequenced ASCII
    FAB$K_RFM_FIX	= 3,			! Fixed length records
    FAB$K_RFM_VFC       = 4,                    ! VFC format ** FTS **
    FAB$K_RFM_UDF       = 5;                    ! Undefined/unknown ** FTS **

LITERAL
    FAB$M_RAT_BLK	= 1 ^ 0,		! Blocked records
    FAB$M_RAT_MACY11    = 1 ^ 1,                ! MACY11 format **FTS**
    FAB$M_RAT_FTN       = 1 ^ 2,                ! FORTRAN cc ** Reserved **
    FAB$M_RAT_CR        = 1 ^ 3,                ! Implied CRLF ** Reserved **
    FAB$M_RAT_PRN       = 1 ^ 4,                ! Print file ** Reserved **
    FAB$M_RAT_EMB       = 1 ^ 5,                ! Embedded cc ** Reserved **
    FAB$M_RAT_CBL       = 1 ^ 6;                ! COBOL cc ** Reserved ** 
!++
!
!	The following macros support declaration,
!	allocation, and/or initialization of various
!	flavors of FABs.
!
!--

!+
!
!  $FAB_DECL
!
!	Used to declare a FAB control block where
!	initialization is not required
!-

MACRO

    $FAB_DECL =
	BLOCK[FAB$K_BLN] FIELD($FAB_BLOCK_FIELDS) %;

!+
!
!  $FAB
!
!	Used to allocate and statically initialize
!	a FAB control block
!
!-

KEYWORDMACRO
    $FAB(				! Declare a compile_time FAB
	BKS = 0,	BLS = 0,	BSZ = 7,	CTX = 0,
	FAC = GET,	FNA = 0,	FOP,		JFN = 0,
	JNL = 0,	MRN = 0,	MRS = 0,	ORG = SEQ,
	RAT,		RFM = VAR,	SHR = NIL,      XAB = 0,
        NAM = 0,        TYP = 0  ) =

	$FAB_DECL
	PRESET(
	    [FAB$H_BLN]		= FAB$K_BLN,
	    [FAB$H_BID]		= FAB$K_BID,
	    [FAB$H_STV]		= 0,
	    [FAB$H_STS]		= 0,
	    [FAB$G_CTX]		= CTX,
	    [FAB$H_JFN]		= JFN,
	    [FAB$H_SHR]		= $RMS_BITFLD(FAB$M_SHR_, SHR),
	    [FAB$H_FAC]		= $RMS_BITFLD(FAB$M_FAC_, FAC),
	    [FAB$Z_BLS]		= BLS,
	    [FAB$Z_BSZ]		= BSZ,
	    [FAB$Z_ORG]		= $RMS_CODFLD(FAB$K_ORG_, ORG),
	    [FAB$H_FOP]		= $RMS_BITFLD(FAB$M_FOP_, FOP),
	    [FAB$A_FNA]		= $RMS_STRFLD(FNA),
	    [FAB$H_MRS]		= MRS,
	    [FAB$H_RAT]		= $RMS_BITFLD(FAB$M_RAT_, RAT),
	    [FAB$G_MRN]		= MRN,
	    [FAB$Z_RFM]		= $RMS_CODFLD(FAB$K_RFM_, RFM),
	    [FAB$Z_BKS]		= BKS,
	    [FAB$A_XAB]		= XAB,
	    [FAB$A_JNL]		= JNL,
            [FAB$A_NAM]         = NAM,
            [FAB$A_TYP]         = TYP ) %;


!+
!
!  $FAB_INIT
!
!	Used to dynamically initialize
!	a FAB control block
!
!-

KEYWORDMACRO
    $FAB_INIT(					! Initialize a FAB

	FAB,

	BKS = 0,	BLS = 0,	BSZ = 7,	CTX = 0,
	FAC = GET,	FNA = 0,	FOP,		JFN = 0,
	JNL = 0,	MRN = 0,	MRS = 0,	ORG = SEQ,
	RAT,		RFM = VAR,	SHR = NIL,	XAB = 0,
        NAM = 0,        TYP = 0 ) =

	( BIND $RMS_PTR = FAB : $FAB_DECL;
	  CH$FILL(0, FAB$K_BLN, CH$PTR($RMS_PTR, 0, 36));

	    $RMS_PTR [FAB$H_BLN]	= FAB$K_BLN;
	    $RMS_PTR [FAB$H_BID]	= FAB$K_BID;
	    $RMS_PTR [FAB$H_STV]	= 0;
	    $RMS_PTR [FAB$H_STS]	= 0;
	    $RMS_PTR [FAB$G_CTX]	= CTX;
	    $RMS_PTR [FAB$H_JFN]	= JFN;
	    $RMS_PTR [FAB$H_SHR]	= $RMS_BITFLD(FAB$M_SHR_, SHR);
	    $RMS_PTR [FAB$H_FAC]	= $RMS_BITFLD(FAB$M_FAC_, FAC);
	    $RMS_PTR [FAB$Z_BLS]	= BLS;
	    $RMS_PTR [FAB$Z_BSZ]	= BSZ;
	    $RMS_PTR [FAB$Z_ORG]	= $RMS_CODFLD(FAB$K_ORG_, ORG);
	    $RMS_PTR [FAB$H_FOP]	= $RMS_BITFLD(FAB$M_FOP_, FOP);
	    $RMS_PTR [FAB$A_FNA]	= $RMS_STRFLD(FNA);
	    $RMS_PTR [FAB$H_MRS]	= MRS;
	    $RMS_PTR [FAB$H_RAT]	= $RMS_BITFLD(FAB$M_RAT_, RAT);
	    $RMS_PTR [FAB$G_MRN]	= MRN;
	    $RMS_PTR [FAB$Z_RFM]	= $RMS_CODFLD(FAB$K_RFM_, RFM);
	    $RMS_PTR [FAB$Z_BKS]	= BKS;
	    $RMS_PTR [FAB$A_XAB]	= XAB;
	    $RMS_PTR [FAB$A_JNL]	= JNL;
            $RMS_PTR [FAB$A_NAM]        = NAM;
            $RMS_PTR [FAB$A_TYP]        = TYP;
	    1) %;

!+
!
!  $FAB_STORE
!
!	Used to dynamically change
!	a FAB control block
!
!-

KEYWORDMACRO
    $FAB_STORE(					! Change a FAB

	FAB,

	BKS,	BLS,	BSZ,	CTX,	FAC,	FNA,	FOP,	JFN,
	JNL,	MRN,	MRS,	ORG,	RAT,	RFM,	SHR,	XAB,
        NAM,    TYP ) =

	( BIND $RMS_PTR = FAB : $FAB_DECL;

	%IF NOT %NULL(CTX)
	%THEN
	    $RMS_PTR [FAB$G_CTX]	= CTX;
	%FI
	%IF NOT %NULL(JFN)
	%THEN
	    $RMS_PTR [FAB$H_JFN]	= JFN;
	%FI
	%IF NOT %NULL(SHR)
	%THEN
	    $RMS_PTR [FAB$H_SHR]	= $RMS_BITFLD(FAB$M_SHR_, SHR);
	%FI
	%IF NOT %NULL(FAC)
	%THEN
	    $RMS_PTR [FAB$H_FAC]	= $RMS_BITFLD(FAB$M_FAC_, FAC);
	%FI
	%IF NOT %NULL(BLS)
	%THEN
	    $RMS_PTR [FAB$Z_BLS]	= BLS;
	%FI
	%IF NOT %NULL(BSZ)
	%THEN
	    $RMS_PTR [FAB$Z_BSZ]	= BSZ;
	%FI
	%IF NOT %NULL(ORG)
	%THEN
	    $RMS_PTR [FAB$Z_ORG]	= $RMS_CODFLD(FAB$K_ORG_, ORG);
	%FI
	%IF NOT %NULL(FOP)
	%THEN
	    $RMS_PTR [FAB$H_FOP]	= $RMS_BITFLD(FAB$M_FOP_, FOP);
	%FI
	%IF NOT %NULL(FNA)
	%THEN
	    $RMS_PTR [FAB$A_FNA]	= $RMS_STRFLD(FNA);
	%FI
	%IF NOT %NULL(MRS)
	%THEN
	    $RMS_PTR [FAB$H_MRS]	= MRS;
	%FI
	%IF NOT %NULL(RAT)
	%THEN
	    $RMS_PTR [FAB$H_RAT]	= $RMS_BITFLD(FAB$M_RAT_, RAT);
	%FI
	%IF NOT %NULL(MRN)
	%THEN
	    $RMS_PTR [FAB$G_MRN]	= MRN;
	%FI
	%IF NOT %NULL(RFM)
	%THEN
	    $RMS_PTR [FAB$Z_RFM]	= $RMS_CODFLD(FAB$K_RFM_, RFM);
	%FI
	%IF NOT %NULL(BKS)
	%THEN
	    $RMS_PTR [FAB$Z_BKS]	= BKS;
	%FI
	%IF NOT %NULL(XAB)
	%THEN
	    $RMS_PTR [FAB$A_XAB]	= XAB;
	%FI
	%IF NOT %NULL(JNL)
	%THEN
	    $RMS_PTR [FAB$A_JNL]	= JNL;
	%FI

        %IF NOT %NULL(NAM)
        %THEN
            $RMS_PTR [FAB$A_NAM]        = NAM;
        %FI

        %IF NOT %NULL(TYP)
        %THEN
            $RMS_PTR [FAB$A_TYP]        = TYP;
        %FI

	1) %;


!+
!
!  $FAB_ZERO
!
!	Used to dynamically zero
!	a FAB control block
!
!-

KEYWORDMACRO
    $FAB_ZERO(FAB) =				! Zero a FAB
	(BIND $RMS_PTR = FAB : $FAB_DECL;
	CH$FILL(0, FAB$K_BLN, CH$PTR($RMS_PTR, 0, 36))) %;


%SBTTL 'RAB definitions'
!++
!
!	RAB definitions
!
!--

! RAB structure

$FIELD
    $RAB_BLOCK_FIELDS =
	SET
	RAB$H_BLN	= [$BYTES(2)],		! RAB length
	RAB$H_BID	= [$BYTES(2)],		! RAB identifier
	RAB$H_STV	= [$BYTES(2)],		! Status value
	RAB$H_STS	= [$BYTES(2)],		! Primary status
	RAB$G_CTX	= [$BYTES(4)],		! User's context word
	RAB$A_FAB	= [$ADDRESS],		! Pointer to FAB
	RAB$A_ISI	= [$ADDRESS],		! Internal stream identifier
	RAB$H_ROP	= [$BITS(18)],		! Record operation bits
	    $OVERLAY(RAB$H_ROP)
	    RAB$V_ROP_EOF = [$BIT],		! Set to EOF on $CONNECT
	    RAB$V_ROP_FDL = [$BIT],		! Fast delete
	    RAB$V_ROP_LOC = [$BIT],		! Use locate mode on $GETs
	    RAB$V_ROP_RAH = [$BIT],		! Read ahead
	    RAB$V_ROP_LOA = [$BIT],		! Use load limits
	    RAB$V_ROP_WBH = [$BIT],		! Write behind
	    RAB$V_ROP_KGT = [$BIT],		! Search key >
	    RAB$V_ROP_KGE = [$BIT],		! Search key >=
	    RAB$V_ROP_PAD = [$BIT],		! Use PAD character as filler
	    RAB$V_ROP_NRP = [$BIT],		! Set NRP on $FIND
            RAB$V_ROP_UIF = [$BIT],             ! Update existing ** Reserved *
            RAB$V_ROP_ULK = [$BIT],             ! Manual unlock ** Reserved **
            RAB$V_ROP_TPT = [$BIT],             ! Truncate to EOF ** Reserved *
            RAB$V_ROP_NLK = [$BIT],             ! Do not lock ** Reserved **
            RAB$V_ROP_RLK = [$BIT],             ! Read locked rec ** Reserved *
            RAB$V_ROP_BIO = [$BIT],             ! Block I/O ** Reserved **
            RAB$V_ROP_LIM = [$BIT],             ! ** RESERVED ** key lim
            RAB$V_ROP_NXR = [$BIT],             ! ** RESERVED ** non ex record
	    $CONTINUE
	RAB$Z_MBF	= [$BYTE],		! Multi-buffer count
	RAB$Z_RAC	= [$BYTE],		! Record access
	RAB$A_UBF	= [$POINTER],		! User buffer
	RAB$A_RBF	= [$POINTER],		! Record buffer
	RAB$H_USZ	= [$SHORT_INTEGER],	! User buffer size (words)
	RAB$H_RSZ	= [$SHORT_INTEGER],	! Record size (bytes)
	RAB$G_RFA	= [$BYTES(4)],		! Record file address
	RAB$H_LSN	= [$BYTES(2)],		! Line sequence number
	RAB$Z_KSZ	= [$TINY_INTEGER],	! Key size
	RAB$Z_KRF	= [$TINY_INTEGER],	! Key of reference
	RAB$A_KBF	= [$POINTER],		! Key buffer
	RAB$G_BKT	= [$BYTES(4)],		! Bucket hash code
	RAB$Z_UNUSED_0	= [$BYTES(3)],		! Unused area
	RAB$Z_PAD	= [$BYTE],		! Padding character
	RAB$G_UNUSED_1	= [$BYTES(4)],		! Three
	RAB$G_UNUSED_2	= [$BYTES(4)],		!    unused
	RAB$G_UNUSED_3	= [$BYTES(4)]		!       words
	TES;

! End of RAB
!++
!
!	Symbol definitions for RAB
!
!--

LITERAL
    RAB$K_SIZE = $FIELD_SET_SIZE;

LITERAL

!
!	Default values
!
	RAB$K_BLN	= 16,		! RAB length
	RAB$K_BID	= 2,		! Block type
!
!	RAC (record access) field
!
    RAB$K_RAC_SEQ	= 0,		! Sequential access mode
    RAB$K_RAC_KEY	= 1,		! Key access mode
    RAB$K_RAC_RFA	= 2,		! RFA access mode
    RAB$K_RAC_BLK      = 253,                   ! Block access ** RESERVED **
    RAB$K_RAC_TRA      = 254,          ! Record mode file transfer  **FTS**
    RAB$K_RAC_BFT      = 255,          ! Block Mode file transfer   **FTS**

!
!	ROP (record options) field
!
	RAB$M_ROP_EOF	= 1 ^ 0,	! Position file to EOF
	RAB$M_ROP_FDL	= 1 ^ 1,	! Fast delete
	RAB$M_ROP_LOC	= 1 ^ 2,	! Use locate mode on $GETs
	RAB$M_ROP_RAH	= 1 ^ 3,	! Read ahead
	RAB$M_ROP_LOA	= 1 ^ 4,	! Follow load percentages
	RAB$M_ROP_WBH	= 1 ^ 5,	! Write behind
	RAB$M_ROP_KGT	= 1 ^ 6,	! Key greater than
	RAB$M_ROP_KGE	= 1 ^ 7,	! Key greater than or equal to
	RAB$M_ROP_PAD	= 1 ^ 8,	! Use PAD character to fill buffer
	RAB$M_ROP_NRP	= 1 ^ 9,	! Set Next Record Ptr on $FIND
        RAB$M_ROP_UIF   = 1 ^ 10,               ! ** RESERVED **
        RAB$M_ROP_ULK   = 1 ^ 11,               ! ** RESERVED **
        RAB$M_ROP_TPT   = 1 ^ 12,               ! ** RESERVED **
        RAB$M_ROP_NLK   = 1 ^ 13,               ! ** RESERVED **
        RAB$M_ROP_BIO   = 1 ^ 14,               ! ** RESERVED **
        RAB$M_ROP_LIM   = 1 ^ 15,               ! ** RESERVED **
        RAB$M_ROP_NXR   = 1 ^ 16;               ! ** RESERVED **

!++
!
!	RAB declaration/allocation/initialization macros
!
!--

!+
!
!  $RAB_DECL
!
!	$RAB_DECL allocates space for a RAB
!	but does not initialize any storage
!
!-
MACRO

    $RAB_DECL = 
	BLOCK[RAB$K_BLN] FIELD($RAB_BLOCK_FIELDS) %;

!+
!
!  $RAB
!
!	$RAB allocates space for a RAB and 
!	initializes the fields therein.
!
!-

KEYWORDMACRO

    $RAB(				! Build a compile-time RAB
	RAC = SEQ,	ROP,		UBF = 0,	USZ = 0,
	RBF = 0,	RSZ = 0,	PAD = 0,	KBF = 0,
	KSZ = 0,	FAB = 0,	MBF = 0,	CTX = 0,
	KRF = 0) =

	$RAB_DECL
	PRESET (			! Set up the fields
		[RAB$H_BLN]		= RAB$K_BLN,
		[RAB$H_BID]		= RAB$K_BID,
		[RAB$G_CTX]		= CTX,
		[RAB$A_FAB]		= FAB,
		[RAB$H_ROP]		= $RMS_BITFLD(RAB$M_ROP_, ROP),
		[RAB$Z_MBF]		= MBF,
		[RAB$Z_RAC]		= $RMS_CODFLD(RAB$K_RAC_, RAC),
		[RAB$A_UBF]		= UBF,
		[RAB$A_RBF]		= RBF,
		[RAB$H_USZ]		= USZ,
		[RAB$H_RSZ]		= RSZ,
		[RAB$Z_KSZ]		= KSZ,
		[RAB$Z_KRF]		= KRF,
		[RAB$A_KBF]		= KBF,
		[RAB$Z_PAD]		= PAD) %;
!+
!
!  $RAB_INIT
!
!	$RAB_INIT dynamically initializes a RAB.
!
!-

KEYWORDMACRO

    $RAB_INIT(				! Initialize a RAB

	RAB,

	RAC = SEQ,	ROP,		UBF = 0,	USZ = 0,
	RBF = 0,	RSZ = 0,	PAD = 0,	KBF = 0,
	KSZ = 0,	FAB = 0,	MBF = 0,	CTX = 0,
	KRF = 0) =

	(BIND $RMS_PTR = RAB : $RAB_DECL;
	CH$FILL(0, RAB$K_BLN, CH$PTR($RMS_PTR, 0, 36));

		$RMS_PTR [RAB$H_BLN]		= RAB$K_BLN;
		$RMS_PTR [RAB$H_BID]		= RAB$K_BID;
		$RMS_PTR [RAB$G_CTX]		= CTX;
		$RMS_PTR [RAB$A_FAB]		= FAB;
		$RMS_PTR [RAB$H_ROP]		= $RMS_BITFLD(RAB$M_ROP_, ROP);
		$RMS_PTR [RAB$Z_MBF]		= MBF;
		$RMS_PTR [RAB$Z_RAC]		= $RMS_CODFLD(RAB$K_RAC_, RAC);
		$RMS_PTR [RAB$A_UBF]		= UBF;
		$RMS_PTR [RAB$A_RBF]		= RBF;
		$RMS_PTR [RAB$H_USZ]		= USZ;
		$RMS_PTR [RAB$H_RSZ]		= RSZ;
		$RMS_PTR [RAB$Z_KSZ]		= KSZ;
		$RMS_PTR [RAB$Z_KRF]		= KRF;
		$RMS_PTR [RAB$A_KBF]		= KBF;
		$RMS_PTR [RAB$Z_PAD]		= PAD;
		1) %;

!+
!
!  $RAB_STORE
!
!	$RAB_STORE dynamically changes a RAB.
!
!-

KEYWORDMACRO

    $RAB_STORE(				! Change a RAB

	RAB,

	RAC,	ROP,	UBF,	USZ,	RBF,	RSZ,	PAD,	KBF,
	KSZ,	FAB,	MBF,	CTX,	KRF) =

	(BIND $RMS_PTR = RAB : $RAB_DECL;

	%IF NOT %NULL(CTX)
	%THEN
		$RMS_PTR [RAB$G_CTX]		= CTX;
	%FI
	%IF NOT %NULL(FAB)
	%THEN
		$RMS_PTR [RAB$A_FAB]		= FAB;
	%FI
	%IF NOT %NULL(ROP)
	%THEN
		$RMS_PTR [RAB$H_ROP]		= $RMS_BITFLD(RAB$M_ROP_, ROP);
	%FI
	%IF NOT %NULL(MBF)
	%THEN
		$RMS_PTR [RAB$Z_MBF]		= MBF;
	%FI
	%IF NOT %NULL(RAC)
	%THEN
		$RMS_PTR [RAB$Z_RAC]		= $RMS_CODFLD(RAB$K_RAC_, RAC);
	%FI
	%IF NOT %NULL(UBF)
	%THEN
		$RMS_PTR [RAB$A_UBF]		= UBF;
	%FI
	%IF NOT %NULL(RBF)
	%THEN
		$RMS_PTR [RAB$A_RBF]		= RBF;
	%FI
	%IF NOT %NULL(USZ)
	%THEN
		$RMS_PTR [RAB$H_USZ]		= USZ;
	%FI
	%IF NOT %NULL(RSZ)
	%THEN
		$RMS_PTR [RAB$H_RSZ]		= RSZ;
	%FI
	%IF NOT %NULL(KSZ)
	%THEN
		$RMS_PTR [RAB$Z_KSZ]		= KSZ;
	%FI
	%IF NOT %NULL(KRF)
	%THEN
		$RMS_PTR [RAB$Z_KRF]		= KRF;
	%FI
	%IF NOT %NULL(KBF)
	%THEN
		$RMS_PTR [RAB$A_KBF]		= KBF;
	%FI
	%IF NOT %NULL(PAD)
	%THEN
		$RMS_PTR [RAB$Z_PAD]		= PAD;
	%FI
		1) %;

!+
!
!  $RAB_ZERO
!
!	$RAB_ZERO dynamically zeroes a RAB.
!
!-

KEYWORDMACRO

    $RAB_ZERO(RAB) =				! Zero a RAB
	(BIND $RMS_PTR = RAB : $RAB_DECL;
	CH$FILL(0, RAB$K_BLN, CH$PTR($RMS_PTR, 0, 36)))  %;


%SBTTL 'XAB definitions'

!++
!
!	RMSXAB.REQ defines all symbols and macros pertaining
!	to XABs: the fields of a XAB, the $XAB_DECL, $XAB,
!	and $XAB_INIT macros, and the values stored therein.
!
!--

!+
!
!	The XAB field definitions are given using XPORT macros
!
!-

! XABALL block
$FIELD
    $XABALL_BLOCK_FIELDS =
	SET
	XABALL$H_BLN	= [$BYTES(2)],		! Block length
	XABALL$H_BID	= [$BYTES(2)],		! Block type
	XABALL$A_NXT	= [$ADDRESS],		! Address of next XAB in chain
	XABALL$Z_COD	= [$BITS(5)],		! XAB-type code
	XABALL$Z_UNUSED_0	= [$BITS(13)],		!
	XABALL$Z_BKZ	= [$BYTE],		! Bucket size
	XABALL$Z_AID	= [$BYTE],		! Area I.D.
	XABALL$H_UNUSED_1	= [$BYTES(2)],		!
	XABALL$G_UNUSED_2	= [$BYTES(4)],		!
	XABALL$G_UNUSED_3	= [$BYTES(4)],		!
	XABALL$G_UNUSED_4	= [$BYTES(4)]		!
	TES;

LITERAL
    XABALL$K_SIZE = $FIELD_SET_SIZE;

LITERAL
    XABALL$K_BLN = 6,				! XABALL block length
    XABALL$K_COD = 1,				! XABALL block code
    XABALL$K_BID = 3;				! XAB block type


!+
!
!   $XABALL_DECL
!
!	$XABALL_DECL allocates space for an area XAB 
!	without initializing storage.  It is meant
!	to be used with the $XABALL_INIT macro.
!
!-

MACRO
    $XABALL_DECL = BLOCK[XABALL$K_BLN] FIELD($XABALL_BLOCK_FIELDS) %;

!+
!
!   $XABALL
!
!	$XABALL allocates space and initializes
!	storage for a compile-time area XAB.
!
!-

KEYWORDMACRO
    $XABALL(
	NXT = 0,	AID = 0,	BKZ = 1) =

	$XABALL_DECL
	PRESET(
	    [XABALL$H_BLN]	= XABALL$K_BLN,
	    [XABALL$H_BID]	= XABALL$K_BID,
	    [XABALL$Z_COD]	= XABALL$K_COD,
	    [XABALL$A_NXT]	= NXT,
	    [XABALL$Z_BKZ]	= BKZ,
	    [XABALL$Z_AID]	= AID) %;


!+
!
!   $XABALL_INIT
!
!	$XABALL_INIT initializes storage
!	for an area XAB.
!
!-

KEYWORDMACRO
    $XABALL_INIT(

	XAB,

	NXT = 0,	AID = 0,	BKZ = 1) =

	(BIND $RMS_PTR = XAB : $XABALL_DECL;
	 CH$FILL(0, XABALL$K_BLN, CH$PTR($RMS_PTR, 0, 36));

	    $RMS_PTR [XABALL$H_BLN]	= XABALL$K_BLN;
	    $RMS_PTR [XABALL$H_BID]	= XABALL$K_BID;
	    $RMS_PTR [XABALL$Z_COD]	= XABALL$K_COD;
	    $RMS_PTR [XABALL$A_NXT]	= NXT;
	    $RMS_PTR [XABALL$Z_BKZ]	= BKZ;
	    $RMS_PTR [XABALL$Z_AID]	= AID;
	    1) %;


!+
!
!   $XABALL_STORE
!
!	$XABALL_STORE changes storage
!	fields of an area XAB.
!
!-

KEYWORDMACRO
    $XABALL_STORE(

	XAB,	NXT,	AID,	BKZ) =

	(BIND $RMS_PTR = XAB : $XABALL_DECL;

	%IF NOT %NULL(NXT)
	%THEN
	    $RMS_PTR [XABALL$A_NXT]	= NXT;
	%FI
	%IF NOT %NULL(AID)
	%THEN
	    $RMS_PTR [XABALL$Z_AID]	= AID;
	%FI
	%IF NOT %NULL(BKZ)
	%THEN
	    $RMS_PTR [XABALL$Z_BKZ]	= BKZ;
	%FI
	    1) %;

!+
!
!   $XABALL_ZERO
!
!	$XABALL_ZERO zeroes storage
!	for an area XAB.
!
!-

KEYWORDMACRO
    $XABALL_ZERO(XAB) =			! Zero an area XAB
	(BIND $RMS_PTR = XAB : $XABALL_DECL;
	 CH$FILL(0, XABALL$K_BLN, CH$PTR($RMS_PTR, 0, 36)))  %;

! XABDAT block
$FIELD
    $XABDAT_BLOCK_FIELDS =
	SET
	XABDAT$H_BLN	= [$BYTES(2)],	! Block length
	XABDAT$H_BID	= [$BYTES(2)],	! Block type
	XABDAT$A_NXT	= [$ADDRESS],		! Address of next XAB in chain
	XABDAT$Z_COD	= [$BITS(5)],		! XAB-type code
	XABDAT$Z_UNUSED_0	= [$BITS(13)],		!
	XABDAT$G_CDT	= [$BYTES(4)],		! Creation date
	XABDAT$G_RDT	= [$BYTES(4)],		! Read date
	XABDAT$G_EDT	= [$BYTES(4)]		! Deletion date
	TES;

LITERAL
    XABDAT$K_SIZE = $FIELD_SET_SIZE;

LITERAL
    XABDAT$K_BLN = 5,				! XABDAT block length
    XABDAT$K_COD = 2,				! XABDAT block code
    XABDAT$K_BID = 3;				! XAB block type

!+
!
!   $XABDAT_DECL
!
!	$XABDAT_DECL allocates space for a date XAB 
!	without initializing storage.  It is meant
!	to be used with the $XABDAT_INIT macro.
!
!-

MACRO
    $XABDAT_DECL = BLOCK[XABDAT$K_BLN] FIELD($XABDAT_BLOCK_FIELDS) %;

!+
!
!   $XABDAT
!
!	$XABDAT allocates space and initializes
!	storage for a compile-time date XAB.
!
!-

KEYWORDMACRO
    $XABDAT(
	NXT = 0,	EDT = 0) =

	$XABDAT_DECL
	PRESET(
	    [XABDAT$H_BLN]	= XABDAT$K_BLN,
	    [XABDAT$H_BID]	= XABDAT$K_BID,
	    [XABDAT$Z_COD]	= XABDAT$K_COD,
	    [XABDAT$A_NXT]	= NXT,
	    [XABDAT$G_EDT]	= EDT) %;


!+
!
!   $XABDAT_INIT
!
!	$XABDAT_INIT initializes storage
!	for a date XAB.
!
!-

KEYWORDMACRO
    $XABDAT_INIT(
	XAB,
	NXT = 0,	EDT = 0) =
	(BIND $RMS_PTR = XAB : $XABDAT_DECL;
	 CH$FILL(0, XABDAT$K_BLN, CH$PTR($RMS_PTR, 0, 36));
	    $RMS_PTR [XABDAT$H_BLN]	= XABDAT$K_BLN;
	    $RMS_PTR [XABDAT$H_BID]	= XABDAT$K_BID;
	    $RMS_PTR [XABDAT$Z_COD]	= XABDAT$K_COD;
	    $RMS_PTR [XABDAT$A_NXT]	= NXT;
	    $RMS_PTR [XABDAT$G_EDT]	= EDT;
	    1) %;


!+
!
!   $XABDAT_STORE
!
!	$XABDAT_STORE changes storage
!	fields of a date XAB.
!
!-

KEYWORDMACRO
    $XABDAT_STORE(

	XAB,	NXT,	EDT) =

	(BIND $RMS_PTR = XAB : $XABDAT_DECL;

	%IF NOT %NULL(NXT)
	%THEN
	    $RMS_PTR [XABDAT$A_NXT]	= NXT;
	%FI
	%IF NOT %NULL(EDT)
	%THEN
	    $RMS_PTR [XABDAT$G_EDT]	= EDT;
	%FI
	    1) %;
!+
!
!   $XABDAT_ZERO
!
!	$XABDAT_ZERO zeroes a date XAB
!
!-

KEYWORDMACRO
    $XABDAT_ZERO(XAB) =			! Zero a date XAB
	(BIND $RMS_PTR = XAB : $XABDAT_DECL;
	 CH$FILL(0, XABDAT$K_BLN, CH$PTR($RMS_PTR, 0, 36))) %;
! XABKEY block
$FIELD
    $XABKEY_BLOCK_FIELDS =
	SET
	XABKEY$H_BLN	= [$BYTES(2)],	! Block length
	XABKEY$H_BID	= [$BYTES(2)],	! Block type
	XABKEY$A_NXT	= [$ADDRESS],		! Address of next XAB in chain
	XABKEY$Z_COD	= [$BITS(5)],		! XAB-type code
	XABKEY$Z_UNUSED_0	= [$BITS(13)],		!
	XABKEY$H_FLG	= [$BITS(18)],		! Key flags
	    $OVERLAY(XABKEY$H_FLG)
	    XABKEY$V_FLG_DUP = [$BIT],		! Duplicate keys allowed
	    XABKEY$V_FLG_CHG = [$BIT],		! Change of key allowed
	    XABKEY$V_FLG_HSH = [$BIT],		! Hash method of index org.
	    $CONTINUE
	XABKEY$Z_DTP	= [$BITS(6)],		! Data type
	XABKEY$Z_UNUSED_1	= [$BITS(12)],		!
	XABKEY$Z_REF	= [$BYTE],		! Key of reference
	XABKEY$Z_LAN	= [$BYTE],		! Lowest index area number
	XABKEY$Z_DAN	= [$BYTE],		! Data area number
	XABKEY$Z_IAN	= [$BYTE],		! Index area number
	XABKEY$H_DFL	= [$BYTES(2)],	! Data fill limit
	XABKEY$H_IFL	= [$BYTES(2)],	! Index fill limit
	XABKEY$A_KNM	= [$POINTER],		! Address of key name
	XABKEY$G_RES0	= [$BYTES(4)],		! Two words
	XABKEY$G_RES1	= [$BYTES(4)],		!    are reserved
	XABKEY$G_UNUSED_2	= [$BYTES(4)],		! Unused
	XABKEY$G_UNUSED_3	= [$BYTES(4)],		! Unused
	XABKEY$G_UNUSED_4	= [$BYTES(4)],		! Unused
	XABKEY$H_SIZ0	= [$BYTES(2)],	! Size of segment 0
	XABKEY$H_POS0	= [$BYTES(2)],	! Position of segment 0
	XABKEY$H_SIZ1	= [$BYTES(2)],	! Size of segment 1
	XABKEY$H_POS1	= [$BYTES(2)],	! Position of segment 1
	XABKEY$H_SIZ2	= [$BYTES(2)],	! Size of segment 2
	XABKEY$H_POS2	= [$BYTES(2)],	! Position of segment 2
	XABKEY$H_SIZ3	= [$BYTES(2)],	! Size of segment 3
	XABKEY$H_POS3	= [$BYTES(2)],	! Position of segment 3
	XABKEY$H_SIZ4	= [$BYTES(2)],	! Size of segment 4
	XABKEY$H_POS4	= [$BYTES(2)],	! Position of segment 4
	XABKEY$H_SIZ5	= [$BYTES(2)],	! Size of segment 5
	XABKEY$H_POS5	= [$BYTES(2)],	! Position of segment 5
	XABKEY$H_SIZ6	= [$BYTES(2)],	! Size of segment 6
	XABKEY$H_POS6	= [$BYTES(2)],	! Position of segment 6
	XABKEY$H_SIZ7	= [$BYTES(2)],	! Size of segment 7
	XABKEY$H_POS7	= [$BYTES(2)]	! Position of segment 7
	TES;

! end of XABKEY

!+
!
!	XABKEY symbols
!
!-

LITERAL
    XABKEY$K_SIZE = $FIELD_SET_SIZE;

LITERAL
    XABKEY$K_DTP_STG = 0,			! String (ASCII) data
    XABKEY$K_DTP_EBC = 1,			! EBCDIC data
    XABKEY$K_DTP_SIX = 2,			! SIXBIT data
    XABKEY$K_DTP_PAC = 3,                       ! PACKED DECIMAL data
    XABKEY$K_DTP_IN4 = 4,                       ![10] INTEGER (1 word, 4 bytes)
    XABKEY$K_DTP_IN8 = 5;                       ![10] INTEGER (2 word, 8 bytes)

LITERAL
    XABKEY$M_FLG_DUP = 1 ^ 0,			! Duplicate keys allowed
    XABKEY$M_FLG_CHG = 1 ^ 1,			! Key change on update allowed
    XABKEY$M_FLG_HSH = 1 ^ 2;			! Hash indexing

LITERAL
    XABKEY$K_BLN = 19,				! XABKEY block length
    XABKEY$K_COD = 0,				! XABKEY block code
    XABKEY$K_BID = 3;				! XAB block type

!+
!
!   $XABKEY_DECL
!
!	$XABKEY_DECL allocates space for an key XAB 
!	without initializing storage.  It is meant
!	to be used with the $XABKEY_INIT macro.
!
!-

MACRO
    $XABKEY_DECL = BLOCK[XABKEY$K_BLN] FIELD($XABKEY_BLOCK_FIELDS) %;

!+
!
!   $XABKEY
!
!	$XABKEY allocates space and initializes
!	storage for a compile-time key XAB.
!
!-

KEYWORDMACRO
    $XABKEY(
	FLG,		DTP = STG,	KREF = 0,	DAN = 0,
	IAN = 0,	DFL = 0,	IFL = 0,	KNM = 0,
	SIZ = <0,0,0,0,0,0,0,0>,	POS = <0,0,0,0,0,0,0,0>,
	NXT = 0,	LAN = 0) =

	$XABKEY_DECL
	PRESET(
	    [XABKEY$H_BLN]	= XABKEY$K_BLN,
	    [XABKEY$H_BID]	= XABKEY$K_BID,
	    [XABKEY$Z_COD]	= XABKEY$K_COD,
	    [XABKEY$A_NXT]	= NXT,
	    [XABKEY$H_FLG]	= $RMS_BITFLD(XABKEY$M_FLG_, FLG),
	    [XABKEY$Z_DTP]	= $RMS_CODFLD(XABKEY$K_DTP_, DTP),
	    [XABKEY$Z_REF]	= KREF,
	    [XABKEY$Z_LAN]	= LAN,
	    [XABKEY$Z_IAN]	= IAN,
	    [XABKEY$Z_DAN]	= DAN,
	    [XABKEY$H_DFL]	= DFL,
	    [XABKEY$H_IFL]	= IFL,
	    $RMS_POSITION(%REMOVE(POS)),
	    $RMS_SIZE(%REMOVE(SIZ)),
	    [XABKEY$A_KNM]	= $RMS_STRFLD(KNM)) %;


!+
!
!   $XABKEY_INIT
!
!	$XABKEY_INIT initializes
!	storage for a key XAB.
!
!-

KEYWORDMACRO
    $XABKEY_INIT(

	XAB,

	FLG,		DTP = STG,	KREF = 0,	DAN = 0,
	IAN = 0,	DFL = 0,	IFL = 0,	KNM = 0,
	SIZ = <0,0,0,0,0,0,0,0>,	POS = <0,0,0,0,0,0,0,0>,
	NXT = 0,	LAN = 0) =

	(BIND $RMS_PTR = XAB: $XABKEY_DECL;

	    CH$FILL(0, XABKEY$K_BLN, CH$PTR($RMS_PTR, 0, 36));
	    $RMS_PTR [XABKEY$H_BLN]	= XABKEY$K_BLN;
	    $RMS_PTR [XABKEY$H_BID]	= XABKEY$K_BID;
	    $RMS_PTR [XABKEY$Z_COD]	= XABKEY$K_COD;
	    $RMS_PTR [XABKEY$A_NXT]	= NXT;
	    $RMS_PTR [XABKEY$H_FLG]	= $RMS_BITFLD(XABKEY$M_FLG_, FLG);
	    $RMS_PTR [XABKEY$Z_DTP]	= $RMS_CODFLD(XABKEY$K_DTP_, DTP);
	    $RMS_PTR [XABKEY$Z_REF]	= KREF;
	    $RMS_PTR [XABKEY$Z_LAN]	= LAN;
	    $RMS_PTR [XABKEY$Z_IAN]	= IAN;
	    $RMS_PTR [XABKEY$Z_DAN]	= DAN;
	    $RMS_PTR [XABKEY$H_DFL]	= DFL;
	    $RMS_PTR [XABKEY$H_IFL]	= IFL;
	    $RMS_POSITION_INI ($RMS_PTR, %REMOVE (POS));
	    $RMS_SIZE_INI ($RMS_PTR, %REMOVE (SIZ));
	    $RMS_PTR [XABKEY$A_KNM]	= $RMS_STRFLD(KNM);
	    1) %;
!+
!
!   $XABKEY_STORE
!
!	$XABKEY_STORE changes storage
!	fields of an key XAB.
!
!-

KEYWORDMACRO
    $XABKEY_STORE(
	XAB,
	FLG,	DTP,	KREF,	DAN,	IAN,	DFL,	IFL,	KNM,
	SIZ,	POS,	NXT,	LAN) =
	(BIND $RMS_PTR = XAB: $XABKEY_DECL;
	    %IF NOT %NULL(NXT)
	    %THEN
	    $RMS_PTR [XABKEY$A_NXT]	= NXT;
	    %FI
	    %IF NOT %NULL(FLG)
	    %THEN
	    $RMS_PTR [XABKEY$H_FLG]	= $RMS_BITFLD(XABKEY$M_FLG_, FLG);
	    %FI
	    %IF NOT %NULL(DTP)
	    %THEN
	    $RMS_PTR [XABKEY$Z_DTP]	= $RMS_CODFLD(XABKEY$K_DTP_, DTP);
	    %FI
	    %IF NOT %NULL(KREF)
	    %THEN
	    $RMS_PTR [XABKEY$Z_REF]	= KREF;
	    %FI
	    %IF NOT %NULL(LAN)
	    %THEN
	    $RMS_PTR [XABKEY$Z_LAN]	= LAN;
	    %FI
	    %IF NOT %NULL(IAN)
	    %THEN
	    $RMS_PTR [XABKEY$Z_IAN]	= IAN;
	    %FI
	    %IF NOT %NULL(DAN)
	    %THEN
	    $RMS_PTR [XABKEY$Z_DAN]	= DAN;
	    %FI
	    %IF NOT %NULL(DFL)
	    %THEN
	    $RMS_PTR [XABKEY$H_DFL]	= DFL;
	    %FI
	    %IF NOT %NULL(IFL)
	    %THEN
	    $RMS_PTR [XABKEY$H_IFL]	= IFL;
	    %FI
	    %IF NOT %NULL(POS)
	    %THEN
	    $RMS_POSITION_INI ($RMS_PTR, %REMOVE POS);
	    %FI
	    %IF NOT %NULL(SIZ)
	    %THEN
	    $RMS_SIZE_INI ($RMS_PTR, %REMOVE SIZ);
	    %FI
	    %IF NOT %NULL(KNM)
	    %THEN
	    $RMS_PTR [XABKEY$A_KNM]	= $RMS_STRFLD(KNM);
	    %FI
	    1) %;


!+
!
!   $XABKEY_ZERO
!
!	$XABKEY_ZERO zeroes a key XAB
!
!-

KEYWORDMACRO
    $XABKEY_ZERO(XAB) =			! Zero a key XAB
	(BIND $RMS_PTR = XAB: $XABKEY_DECL;
	CH$FILL(0, XABKEY$K_BLN, CH$PTR($RMS_PTR, 0, 36)))  %;

! XABSUM block
$FIELD
    $XABSUM_BLOCK_FIELDS =
	SET
	XABSUM$H_BLN	= [$BYTES(2)],	! Block length
	XABSUM$H_BID	= [$BYTES(2)],	! Block type
	XABSUM$A_NXT	= [$ADDRESS],		! Address of next XAB in chain
	XABSUM$Z_COD	= [$BITS(5)],		! XAB-type code
	XABSUM$Z_UNUSED_0	= [$BITS(13)],		!
	XABSUM$Z_NOA	= [$BYTE],		! Number of areas
	XABSUM$Z_NOK	= [$BYTE],		! Number of keys
	XABSUM$H_UNUSED_1	= [$BYTES(2)],		!
	XABSUM$G_UNUSED_2	= [$BYTES(4)],		!
	XABSUM$G_UNUSED_3	= [$BYTES(4)],		!
	XABSUM$G_UNUSED_4	= [$BYTES(4)]		!
	TES;

LITERAL
    XABSUM$K_SIZE = $FIELD_SET_SIZE;

LITERAL
    XABSUM$K_BLN = 6,				! XABSUM block length
    XABSUM$K_COD = 3,				! XABSUM block code
    XABSUM$K_BID = 3;				! XAB block type

!+
!
!   $XABSUM_DECL
!
!	$XABSUM_DECL allocates space for an summary XAB 
!	without initializing storage.  It is meant
!	to be used with the $XABSUM_INIT macro.
!
!-

MACRO
    $XABSUM_DECL = BLOCK[XABSUM$K_BLN] FIELD($XABSUM_BLOCK_FIELDS) %;

!+
!
!   $XABSUM
!
!	$XABSUM allocates space and initializes
!	storage for a compile-time summary XAB.
!
!-

KEYWORDMACRO
    $XABSUM(
	NXT = 0) =

	$XABSUM_DECL
	PRESET(
	    [XABSUM$H_BLN]	= XABSUM$K_BLN,
	    [XABSUM$H_BID]	= XABSUM$K_BID,
	    [XABSUM$Z_COD]	= XABSUM$K_COD,
	    [XABSUM$A_NXT]	= NXT )%;


!+
!
!   $XABSUM_INIT
!
!	$XABSUM_INIT initializes storage
!	for an summary XAB.
!
!-

KEYWORDMACRO
    $XABSUM_INIT(

	XAB,

	NXT = 0) =

	(BIND $RMS_PTR = XAB : $XABSUM_DECL;
	 CH$FILL(0, XABSUM$K_BLN, CH$PTR($RMS_PTR, 0, 36));

	    $RMS_PTR [XABSUM$H_BLN]	= XABSUM$K_BLN;
	    $RMS_PTR [XABSUM$H_BID]	= XABSUM$K_BID;
	    $RMS_PTR [XABSUM$Z_COD]	= XABSUM$K_COD;
	    $RMS_PTR [XABSUM$A_NXT]	= NXT;
	    1) %;


!+
!
!   $XABSUM_STORE
!
!	$XABSUM_STORE changes storage
!	fields of an summary XAB.
!
!-

KEYWORDMACRO
    $XABSUM_STORE(

	XAB,	NXT) =

	(BIND $RMS_PTR = XAB : $XABSUM_DECL;

	%IF NOT %NULL(NXT)
	%THEN
	    $RMS_PTR [XABSUM$A_NXT]	= NXT;
	%FI
	1) %;

!+
!
!   $XABSUM_ZERO
!
!	$XABSUM_ZERO zeroes a summary XAB
!
!-

KEYWORDMACRO
    $XABSUM_ZERO(XAB) =			! Zero a summary XAB
	(BIND $RMS_PTR = XAB : $XABSUM_DECL;
	 CH$FILL(0, XABSUM$K_BLN, CH$PTR($RMS_PTR, 0, 36)))  %;


%SBTTL 'NAM definitions'
!++
!
!       NAM definitions
!
!--

! Some constants (worst case)
! Include punctuation & terminating null character

LITERAL
    RMS$K_NODE_NAME_SIZE=9,             ! 6 Chars + ::
    RMS$K_USERID_SIZE=40,               ! Phase III allows 39 chars
    RMS$K_PASSWORD_SIZE=40,             ! 
    RMS$K_ACCOUNT_SIZE=40,              ! 
    RMS$K_OPTIONAL_DATA_SIZE=17,        ! Optional data can be 16 chars
    RMS$K_DEVICE_NAME_SIZE=41,          ! 39 chars (TOPS-20) + :
    RMS$K_DIRECTORY_NAME_SIZE=82,       ! [ + ((dirname(9)+.) * 8) + ] (VMS)
    RMS$K_FILE_NAME_SIZE=40,            ! 39 chars (TOPS-20)
    RMS$K_EXTENSION_SIZE=41,            ! . + 39 chars (TOPS-20)
    RMS$K_VERSION_SIZE=8;               ! {.|;} + 6 digits (TOPS-20, VMS)

! NAM structure

$FIELD
    $NAM_BLOCK_FIELDS =
        SET
        NAM$H_BLN       = [$BYTES(2)],          ! NAM length
        NAM$H_BID       = [$BYTES(2)],          ! NAM identifier
        NAM$A_ESA       = [$POINTER],           ! Expanded string address
        NAM$H_ESS       = [$SHORT_INTEGER],     ! Expanded string length
        NAM$H_ESL       = [$SHORT_INTEGER],     ! Exp string area size
        NAM$A_RLF       = [$ADDRESS],           ! Related NAM block
        NAM$A_RSA       = [$POINTER],           ! Resultant string address
        NAM$H_RSL       = [$SHORT_INTEGER],     ! Resultant string length
        NAM$H_RSS       = [$SHORT_INTEGER],     ! Resultant string area size
        NAM$G_FNB       = [$BYTES(4)],          ! Status bits
         $OVERLAY(NAM$G_FNB)
         NAM$V_FNB_INV  = [$BIT],               ! Ignoring invisible files
         NAM$V_FNB_XXX  = [$BITS(4)],           ! Reserved
         NAM$V_FNB_GND  = [$BIT],               ! Ignoring deleted files
         NAM$V_FNB_TFS  = [$BIT],               ! Temporary file
         NAM$V_FNB_ACT  = [$BIT],               ! Account given
         NAM$V_FNB_PRO  = [$BIT],               ! Protection given
         NAM$V_FNB_ULV  = [$BIT],               ! Lowest generation (-2)
          NAM$V_FNB_LOWVER = [%FIELDEXPAND(NAM$V_FNB_ULV)],
         NAM$V_FNB_NHV  = [$BIT],               ! Next higher generation (0,-1)
         NAM$V_FNB_UHV  = [$BIT],               ! Highest generation (0)
          NAM$V_FNB_HIGHVER = [%FIELDEXPAND(NAM$V_FNB_UHV)],
         NAM$V_FNB_VER  = [$BIT],               ! Wildcard generation number
          NAM$V_FNB_WILD_VER = [%FIELDEXPAND(NAM$V_FNB_VER)],
         NAM$V_FNB_EXT  = [$BIT],               ! Extension wildcarded
          NAM$V_FNB_WILD_TYPE = [%FIELDEXPAND(NAM$V_FNB_EXT)],
         NAM$V_FNB_NAM  = [$BIT],               ! Name wildcarded
          NAM$V_FNB_WILD_NAME = [%FIELDEXPAND(NAM$V_FNB_NAM)],
         NAM$V_FNB_DIR  = [$BIT],               ! Directory wildcarded
          NAM$V_FNB_WILD_DIR = [%FIELDEXPAND(NAM$V_FNB_DIR)],
         NAM$V_FNB_UNT  = [$BIT],               ! Unit number wildcard (never)
         NAM$V_FNB_DEV  = [$BIT],               ! Device wildcarded
          NAM$V_FNB_WILD_DEV = [%FIELDEXPAND(NAM$V_FNB_DEV)],
         NAM$V_FNB_NODE = [$BIT],               ! Node name in filespec
         NAM$V_FNB_QUOTED = [$BIT],             ! Filespec has quoted string
         NAM$V_FNB_EXP_DEV = [$BIT],            ! Explicit device
         NAM$V_FNB_EXP_DIR = [$BIT],            ! Explicit directory
         NAM$V_FNB_EXP_NAME = [$BIT],           ! Explicit name
         NAM$V_FNB_EXP_TYPE = [$BIT],           ! Explicit extension
         NAM$V_FNB_EXP_VER = [$BIT],            ! Explicit version
         NAM$V_FNB_UNUSED_2 = [$BITS(9)],       !
         NAM$V_FNB_MULTIPLE = [$BIT],           ! Multiple filespecs seen
         NAM$V_FNB_WILDCARD = [$BIT],           ! Somewhere there is a wildcard
         $CONTINUE
        NAM$T_NODE      = [$STRING(RMS$K_NODE_NAME_SIZE)], ! Node name
        NAM$T_USERID    = [$STRING(RMS$K_USERID_SIZE)],
        NAM$T_PASSWORD  = [$STRING(RMS$K_PASSWORD_SIZE)],
        NAM$T_ACCOUNT   = [$STRING(RMS$K_ACCOUNT_SIZE)],
        NAM$T_OPTIONAL_DATA = [$STRING(RMS$K_OPTIONAL_DATA_SIZE)],
        NAM$T_DVI       = [$STRING(RMS$K_DEVICE_NAME_SIZE)],  ! Device
         NAM$T_DEV      = [%FIELDEXPAND(NAM$T_DVI)],
        NAM$T_DIR       = [$STRING(RMS$K_DIRECTORY_NAME_SIZE)], ! Directory
        NAM$T_NAM       = [$STRING(RMS$K_FILE_NAME_SIZE)],        ! Name
        NAM$T_EXT       = [$STRING(RMS$K_EXTENSION_SIZE)],        ! Extension
        NAM$T_VER       = [$STRING(RMS$K_VERSION_SIZE)],    ! Generation number
        NAM$G_WCC       = [$BYTES(4)],          ! Wildcard context
         $OVERLAY(NAM$G_WCC)
         NAM$H_WCC_COUNT= [$BYTES(2)],          ! Number of files found here
         NAM$H_WCC_NEXT = [$BYTES(2)],          ! Filespec chars eaten so far
        NAM$Z_CHA       = [$BYTES(2)],          ! What changed
         $OVERLAY(NAM$Z_CHA)
         NAM$V_CHA_xxx  = [$BIT],               ! reserved
         NAM$V_CHA_EXT  = [$BIT],               ! Extension changed
         NAM$V_CHA_NAM  = [$BIT],               ! Name changed
         NAM$V_CHA_DIR  = [$BIT],               ! Directory changed
         NAM$V_CHA_STR  = [$BIT],               ! Structure changed
          NAM$V_CHA_DEV = [%FIELDEXPAND(NAM$V_CHA_STR)]
         $CONTINUE
        TES;

! End of NAM

!++
!
!       Symbol definitions for NAM
!
!--

LITERAL
    NAM$K_SIZE = $FIELD_SET_SIZE;

LITERAL

!
!       Default values
!
        NAM$K_BLN       = NAM$K_SIZE,           ! NAM length
        NAM$K_BID       = 16;                   ! Block type

!
!       Masks
!

LITERAL NAM$M_FNB_WILDCARD_BITS=%O'770000';     ![11] Mask for wildcard bits


!+
!
!  $NAM_DECL
!
!	$NAM_DECL allocates space for a NAM
!	but does not initialize any storage
!
!-
MACRO

    $NAM_DECL = 
	BLOCK[NAM$K_BLN] FIELD ($NAM_BLOCK_FIELDS) %;

!+
!
!  $NAM
!
!	$NAM allocates space for a NAM and 
!	initializes the fields therein.
!
!-

KEYWORDMACRO

    $NAM(				! Build a compile-time NAM
	ESA = 0,	ESS = 0,	RLF = 0,	RSA = 0,
	RSS = 0) =

	$NAM_DECL
	PRESET (			! Set up the fields
		[NAM$H_BLN]		= NAM$K_BLN,
                [NAM$H_BID]             = NAM$K_BID,
                [NAM$A_ESA]             = ESA,
                [NAM$H_ESS]             = ESS,
                [NAM$A_RLF]             = RLF,
                [NAM$A_RSA]             = RSA,
                [NAM$H_RSS]             = RSS
               ) %;


!+
!
!  $NAM_INIT
!
!	$NAM_INIT dynamically initializes a NAM.
!
!-

KEYWORDMACRO

    $NAM_INIT(				! Initialize a NAM

	NAM,
	ESA = 0,	ESS = 0,	RLF = 0,	RSA = 0,
	RSS = 0) =

	(BIND $RMS_PTR = NAM : $NAM_DECL;
	CH$FILL(0, NAM$K_BLN, CH$PTR($RMS_PTR, 0, 36));

		$RMS_PTR [NAM$H_BLN]		= NAM$K_BLN;
		$RMS_PTR [NAM$H_BID]		= NAM$K_BID;
		$RMS_PTR [NAM$A_ESA]            = ESA;
		$RMS_PTR [NAM$H_ESS]            = ESS;
		$RMS_PTR [NAM$A_RSA]            = RSA;
         	$RMS_PTR [NAM$H_RSS]            = RSS;
		$RMS_PTR [NAM$A_RLF]            = RLF;
		1) %;

!+
!  $NAM_STORE
!
!	$NAM_STORE dynamically changes a NAM.
!
!-

KEYWORDMACRO

    $NAM_STORE(				! Change a NAM
        NAM,    ESA,    ESS,    RLF,    RSA,    RSS) =

	(BIND $RMS_PTR = NAM : $NAM_DECL;

	%IF NOT %NULL(ESA)
	%THEN
		$RMS_PTR [NAM$A_ESA]		= ESA;
	%FI
	%IF NOT %NULL(ESS)
	%THEN
		$RMS_PTR [NAM$H_ESS]		= ESS;
	%FI
	%IF NOT %NULL(RLF)
	%THEN
		$RMS_PTR [NAM$A_RLF]		= RLF;
	%FI
	%IF NOT %NULL(RSA)
	%THEN
		$RMS_PTR [NAM$A_RSA]		= RSA;
	%FI
	%IF NOT %NULL(RSS)
	%THEN
		$RMS_PTR [NAM$H_RSS]		= RSS;
	%FI


		1) %;

!+
!
!  $NAM_ZERO
!
!	$NAM_ZERO dynamically zeroes a NAM.
!
!-

KEYWORDMACRO

    $NAM_ZERO(NAM) =				! Zero a NAM
	(BIND $RMS_PTR = NAM : $NAM_DECL;
	CH$FILL(0, NAM$K_BLN, CH$PTR($RMS_PTR, 0, 36)))  %;
%SBTTL 'TYP Definitions'
!++
!
!       TYP definitions
!
!--

! TYP structure

$FIELD
    $TYP_BLOCK_FIELDS =
        SET
        TYP$H_BLN=[$SHORT_INTEGER],
        TYP$H_BID=[$BYTES(2)],
        TYP$H_CLASS=[$SHORT_INTEGER],
        TYP$H_CODE=[$SHORT_INTEGER],
        TYP$H_LENGTH=[$SHORT_INTEGER],
        TYP$B_SCALE=[$TINY_INTEGER],
        TYP$A_NEXT=[$ADDRESS],          ! Descriptor for next field
        TYP$A_MORE=[$ADDRESS]           ! Alternate chain (multiple record formats)
        TES;

!++
!
!       Symbol definitions for TYP
!
!--

LITERAL
    TYP$K_SIZE = $FIELD_SET_SIZE;

LITERAL

!
!       Default values
!
        TYP$K_BLN       = TYP$K_SIZE,           ! TYP length
        TYP$K_BID       = 17;                   ! Block type

LITERAL
        TYP$K_CLASS_ASCII = 1,          ! ASCII Data
        TYP$K_CLASS_IMAGE = 2,          ! IMAGE data
        TYP$K_CLASS_MACY11 = 3;         ! MACY11 (binary) data

LITERAL TYP$K_CLASS_MAX=3;
!+
!
!  $TYP_DECL
!
!	$TYP_DECL allocates space for a TYP
!	but does not initialize any storage
!
!-
MACRO

    $TYP_DECL = 
	BLOCK[TYP$K_BLN] FIELD ($TYP_BLOCK_FIELDS) %;

!+
!
!  $TYP
!
!	$TYP allocates space for a TYP and 
!	initializes the fields therein.
!
!-

KEYWORDMACRO

    $TYP(				! Build a compile-time TYP
         CLASS=0, CODE=0, LENGTH=0
        )=

	$TYP_DECL
	PRESET (			! Set up the fields
		[TYP$H_BLN]		= TYP$K_BLN,
                [TYP$H_BID]             = TYP$K_BID,
                [TYP$H_CLASS]           = CLASS,
                [TYP$H_CODE]            = CODE,
                [TYP$H_LENGTH]          = LENGTH
               ) %;


!+
!
!  $TYP_INIT
!
!	$TYP_INIT dynamically initializes a TYP.
!
!-

KEYWORDMACRO

    $TYP_INIT(				! Initialize a TYP
	TYP, CLASS=0, CODE=0, LENGTH=0 ) =

	(BIND $RMS_PTR = TYP : $TYP_DECL;
	CH$FILL(0, TYP$K_BLN, CH$PTR($RMS_PTR, 0, 36));

		$RMS_PTR [TYP$H_BLN]		= TYP$K_BLN;
		$RMS_PTR [TYP$H_BID]		= TYP$K_BID;
		$RMS_PTR [TYP$H_CLASS]          = CLASS;
		$RMS_PTR [TYP$H_CODE]           = CODE;
		$RMS_PTR [TYP$H_LENGTH]         = LENGTH;
		1) %;

!+
!  $TYP_STORE
!
!	$TYP_STORE dynamically changes a TYP.
!
!-

KEYWORDMACRO

    $TYP_STORE(				! Change a TYP
        TYP, CLASS, CODE, LENGTH)=

	(BIND $RMS_PTR = TYP: $TYP_DECL;

	%IF NOT %NULL(CLASS)
	%THEN
		$RMS_PTR [TYP$H_CLASS]		= CLASS;
	%FI
	%IF NOT %NULL(CODE)
	%THEN
		$RMS_PTR [TYP$H_CODE]		= CODE;
	%FI
	%IF NOT %NULL(LENGTH)
	%THEN
		$RMS_PTR [TYP$H_LENGTH]		= LENGTH;
	%FI
		1) %;

!+
!
!  $TYP_ZERO
!
!	$TYP_ZERO dynamically zeroes a TYP.
!
!-

KEYWORDMACRO

    $TYP_ZERO(TYP) =				! Zero a TYP
	(BIND $RMS_PTR = TYP : $TYP_DECL;
	CH$FILL(0, TYP$K_BLN, CH$PTR($RMS_PTR, 0, 36)))  %;
%SBTTL 'Status-checking macros'
!++
!
!	RMS status-checking macros
!
!--

!+
!
!   $RMS_STATUS_OK
!   $RMS_STATUS_SUC
!
!	$RMS_STATUS_OK and $RMS_STATUS_SUCCESS evaluate
!	the value returned in the STS field of a
!	specified block for being o.k. (success or informatory)
!	and unqualified success, respectively,
!	returning 1 if true.
!-

MACRO
    $RMS_STATUS_OK(BLK) =
	(BIND $RMS_PTR = (BLK);
	 MAP $RMS_PTR : BLOCK[];
	 IF .$RMS_PTR[1, 18, 18, 0] GEQ %O'300000'
	 THEN
	     0
	 ELSE
	     1) %,

    $RMS_STATUS_SUCCESS(BLK) =
	(BIND $RMS_PTR = (BLK);
	 MAP $RMS_PTR : BLOCK[];
	 IF .$RMS_PTR[1, 18, 18, 0] NEQ %O'1000'
	 THEN
	     0
	 ELSE
	     1) %;

!+
!
!   $RMS_STATUS_CHECK
!
!	$RMS_STATUS_CHECK checks the status value of
!	a specified block against a named error condition.
!	It is called as 
!
!		IF $RMS_STATUS_CHECK(RAB = SOME_RAB,
!		    STATUS = <RNF,REX>)
!		THEN
!		    .....
!
!			or
!
!		IF $RMS_STATUS_CHECK(FAB = SOME_FAB,
!		    STATUS = <FNF,FEX>)
!		THEN
!		    .....
!
!	and returns a 1 if any of the named conditions is found
!	in the STS field of the block.
!-

MACRO
    $RMS_STS_OR[] =
	OR %,

    $RMS_STS_VAL_CHK(VAL_NAM)[] = 
	.$RMS_PTR [1, 18, 18, 0] EQL %NAME(RMS$_, VAL_NAM)
	    $RMS_STS_OR(%REMAINING) $RMS_STS_VAL_CHK(%REMAINING) %;

KEYWORDMACRO
    $RMS_STATUS_CHECK(FAB =, RAB =, STATUS =) =
	%IF %NULL(STATUS) %THEN 0 %EXITMACRO %FI

	(%IF NOT %NULL(FAB) %THEN
	    BIND $RMS_PTR = (FAB) : BLOCK [];
	%ELSE %IF NOT %NULL(RAB) %THEN
	    BIND $RMS_PTR = (RAB) : BLOCK[];
	%ELSE ) %ERRORMACRO ('?No block specified for $RMS_STATUS_CHECK')
	%FI %FI
	IF
	    $RMS_STS_VAL_CHK(%REMOVE (STATUS))
	THEN
	    1
	ELSE
	    0) %;

%SBTTL 'RMS verb definitions'
!+
!
!	RMS calls
!
!-


MACRO
    RMS$$VALUE(NAME) =
	%NAME(RMS$K_, NAME, _VALUE) %;

LITERAL
    RMS$$VALUE(OPEN) = 0,			! 
    RMS$$VALUE(CLOSE) = 1,			! 
    RMS$$VALUE(GET) = 2,			! 
    RMS$$VALUE(PUT) = 3,			! 
    RMS$$VALUE(UPDATE) = 4,			! 
    RMS$$VALUE(DELETE) = 5,			! 
    RMS$$VALUE(FIND) = 6,			! 
    RMS$$VALUE(TRUNCATE) = 7,			! 
    RMS$$VALUE(CONNECT) = 8,			! 
    RMS$$VALUE(DISCONNECT) = 9,			! 
    RMS$$VALUE(CREATE) = 10,			! 
    RMS$$VALUE(DEBUG) = 11,			! 
    RMS$$VALUE(RELEASE) = 12,			! 
    RMS$$VALUE(FLUSH) = 13,			! 
    RMS$$VALUE(MESSAGE) = 14,			! 
    RMS$$VALUE(NOMESSAGE) = 15,			! 
    RMS$$VALUE(DISPLAY) = 16,			! 
    RMS$$VALUE(ERASE) = 17,			! 
    RMS$$VALUE(FREE) = 18,			! 
    RMS$$VALUE(UTLINT) = 19;                    !

!+
!
!   RMS$CALL
!
!	The RMS call linkage is either a PUSHJ
!	with the parameter passed in Register 1
!	(on the 10) or a JSYS linkage with the
!	argblk address passed in Register 1.
!
!	In either case registers 2, 3, and 4 are
!	not preserved.
!-


LINKAGE
    RMS$CALL = 
	%IF %SWITCHES(TOPS10)
	%THEN
	    PUSHJ
	%FI

	%IF %SWITCHES(TOPS20)
	%THEN
	    JSYS
	%FI

		(REGISTER = 1) :

			%IF %SWITCHES(TOPS10)
			%THEN
			    LINKAGE_REGS(15, 13, 1)
			%FI
				NOPRESERVE(2, 3, 4)
				PRESERVE(0, 5, 6, 7, 8, 9, 10, 11, 12, 14)
				%IF %SWITCHES(TOPS20)
				%THEN
				    SKIP(-1)
				%FI
					;

LINKAGE RMS$ERCAL=PUSHJ(REGISTER=1): LINKAGE_REGS(15,13,2);


MACRO
    $INIT =
	BEGIN
	EXTERNAL ROUTINE
	    $$RMS;
	$$RMS();
	END; %;

!+
!
!   CALL$$VALUE
!
!	CALL$$VALUE takes the verb value passed to it and
!	calculates
!	    on the 10: the absolute address to which the
!		RMS routine call is made;
!
!	    on the 20: the JSYS value which calls the appropriate
!		RMS routine
!-

MACRO
   CALL$$VALUE(VERB) = 
	%IF %SWITCHES(TOPS10)
	%THEN
	    VERB + RMS$10
	%FI

	%IF %SWITCHES(TOPS20)
	%THEN
	    VERB + RMS$K_INITIAL_JSYS
	%FI
	%;

!+
!
!   $RMS$DEFINE_CALL
!
!	$RMS$DEFINE_CALL defines an RMS verb macro.  If a block type
!	(RAB or FAB) is passed to the macro, the verb is defined as
!	a KEYWORDMACRO with name $xxxx; if no block type is present,
!	a simple macro of name $xxxx is defined, which takes no 
!	arguments.
!
!	The keyword macro form takes the appropriate block type
!	("RAB = " or "FAB = ") and optional success ("SUC = ") and
!	failure ("ERR = ") returns.  Moreover, the call returns a
!	one if the call was a success (or just O.K.) and 0 if an
!	error of any sort occurred.
!-
KEYWORDMACRO
    $RMS$DEFINE_CALL(NAME, BLK_TYPE = NO_BLOCK, ERRSTR =) =

%IF NOT %IDENTICAL(NO_BLOCK, BLK_TYPE)
%THEN
KEYWORDMACRO
    %NAME($,NAME) (BLK_TYPE, ERR=, SUC=)
	= (
	%QUOTE %IF %QUOTE %NULL(BLK_TYPE)
	%QUOTE %THEN
		) %QUOTE %ERRORMACRO (ERRSTR)
	%QUOTE %FI

	IF RMS$CALL(%QUOTE CALL$$VALUE(%NAME(RMS$K_,NAME,_VALUE)), BLK_TYPE)
        THEN %QUOTE %IF NOT %QUOTE %NULL(SUC)
             %QUOTE %THEN (SUC)()
             %QUOTE %ELSE 1
             %QUOTE %FI

        ELSE (%QUOTE %IF NOT %QUOTE %NULL(ERR)
              %QUOTE %THEN RMS$ERCAL(ERR,BLK_TYPE,UPLIT((%O'104000000000'
              %(So Error Routine can see the JSYS )%      +RMS$K_INITIAL_JSYS
              %(That invoked it, or something like it)%   +%QUOTE CALL$$VALUE(%NAME(RMS$K_,NAME,_VALUE))),
                                                         0,0)+2);
              %QUOTE %FI
              0))
%QUOTE %
%ELSE
MACRO
    %NAME($,NAME)
	= (
	RMS$CALL(%QUOTE CALL$$VALUE(%NAME(RMS$K_,NAME,_VALUE)))) %QUOTE %
%FI
	%;			! end of $RMS$DEFINE_CALL macro
                                ![11] Add paren after _VALUE to match parens
!+
!
!	RMS verbs defined using $RMS$DEFINE_CALL macro
!
!-

$RMS$DEFINE_CALL(NAME = OPEN, BLK_TYPE = FAB, ERRSTR = '?No FAB for $OPEN');
$RMS$DEFINE_CALL(NAME = CLOSE, BLK_TYPE = FAB, ERRSTR = '?No FAB for $CLOSE');
$RMS$DEFINE_CALL(NAME = GET, BLK_TYPE = RAB, ERRSTR = '?No RAB for $GET');
$RMS$DEFINE_CALL(NAME = PUT, BLK_TYPE = RAB, ERRSTR = '?No RAB for $PUT');
$RMS$DEFINE_CALL(NAME = UPDATE, BLK_TYPE = RAB, ERRSTR = '?No RAB for $UPDATE');
$RMS$DEFINE_CALL(NAME = DELETE, BLK_TYPE = RAB, ERRSTR = '?No RAB for $DELETE');
$RMS$DEFINE_CALL(NAME = FIND, BLK_TYPE = RAB, ERRSTR = '?No RAB for $FIND');
$RMS$DEFINE_CALL(NAME = TRUNCATE, BLK_TYPE = RAB,
			ERRSTR = '?No RAB for $TRUNCATE');
$RMS$DEFINE_CALL(NAME = CONNECT, BLK_TYPE = RAB,
			ERRSTR = '?No RAB for $CONNECT');
$RMS$DEFINE_CALL(NAME = DISCONNECT, BLK_TYPE = RAB,
			ERRSTR = '?No RAB for $DISCONNECT');
$RMS$DEFINE_CALL(NAME = CREATE, BLK_TYPE = FAB, ERRSTR = '?No FAB for $CREATE');
$RMS$DEFINE_CALL(NAME = DEBUG);
$RMS$DEFINE_CALL(NAME = RELEASE, BLK_TYPE = RAB,
			ERRSTR = '?No RAB for $RELEASE');
$RMS$DEFINE_CALL(NAME = FLUSH, BLK_TYPE = RAB, ERRSTR = '?No RAB for $FLUSH');
$RMS$DEFINE_CALL(NAME = MESSAGE);
$RMS$DEFINE_CALL(NAME = NOMESSAGE);
$RMS$DEFINE_CALL(NAME = DISPLAY, BLK_TYPE = FAB,
			ERRSTR = '?No FAB for $DISPLAY');
$RMS$DEFINE_CALL(NAME = ERASE, BLK_TYPE = FAB, ERRSTR = '?No FAB for $ERASE');
$RMS$DEFINE_CALL(NAME = FREE, BLK_TYPE = RAB, ERRSTR = '?No RAB for $FREE');
$RMS$DEFINE_CALL(NAME = UTLINT, BLK_TYPE = ARGUMENT_BLOCK);

! RMSVRB.REQ -- LAST LINE
! RMSERR.REQ -- definition of fullword RMS error codes

LITERAL
    RMSSTS$K_WARNING	= %O'300000',	! Warning
    RMSSTS$K_SUCCESS	= %O'1000',	! Successful Completion
    RMSSTS$K_ERROR		= %O'300000',	! Error
    RMSSTS$K_INFO		= %O'1000',	! Information
    RMSSTS$K_SEVERE	= %O'300000';	! Severe error

LITERAL
    RMS$K_SUC_MIN	= %O'1000',
    RMS$K_ERR_MIN	= %O'300000',
    RMS$K_SUC_MAX       = RMS$K_SUC_MIN+4,
    RMS$K_ERR_MAX       = RMS$K_ERR_MIN+332,

    RMSSTS$K_FAC_NUL = 0,
    RMSSTS$K_FAC_SYS = 1,
    RMSSTS$K_FAC_RMS = 2;

KEYWORDMACRO
    RMSSTS$VALUE (
	SEVERITY = SEVERE,		! Default to severe error
	CODE) =				! No default code
	    (CODE + %NAME(RMSSTS$K_, SEVERITY) AND %O'777777') %;

!+
!	RMS error code definitions
!-
LITERAL
    RMS$_NORMAL = RMSSTS$VALUE(SEVERITY = SUCCESS,
			CODE = 0),

    RMS$_SUC	= RMS$_NORMAL,

    RMS$_OK_IDX	= RMSSTS$VALUE(SEVERITY = INFO,
			CODE = 1),

    RMS$_OK_REO	= RMSSTS$VALUE(SEVERITY = INFO,
			CODE = 2),

    RMS$_OK_RRV	= RMSSTS$VALUE(SEVERITY = INFO,
			CODE = 3),

    RMS$_OK_DUP	= RMSSTS$VALUE(SEVERITY = INFO,
			CODE = 4),

    RMS$_AID	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 0),

    RMS$_BKZ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 4),

    RMS$_BLN	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 5),

    RMS$_BSZ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 6),

    RMS$_BUG	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 7),

    RMS$_CCF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 8),

    RMS$_CCR	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 9),

    RMS$_CEF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 11),

    RMS$_CGJ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 12),

    RMS$_CHG	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 13),

    RMS$_COD	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 14),

    RMS$_COF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 15),

    RMS$_CUR	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 16),

    RMS$_DAN	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 17),

    RMS$_DEL	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 18),

    RMS$_DEV	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 19),

    RMS$_DME	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 22),

    RMS$_DTP	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 23),

    RMS$_DUP	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 24),

    RMS$_EDQ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 25),

    RMS$_EOF	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 26),

    RMS$_FAB	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 27),

    RMS$_FAC	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 28),

    RMS$_FEX	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 29),

    RMS$_FLG	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 30),

    RMS$_FLK	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 31),

    RMS$_FNC	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 33),

    RMS$_FNF	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 34),

    RMS$_FSI	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 96),

    RMS$_FUL	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 37),

    RMS$_IAL	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 38),

    RMS$_IAN	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 39),

    RMS$_IFI	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 43),

    RMS$_IMX	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 45),

    RMS$_IOP	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 46),

    RMS$_ISI	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 48),

    RMS$_JFN	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 49),

    RMS$_KBF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 50),

    RMS$_KEY	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 51),

    RMS$_KRF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 52),

    RMS$_KSZ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 53),

    RMS$_LSN	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 54),

    RMS$_MRS	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 56),

    RMS$_NEF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 57),

    RMS$_NPK	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 59),

    RMS$_NXT	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 60),

    RMS$_ORD	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 61),

    RMS$_ORG	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 62),

    RMS$_PEF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 63),

    RMS$_PRV	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 66),

    RMS$_RAB	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 68),

    RMS$_RAC	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 69),

    RMS$_RAT	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 70),

    RMS$_RBF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 71),

    RMS$_REF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 72),

    RMS$_RER	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 73),

    RMS$_REX	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 74),

    RMS$_RFA	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 75),

    RMS$_RFM	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 76),

    RMS$_RLK	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 77),

    RMS$_RNF	= RMSSTS$VALUE(SEVERITY = ERROR,
			CODE = 78),

    RMS$_RSZ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 84),

    RMS$_RTB	= RMSSTS$VALUE(SEVERITY = WARNING,
			CODE = 85),

    RMS$_SEQ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 86),

    RMS$_SIZ	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 87),

    RMS$_UBF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 90),

    RMS$_UDF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 91),

    RMS$_WER	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 93),

    RMS$_XAB	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 94),

    RMS$_RRV	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 81),

    RMS$_BEM	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 320),

    RMS$_BFC	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 321),

    RMS$_BHE	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 322),

    RMS$_HNF	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 327),

    RMS$_NOA	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 328),

    RMS$_NOI	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 329),

    RMS$_NOU	= RMSSTS$VALUE(SEVERITY = SEVERE,
			CODE = 332),

    RMS$_NAM    = RMSSTS$VALUE(SEVERITY = SEVERE,
                        CODE = 101),            ! **FTS**

    RMS$_NMF    = RMSSTS$VALUE(SEVERITY = ERROR,
                        CODE = 102),            ! **FTS**

!** Special codes for remote files **FTS**

    RMS$_DPE    = RMSSTS$VALUE(SEVERITY = ERROR,
                        CODE = 97),

    RMS$_SUP    = RMSSTS$VALUE(SEVERITY = ERROR,
                        CODE = 98),

    RMS$_CON    = RMSSTS$VALUE(SEVERITY = ERROR,
                        CODE = 99),     ! Can't connect to FAL

    RMS$_NLB    = RMSSTS$VALUE(SEVERITY = ERROR,
                        CODE = 100),    ! Network link broken

    RMS$_RTD    = RMSSTS$VALUE(SEVERITY = ERROR,
                        CODE = 103),    ! Rename -- 2 different devices

    RMS$_RTN    = RMSSTS$VALUE(SEVERITY = ERROR,
                        CODE = 104);    ! Rename -- 2 different nodes

! RMSERR.REQ -- LAST LINE

MACRO FAB$V_REMOTE=FAB$V_DEV_REMOTE %;

!
! Directory listing level (/BRIEF, /FULL, /LIST):
!

LITERAL
    RMS$K_LIST_DEFAULT = 0,
    RMS$K_LIST_BRIEF = 1,
    RMS$K_LIST_NORMAL = 2,
    RMS$K_LIST_FULL=3,
    RMS$K_LIST_NAME_ONLY=5;

!
! Merge flags bits
!
LITERAL
    MERGE$V_CREATE   = 0,
    MERGE$V_EXPANDED = 1,
    MERGE$V_RLF      = 2,
    MERGE$V_CIF      = 3,
    MERGE$V_POINT    = 4,
    MERGE$V_DEFAULTS = 5;

LITERAL
    MERGE$M_CREATE   = 1^0,
    MERGE$M_EXPANDED = 1^1,
    MERGE$M_RLF      = 1^2,
    MERGE$M_CIF      = 1^3,
    MERGE$M_POINT    = 1^4,
    MERGE$M_DEFAULTS = 1^5;

!
! End of RMSUSR
!