Trailing-Edge
-
PDP-10 Archives
-
BB-LW55A-BM_1988
-
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