Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist2-clock - language-sources/rmsusr.r36
There are 30 other files named rmsusr.r36 in the archive. Click here to see a list.
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!

!<BLF/MACRO>
!<BLF/LOWERCASE_USER>
!<BLF/UPPERCASE_KEY>
!<BLF/SYNONYM $LITERAL = LITERAL>
!<BLF/SYNONYM $DISTINCT = 1>
!<BLF/SYNONYM $FIELD = FIELD>
%TITLE 'R M S U S R  -- RMS user definitions'
!
! RMSUSR.R36 -- RMS user definitions
!

!
! Revision History
!

! Product Edit                            Description
!
! 664                                (GAS, 6-Mar-87) Add ostypes and filesys 
!                                    types from DAP 7.2 spec.
! 656                                (GAS, 13-Oct-86) Fix all protection XAB
!                                    macros and field definitions
! 626                                (GAS, 12-Jun-86) Add FAB picture; fix NAM
!                                    picture; NAM$M_PWD and NAM$M_SYNCHK were
!                                    defined wrong; XABPRO masks defined wrong.
! 613	                             Add DIL8 type class to support DIL format
!                                       8-bit records, generated only by DIU
! 403                                Add Write (Before|After) 
!					Advancing and ELS (AWN)
! 411                                Add Non-display keys (AWN)
! ???                                Fix $NOMESSAGE to not require a FAB (AWN)
! 452				     Add ELS argument to $RAB macros (RL)
! 462				     Fix reference to XABALL$K_BID in
!					$XABALL_INIT.  Should be
!					XAB$K_BID.
! 501                                Add feature test for RMSSYS version
!                                    Add FAB$A_NAM and FAB$A_TYP
! 504				     Add Typ$k_Byte
! 520                                Add NAM$V_SRCHFILL,
!                                        NAM$K_MAXRSS,
!                                        NAM$K_MAXESS,
! 521                                Fix $RENAME macro def
! 523                                Fix Fab$v_Ftn typo
! 551				     Remove skip value from PUSHJ call in
!				     RMS$CALL and complete LINKAGE 
!				     declaration to remove conflict with
!				     implicit register declaration.
!				     Also, put in code for $FFFINT calls.
! 563				     Add TYP block classes for FFF calls.
! 571                                dummy fab for $message & $nomessage
!                                    make $init do nothing if dynlib call
! 576                                (asp 29-Oct-85) Add rfa to RAB_STORE
!-
%IF NOT %DECLARED (%QUOTE $BIT)
%THEN LIBRARY 'BLI:XPORT';
%FI

%IF %SWITCHES (TOPS10) %THEN
LITERAL RMS$10=%O'600010';		! Referenced in verb calls on TOPS-10.
					! To load user prog with RMS.REL,
					! replace with external RMS$10;
%FI

!+
! Feature tests -- selected by /VARIANT:n (when compiling library) where n =
!
!    0 -- JSYS linkage for RMS verbs
!    1 -- Dynamic Library calls for RMS verbs
!         Must link with RMSJCK,RTLJCK,DYNBOO (if calling from nonzero sec)
!         Must link with RMSZER,RTLZER,ZERBOO,DYNBOO (if calling from sec 0)
!    8 -- For building RMS only. Verbs defined as $RMS_xxx instead of $xxx
!-

COMPILETIME rms$$sys=(%VARIANT AND 8) NEQ 0;
COMPILETIME rms$linkage=%VARIANT AND 7;
%IF rms$linkage EQL 2
%THEN %ERROR('Indirect linkage is not callable from BLISS')
%FI

%SBTTL 'Internal macro definitions'

!++
!
!	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 Protection fields
!  of form <RWED,RWED,RWED,RWED>
!-

    $rms_profld (args, whichone) =
        $$rms_profld (%REMOVE(args), whichone) %,

    $$rms_profld ( protsys, protown, protgrp, protwld, which ) =

                   %IF %IDENTICAL (which, sys)
                       %THEN $$rms_1profld (protsys)
                   %FI

                   %IF %IDENTICAL (which, own)
                       %THEN $$rms_1profld (protown)
                   %FI

                   %IF %IDENTICAL (which, grp)
                       %THEN $$rms_1profld (protgrp)
                   %FI

                   %IF %IDENTICAL (which, wld)
                       %THEN $$rms_1profld (protwld)
                   %FI
                   
                   %,

    $$rms_1profld (letters) =
        %IF %NULL (letters)
        %THEN %O'377'
        %ELSE %O'377' - ($$rms_2profld (%EXPLODE(letters)))
        %FI
        %,

    $$rms_2profld (letter) [] =
        $$rms_2profld (%REMAINING) + %NAME (xab$m_pro_, letter)
        %,


!+
!
!  $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 (xab$h_pos, %COUNT)] = position %,
    $rms_size [size] =
	[%NAME (xab$h_siz, %COUNT)] = size %;

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

MACRO
    $rms_position_ini (BLOCK) [position] =
	BLOCK [%NAME (xab$h_pos, %COUNT)] = position %,
    $rms_size_ini (BLOCK) [size] =
	BLOCK [%NAME (xab$h_siz, %COUNT)] = size %;
%SBTTL 'FAB definitions'
!+
!
!	FAB symbols and macros
!
!-


! Diagram of FAB block
!++
!
!              F A B    B l o c k
!
!    +------------------+------------------+ BID: standard RMS block ID
!  0 |    FAB$H_BID     |     FAB$H_BLN    | BLN: standard RMS block length
!    +------------------+------------------+ STS: primary status
!  1 |    FAB$H_STS     |     FAB$H_STV    | STV: secondary status
!    +------------------+------------------+ 
!  2 |              FAB$G_CTX              | CTX: user context word
!    +------------------+------------------+ JFN: user supplied JFN 
!  3 |    FAB$A_IFI     |     FAB$H_JFN    | IFI: (internal) address of FST
!    +------------------+------------------+ SHR: share access bits 
!  4 |    FAB$H_FAC     |     FAB$H_SHR    | FAC: file access bits
!    +------------------+------------------+ FOP: file options ORG(4): file org
!  5 |    FAB$H_FOP     | ORG| BSZ |  BLS  | BSZ(6): byte size
!    +------------------+------------------+ BLS(8): tape block size
!  6 |              FAB$A_FNA              | FNA: pointer to file name
!    +------------------+------------------+ RAT: record attribute bits
!  7 |    FAB$H_RAT     |     FAB$H_MRS    | MRS: max record size
!    +------------------+------------------+ 
! 10 |              FAB$G_MRN              | MRN: maximum record number 
!    +------------------+------------------+ FSZ(5): fixed header size
! 11 |    (reserved)    |FSZ|    BKS   |RFM| BKS(8): bucket siz RFM(5): rec fmt
!    +------------------+------------------+ JNL: address of log block 
! 12 |    FAB$A_JNL     |     FAB$A_XAB    | XAB: address of first XAB
!    +------------------+------------------+ DEV: device characteristics bits 
! 13 |    FAB$H_DEV     |     FAB$H_SDC    | SDC: spooling device char bits
!    +------------------+------------------+ TYP: address of TYP block 
! 14 |    FAB$A_TYP     |     FAB$A_NAM    | NAM: address of NAM block
!    +------------------+------------------+ 
! 15 |             FAB$G_ALQ               | ALQ: size of file
!    +------------------+------------------+ 
! 16 |             (reserved)              |
!    +------------------+------------------+ 
! 17 |             (reserved)              |
!    +------------------+------------------+ 
!--

LITERAL
    fab$k_bln = 16,
    fab$k_bid = 1;

! FAB structure

    $field
    fab$r_fields =
	SET
	fab$h_bln = [$bytes (2)],		! Block length field
	fab$h_bid = [$bytes (2)],		! Block type field
	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_shrget = [$bit],			! Allow read access
	fab$v_shrupd = [$bit],			! Allow update access
	fab$v_shrput = [$bit],			! Allow write access
	fab$v_shrdel = [$bit],			! Allow delete access
        fab$v_shrbio = [$bit],                  ! Block mode I/O        !a501
        fab$v_shrbro = [$bit],                  ! Block and Record I/O  !a501
        fab$v_shrapp = [$bit],                  ! Append Only           !a501
	$continue				! 
	fab$h_fac = [$bits (18)],		! User's desired access
	$overlay (fab$h_fac)			!
	fab$v_get = [$bit],			! Read access
	fab$v_upd = [$bit],			! Update access
	fab$v_put = [$bit],			! Write access
	fab$v_del = [$bit],			! Delete access
	fab$v_trn = [$bit],			! Truncate access
        fab$v_bio = [$bit],                     ! Block mode I/O        !a501
        fab$v_bro = [$bit],                     ! Block and Record I/O  !a501
        fab$v_app = [$bit],                     ! Append Only           !a501
	$continue				! 
	fab$v_bls = [$bits (8)],		! Block size for tape
	fab$v_bsz = [$bits (6)],		! File byte-size
	fab$v_org = [$bits (4)],		! File organization
	fab$h_fop = [$bits (18)],		! File options
 	$overlay(fab$h_fop)			! 
	fab$v_wat = [$bit],			! Wait if file is locked
	fab$v_cif = [$bit],			! Create file, open if existing
	fab$v_drj = [$bit],			! Do not release JFN
	fab$v_dfw = [$bit],			! Deferred Write
	fab$v_sup = [$bit],			! Supersede existing file
        fab$v_spl = [$bit],                     ! print on close	!a501
        fab$v_scf = [$bit],                     ! Submit on close       !a501
        fab$v_dlt = [$bit],                     ! Delete on close	!a501
        fab$v_nam = [$bit],                     ! open by NAM blk	!a501  
        fab$v_ctg = [$bit],             ! File is contiguous (reserved) !a501
        fab$v_lko = [$bit],             ! Override lock ** Reserved **  !a501
        fab$v_tmp = [$bit],             ! Temporary file ** Reserved ** !a501
        fab$v_mkd = [$bit],             ! Mark for delete ** Reserved * !a501
        fab$v_ofp = [$bit],             ! Output file parse		!a501
 	$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_blk =    [$bit],			! Do not span pages
        fab$v_macy11 = [$bit],                  ! MACY11 format		!a501
        fab$v_ftn    = [$bit],                  ! FORTRAN carr. ctl.	!m523
        fab$v_cr     = [$bit],                  ! Implied CRLF		!a501
        fab$v_prn    = [$bit],                  ! Print File 		!a501
        fab$v_emb    = [$bit],                  ! Embedded cc (reserved)!a501
        fab$v_cbl    = [$bit],                  ! COBOL (reserved)      !a501
 	$continue				! 
	fab$g_mrn = [$integer],			! Maximum record number
	fab$v_rfm = [$bits (5)],		! Record format
	fab$v_bks = [$bits (8)],		! Default bucket size
        fab$b_fsz = [$bits (5)],                ! Fixed Header Size       !a501
	fab$v_unused_0 = [$bits (18)],		! Unused area             !m501
	fab$a_xab = [$address],			! Address of XAB chain
	fab$a_jnl = [$address],			! Address of log block
	fab$h_sdc = [$bits (18)],		! Spooling dev. characteristics
 	$overlay(fab$h_sdc)			! 
	sdc$v_rec = [$bit],			! Record device
	sdc$v_ccl = [$bit],			! Carriage-control device
	sdc$v_trm = [$bit],			! Terminal
	sdc$v_mdi = [$bit],			! Multiple-directory device
	sdc$v_sqd = [$bit],			! Sequential device
	sdc$v_idv = [$bit],			! Device does input
	sdc$v_odv = [$bit],			! Device does output
	sdc$v_net = [$bit],			! Network device
	sdc$v_mnt = [$bit],			! Device is mounted
	sdc$v_avl = [$bit],			! Device is available for use
	sdc$v_spl = [$bit],			! Device is spooled
 	$continue				! 
	fab$h_dev = [$bits (18)],		! Device characteristics
 	$overlay(fab$h_dev)			! 
	dev$v_rec = [$bit],			! Record device
	dev$v_ccl = [$bit],			! Carriage-control device
	dev$v_trm = [$bit],			! Terminal
	dev$v_mdi = [$bit],			! Multiple-directory device
	dev$v_sqd = [$bit],			! Sequential device
	dev$v_idv = [$bit],			! Device does input
	dev$v_odv = [$bit],			! Device does output
	dev$v_net = [$bit],			! Network device
	dev$v_mnt = [$bit],			! Device is mounted
	dev$v_avl = [$bit],			! Device is available for use
	dev$v_spl = [$bit],			! Device is spooled
        dev$v_rmt = [$bit],                     ! Device is remote
        fab$v_remote = [%FIELDEXPAND(dev$v_rmt)], ! other name **TEMP??**
 	$continue				! 
        fab$a_nam = [$address],                 ! Address of NAM block ! A501
        fab$a_typ = [$address],                 ! Address of TYP block ! A501
	fab$g_alq = [$integer],                 ! Size of file          !a555
	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_nil = 0,				! Quick'n'dirty read
    fab$m_get = 1^0,				! Read access
    fab$m_upd = 1^1,				! Update access
    fab$m_put = 1^2,				! Write access
    fab$m_del = 1^3,				! Delete access
    fab$m_trn = 1^4,				! Truncate access
    fab$m_bio = 1^5,                            ! Block mode I/O        !a501
    fab$m_bro = 1^6,                            ! Block and Record I/O  !a501
    fab$m_app = 1^7,                            ! Append Only           !a501
    fab$m_shrnil = 0,				! Allow nothing
    fab$m_shrget = 1^0,				! Allow read access
    fab$m_shrupd = 1^1,				! Allow update access
    fab$m_shrput = 1^2,				! Allow write access
    fab$m_shrdel = 1^3,				! Allow delete access
    fab$m_shrbio = 1^5,                         ! Block mode I/O        !a501
    fab$m_shrbro = 1^6,                         ! Block and Record I/O  !a501
    fab$m_shrapp = 1^7;                         ! Append Only           !a501

LITERAL
    fab$m_wat = 1^0,				! Wait for file access
    fab$m_cif = 1^1,				! Create if non-existent
    fab$m_drj = 1^2,				! Do not release JFN
    fab$m_dfw = 1^3,				! Deferred write to file
    fab$m_sup = 1^4,				! Supersede existing file
    fab$m_spl = 1^5,                            ! print on close	!a501
    fab$m_scf = 1^6,                            ! Submit on close       !a501
    fab$m_dlt = 1^7,                            ! Delete on close	!a501
    fab$m_nam = 1^8,                            ! open by NAM blk	!a501  
    fab$m_ctg = 1^9,                    ! File is contiguous (reserved) !a501
    fab$m_lko = 1^10,                   ! Override lock ** Reserved **  !a501
    fab$m_tmp = 1^11,                   ! Temporary file ** Reserved ** !a501
    fab$m_mkd = 1^12,                   ! Mark for delete ** Reserved * !a501
    fab$m_ofp = 1^13;                   ! Output file parse		!a501

LITERAL
    fab$k_seq = 1,				! Sequential organization
    fab$k_rel = 2,				! Relative file organization
    fab$k_idx = 3;				! Indexed file organization

LITERAL
    fab$k_var = 0,				! Variable record format
    fab$k_stm = 1,				! Stream ASCII records
    fab$k_lsa = 2,				! Line sequenced ASCII
    fab$k_fix = 3,				! Fixed length records
    fab$k_vfc = 4,                              ! VFC format 		!a501
    fab$k_udf = 5,                              ! undefined/unknown	!a501
    fab$k_scr = 6,                              ! Stream_cr             !a570
    fab$k_stm_cr = 6,                           ! Stream_cr             !a570
    fab$k_slf = 7,                              ! Stream_lf             !a570
    fab$k_stm_lf = 7,                           ! Stream_lf             !a570
    fab$k_rfm_max = 7;                  ! maximum defined               !a504

LITERAL
    fab$m_blk    = 1^0,				! Blocked records
    fab$m_macy11 = 1^1,                         ! MACY11 format		!a501
    fab$m_ftn    = 1^2,                         ! FORTRAN carr. ctl.	!a501
    fab$m_cr     = 1^3,                         ! Implied CRLF		!a501
    fab$m_prn    = 1^4,                         ! Print File 		!a501
    fab$m_emb    = 1^5,                         ! Embedded cc (reserved)!a501
    fab$m_cbl    = 1^6;                         ! COBOL (reserved)      !a501

!++
!
!	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$r_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,
	    fnm =,
	    fop,
            fsz = 0,							!a501
	    jfn = 0,
	    jnl = 0,
	    mrn = 0,
	    mrs = 0,
            nam = 0,                            			!a501 
	    org = seq,
	    rat,
	    rfm = var,
	    shr = nil,
            typ = 0,                            			!a501 
	    xab = 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),
	    [fab$h_fac] = $rms_bitfld (fab$m_, fac),
	    [fab$v_bls] = bls,
	    [fab$v_bsz] = bsz,
	    [fab$v_org] = $rms_codfld (fab$k_, org),
	    [fab$h_fop] = $rms_bitfld (fab$m_, fop),
%IF %NULL(FNM)
%THEN
	    [fab$a_fna] = $rms_strfld (fna),
%ELSE
	    [fab$a_fna] = $rms_strfld (fnm),
%FI
	    [fab$h_mrs] = mrs,
	    [fab$h_rat] = $rms_bitfld (fab$m_, rat),
	    [fab$g_mrn] = mrn,
	    [fab$v_rfm] = $rms_codfld (fab$k_, rfm),
	    [fab$v_bks] = bks,
	    [fab$a_xab] = xab,
            [fab$a_nam] = nam,
            [fab$a_typ] = typ,                         			!a501
	    [fab$a_jnl] = jnl) %;

!+
!
!  $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,
	    fnm =,
	    fop,
            fsz = 0,							!a501
	    jfn = 0,
	    jnl = 0,
	    mrn = 0,
	    mrs = 0,
            nam = 0,							!a501
	    org = seq,
	    rat,
	    rfm = var,
	    shr = nil,
            typ = 0,							!a501
	    xab = 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);	! 
	$rms_ptr [fab$h_fac] = $rms_bitfld (fab$m_, fac);	! 
	$rms_ptr [fab$v_bls] = bls;		! 
	$rms_ptr [fab$v_bsz] = bsz;		! 
	$rms_ptr [fab$v_org] = $rms_codfld (fab$k_, org);	! 
	$rms_ptr [fab$h_fop] = $rms_bitfld (fab$m_, fop);	! 
%IF %NULL(fnm)
%THEN
	$rms_ptr [fab$a_fna] = $rms_strfld (fna);	! 
%ELSE
	$rms_ptr [fab$a_fna] = $rms_strfld (fnm);	! 
%FI
	$rms_ptr [fab$h_mrs] = mrs;		! 
	$rms_ptr [fab$h_rat] = $rms_bitfld (fab$m_, rat);	! 
	$rms_ptr [fab$g_mrn] = mrn;		! 
	$rms_ptr [fab$v_rfm] = $rms_codfld (fab$k_, rfm);	! 
	$rms_ptr [fab$v_bks] = bks;		! 
	$rms_ptr [fab$a_xab] = xab;		! 
	$rms_ptr [fab$a_jnl] = jnl;		! 
	$rms_ptr [fab$a_nam] = nam;		! 			!a501
	$rms_ptr [fab$a_typ] = typ;		!  			!a501
	$rms_ptr [fab$b_fsz] = fsz;		!  			!a501
	1) %;

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

KEYWORDMACRO
    $fab_store (				! Change a FAB
	    fab,
	    bks,
	    bls,
	    bsz,
	    ctx,
	    fac,
	    fna,
	    fnm,
	    fop,
            fsz,
	    jfn,
	    jnl,
	    mrn,
	    mrs,
            nam,
	    org,
	    rat,
	    rfm,
	    shr,
            typ,
	    xab) =
	(

	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);
	%FI

	%IF NOT %NULL (fac)
	%THEN
	    	    $rms_ptr [fab$h_fac] = $rms_bitfld (fab$m_, fac);
	%FI

	%IF NOT %NULL (bls)
	%THEN
	    	    $rms_ptr [fab$v_bls] = bls;
	%FI

	%IF NOT %NULL (bsz)
	%THEN
	    	    $rms_ptr [fab$v_bsz] = bsz;
	%FI

	%IF NOT %NULL (org)
	%THEN
	    	    $rms_ptr [fab$v_org] = $rms_codfld (fab$k_, org);
	%FI

	%IF NOT %NULL (fop)
	%THEN
	    	    $rms_ptr [fab$h_fop] = $rms_bitfld (fab$m_, fop);
	%FI

	%IF NOT %NULL (fna)
	%THEN
	    	    $rms_ptr [fab$a_fna] = $rms_strfld (fna);
	%FI

	%IF NOT %NULL (fnm)
	%THEN
	    	    $rms_ptr [fab$a_fna] = $rms_strfld (fnm);
	%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);
	%FI

	%IF NOT %NULL (mrn)
	%THEN
	    	    $rms_ptr [fab$g_mrn] = mrn;
	%FI

	%IF NOT %NULL (rfm)
	%THEN
	    	    $rms_ptr [fab$v_rfm] = $rms_codfld (fab$k_, rfm);
	%FI

	%IF NOT %NULL (bks)
	%THEN
	    	    $rms_ptr [fab$v_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; !	 	        !a501
        %FI

        %IF NOT %NULL (typ)
        %THEN
                    $rms_ptr [fab$a_typ] = typ;	!  			!a501
        %FI

        %IF NOT %NULL (fsz)
        %THEN                                   ! 
                    $rms_ptr [fab$b_fsz] = fsz;	!  			!a501
        %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
!
!--

! Diagram of RAB block
!++
!
!              R A B    B l o c k
!
!    +------------------+------------------+ BID: standard RMS block ID
!  0 |    RAB$H_BID     |     RAB$H_BLN    | BLN: standard RMS block length
!    +------------------+------------------+ STS: primary status
!  1 |    RAB$H_STS     |     RAB$H_STV    | STV: secondary status
!    +------------------+------------------+ 
!  2 |              RAB$G_CTX              | CTX: user context word
!    +------------------+------------------+ JFN: user supplied JFN 
!  3 |    RAB$A_ISI     |     RAB$A_FAB    | ISI: (internal) stream identifier
!    +--------+---------+------------------+ FAB: address of associated FAB
!  4 |  RAC   |  MBF    |     RAB$H_ROP    | RAC(9): rec access MBF(9): mul bfr
!    +--------+---------+------------------+ ROP: record operation bits
!  5 |              RAB$A_UBF              | UBF: user buffer
!    +------------------+------------------+ 
!  6 |              RAB$A_RBF              | RBF: record buffer        
!    +------------------+------------------+ USZ: user buffer size in words
!  7 |    RAB$H_USZ     |     RAB$H_RSZ    | RSZ: record size
!    +------------------+------------------+
! 10 |              RAB$G_RFA              | RFA: record file address
!    +--------+---------+------------------+ KRF(9): key of reference 
! 11 |  KRF   |  KSZ    |     FAB$H_LSN    | KSZ(9): key size LSN: line seq num
!    +--------+---------+------------------+ 
! 12 |             RAB$A_KBF               | KBF: key buffer
!    +------------------+------------------+ 
! 13 |             RAB$G_BKT               | BKT: bucket hash code
!    +--------+---------+------------------+
! 14 |  PAD   |       (reserved)           | PAD(9): padding character
!    +--------+---------+------------------+ 
! 15 |             (reserved)              | 
!    +------------------+------------------+ 
! 16 |             (reserved)              |
!    +------------------+------------------+ 
! 17 |             (reserved)              |
!    +------------------+------------------+ 
!--

! RAB structure

    $field
    rab$r_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_eof = [$bit],			! Set to EOF on $CONNECT
	rab$v_fdl = [$bit],			! Fast delete
	rab$v_loc = [$bit],			! Use locate mode on $GETs
	rab$v_rah = [$bit],			! Read ahead
	rab$v_loa = [$bit],			! Use load limits
	rab$v_wbh = [$bit],			! Write behind
	rab$v_kgt = [$bit],			! Search key >
	rab$v_kge = [$bit],			! Search key >=
	rab$v_pad = [$bit],			! Use PAD character as filler
	rab$v_nrp = [$bit],			! Set NRP on $FIND
        rab$v_waa = [$bit],                     ! Write after advancing	!A403
        rab$v_wba = [$bit],                     ! Write before advancing!A403
 	$continue				! 
	rab$b_mbf = [$byte],			! Multi-buffer count
	rab$b_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 = [$short_integer],		! Line sequence number
	rab$b_ksz = [$tiny_integer],		! Key size
	rab$b_krf = [$tiny_integer],		! Key of reference
	rab$a_kbf = [$pointer],			! Key buffer
	rab$g_bkt = [$bytes (4)],		! Bucket hash code
	$overlay(rab$g_bkt)			!			!A403
        rab$a_els = [$bytes (4)],		! End-of-line sequence	!A403
	$continue				!			!A403
	rab$v_unused_0 = [$bytes (3)],		! Unused area
	rab$b_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_seq = 0,				! Sequential access mode
    rab$k_key = 1,				! Key access mode
    rab$k_rfa = 2,				! RFA access mode
    rab$k_blk = 3,                              ! Block mode
    rab$k_tra = 4,                              ! File Transfer Mode
    rab$k_bft = 5,                              ! Block mode File xfer


!
!	ROP (record options) field
!
    rab$m_eof = 1^0,				! Position file to EOF
    rab$m_fdl = 1^1,				! Fast delete
    rab$m_loc = 1^2,				! Use locate mode on $GETs
    rab$m_rah = 1^3,				! Read ahead
    rab$m_loa = 1^4,				! Follow load percentages
    rab$m_wbh = 1^5,				! Write behind
    rab$m_kgt = 1^6,				! Key greater than
    rab$m_kge = 1^7,				! Key greater than or equal to
    rab$m_pad = 1^8,				! Fill buffer w/ PAD character
    rab$m_nrp = 1^9,				! Set Next Record Ptr on $FIND
    rab$m_waa = 1^10,				! Write ELS after advancing
    rab$m_wba = 1^11;				! Write ELS before advancing

!++
!
!	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$r_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,
	    els = 0,				! End-of-line sequence	!A452
	    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),	! 
	    [rab$b_mbf] = mbf,			! 
	    [rab$b_rac] = $rms_codfld (rab$k_, rac),	! 
	    [rab$a_ubf] = ubf,			! 
	    [rab$a_rbf] = rbf,			! 
	    [rab$h_usz] = usz,			! 
	    [rab$h_rsz] = rsz,			! 
	    [rab$b_ksz] = ksz,			! 
	    [rab$b_krf] = krf,			! 
	    [rab$a_kbf] = kbf,			! 
	    [rab$a_els] = $rms_strfld (els),	!			!A452
	    [rab$b_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,
	    els = 0,				! End-of-line sequence	!A452
	    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);	! 
	$rms_ptr [rab$b_mbf] = mbf;		! 
	$rms_ptr [rab$b_rac] = $rms_codfld (rab$k_, 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$b_ksz] = ksz;		! 
	$rms_ptr [rab$b_krf] = krf;		! 
	$rms_ptr [rab$a_kbf] = kbf;		! 
	$rms_ptr [rab$a_els] = $rms_strfld (els); !			!A452
	$rms_ptr [rab$b_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,
	    els,				!			!A452
            rfa,                                ! 
	    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);
	%FI

	%IF NOT %NULL (mbf)
	%THEN
	    	    $rms_ptr [rab$b_mbf] = mbf;
	%FI

	%IF NOT %NULL (rac)
	%THEN
	    	    $rms_ptr [rab$b_rac] = $rms_codfld (rab$k_, 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$b_ksz] = ksz;
	%FI

	%IF NOT %NULL (krf)
	%THEN
	    	    $rms_ptr [rab$b_krf] = krf;
	%FI

	%IF NOT %NULL (kbf)
	%THEN
	    	    $rms_ptr [rab$a_kbf] = kbf;
	%FI

        %IF NOT %NULL (rfa)
        %THEN
                    $rm_ptr [rab$g_rfa] = rfa;
        %FI

	%IF NOT %NULL (pad)
	%THEN
	    	    $rms_ptr [rab$a_els] = $rms_strfld (els); !		!A452
	%FI

	%IF NOT %NULL (pad)
	%THEN
	    	    $rms_ptr [rab$b_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'

!++
!
!	This section 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.
!
!--

! XABHDR

    $field
    xabhdr$r_fields =
	SET
	xab$h_bln = [$bytes (2)],		! Block length
	xab$h_bid = [$bytes (2)],		! Block type
	xab$a_nxt = [$address],			! Address of next XAB in chain
	xab$v_cod = [$bits (5)],		! XAB-type code
	xab$v_unused_0 = [$bits (13)]		! Unused area
	TES;

LITERAL
    xab$k_hdrlen = $field_set_size;

LITERAL
    xab$k_bid = 3;				! XAB block type

! XABALL block

    $field
    xaball$r_fields =
	SET
	xaball$v_hdr = [$sub_block (xab$k_hdrlen)],	!
	xab$b_bkz = [$byte],			! Bucket size
	xab$b_aid = [$byte],			! Area I.D.
	xaball$h_unused_1 = [$bytes (2)],	! Unused halfword
	xaball$v_unused_2 = [$sub_block (3)]	! 3 unused words
	TES;

LITERAL
    xab$k_alllen = $field_set_size;

LITERAL
    xab$k_all = 1;				! XABALL block code

!+
!
!   $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 [xab$k_alllen]

	FIELD
	(xabhdr$r_fields, xaball$r_fields) %;

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

KEYWORDMACRO
    $xaball (
	    nxt = 0,
	    aid,
	    bkz = 1 ) =
	$xaball_decl PRESET(			! 
	    [xab$h_bln] = xab$k_alllen,		! 
	    [xab$h_bid] = xab$k_bid,		! 
	    [xab$v_cod] = xab$k_all,		! 
	    [xab$a_nxt] = nxt,			! 
	    [xab$b_bkz] = bkz,			! 
	    [xab$b_aid] = aid) %;		! 

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

KEYWORDMACRO
    $xaball_init (
	    xab,
	    nxt = 0,
	    aid,
	    bkz = 1 ) =
	(

	BIND
	    $rms_ptr = xab : $xaball_decl;

	CH$FILL (0, xab$k_alllen, CH$PTR ($rms_ptr, 0, 36));	! 
	$rms_ptr [xab$h_bln] = xab$k_alllen;	! 
	$rms_ptr [xab$h_bid] = xab$k_bid;	! 			!m462
	$rms_ptr [xab$v_cod] = xab$k_all;	! 
	$rms_ptr [xab$a_nxt] = nxt;		! 
	$rms_ptr [xab$b_bkz] = bkz;		! 
	$rms_ptr [xab$b_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 [xab$a_nxt] = nxt;
	%FI

	%IF NOT %NULL (aid)
	%THEN
	    	    $rms_ptr [xab$b_aid] = aid;
	%FI

	%IF NOT %NULL (bkz)
	%THEN
	    	    $rms_ptr [xab$b_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, xab$k_alllen, CH$PTR ($rms_ptr, 0, 36))) %;

! XABDAT block

    $field
    xabdat$r_fields =
	SET
	xabdat$v_hdr = [$sub_block (xab$k_hdrlen)],	!
	xab$g_cdt = [$bytes (4)],		! Creation date
	xab$g_rdt = [$bytes (4)],		! Read date
	xab$g_edt = [$bytes (4)]		! Deletion date
	TES;

LITERAL
    xab$k_datlen = $field_set_size;

LITERAL
    xab$k_dat = 2;				! XABDAT block code

!+
!
!   $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 [xab$k_datlen]

	FIELD
	(xabhdr$r_fields, xabdat$r_fields) %;

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

KEYWORDMACRO
    $xabdat (
	    nxt = 0,
	    edt = 0 ) =
	$xabdat_decl PRESET(			! 
	    [xab$h_bln] = xab$k_datlen,		! 
	    [xab$h_bid] = xab$k_bid,		! 
	    [xab$v_cod] = xab$k_dat,		! 
	    [xab$a_nxt] = nxt,			! 
	    [xab$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, xab$k_datlen, CH$PTR ($rms_ptr, 0, 36));	! 
	$rms_ptr [xab$h_bln] = xab$k_datlen;	! 
	$rms_ptr [xab$h_bid] = xab$k_bid;	! 
	$rms_ptr [xab$v_cod] = xab$k_dat;	! 
	$rms_ptr [xab$a_nxt] = nxt;		! 
	$rms_ptr [xab$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 [xab$a_nxt] = nxt;
	%FI

	%IF NOT %NULL (edt)
	%THEN
	    	    $rms_ptr [xab$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, xab$k_datlen, CH$PTR ($rms_ptr, 0, 36))) %;

! XABKEY block

    $field
    xabkey$r_fields =
	SET
	xabkey$v_hdr = [$sub_block (xab$k_hdrlen)],	!
	xab$h_flg = [$bits (18)],		! Key flags
 	$overlay(xab$h_flg)
	xab$v_dup = [$bit],			! Duplicate keys allowed
	xab$v_chg = [$bit],			! Change of key allowed
	xab$v_hsh = [$bit],			! Hash method of index org.
 	$continue
	xab$v_dtp = [$bits (6)],		! Data type
	xabkey$v_unused_1 = [$bits (12)],	!
	xab$b_ref = [$byte],			! Key of reference
	xab$b_lan = [$byte],			! Lowest index area number
	xab$b_dan = [$byte],			! Data area number
	xab$b_ian = [$byte],			! Index area number
	xab$h_dfl = [$bytes (2)],		! Data fill limit
	xab$h_ifl = [$bytes (2)],		! Index fill limit
	xab$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
	xab$h_siz0 = [$bytes (2)],		! Size of segment 0
	xab$h_pos0 = [$bytes (2)],		! Position of segment 0
	xab$h_siz1 = [$bytes (2)],		! Size of segment 1
	xab$h_pos1 = [$bytes (2)],		! Position of segment 1
	xab$h_siz2 = [$bytes (2)],		! Size of segment 2
	xab$h_pos2 = [$bytes (2)],		! Position of segment 2
	xab$h_siz3 = [$bytes (2)],		! Size of segment 3
	xab$h_pos3 = [$bytes (2)],		! Position of segment 3
	xab$h_siz4 = [$bytes (2)],		! Size of segment 4
	xab$h_pos4 = [$bytes (2)],		! Position of segment 4
	xab$h_siz5 = [$bytes (2)],		! Size of segment 5
	xab$h_pos5 = [$bytes (2)],		! Position of segment 5
	xab$h_siz6 = [$bytes (2)],		! Size of segment 6
	xab$h_pos6 = [$bytes (2)],		! Position of segment 6
	xab$h_siz7 = [$bytes (2)],		! Size of segment 7
	xab$h_pos7 = [$bytes (2)]		! Position of segment 7
	TES;

! end of XABKEY
!+
!
!	XABKEY symbols
!
!-

LITERAL
    xab$k_keylen = $field_set_size;

LITERAL
    xab$k_stg = 0,				! String (ASCII) data
    xab$k_ebc = 1,				! EBCDIC data
    xab$k_six = 2,				! SIXBIT data
    xab$k_pac = 3,                              ! PACKED DECIMAL data  !A411
    xab$k_in4 = 4,                              ! 1 WORD INTEGER data  !A411
    xab$k_fl1 = 5,                              ! 1 WORD FLOATING data !A411
    xab$k_fl2 = 6,                              ! 2 WORD FLOATING data !A411
    xab$k_gfl = 7,                              ! GFLOATING data       !A411
    xab$k_in8 = 8,                              ! 2 WORD INTEGER data  !A411
    xab$k_as8 = 9,                              ! 8-bit ascii          !A411
    xab$k_bn4 = 10,                             ! Unsigned 1 word integer !a501
     xab$k_uin = 10;                            ! Unsigned Integer     !A411

LITERAL
    xab$m_dup = 1^0,				! Duplicate keys allowed
    xab$m_chg = 1^1,				! Key change on update allowed
    xab$m_hsh = 1^2;				! Hash indexing

LITERAL
    xab$k_key = 0;				! XABKEY block code

!+
!
!   $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 [xab$k_keylen]

	FIELD
	(xabhdr$r_fields, xabkey$r_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(
	    [xab$h_bln] = xab$k_keylen,		! 
	    [xab$h_bid] = xab$k_bid,		! 
	    [xab$v_cod] = xab$k_key,		! 
	    [xab$a_nxt] = nxt,			! 
	    [xab$h_flg] = $rms_bitfld (xab$m_, flg),	! 
	    [xab$v_dtp] = $rms_codfld (xab$k_, dtp),	! 
	    [xab$b_ref] = kref,			! 
	    [xab$b_lan] = lan,			! 
	    [xab$b_ian] = ian,			! 
	    [xab$b_dan] = dan,			! 
	    [xab$h_dfl] = dfl,			! 
	    [xab$h_ifl] = ifl,			! 
	    $rms_position (%REMOVE (pos)), $rms_size (%REMOVE (siz)),	! 
	    [xab$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, xab$k_keylen, CH$PTR ($rms_ptr, 0, 36));	! 
	$rms_ptr [xab$h_bln] = xab$k_keylen;	! 
	$rms_ptr [xab$h_bid] = xab$k_bid;	! 
	$rms_ptr [xab$v_cod] = xab$k_key;	! 
	$rms_ptr [xab$a_nxt] = nxt;		! 
	$rms_ptr [xab$h_flg] = $rms_bitfld (xab$m_, flg);	! 
	$rms_ptr [xab$v_dtp] = $rms_codfld (xab$k_, dtp);	! 
	$rms_ptr [xab$b_ref] = kref;		! 
	$rms_ptr [xab$b_lan] = lan;		! 
	$rms_ptr [xab$b_ian] = ian;		! 
	$rms_ptr [xab$b_dan] = dan;		! 
	$rms_ptr [xab$h_dfl] = dfl;		! 
	$rms_ptr [xab$h_ifl] = ifl;		! 
	$rms_position_ini ($rms_ptr, %REMOVE (pos));	! 
	$rms_size_ini ($rms_ptr, %REMOVE (siz));	! 
	$rms_ptr [xab$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 [xab$a_nxt] = nxt;
	%FI

	%IF NOT %NULL (flg)
	%THEN
	    	    $rms_ptr [xab$h_flg] = $rms_bitfld (xab$m_, flg);
	%FI

	%IF NOT %NULL (dtp)
	%THEN
	    	    $rms_ptr [xab$v_dtp] = $rms_codfld (xab$k_, dtp);
	%FI

	%IF NOT %NULL (kref)
	%THEN
	    	    $rms_ptr [xab$b_ref] = kref;
	%FI

	%IF NOT %NULL (lan)
	%THEN
	    	    $rms_ptr [xab$b_lan] = lan;
	%FI

	%IF NOT %NULL (ian)
	%THEN
	    	    $rms_ptr [xab$b_ian] = ian;
	%FI

	%IF NOT %NULL (dan)
	%THEN
	    	    $rms_ptr [xab$b_dan] = dan;
	%FI

	%IF NOT %NULL (dfl)
	%THEN
	    	    $rms_ptr [xab$h_dfl] = dfl;
	%FI

	%IF NOT %NULL (ifl)
	%THEN
	    	    $rms_ptr [xab$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 [xab$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, xab$k_keylen, CH$PTR ($rms_ptr, 0, 36))) %;

! XABSUM block

    $field
    xabsum$r_fields =
	SET
	xabsum$v_hdr = [$sub_block (xab$k_hdrlen)],	!
	xab$b_noa = [$byte],			! Number of areas
	xab$b_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
    xab$k_sumlen = $field_set_size;

LITERAL
    xab$k_sum = 3;				! XABSUM block code

!+
!
!   $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 [xab$k_sumlen]

	FIELD
	(xabhdr$r_fields, xabsum$r_fields) %;

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

KEYWORDMACRO
    $xabsum (
	    nxt = 0 ) =
	$xabsum_decl PRESET(			! 
	    [xab$h_bln] = xab$k_sumlen,		! 
	    [xab$h_bid] = xab$k_bid,		! 
	    [xab$v_cod] = xab$k_sum,		! 
	    [xab$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, xab$k_sumlen, CH$PTR ($rms_ptr, 0, 36));	! 
	$rms_ptr [xab$h_bln] = xab$k_sumlen;	! 
	$rms_ptr [xab$h_bid] = xab$k_bid;	! 
	$rms_ptr [xab$v_cod] = xab$k_sum;	! 
	$rms_ptr [xab$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 [xab$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, xab$k_sumlen, CH$PTR ($rms_ptr, 0, 36))) %;
%SBTTL 'NAM definitions'
!++
!
!       NAM definitions
!
!--

! Diagram of NAM block
!++
!
!              N A M    B l o c k
!
!    +------------------+------------------+
!  0 |    NAM$H_BID     |     NAM$H_BLN    | Standard RMS block ID & length
!    +------------------+------------------+ Expanded String: (as in RMS-32)
!  1 |               NAM$A_ESA             |  ESA: Byte pointer to buffer
!    +------------------+------------------+  ESL: Expanded string length
!  2 |    NAM$H_ESL     |     NAM$H_ESS    |  ESS: Size of buffer
!    +--------+---------+------------------+ NOP: NAM options
!  3 |        |NAM$V_NOP|     NAM$A_RLF    | RLF: Address of Related NAM block
!    +--------+---------+------------------+ Resultant String: (as in RMS-32)
!  4 |              NAM$A_RSA              |  RSA: Byte Pointer to buffer
!    +------------------+------------------+  RSL: Resultant string length
!  5 |    NAM$H_RSL     |     NAM$H_RSS    |  RSS: Size of buffer
!    +------------------+------------------+
!  6 |              NAM$G_FNB              | FNB: flags wild & default fields
!    +------------------+------------------+ WCC_COUNT: Number of $SEARCHes
!  7 | NAM$H_WCC_COUNT  |  NAM$H_WCC_NEXT  |            on this wildcard
!    +--------+---------+------------------+ WCC_NEXT: Character offset to
! 10 | B_DEV  | B_NODE  |    NAM$Z_CHA     |           next filespec in list
!    +--------+---------+---------+--------+ CHA: fields changed on $SEARCH
! 11 | B_VER  | B_TYPE  | B_NAME  | B_DIR  | NAM$B_(NODE,DEV,DIR,NAME,TYPE,VER)
!    +--------+---------+---------+--------+ length of each field of filespec
! 12 |             NAM$A_NODE              | Address of Nodeid
!    +-------------------------------------+
! 13 |             NAM$A_DEV               | Address of Device/Structure
!    +-------------------------------------+
! 14 |             NAM$A_DIR               | Address of Directory
!    +-------------------------------------+
! 15 |             NAM$A_NAME              | Address of Filename
!    +-------------------------------------+
! 16 |             NAM$A_TYPE              | Address of File type (Extension)
!    +-------------------------------------+
! 17 |             NAM$A_VER               | Address of Version/Generation no
!    +-------------------------------------+
!--

!+
! Length of filespec components
!-
! Include punctuation & terminating null character

LITERAL
    RMS$K_NODE_NAME_SIZE=9,             ! 6 Chars + ::
    RMS$K_USERID_SIZE=40,               ! Phase III allows 39 char user
    RMS$K_PASSWORD_SIZE=40,             ! Phase III allows 39 char password
    RMS$K_ACCOUNT_SIZE=40,              ! Phase III allows 39 char account
    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],     ! Expanded string area size
        NAM$A_RLF       = [$ADDRESS],           ! Related NAM block
        NAM$V_NOP       = [$BYTE],              ! Options
         $OVERLAY (NAM$V_NOP)
         NAM$V_PWD = [$BIT],      		! Really return the password
         NAM$V_SYNCHK = [$BIT],                 ! Parse-only
         NAM$V_SRCHFILL = [$BIT],               ! Reserved: $SEARCH Fills XABs
         $CONTINUE
        NAM$A_RSA       = [$POINTER],           ! Resultant string address
        NAM$H_RSS       = [$SHORT_INTEGER],     ! Resultant string area size
        NAM$H_RSL       = [$SHORT_INTEGER],     ! Resultant string length
        NAM$G_FNB       = [$BYTES(4)],          ! Status bits:
         $OVERLAY(NAM$G_FNB)
         NAM$V_INV  = [$BIT],                   ! Ignoring invisible files
          NAM$V_GIV  = [%FIELDEXPAND(NAM$V_INV)],                      !m575
         NAM$V_XXX  = [$BITS(3)],               ! Reserved
         NAM$V_NODE  = [$BIT],                  ! Node name given         !m575
          NAM$V_NOD  = [%FIELDEXPAND(NAM$V_NODE)],      ! Node name given
         NAM$V_GND  = [$BIT],                   ! Ignoring deleted files
         NAM$V_TFS  = [$BIT],                   ! Temporary file
         NAM$V_ACT  = [$BIT],                   ! Account given
         NAM$V_PRO  = [$BIT],                   ! Protection given
         NAM$V_ULV  = [$BIT],                   ! Lowest generation (-2)
          NAM$V_LOWVER = [%FIELDEXPAND(NAM$V_ULV)],	! Synonym
         NAM$V_NHV  = [$BIT],                   ! Next higher generation (0,-1)
         NAM$V_UHV  = [$BIT],                   ! Highest generation (0)
          NAM$V_HIGHVER = [%FIELDEXPAND(NAM$V_UHV)],	! Synonym
         NAM$V_VER  = [$BIT],                   ! Wildcard generation number
          NAM$V_WILD_VER = [%FIELDEXPAND(NAM$V_VER)],	! Synonym
         NAM$V_EXT  = [$BIT],                   ! Extension wildcarded
          NAM$V_WILD_TYPE = [%FIELDEXPAND(NAM$V_EXT)],	! Synonym
         NAM$V_NAM  = [$BIT],                   ! Name wildcarded
          NAM$V_WILD_NAME = [%FIELDEXPAND(NAM$V_NAM)],	! Synonym
         NAM$V_DIR  = [$BIT],                   ! Directory wildcarded
          NAM$V_WILD_DIR = [%FIELDEXPAND(NAM$V_DIR)],	! Synonym
         NAM$V_UNT  = [$BIT],                   ! Unit number wildcard (never)
         NAM$V_DEV  = [$BIT],                   ! Device wildcarded
          NAM$V_WILD_DEV = [%FIELDEXPAND(NAM$V_DEV)],	! Synonym
         NAM$V_res2 = [$BIT],                   ! reserved                !m575
         NAM$V_QUOTED = [$BIT],                 ! Filespec has quoted string
         NAM$V_EXP_DEV = [$BIT],                ! Explicit device
         NAM$V_EXP_DIR = [$BIT],                ! Explicit directory
         NAM$V_EXP_NAME = [$BIT],               ! Explicit name
         NAM$V_EXP_TYPE = [$BIT],               ! Explicit extension
         NAM$V_EXP_VER = [$BIT],                ! Explicit version
         NAM$V_UNUSED_2 = [$BITS(9)],           ! Reserved
         NAM$V_MULTIPLE = [$BIT],               ! Multiple filespecs seen
         NAM$V_WILDCARD = [$BIT],               ! Somewhere there is a wildcard
         $CONTINUE
        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
         $CONTINUE
        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)],	! Synonym
         $CONTINUE

        NAM$B_NODE    = [$BYTE],                ! Length of nodeid
        NAM$B_DEV     = [$BYTE],                !           device
        NAM$B_DIR     = [$BYTE],                !           directory
        NAM$B_NAME    = [$BYTE],                !           file name
        NAM$B_TYPE    = [$BYTE],                !           extension
        NAM$B_VER     = [$BYTE],                !           version/generation

        NAM$A_NODE    = [$POINTER],             ! Pointer to nodeid
        NAM$A_DEV     = [$POINTER],             !            device
        NAM$A_DIR     = [$POINTER],             !            directory
        NAM$A_NAME    = [$POINTER],             !            file name
        NAM$A_TYPE    = [$POINTER],             !            file type
        NAM$A_VER     = [$POINTER]              !            version/generation

        TES;

! End of NAM

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

LITERAL
    Nam$k_Size = $Field_Set_Size;

LITERAL

!
!       Fixed values
!
        Nam$k_Bln       = Nam$k_Size,           ! NAM length
        Nam$k_Bid       = 16;                   ! Block type

!
!       Masks
!

LITERAL Nam$m_Wildcard_Bits=%O'770000';         ! Mask for wildcard bits

LITERAL nam$m_pwd = 1^0,                ! Really return the password
        nam$m_synchk = 1^1,             ! Parse-only
        nam$m_srchfill = 1^2;           ! Reserved: $SEARCH Fills XABs
!+
!
!  $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,        Nop ) =

        $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$v_Nop]             = $Rms_Bitfld( Nam$m_, Nop)
               ) %;
!+
!
!  $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,        Nop) =

        (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;
                $Rms_Ptr [Nam$v_Nop]            = $Rms_Bitfld( Nam$m_, Nop);
                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

        %IF NOT %NULL(Nop)
        %THEN
                $Rms_Ptr [Nam$v_Nop]            = $Rms_Bitfld( Nam$m_, Nop);
        %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_Ascii = 1,          ! ASCII Data
        Typ$k_Image = 2,          ! IMAGE data
        Typ$k_Macy11 = 3,         ! MACY11 (binary) data
        Typ$k_Byte = 4,           ! Byte data
        Typ$k_DIL8 = 5;           ! DIL 8-bit data formatted for "8-bit image"

LITERAL Typ$k_Class_Max=5;

!+
! File class codes that call the foreign file facility
!-
LITERAL
       Typ$k_Sixbit         = -1,	! COBOL SIXBIT
       Typ$k_Ebcdic         = -2,	! COBOL EBCDIC
       Typ$k_Isam           = -3,	! LIBOL ISAM
       Typ$k_Fortran_Binary = -4,	! FORTRAN BINARY

       Typ$k_FFF_Class_Min = -4,
       Typ$k_FFF_Class_Max = -1;
!+
!
!  $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)))  %;
!++
! Configuration Block
!
!    +------------------+------------------+ BID: RMS block id
!  0 |     XAB$H_BID    |      XAB$H_BLN   | BLN: RMS block length
!    +------------------+------------------+ COD: XAB code (4 for config)
!  1 |     XAB$H_COD    |      XAB$A_NXT   | NXT: address of next XAB or 0
!    +------------------+------------------+ BUFSIZ: SYSCAP size
!  2 |FILESYS | OSTYPE  |     XAB$H_BUFSIZ | 
!    +------------------+------------------+ The other fields here are
!  3 | DECVER | USRNUM  | ECONUM  |VERSION | defined in the DAP version
!    +------------------+------------------+ 7.0 specification
!  4 |reserved|USRSOFT  | USRVER  |SOFTVER | 
!    +------------------+------------------+
!  5 |             XAB$Z_SYSCAP            | SYSCAP is a bitvector of DAP 
!    +                                     + capabilities.  The individual
!    |                                     | bits are defined in the
!    +------------------+------------------+ DAP specification and below
!--
! XABCFG block

    $field
    xabcfg$r_fields =
	SET
	xabcfg$v_hdr = [$sub_block (xab$k_hdrlen)],

	!BLISS Field Name			MACRO Field Name

	xab$h_bufsiz=[$short_integer],		! bfs
        xab$b_ostype=[$byte],                   ! ost
        xab$b_filesys=[$byte],                  ! fil

	xab$b_version=[$byte],			! ver
	xab$b_econum=[$byte],			! eco
	xab$b_usrnum=[$byte],                   ! usn
	xab$b_decver=[$byte],                   ! dsv
	xab$b_softver=[%FIELDEXPAND(xab$b_decver)],

	xab$b_usrver=[$byte],                  ! usv
	xab$b_usrsoft=[%FIELDEXPAND(xab$b_usrver)],

        $align(FullWord)
	xab$v_syscap=[$bits(84)],               ! cap

	!SYSCAP bits:
	!BLISS Field Name	       MACRO Bit Name	Comments
        !                                 xb$xxx
        $overlay(xab$v_syscap)
	xab$v_preallocation=[$bit],        ! pre ! Preallocation supported

                                           ! File Organizations Supported:
	xab$v_sequential_org=[$bit],       ! sqo !  Sequential 
	xab$v_relative_org=[$bit],         ! rlo !  Relative 
	xab$v_direct_org=[$bit],           ! dro !  DIRECT (reserved)

	xab$v_control_extend=[$bit],       ! ext ! Control message $EXTEND

                                           ! File Access Modes Supported:
	xab$v_sequential_transfer=[$bit],  ! sqt !   Sequential File Transfer
                                           !           Random access by
	xab$v_random_access_recnum=[$bit], ! rre !     Record Number
	xab$v_random_access_vbn=[$bit],    ! rvb !     Virtual Block number
	xab$v_random_access_key=[$bit],    ! rke !     Key
	xab$v_random_access_hash=[$bit],   ! rha !     hash code (reserved)
	xab$v_random_access_rfa=[$bit],    ! rrf !     RFA
	xab$v_indexed_multi_key=[$bit],    ! imk !     Multi-key ISAM

	xab$v_switch_access_mode=[$bit],   ! swa ! Switching access mode 
	xab$v_append_access=[$bit],        ! apa ! APPEND supported
	xab$v_submit_access=[$bit],        ! sba ! Control message $SUBMIT
	xab$v_data_compression=[$bit],     ! cmp ! Reserved
	xab$v_multi_data_streams=[$bit],   ! mds ! Multiple record streams
	xab$v_display=[$bit],              ! dis ! Control message $DISPLAY

                                           ! DAP Message blocking:
	xab$v_blocking=[$bit],             ! blr !   Until response needed
	xab$v_unrestricted_blocking=[$bit],! blu !   Unrestricted

	xab$v_len256=[$bit],               ! xln ! Extended length field
	xab$v_checksum=[$bit],             ! chk ! DAP checksumming

                                           ! XAB messages supported
	xab$v_key_definition=[$bit],       ! kem ! KEY DEFINITION message
	xab$v_allocation=[$bit],           ! alm ! ALLOCATION message
	xab$v_summary=[$bit],              ! smm ! SUMMARY message
	xab$v_directory=[$bit],            ! dir ! DIRECTORY access
	xab$v_date_time=[$bit],            ! dtm ! DATE/TIME message
	xab$v_protection=[$bit],           ! pro ! PROTECTION message
	xab$v_acl=[$bit],                  ! acl ! ACL message (reserved)

                                           ! FOP Close bits supported:
	xab$v_fop_print=[$bit],            ! fpr ! FOP SPL bit
	xab$v_fop_submit=[$bit],           ! fsb ! FOP SCF bit
	xab$v_fop_delete=[$bit],           ! fde ! FOP DLT bit

	xab$v_default_filespec=[$bit],     ! dfs ! Default Filespec (Reserved)
	xab$v_sequential_access=[$bit],    ! sqa ! Sequential RECORD access
	xab$v_recovery=[$bit],		   ! rec ! Reserved for Checkpointing
	xab$v_bitcnt=[$bit],		   ! bit ! BITCNT field
	xab$v_warning_status=[$bit],	   ! war ! WARNING STATUS message
	xab$v_rename_access=[$bit],	   ! ren ! $RENAME
	xab$v_wildcarding=[$bit],	   ! wld ! Wildcarding
	xab$v_go_no_go=[$bit],		   ! go  ! GO/NOGO option
	xab$v_name=[$bit],		   ! nam ! NAME message
	xab$v_segmenting=[$bit],	   ! seg ! DAP message segmentation 
	xab$v_change_attributes=[$bit],	   ! cat ! Change Attributes on CLOSE
	xab$v_change_dtm=[$bit],	   ! cdt ! Change Date/Time on CLOSE
	xab$v_change_protection=[$bit],	   ! cpr ! Change Protection on CLOSE
	xab$v_change_name=[$bit],	   ! cna ! Change Name on $CLOSE
	xab$v_modified_attributes=[$bit],  ! mat ! Changed Attributes on CREATE
        xab$v_display_3_part_name=[$bit],  ! d3n ! 3-part name in $DISPLAY
        xab$v_rename_change_attributes=[$bit],! rat ! Change Attributes
        xab$v_rename_change_dtm=[$bit],    ! rdt ! Change Date/Time
        xab$v_rename_change_protection=[$bit],! rpr ! Change Protection
        xab$v_blkcnt=[$bit],               ! bcs ! Block Count
        xab$v_Octal_Version_Numbers=[$bit] ! ovn ! Octal Version numbers
 	TES;

LITERAL
    xab$k_cfglen = 8;                   ! $field_set_size is wrong     !m572
                                        ! in some version of XPORT
LITERAL
    xab$k_cfg = 4;				! XABCFG block code

! Operating system type codes

LITERAL
        Xab$k_RT11        =  1,
        Xab$k_RSTS        =  2,
        Xab$k_RSX11S      =  3,
        Xab$k_RSX11M      =  4,
        Xab$k_RSX11D      =  5,
        Xab$k_IAS         =  6,
        Xab$k_VMS         =  7,
        Xab$k_TOPS20      =  8,
        Xab$k_TOPS10      =  9,
        Xab$k_RTS8        = 10,
        Xab$k_OS8         = 11,
        Xab$k_RSX11M_PLUS = 12,
        Xab$k_COPOS11     = 13,
        Xab$k_POS         = 14,
        Xab$k_Elan        = 15,
        Xab$k_Cpm         = 16,
        Xab$k_Msdos       = 17,
	Xab$k_Ultrix32    = 18,
	Xab$k_Ultrix11    = 19,
        Xab$K_DTF_MVS     = 20;

        !
        ! File System Types
        !

LITERAL
        Xab$k_Filesys_RMS11    = 1,
        Xab$k_Filesys_RMS20    = 2,
        Xab$k_Filesys_RMS32    = 3,
        Xab$k_Filesys_FCS11    = 4,
        Xab$k_Filesys_RT11     = 5,
        Xab$k_Filesys_none     = 6,
        Xab$k_Filesys_TOPS20   = 7,
        Xab$k_Filesys_TOPS10   = 8,
        Xab$k_Filesys_OS8      = 9,
        Xab$K_Filesys_RMS32S   = 10,
        Xab$K_Filesys_CPM      = 11,
        Xab$K_Filesys_MSDOS    = 12,
        Xab$K_Filesys_Ultrix32 = 13,
        Xab$K_Filesys_Ultrix11 = 14;

!+
! Environment-dependent constants
!-
LITERAL
       Nam$k_MaxRss = 255+6+1+39+1+39+1+39+2,
       Nam$k_MaxEss = 255+6+1+39+1+39+1+39+2,
       Rab$k_BufSiz = 2500;

!+
!
!   $XABCFG_DECL
!
!	$XABCFG_DECL allocates space for an configuration XAB
!	without initializing storage.  It is meant
!	to be used with the $XABCFG_INIT macro.
!
!-

MACRO
    $xabcfg_decl =
	BLOCK [xab$k_cfglen]

	FIELD
	(xabhdr$r_fields, xabcfg$r_fields) %;

!+
!
!   $XABCFG
!
!	$XABCFT allocates space and initializes
!	storage for a compile-time configuation XAB.
!
!-

KEYWORDMACRO
    $xabcfg (
	    nxt = 0 ) =
	$xabcfg_decl PRESET(
	    [xab$h_bln] = xab$k_cfglen,
	    [xab$h_bid] = xab$k_bid,
	    [xab$v_cod] = xab$k_cfg,
	    [xab$a_nxt] = nxt) %;

!+
!
!   $XABCFG_INIT
!
!	$XABCFG_INIT initializes storage
!	for an configuration XAB.
!
!-

KEYWORDMACRO
    $xabcfg_init (
	    xab,
	    nxt = 0 ) =
	(

	BIND
	    $rms_ptr = xab : $xabcfg_decl;

	CH$FILL (0, xab$k_cfglen, CH$PTR ($rms_ptr, 0, 36));
	$rms_ptr [xab$h_bln] = xab$k_cfglen;
	$rms_ptr [xab$h_bid] = xab$k_bid;
	$rms_ptr [xab$v_cod] = xab$k_cfg;
	$rms_ptr [xab$a_nxt] = nxt;
	1) %;

!+
! 
!   $XABCFG_STORE
!
!	$XABCFG_STORE changes storage
!	fields of an configuration XAB.
!
!-

KEYWORDMACRO
    $xabcfg_store (
	    xab,
	    nxt) =
	(

	BIND
	    $rms_ptr = xab : $xabcfg_decl;

	%IF NOT %NULL (nxt)
	%THEN
	    $rms_ptr [xab$a_nxt] = nxt;
	%FI

	1) %;

!+
!
!   $XABCFG_ZERO
!
!	$XABCFG_ZERO zeroes a configuration XAB
!
!-

KEYWORDMACRO
    $xabcfg_zero (
	    xab) =
	! Zero a Configuration XAB
	(

	BIND
	    $rms_ptr = xab : $xabcfg_decl;

	CH$FILL (0, xab$k_cfglen, CH$PTR ($rms_ptr, 0, 36))) %;
!++
! Protection XAB
!
!    +------------------+------------------+
!    |     XAB$H_BID    |      XAB$H_BLN   | Normal start of an XAB
!    +------------------+------------------+
!    |     XAB$H_COD    |      XAB$A_NXT   |   "      "   "   "  "
!    +------------------+------------------+
!    |   XAB$V_PROTSYS  |   XAB$V_PROTOWN  | \
!    +------------------+------------------+  \  Values for These fields
!    |   XAB$V_PROTGRP  |   XAB$V_PROTWLD  |  /  defined in the DAP spec.
!    +------------------+------------------+ /   
!--
! XABPRO block

    $field
    xabpro$r_fields =
	SET
	xabpro$v_hdr = [$sub_block (xab$k_hdrlen)],

	!BLISS Field Name			MACRO Field Name

	xab$v_protsys=[$bits(18)],		! sys
	xab$v_protown=[$bits(18)],		! own
	xab$v_protgrp=[$bits(18)],		! grp
	xab$v_protwld=[$bits(18)]		! wld
	TES;

LITERAL
    xab$k_prolen = $field_set_size;

LITERAL
    xab$k_pro = 5;				! XABPRO block code

LITERAL
    Xab$m_NoRead    = 1^0,    Xab$m_Pro_R = 1^0,
    Xab$m_NoWrite   = 1^1,    Xab$m_Pro_W = 1^1,
    Xab$m_NoExecute = 1^2,    Xab$m_Pro_E = 1^2,
    Xab$m_NoDelete  = 1^3,    Xab$m_Pro_D = 1^3,
    Xab$m_NoAppend  = 1^4,    Xab$m_Pro_A = 1^4,
    Xab$m_NoList    = 1^5,    Xab$m_Pro_L = 1^5,
    Xab$m_NoUpdate  = 1^6,    Xab$m_Pro_U = 1^6,
    Xab$m_NoChange  = 1^7,    Xab$m_Pro_C = 1^7,
    Xab$m_NoExtend  = 1^8,    Xab$m_Pro_X = 1^8;

!+
!
!   $XABPRO_DECL
!
!	$XABPRO_DECL allocates space for an configuration XAB
!	without initializing storage.  It is meant
!	to be used with the $XABPRO_INIT macro.
!
!-

MACRO
    $XabPro_decl =
	BLOCK [xab$k_Prolen]
	FIELD
	(xabhdr$r_fields, xabpro$r_fields) %;

!+
!
!   $XABPRO
!
!	$XABPRO allocates space and initializes storage for a compile-time
!       protection XAB.
! 
!-

KEYWORDMACRO
    $xabpro (
	    nxt = 0,
            pro = <RWEDALUCX,RWEDALUCX,RE,>
            ) =
	$xabpro_decl PRESET(
	    [xab$h_bln] = xab$k_prolen,
	    [xab$h_bid] = xab$k_bid,
	    [xab$v_cod] = xab$k_pro,
	    [xab$v_protsys] = $rms_profld (pro, sys),
	    [xab$v_protown] = $rms_profld (pro, own),
	    [xab$v_protgrp] = $rms_profld (pro, grp),
	    [xab$v_protwld] = $rms_profld (pro, wld),
	    [xab$a_nxt] = nxt) %;

!+
!
!   $XABPRO_INIT
!
!	$XABPRO_INIT initializes storage for a protection XAB.
!
!-

KEYWORDMACRO
    $xabpro_init (
	    xab,
            pro = <RWED,RWED,R,>,
	    nxt = 0 ) =
	(

	BIND
	    $rms_ptr = xab : $xabpro_decl;

	CH$FILL (0, xab$k_prolen, CH$PTR ($rms_ptr, 0, 36));
	$rms_ptr [xab$h_bln] = xab$k_prolen;
	$rms_ptr [xab$h_bid] = xab$k_bid;
	$rms_ptr [xab$v_cod] = xab$k_pro;
	$rms_ptr [xab$a_nxt] = nxt;
	$rms_ptr [xab$v_protsys] = $rms_profld (pro, sys);
	$rms_ptr [xab$v_protown] = $rms_profld (pro, own);
	$rms_ptr [xab$v_protgrp] = $rms_profld (pro, grp);
	$rms_ptr [xab$v_protwld] = $rms_profld (pro, wld);
	1) %;

!+
!
!   $XABPRO_STORE
!
!	$XABPRO_STORE changes storage fields of a protection XAB.
!
!-

KEYWORDMACRO
    $xabpro_store (
	    xab,
            pro,
	    nxt) =
	(

	BIND
	    $rms_ptr = xab : $xabpro_decl;

	%IF NOT %NULL (nxt)
	%THEN
	    $rms_ptr [xab$a_nxt] = nxt;
	%FI

	%IF NOT %NULL (pro)
	%THEN
	    	    $rms_ptr [xab$v_protsys] = $rms_profld (pro, sys);
	    	    $rms_ptr [xab$v_protown] = $rms_profld (pro, own);
	    	    $rms_ptr [xab$v_protgrp] = $rms_profld (pro, grp);
	    	    $rms_ptr [xab$v_protwld] = $rms_profld (pro, wld);
	%FI

	1) %;

!+
!
!   $XABPRO_ZERO
!
!	$XABPRO_ZERO zeroes a configuration XAB
!
!-

KEYWORDMACRO
    $xabpro_zero (
	    xab) =
	! Zero a Configuration XAB
	(

	BIND
	    $rms_ptr = xab : $xabpro_decl;

	CH$FILL (0, xab$k_prolen, CH$PTR ($rms_ptr, 0, 36))) %;


LITERAL xab$k_cod_max = xab$k_pro;      ! Highest legal COD value  !501

! **End of RMS block definitions
%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)	! Check value
	$rms_sts_or(%REMAINING)			! Optional "OR"
	$rms_sts_val_chk(%REMAINING)		! More checks if needed
    %;

KEYWORDMACRO
    $rms_status_check (
	    fab = , rab =,
	    status = ) =

	%IF %NULL (status)
	%THEN
	    0 %EXITMACRO
	%FI

	%IF %NULL (fab) AND %NULL (rab)
	%THEN
	    %ERRORMACRO ('No block specified for $RMS_STATUS_CHECK')
	%FI

	(

	%IF NOT %NULL (fab)
	%THEN

	    BIND
		$rms_ptr = (fab) : BLOCK [];

	%ELSE

	    BIND
		$rms_ptr = (rab) : BLOCK [];

	%FI

	IF $rms_sts_val_chk (%REMOVE (status)) THEN 1 ELSE 0) %;
%SBTTL 'RMS verb definitions'
!<BLF/NOERROR>

!++
!
!	RMS calls
!
!--

!+
!
!   RMS$CALL
!
!       There are now three different kinds of RMS calls.
!       
!       New programs should use the dynamic library call mechanisms
!       for lower overhead.
!       There are two different flavours of dynamic library call:
!
!       PUSHJ P,$OPEN    <- calls a jacket routine that calls RMS
!       PUSHJ P,@$$OPEN  <- indirects thru the transfer vector to RMS
!
!	The "traditional" RMS call linkage is a JSYS linkage
!       with the argblk address passed in Register 1.
!
!	On return, register 1 contains the address of the
!	argument block passed to RMS and register 2 contains
!	the return status code, which is also stored in
!	the argument block STS field.
!	Registers 3 and 4 are preserved.
!-

%IF %SWITCHES(TOPS20)
%THEN

    %IF rms$linkage EQL 0
    %THEN
    LINKAGE
        rms$call = JSYS (REGISTER = 1, REGISTER = 2;
                         REGISTER = 1, REGISTER = 2) : skip (-1);
    %ELSE
    LINKAGE
        rms$call = PUSHJ (REGISTER = 1, REGISTER = 2;
                          REGISTER = 1, REGISTER = 2) :	! 		!A551
                          LINKAGE_REGS (15,13,1)	!		!A551
                          NOPRESERVE (2)		!		!A551
                          PRESERVE (0,3,4,5,6,7,8,9,10,11,12,14);	!A551
   %FI

%ELSE           ! TOPS-10

LINKAGE
    rms$call = PUSHJ (REGISTER = 1, REGISTER = 2;
                      REGISTER = 1, REGISTER = 2) :	! 		!A551
		      LINKAGE_REGS (15,13,0)	!			!A551
		      NOPRESERVE (0,1,2)	!			!A551
		      PRESERVE (3,4,5,6,7,8,9,10,11,12,14);	! 	!A551
%FI

LITERAL
    rms$k_initial_jsys = %O'1000';

LITERAL
    rms$open_jsys = rms$k_initial_jsys + 0,
    rms$close_jsys = rms$k_initial_jsys + 1,
    rms$get_jsys = rms$k_initial_jsys + 2,
    rms$put_jsys = rms$k_initial_jsys + 3,
    rms$update_jsys = rms$k_initial_jsys + 4,
    rms$delete_jsys = rms$k_initial_jsys + 5,
    rms$find_jsys = rms$k_initial_jsys + 6,
    rms$truncate_jsys = rms$k_initial_jsys + 7,
    rms$connect_jsys = rms$k_initial_jsys + 8,
    rms$disconnect_jsys = rms$k_initial_jsys + 9,
    rms$create_jsys = rms$k_initial_jsys + 10,
    rms$debug_jsys = rms$k_initial_jsys + 11,
    rms$release_jsys = rms$k_initial_jsys + 12,
    rms$flush_jsys = rms$k_initial_jsys + 13,
    rms$message_jsys = rms$k_initial_jsys + 14,
    rms$nomessage_jsys = rms$k_initial_jsys + 15,
    rms$display_jsys = rms$k_initial_jsys + 16,
    rms$erase_jsys = rms$k_initial_jsys + 17,
    rms$free_jsys = rms$k_initial_jsys + 18,
    rms$utlint_jsys = rms$k_initial_jsys + 19,
    rms$nxtvol_jsys = rms$k_initial_jsys + 20,
    rms$rewind_jsys = rms$k_initial_jsys + 21,
    rms$wait_jsys = rms$k_initial_jsys + 22,
    rms$read_jsys = rms$k_initial_jsys + 23,
    rms$space_jsys = rms$k_initial_jsys + 24,
    rms$write_jsys = rms$k_initial_jsys + 25,
    rms$parse_jsys = rms$k_initial_jsys + 26,
    rms$search_jsys = rms$k_initial_jsys + 27,
    rms$enter_jsys = rms$k_initial_jsys + 28,
    rms$extend_jsys = rms$k_initial_jsys + 29,
    rms$remove_jsys = rms$k_initial_jsys + 30,
    rms$rename_jsys = rms$k_initial_jsys + 31,
    rms$fffint_jsys = rms$k_initial_jsys + 32;	! DYNLIB ONLY! NOT A JSYS !A551

%IF rms$$sys
%THEN MACRO $$rms_verb ( nm ) = %NAME ( $Rms_, nm ) %
%ELSE MACRO $$rms_verb ( nm ) = %NAME ( $, nm ) %
%FI;

%IF %SWITCHES(TOPS20)
%THEN

    %IF rms$linkage EQL 0                   ! Traditional linkage
    %THEN
        MACRO rms$action(vnam) = %NAME( rms$, vnam, _jsys ) %;
    %FI

    %IF rms$linkage EQL 1                   ! Direct linkage
    %THEN
        MACRO rms$action(vnam) =			! 			!M551
            (EXTERNAL ROUTINE %NAME('%$',vnam);	! 			!A551
             %NAME('%$',vnam)  ) %;			! 			!A551
    %FI

    %IF rms$linkage EQL 2                   ! Indirect linkage
    %THEN
        MACRO rms$action(vnam) = %NAME( $$, vnam ) %;
    %FI
%ELSE                ! TOPS-10
    %IF rms$linkage EQL 0                   ! Traditional linkage
    %THEN

    MACRO rms$action(vnam) =
	 %NAME( rms$, vnam, _jsys ) - rms$k_initial_jsys + RMS$10 %;
    %FI

    %IF rms$linkage EQL 1                   ! Direct linkage
    %THEN

    MACRO rms$action(vnam) =
    	(EXTERNAL ROUTINE %NAME('%$',vnam);
         %NAME('%$',vnam)  ) %;

    %FI

%FI

MACRO
    $$rms_verb(init) =                                                   !m571
    %IF rms$linkage EQL 0               ! Only need this for JSYS linkage
    %THEN
	BEGIN

	EXTERNAL ROUTINE
	    $$rms;

	$$rms ();
	END;
    %ELSE 1                             ! Return true   
    %FI
    %;

!+
!   Define the RMS verbs.
!-

KEYWORDMACRO
    $$rms_verb(open) (fab, err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $OPEN')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(open), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$open_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$open_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(close) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $CLOSE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(close), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$close_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$close_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(get) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $GET')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(get), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$get_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$get_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(put) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $PUT')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(put), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$put_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$put_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(update) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $UPDATE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(update), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$update_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$update_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(delete) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $DELETE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(delete), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$delete_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$delete_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(find) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $FIND')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(find), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$find_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$find_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(truncate) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $TRUNCATE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(truncate), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$truncate_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$truncate_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(connect) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $CONNECT')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(connect), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$connect_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$connect_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(disconnect) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $DISCONNECT')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(disconnect), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$disconnect_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$disconnect_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(create) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $CREATE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(create), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$create_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$create_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(debug) (
	    value) =
	rms$call ( rms$action(debug), value) %;

KEYWORDMACRO
    $$rms_verb(release) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $RELEASE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(release), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$release_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$release_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(flush) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $FLUSH')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(flush), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$flush_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$flush_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(message) =                                               !m571
        BEGIN
        LOCAL dumfab: $Fab_decl, retval;
	rms$call ( rms$action(message), dumfab; dumfab, retval);
        END %;

KEYWORDMACRO
    $$rms_verb(nomessage) =           					!M571
        BEGIN
        LOCAL dumfab: $Fab_decl, retval;
	rms$call ( rms$action(nomessage), dumfab; dumfab, retval);
        END %;

KEYWORDMACRO
    $$rms_verb(display) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $DISPLAY')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(display), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$display_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$display_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(erase) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $ERASE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(erase), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$erase_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$erase_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(free) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $FREE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(free), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$free_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$free_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(utlint) (
	    uab,
	    err = , suc = ) =

	%IF %NULL (uab)
	%THEN
	    %ERRORMACRO ('?No UAB for $UTLINT')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(utlint), uab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$utlint_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$utlint_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(nxtvol) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $NXTVOL')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(nxtvol), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$nxtvol_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$nxtvol_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(rewind) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $REWIND')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(rewind), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$rewind_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$rewind_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(wait) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $WAIT')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(wait), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$wait_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$wait_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(read) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $READ')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(read), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$read_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$read_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(space) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $SPACE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(space), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$space_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$space_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(write) (
	    rab,
	    err = , suc = ) =

	%IF %NULL (rab)
	%THEN
	    %ERRORMACRO ('?No RAB for $WRITE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(write), rab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$write_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$write_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(parse) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $PARSE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(parse), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$parse_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$parse_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(search) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $SEARCH')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(search), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$search_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$search_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(enter) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $ENTER')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(enter), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$enter_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$enter_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(extend) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $EXTEND')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(extend), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$extend_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$extend_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(remove) (
	    fab,
	    err = , suc = ) =

	%IF %NULL (fab)
	%THEN
	    %ERRORMACRO ('?No FAB for $REMOVE')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(remove), fab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$remove_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$remove_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

KEYWORDMACRO
    $$rms_verb(rename) (
	    oldfab, newfab,
	    err = , suc = ) =

	%IF %NULL (oldfab)
	%THEN
	    %ERRORMACRO ('?No OLDFAB for $RENAME')
	%FI

	%IF %NULL (newfab)
	%THEN
	    %ERRORMACRO ('?No NEWFAB for $RENAME')
	%FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(rename), oldfab, newfab;  ! Do the JSYS
		block_address, status_return)              ! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$rename_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$rename_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;


KEYWORDMACRO
    $$rms_verb(fffint) (			! New FFFINT macro	!A551
	    Uab,
	    err = , suc = ) =

	%IF %NULL ( Uab )
	%THEN
	    %ERRORMACRO ('?No UAB for $FFFINT')
	%FI

        %IF rms$linkage EQL 0
        %THEN
            %ERRORMACRO ('$FFFINT may not be called as a JSYS')
        %FI

	BEGIN

	LOCAL
	    block_address,
	    status_return;

	IF rms$call ( rms$action(FFFint), Uab; 	! Do the JSYS
		block_address, status_return)	! Return the values
	THEN

	%IF NOT %NULL (suc)
	%THEN
		suc (rms$FFFint_jsys, .block_address, .status_return)
	    %ELSE
	    1

	%FI

    ELSE

	%IF NOT %NULL (err)
	%THEN
	    err (rms$FFFint_jsys, .block_address, .status_return)
	%ELSE
	    0
	%FI

	END
    %;

!<BLF/ERROR>
%SBTTL 'RMS error code definitions'

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',                   ! Min success code allowed
    rms$k_suc_max = %O'1037',                   ! Max success code allowed!a501
    rms$k_err_min = %O'300000',                 ! Min error code allowed
    rms$k_err_max = %O'307777',                 ! Max error code allowed  !a501
    
    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
!
!   Success codes
!
    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),
!
!   Error codes
!
    rms$_aid = rmssts$value (severity = severe, CODE = 0),
    rms$_alq = rmssts$value (severity = severe, CODE = 1),
    rms$_ani = rmssts$value (severity = severe, CODE = 2),
    rms$_bks = rmssts$value (severity = severe, CODE = 3),
    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$_cdr = rmssts$value (severity = severe, CODE = 10),
    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$_dfl = rmssts$value (severity = severe, CODE = 20),
    rms$_dlk = rmssts$value (severity = severe, CODE = 21),
    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$_fna = rmssts$value (severity = severe, CODE = 32),
    rms$_fnc = rmssts$value (severity = error, CODE = 33),
    rms$_fnf = rmssts$value (severity = error, CODE = 34),
    rms$_fop = rmssts$value (severity = severe, CODE = 35),
    rms$_fsz = rmssts$value (severity = severe, CODE = 36),
    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$_ibc = rmssts$value (severity = severe, CODE = 40),
    rms$_ibo = rmssts$value (severity = severe, CODE = 41),
    rms$_ibs = rmssts$value (severity = severe, CODE = 42),
    rms$_ifi = rmssts$value (severity = severe, CODE = 43),
    rms$_ifl = rmssts$value (severity = severe, CODE = 44),
    rms$_imx = rmssts$value (severity = severe, CODE = 45),
    rms$_iop = rmssts$value (severity = severe, CODE = 46),
    rms$_irc = rmssts$value (severity = severe, CODE = 47),
    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$_mrn = rmssts$value (severity = severe, CODE = 55),
    rms$_mrs = rmssts$value (severity = severe, CODE = 56),
    rms$_nef = rmssts$value (severity = severe, CODE = 57),
    rms$_nlg = rmssts$value (severity = severe, CODE = 58),
    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$_plg = rmssts$value (severity = severe, CODE = 64),
    rms$_pos = rmssts$value (severity = severe, CODE = 65),
    rms$_prv = rmssts$value (severity = error, CODE = 66),
    rms$_qpe = rmssts$value (severity = severe, CODE = 67),
    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$_rnl = rmssts$value (severity = severe, CODE = 79),
    rms$_rop = rmssts$value (severity = severe, CODE = 80),
    rms$_rrv = rmssts$value (severity = severe, CODE = 81),
    rms$_rsa = rmssts$value (severity = severe, CODE = 82),
    rms$_rsd = rmssts$value (severity = severe, CODE = 83),
    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$_tre = rmssts$value (severity = severe, CODE = 88),
    rms$_tru = rmssts$value (severity = severe, CODE = 89),
    rms$_ubf = rmssts$value (severity = severe, CODE = 90),
    rms$_udf = rmssts$value (severity = severe, CODE = 91),
    rms$_ver = rmssts$value (severity = severe, CODE = 92),
    rms$_wer = rmssts$value (severity = severe, CODE = 93),
    rms$_xab = rmssts$value (severity = severe, CODE = 94),
    rms$_xcl = rmssts$value (severity = severe, CODE = 95),
    rms$_fsi = rmssts$value (severity = severe, CODE = 96),
    rms$_dpe = rmssts$value (severity = severe, CODE = 97),
    rms$_ons = rmssts$value (severity = severe, CODE = 98),
    rms$_dcf = rmssts$value (severity = severe, CODE = 99),
    rms$_ext = rmssts$value (severity = severe, CODE = 100),
    rms$_nam = rmssts$value (severity = severe, CODE = 101),    !a501
    rms$_nmf = rmssts$value (severity = error,  CODE = 102),    !a501
    rms$_rtd = rmssts$value (severity = severe, CODE = 103),    !a501
    rms$_rtn = rmssts$value (severity = severe, CODE = 104),    !A501
    rms$_dcb = rmssts$value (severity = error,  CODE = 105),    !a501
    rms$_iac = rmssts$value (severity = error,  CODE = 106),    !a501
    rms$_typ = rmssts$value (severity = error,  CODE = 107),    !A504
    rms$_cla = rmssts$value (severity = error,  CODE = 108),    !A504
!
!   File errors
!
    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$_bir = rmssts$value (severity = severe, CODE = 323),
    rms$_enf = rmssts$value (severity = severe, CODE = 324),
    rms$_eop = rmssts$value (severity = severe, CODE = 325),
    rms$_hdr = rmssts$value (severity = severe, CODE = 326),
    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$_nor = rmssts$value (severity = severe, CODE = 330),
    rms$_nos = rmssts$value (severity = severe, CODE = 331),
    rms$_nou = rmssts$value (severity = severe, CODE = 332),
    rms$_pgo = rmssts$value (severity = severe, CODE = 333),
    rms$_rsz2 = rmssts$value (severity = severe, CODE = 334),
    rms$_unl = rmssts$value (severity = severe, CODE = 335);

    !Synonyms - temporary

MACRO                                   !a501
    rms$_nlb = %INFORM ('Use rms$_dcb - code has changed') rms$_dcb %,
    rms$_con = %INFORM ('Use rms$_dcf') rms$_dcf %,
    rms$_sup = %INFORM ('Use rms$_ons') rms$_ons %;

! RMSINT.R36 -- Last line