Google
 

Trailing-Edge - PDP-10 Archives - bb-h138e-bm_tops20_v6_1_distr - language-sources/rmsblk.r36
There are 21 other files named rmsblk.r36 in the archive. Click here to see a list.
%TITLE'R M S B L K   -- RMS internal block defintions only'
!
! RMSBLK.R36 -- RMS internal symbols and definitions
!
!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1985.
!  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.

%SBTTL'Module description'
!++
! FACILITY:	RMS
!
! ABSTRACT:
!
!	RMSSYB contains all symbols and definitions specific to
!	the internal structure definitions used   in   RMS   proper.
!       Definitions of structures which are available to the user
!       (FAB, RAB,  XAB) are found in RMSUSR.R36.
!
! ENVIRONMENT:	User mode, within extended RMS v1 environment (i.e FTS)
!
! AUTHOR: Ron Lusk , CREATION DATE:  9-Jul-82
!
! MODIFIED BY: Andrew Nourse -- Extract the internal block definitions
!
!	, : VERSION
! 01	-
!--

!
! TABLE OF CONTENTS
!
%TITLE'R M S B L K   -- RMS internal blocks'

%SBTTL'General Definitions'
!<BLF/PAGE>
!+
!	GENERAL DEFINITIONS
!-

LITERAL
!
!   Standard return values
!
    true = -1,					! Good return, etc.
    false = 0,					! Bad return, etc.
!
!   Limiting values for keys
!
    rms$k_max_keys = 255,			! Number of keys in file
    rms$k_max_key_segments = 8,			! Max number of segments/key
    rms$k_max_key_size = 255,			! Maximum key size in bytes
    rms$k_max_key_words = 64,			! Maximum key size in words
    						! Duplicate def'n in RMSGLB
!
!   Limiting values for areas
!
    rms$k_max_areas = 32,			! Number of areas in file
!
!   Limiting values for buckets
!
    rms$k_max_bucket_fill_percent = 50,		! Maximum fill percentage
    rms$k_maximum_bucketsize = 7,		! 3 bit field to hold it
    rms$k_maximum_levels = 15,			! Number of index levels:
    						! should be more than enough,
    						! for even  half-full buckets
    						! for even with half-full
    						! buckets and 10-word keys,
    						! this will hold
    						! more than 10**20 records.
    						! Duplicate def'n in RMSGLB
!
!   Other limits
!
    rms$k_minimum_user_buffer_addr = %O'20',	! Minimum buffer address
    rms$k_minimum_address = %O'20';		! Minimum address in general

%SBTTL'Index Bucket Header'
!<BLF/PAGE>
!+
!	INDEX BUCKET HEADER DEFINITION
!
!	BHD$... symbols define bucket headers for buckets in an
!	indexed file.
!-

FIELD
    bhd$r_fields =
	SET
	bhd$h_next_byte = [0, 0, 18, 0],	! Next available word
	bhd$v_type = [0, 18, 3, 0],		! Bucket type
	bhd$v_level = [0, 21, 6, 0],		! Level of this bucket
	bhd$b_flags = [0, 27, 9, 0],		! Bucket flags
	bhd$v_root = [0, 27, 1, 0],		! This is root bucket
	bhd$v_end = [0, 28, 1, 0],		! This is rightmost bucket
	bhd$h_next_bucket = [1, 0, 18, 0],	! Next bucket in chain
	bhd$v_this_area = [1, 18, 8, 0],	! Area for this bucket
	bhd$v_unused = [1, 26, 10, 0],		! Nothing
	bhd$h_next_id = [2, 0, 18, 0],		! Next record ID to use
	bhd$h_last_id = [2, 18, 18, 0]		! Last ID to use
	TES;

LITERAL
    bhd$k_bln = 3;				! Length of header

MACRO
    $rms_bucket_header =
			! Define header macro
BLOCK [bhd$k_bln] FIELD (bhd$r_fields) %;

LITERAL
!
!   Bucket header flags
!
    bhd$m_root = 1^0,				! Bucket is root
    bhd$m_end = 1^1,				! Bucket is rightmost in chain
!
!   Bucket types
!
    bhd$k_index = 0,				! Index bucket
    bhd$k_data = 1,				! Data bucket
!
!   Values for levels of the index  (Note from ancient source: "If
!   these change, we've got problems.")
!
    bhd$k_seq_set_level = 1,			! Level of sequence set
    bhd$k_data_level = 0;			! Level of data

%SBTTL'Indexed file RFA'
!<BLF/PAGE>
!+
!	INDEXED FILE RECORD FILE ADDRESS (RFA)
!
!	In the following RFA structure definitions, the record
!	ID is in the left half of the RFA word.  However, the
!	highest ID which is ever allocated is %O'377777'; thus
!	bit 35 (leftmost) is never used.  (It is reserved in
!	the SIDR definitions for future use.)  The ID field
!	could therefore be defined as 17 bits, but this would
!	slow access to RFA values throughout the system, thus
!	full 18-bit values are used instead.
!-

FIELD
    rfa$r_fields =
	SET
	rfa$h_bucket = [0, 0, 18, 0],		! Bucket number
	rfa$h_id = [0, 18, 18, 0]		! Record ID in bucket
	TES;

LITERAL
    rfa$k_bln = 1;				! Length of RFA

MACRO
    $rms_rfa =
					! Define an RFA
BLOCK [rfa$k_bln] FIELD (rfa$r_fields) %;

%SBTTL'Index Record'
!<BLF/PAGE>
!+
!	INDEX RECORD
!
!	IDX$... symbols refer to the index record.
!-

FIELD
    idx$r_fields =
	SET
	idx$h_bucket = [0, 0, 18, 0],		! Bucket pointer
	idx$h_flags = [0, 18, 18, 0],		! Flags
	idx$v_deleted = [0, 18, 1, 0],		! Record is deleted
	idx$v_rrv = [0, 19, 1, 0],		! Record is RRV
	idx$v_hikey = [0, 20, 1, 0],		! Highest key possible
	idx$v_rrvs_updated = [0, 21, 1, 0],	! In-core flag
	idx$v_no_compress = [0, 22, 1, 0]	! Don't compress this record
	TES;

LITERAL
    idx$k_bln = 1;				! Length of header

MACRO
    $rms_index_record =
			! Index record definition
BLOCK [idx$k_bln] FIELD (idx$r_fields) %;

LITERAL
!
!   Index record flag definitions (same as data record)
!
    idx$m_deleted = 1^0,			! Record is deleted
    idx$m_rrv = 1^1,				! Record is RRV
    idx$m_hikey = 1^2,				! This is highest key possible
    idx$m_rrvs_updated = 1^3,			! RRVs for this record have
    						! been updated (in-core only)
    idx$m_no_compress = 1^4;			! Do not compress this record

LITERAL
    idx$k_default_flags = 0;			! Default value for flags

%SBTTL'User Data Record (indexed file)'
!<BLF/PAGE>
!+
!	USER DATA RECORD (indexed file)
!
!	UDR$... symbols define user data records.  Note that
!	the record header may have different lengths depending on
!	whether it is a file of fixed or variable records.
!-

FIELD
    udr$r_fields =
	SET
	udr$h_id = [0, 0, 18, 0],		! ID of record
	udr$h_flags = [0, 18, 18, 0],		! Flags
	udr$v_deleted = [0, 18, 1, 0],		! Record is deleted
	udr$v_rrv = [0, 19, 1, 0],		! Record is RRV
	udr$v_hikey = [0, 20, 1, 0],		! Highest key possible
	udr$v_rrvs_updated = [0, 21, 1, 0],	! In-core flag
	udr$v_no_compress = [0, 22, 1, 0],	! Don't compress this record
	udr$g_rrv_address = [1, 0, 36, 0],	! Address of RRV
	udr$h_rrv_bucket = [1, 0, 18, 0],	! Bucket containing RRV
	udr$h_size = [2, 0, 18, 0]		! Record size
	TES;

LITERAL
!
!   Two different lengths for headers,
!   depending on record type.
!
    udr$k_fix_bln = 2,				! Length of fixed record header
    udr$k_var_bln = 3;				! Length of variable record header

MACRO
    $rms_user_data_record =
			! Define variable record
BLOCK [udr$k_var_bln] FIELD (udr$r_fields) %;

LITERAL
!
!   Flags for user data record
!
    udr$m_delete = 1^0,				! Record is deleted
    udr$m_rrv = 1^1,				! Record is RRV
    udr$m_rrvs_updated = 1^3,			! RRVs for this record have
    						! been updated (in-core only)
    udr$m_no_compress = 1^4;			! Do not compress this record

LITERAL
    udr$k_default_flags = 0;

%SBTTL'Secondary Index Data Record'
!<BLF/PAGE>
!+
!	SECONDARY INDEX DATA RECORD
!
!	Secondary index data record (SIDR) definitions have
!	the structure code SDR.
!-

FIELD
    sdr$r_fields =
	SET
	sdr$h_id = [0, 0, 18, 0],		! Record ID
	sdr$h_flags = [0, 18, 18, 0],		! Flags
	sdr$v_deleted = [0, 18, 1, 0],		! Record is deleted
	sdr$v_rrv = [0, 19, 1, 0],		! Record is RRV
	sdr$v_hikey = [0, 20, 1, 0],		! Highest key possible
	sdr$v_rrvs_updated = [0, 21, 1, 0],	! In-core flag
	sdr$v_no_compress = [0, 22, 1, 0],	! Don't compress this record
	sdr$h_size = [1, 0, 18, 0]		! Record size
	TES;

LITERAL
    sdr$k_bln = 2;				! Length of SIDR header

MACRO
    $rms_sidr =
	! Define SIDR
BLOCK [sdr$k_bln] FIELD (sdr$r_fields) %;

LITERAL
!
!   Flags for SIDR
!
    sdr$m_delete = 1^0,				! Record is deleted
    sdr$m_rrv = 1^1,				! Record is RRV
    sdr$m_rrvs_updated = 1^3,			! RRVs for this record have
    						! been updated (in-core only)
    sdr$m_no_compress = 1^4;			! Do not compress this record

LITERAL
    sdr$k_default_flags = 0;			! Default upon creation

%SBTTL'Record Reference Vector'
!<BLF/PAGE>
!+
!	RECORD REFERENCE VECTOR
!
!	RRV symbols are identified by RRV...
!-

FIELD
    rrv$r_fields =
	SET
	rrv$h_id = [0, 0, 18, 0],		! Record ID
	rrv$h_flags = [0, 18, 18, 0],		! Flags
	rrv$v_deleted = [0, 18, 1, 0],		! Record is deleted
	rrv$v_rrv = [0, 19, 1, 0],		! Record is RRV
	rrv$v_hikey = [0, 20, 1, 0],		! Highest key possible
	rrv$v_rrvs_updated = [0, 21, 1, 0],	! In-core flag
	rrv$v_no_compress = [0, 22, 1, 0],	! Don't compress this record
	rrv$g_rrv_address = [1, 0, 36, 0]	! Address of RRV
	TES;

LITERAL
    rrv$k_bln = 2;				! Length of RRV

MACRO
    $rms_rrv =
				! Define an RRV
BLOCK [rrv$k_bln] FIELD (rrv$r_fields) %;

LITERAL
!
!   RRV flag definitions
!
    rrv$m_delete = 1^0,				! Record is deleted
    rrv$m_rrv = 1^1,				! Record is RRV
    rrv$m_hikey = 1^2,				! This is highest key possible
    rrv$m_rrvs_updated = 1^3,			! RRVs for this record have
    						! been updated (in-core only)
    rrv$m_no_compress = 1^4;			! Do not compress this record

LITERAL
    rrv$k_default_flags = 0;			! Default value for flags

%SBTTL'Record Header'
!<BLF/PAGE>
!+
!	SEQUENTIAL/RELATIVE FILE RECORD HEADER
!
!	RHD... symbols refer to the header of a record in a
!	relative or sequential file.
!	Note that the flags are tested against the whole
!	header (for now).
!-

FIELD
    rhd$r_fields =
	SET
	rhd$h_size = [0, 0, 18, 0],		! Record size
	rhd$v_deleted = [0, 34, 1, 0],		! Record is deleted
	rhd$v_valid = [0, 35, 1, 0]		! Valid bit
	TES;

LITERAL
    rhd$k_bln = 1;				! Length of header

MACRO
    $rms_record_header =
			! Define REL or SEQ record header
BLOCK [rhd$k_bln] FIELD (rhd$r_fields) %;

%SBTTL'Standard Block Header'
!<BLF/PAGE>
!+
!	BLOCK HEADER
!
!	All internal data structures within RMS-36 have
!	basically the same format:  A fixed-length block
!	header followed by a variable-length area which
!	is unique to each block.  The fields within the
!	block header are named identically for all blocks,
!	using BLK$.... symbols.  The fields within the
!	blocks are also named according to the normal
!	conventions (FST$..., etc.) for consistency and
!	clarity.
!-

FIELD
    blk$r_fields =
	SET
	blk$h_bln = [0, 0, 18, 0],		! Blocklength
	blk$h_bid = [0, 18, 18, 0],		! Block ID
	blk$h_stv = [1, 0, 18, 0],		! User status-value
	blk$h_sts = [1, 18, 18, 0],		! User status
	blk$a_flink = [1, 0, 18, 0],		! Forward link
	blk$a_blink = [1, 18, 18, 0]		! Backward_link
	TES;

LITERAL
    blk$k_bln = 2;				! Length of header

MACRO
    $rms_block_header =
			! Define block header
BLOCK [blk$k_bln] FIELD (blk$r_fields) %;

!<BLF/MACRO>

MACRO
    !
    !   Macro to link NEW_BLOCK behind OLD_BLOCK
    !
    $rms$link (new_block, old_block) =
	BEGIN

	REGISTER
	    temp_blk : REF $block_header;	! We need temporary

	temp_blk = .old_block [blk$a_blink];	! Set up for last block
	!
	!   Set up forward links
	!
	temp_blk [blk$a_flink] = .new_block;	! Last block ==> new block
	new_block [blk$a_flink] = .old_block;	! New block ==> old block
	!
	!   Set up backward links
	!
	old_block [blk$a_blink] = .new_block;	! Old block <== new block
	new_block [blk$a_blink] = .temp_blk;	! New block <== last block
	END
    %,
    !
    !   Macro to free a block from chain
    !
    $rms$delink (this_block) =
	BEGIN

	REGISTER
	    forward_block : REF $block_header,
	    backward_block : REF $block_header;

	!
	!   Set up surrounding-block pointers
	!
	forward_block = .this_block [blk$a_flink];
	backward_block = .this_block [blk$a_blink];
	!
	!   Unlink middle block
	!
	forward_block [blk$a_blink] = .backward_block;
	backward_block [blk$a_flink] = .forward_block;
	END
    %;

!<BLF/NOMACRO>
%SBTTL'File Status Table'
!<BLF/PAGE>
!+
!	FILE STATUS TABLE
!
!	The File Status Table (FST) is the primary internal
!	RMS-36 data structure which represents all information
!	of importance to the correct processing of the file.
!	The FST can be thought of as being the "internal FAB."
!	An FST is allocated when the file is opened and
!	is de-allocated only when the file is closed.  There
!	is only one FST per file, per process, regardless of how
!	many record streams may become active on the file.
!-

FIELD
    fst$r_fields =
	SET
	fst$h_bln = [0, 0, 18, 0],		! Block length
	fst$h_bid = [0, 18, 18, 0],		! Block ID
	fst$a_flink = [1, 0, 18, 0],		! Forward link address
	fst$a_blink = [1, 18, 18, 0],		! Backward link address
	fst$a_adb = [2, 0, 18, 0],		! Address of file's ADB
	fst$h_jfn = [2, 18, 18, 0],		! JFN
	fst$h_seq_bkt = [3, 0, 18, 0],		! Bucket file is positioned at
	fst$h_org = [3, 18, 18, 0],		! File organization
	fst$h_flags = [4, 0, 18, 0],		! Processing flags
	fst$v_locking = [4, 1, 1, 0],		! We should lock file
	fst$v_locked = [4, 2, 1, 0],		! File is locked
	fst$v_undefined = [4, 3, 1, 0],		! File in undefined state
	fst$v_new_file = [4, 4, 1, 0],		! This is new file
	fst$v_index_locked = [4, 5, 1, 0],	! Index structure locked
	fst$v_reorganize = [4, 6, 1, 0],	! File needs reorg'n
	fst$h_device_type = [4, 18, 18, 0],	! Device type flags
						! (from DVCHR)
	fst$h_rfm = [5, 0, 18, 0],		! Record format
	fst$b_shr = [5, 18, 9, 0],		! Share access
	fst$b_fac = [5, 27, 9, 0],		! User's access
	fst$h_mrs = [6, 0, 18, 0],		! Max record size
	fst$v_buffer_size = [6, 18, 6, 0],	! Max buffer size
	fst$v_number_buffers = [6, 24, 9, 0],	! Current number of buffers
	fst$v_minimum_buffers = [6, 33, 3, 0],	! Minimum number of buffers
	fst$b_low_byte = [7, 27, 9, 0],		! First byte of record data
	fst$g_mrn = [8, 0, 36, 0],		! Max record number
	fst$v_fop = [9, 0, 10, 0],		! Options on opening file
	fst$v_kbf_size = [9, 10, 8, 0],		! Size of key buffer
	fst$a_kdb = [9, 18, 18, 0],		! First KDB in chain
	fst$h_rat = [10, 0, 18, 0],		! Record attributes
	fst$v_blk = [2, 18, 1, 0],		! Blocked records
	fst$h_bsz = [10, 18, 18, 0],		! File byte size
						! Nonzero on DEC-10 only
	fst$g_dla = [11, 0, 36, 0],		! Date last accessed
	fst$g_ct = [12, 0, 36, 0],		! Creation time of file
	fst$g_sof = [13, 0, 36, 0]		! Size of file in words
	TES;

LITERAL
    fst$k_bln = 14;

MACRO
    $rms_fst =
				! Define FST with own and common fields
BLOCK [fst$k_bln] FIELD (fst$r_fields, blk$r_fields) %;

LITERAL
    !
    !	Block ID
    !
    fst$k_bid = 3,				! Block ID for FST
    !
    !	Minimum buffer counts for various organizations
    !
    fst$k_min_buf_asc = 1,			! Minimum bufs for stream/LSA
    fst$k_min_buf_seq = 1,			! Minimum bufs for sequential
    fst$k_min_buf_rel = 1,			! Minimum bufs for relative
    fst$k_min_buf_idx = 3,			! Minimum bufs for indexed
    !
    !	Access bits
    !
    fst$m_get = 1^0,				! Get access
    fst$m_upd = 1^1,				! Update access
    fst$m_put = 1^2,				! Put access
    fst$m_del = 1^3,				! Delete access
    fst$m_trn = 1^4,				! Truncate access
    !
    !	File option bits
    !
    fst$m_wat = 1^0,				! Wait for file if locked
    fst$m_cif = 1^1,				! Create file if non-existent
    fst$m_drj = 1^2,				! Do not release JFN
    fst$m_dfw = 1^3,				! Deferred write to file
    fst$m_sup = 1^4,				! Supersede file if it exists
    !
    !	Record attribute bits
    !
    fst$m_blk = 1^0,				! Records are blocked
    !
    !	File organizations
    !
    fst$k_seq = 1,				! Sequential organization
    fst$k_rel = 2,				! Relative organization
    fst$k_idx = 3,				! Indexed organization
    !
    !	Record formats
    !
    fst$k_var = 0,				! Variable record format
    fst$k_stm = 1,				! Stream ASCII records
    fst$k_lsa = 2,				! Line-sequenced ASCII
    fst$k_fix = 3,				! Fixed-length records
    !
    !	Device types
    !
    fst$k_dsk = %O'0',				! Disk
    fst$k_mta = %O'2',				! Magtape
    fst$k_lpt = %O'7',				! Line printer
    fst$k_cdr = %O'10',				! Card reader
    fst$k_tty = %O'12',				! Terminal
    !
    !	Bit masks for flag word (bit 0 is unused)
    !
    fst$m_locking = 1^1,			! Records are being locked
    fst$m_locked = 1^2,				! File is locked
    fst$m_undefined = 1^3,			! File is in undefined state
    fst$m_new_file = 1^4,			! This is a new file
    fst$m_index_locked = 1^5,			! Index structure is locked
    fst$m_reorganize = 1^6;			! File should be reorganized

%SBTTL'Record Status Table'
!<BLF/PAGE>
!+
!	RECORD STATUS TABLE (RST)
!
!	The Record Status Table (RST) is the internal data
!	structure which represents all current information,
!	both static and dynamic, concerning the state of
!	the corresponding record stream.  There is exactly one
!	RST for each record stream which is connected to a
!	particular file.  An RST is allocated when a $CONNECT
!	is issued and de-allocated when a $DISCONNECT (or $CLOSE)
!	is issued.
!
!	In the design of the structure of the RST, the issue of
!	access performance was afforded a higher priority than
!	that of internal block size.  Therefore, there are several
!	fields (explained below) which are not absolutely necessary
!	for the correct processing of the file, but which are
!	maintained in the RST because they serve to speed up
!	certain operations on the file.
!
!-

LITERAL
    rst$k_cbd_offset = 8;			! Define offset in structure

FIELD
    rst$r_fields =
	SET
	rst$h_bln = [0, 0, 18, 0],		! Block length
	rst$h_bid = [0, 18, 18, 0],		! Block ID
	rst$a_flink = [1, 0, 18, 0],		! Forward link
	rst$a_blink = [1, 18, 18, 0],		! Backward link
	rst$h_flags = [2, 0, 18, 0],		! Flags
	rst$v_partial = [2, 0, 1, 0],		! Partial record returned
	rst$v_eof = [2, 1, 1, 0],		! EOF on  buffer
	rst$v_data_locked = [2, 2, 1, 0],	! Current record locked
	rst$v_success = [2, 3, 1, 0],		! Last operation successful
	rst$v_update_pointer = [2, 5, 1, 0],	! Update page pointer
	rst$v_last_sequential = [2, 6, 1, 0],	! Last operation sequential
	rst$v_truncate = [2, 7, 1, 0],		! A $TRUNCATE was done
	rst$a_fst = [2, 18, 18, 0],		! Address of FST for RST
	rst$h_record_size_words = [3, 0, 18, 0],	! Words in record
	rst$h_record_size = [3, 18, 18, 0],	! Bytes in record
	rst$g_page_pointer = [4, 0, 36, 0],	! Pointer to current record
	rst$g_data_rfa = [5, 0, 36, 0],		! RFA of last record accessed
	rst$g_next_record_pointer = [6, 0, 36, 0],	! Next record pointer
	rst$v_last_operation = [7, 0, 6, 0],	! Last operation on this RST
	rst$v_rec_header_size = [7, 6, 4, 0],	! Size rec header, stream file
	rst$v_bfd_count = [7, 10, 8, 0],	! Buffer descriptor count
	rst$a_key_buffer = [7, 18, 18, 0],	! Address of key buffer
	rst$z_current_bucket = [rst$k_cbd_offset, 0, 0, 0],	!
						! Current bucket descriptor
						! is two words long.
	rst$g_highest_byte = [10, 0, 36, 0],	! Highest byte written
	rst$h_byte_count = [11, 0, 18, 0],	! STM/LSA: bytes left on page
	rst$b_nrp_ref = [11, 18, 9, 0],		! Key of reference for NRP
	rst$b_pr_ref = [11, 27, 9, 0],		! Current record key of ref
	rst$g_nrp_rrv = [12, 0, 36, 0],		! RRV of next record
	rst$h_sidr_element = [13, 0, 18, 0],	! Offset of current record ptr
	rst$h_rp_sidr = [13, 18, 18, 0],	! Tentative SIDR after $FIND
	rst$g_buffer_desc = [14, 0, 0, 0]	! First buffer descriptor
	TES;

LITERAL
    !
    !	Block identification constants
    !
    rst$k_bid = 4,				! Block ID for RST
    rst$k_bln = 14;				! Length of fixed portion

MACRO
    $rms_rst =
						! Define an RST
BLOCK [rst$k_bln + 18]				! Allow some buffer descriptors
						! (15 levels + 3 for indexed)
FIELD (rst$r_fields) %;				! Define the fields

LITERAL
    !
    !	Record header sizes for stream/LSN ASCII files
    !
    rst$k_ascii_hdr_len = 0,			! No header on ASCII
    rst$k_lsn_hdr_len = 5 + 1,			! LSN + <TAB>
    rst$k_pagemark_hdr_len = 5,			! No <TAB>
    !
    !	RST flags
    !
    rst$m_partial = 1^0,			! Partial record returned
    rst$m_eof = 1^1,				! EOF on this buffer
    rst$m_data_locked = 1^2,			! Current record is locked
    						! (pointed to by data_rfa)
    rst$m_success = 1^3,			! Last operation was success
    						! Bit 31 is free for future use
    rst$m_update_pointer = 1^5,			! Update page_pointer on next
    						! operation (ASCII only)
    rst$m_last_sequential = 1^6,		! Last operation was sequential
    rst$m_truncate = 1^7;			! A $TRUNCATE was done

%SBTTL'Key Descriptor Block'
!<BLF/PAGE>
!+
!	KEY DESCRIPTOR BLOCK (KDB)
!
!	Key Descriptor Blocks are created in free core when
!	an indexed file is initially opened or created.  Each KDB
!	contains a summary of the information about the index
!	characteristics kept in the file prologue.  Such
!	characteristics as the Key-Name and the first data bucket
!	number are not maintained in core because they are so
!	seldom needed.  There are also some fields in the KDB
!	(e.g., data record header size) which are computed dynamically
!	when the KDB is initially created.
!
!	The KDBs are linked together and the first one (i.e., the
!	KDB for the primary key) is pointed to by a field in the
!	FST.  The link of the last KDB is null to indicate the end
!	of the chain.
!
!	The KDBs remain in free core for the duration of the
!	processing of the file.  They are flushed only when the
!	file is closed.
!-

FIELD
    kdb$r_fields =
	SET
	kdb$h_bln = [0, 0, 18, 0],		! KDB length
	kdb$h_bid = [0, 18, 18, 0],		! KDB block ID
	kdb$h_reference = [1, 0, 18, 0],	! Key of reference
	kdb$h_root = [1, 18, 18, 0],		! Root bucket number
	kdb$v_idb_address = [2, 0, 27, 0],	! Disk address of IDB
	kdb$v_datatype = [2, 27, 6, 0],		! Key datatype
	kdb$v_header_size = [2, 33, 3, 0],	! Size of header
	kdb$a_nxt = [3, 0, 18, 0],		! Next KDB in chain
	kdb$h_flags = [3, 18, 18, 0],		! Flags from XAB (see note below)
	kdb$v_no_index = [3, 35, 1, 0],		! ?
	kdb$v_did_change = [3, 34, 1, 0],	! Key changed on update
	kdb$v_dup = [3, 18, 1, 0],		! Duplicates allowed
	kdb$v_chg = [3, 19, 1, 0],		! Keys can change
	kdb$v_hsh = [3, 20, 1, 0],		! Hash indexing
	kdb$b_dan = [4, 0, 9, 0],		! Data area number
	kdb$b_ian = [4, 9, 9, 0],		! Index area number
	kdb$b_data_bkz = [4, 18, 9, 0],		! Data bucket size
	kdb$b_index_bkz = [4, 27, 9, 0],	! Index bucket size
	kdb$h_minimum_rsz = [5, 0, 18, 0],	! Record size to include key
	kdb$v_levels = [5, 18, 6, 0],		! Number of levels in index
	kdb$v_byte_size = [5, 24, 6, 0],	! Key byte size
!	Bits 0-5 of word 5 are free for use
	kdb$h_dfl_offset = [6, 0, 18, 0],	! Offset for DFL (?)
	kdb$h_ifl_offset = [6, 18, 18, 0],	! Offset for IFL (?)
	kdb$h_key_size_words = [7, 0, 18, 0],	! Size of key in words
	kdb$h_key_size_bytes = [7, 18, 18, 0],	! Size of key in bytes
	kdb$z_segments = [8, 0, 0, 0]		! Beginning of segment list
	TES;

LITERAL
    kdb$k_bln = 8 + rms$k_max_key_segments,	! Length of KDB
    kdb$k_bid = 6;				! Block ID

MACRO
    $rms_kdb =
				! Define a KDB
BLOCK [kdb$k_bln] FIELD (kdb$r_fields) %;

LITERAL
    !
    !	Data types
    !
    kdb$k_stg = 0,				! String data type
    kdb$k_ebc = 1,				! EBCDIC data type
    kdb$k_six = 2;				! SIXBIT data type

!<BLF/PAGE>
!+
!   Flags : note that the flag field contains both XAB flags
!   and temporary processing flags.  Thus, the definitions of
!   the flag bits should be synchronized with the XAB.  The
!   processing flags are defined starting from the left-most
!   available bit in the field.  User flags are to be defined
!   starting from the right-most available bit in the field.
!-

LITERAL
    !
    !	Processing flags
    !
    kdb$m_no_index = 1^17,			! ?
    kdb$m_did_change = 1^16,			! Key changed during update
    !
    !	User flags
    !
    kdb$m_dup = 1^0,				! Duplicates allowed
    kdb$m_chg = 1^1,				! Keys can change
    kdb$m_hsh = 1^2;				! Hash method of indexing

%SBTTL'Bucket Descriptor'
!<BLF/PAGE>
!+
!	BUCKET DESCRIPTOR
!
!	BKT... symbols.
!-

FIELD
    bkt$r_fields =
	SET
	bkt$a_bucket_address = [0, 0, 18, 0],	! Bucket in-core
	bkt$a_buffer_desc = [0, 18, 18, 0],	! Buffer descriptor
	bkt$h_bucket_number = [1, 0, 18, 0],	! Bucket number
	bkt$v_flags = [1, 18, 6, 0],		! Flags
	bkt$v_locked = [1, 18, 1, 0],		! Bucket is locked
	bkt$v_size = [1, 24, 8, 0]		! Bucket size (in blocks?)
!   Bits 32-35 of word 1 are free
	TES;

LITERAL
    bkt$k_bln = 2;				! Length

MACRO
    $rms_bucket_descriptor =
		! Define a bucket descriptor
BLOCK [bkt$k_bln] FIELD (bkt$r_fields) %;

LITERAL
    !
    !	Normal bucket sizes for non-index files
    !
    bkt$k_asc_size = 1,				! Page by page for ASCII
    bkt$k_seq_size = 1,				! Same for sequential
    bkt$k_rel_size = 1,				! and for relative files.
    !
    !	Flags for bucket descriptor
    !
    bkt$m_locked = 1^0;				! Bucket is locked

%SBTTL'Buffer Descriptor'
!<BLF/PAGE>
!+
!	BUFFER DESCRIPTOR
!
!	BUF... symbols define buffer descriptors.  The
!	buffer descriptors are maintained within the RST
!	for each record stream.  These descriptors are
!	never moved around nor used as arguments to any
!	routine.
!-

FIELD
    buf$r_fields =
	SET
	buf$h_file_page = [0, 0, 18, 0],	! File page in first
						! page of buffer
	buf$v_bucket_size = [0, 20, 3, 0],	! Number of pages in bucket
						! currently in buffer;
						! 0 indicates buffer empty
	buf$v_update_flag = [0, 23, 1, 0],	! Buffer needs to be output
	buf$v_use_count = [0, 24, 3, 0],	! Users of this buffer
	buf$b_buffer_page = [0, 27, 9, 0]	! Page number of buffer in core
	TES;

LITERAL
    buf$k_bln = 1;				! Length of buffer descriptor

MACRO
    $rms_buffer_descriptor =
		! Define a Buffer Descriptor
BLOCK [buf$k_bln] FIELD (buf$r_fields) %;

%SBTTL'Record Descriptor'
!<BLF/PAGE>
!+
!	RECORD DESCRIPTOR
!
!	REC... symbols defined here are the symbols for the
!	record descriptor packet.  This packet is used only
!	during processing of indexed files in RMS-36.  It is
!	passed between routines and contains temporary results
!	which are required by other routines.  Note that the
!	record descriptor is allocated from local storage (the stack)
!	and is deallocated when the invoking routine is left.
!
!	These parameters are not placed in the RST to conserve
!	space and because the contents of the packet may not be
!	invariant across routine calls.
!-

FIELD
    rec$r_fields =
	SET
	rec$h_status = [0, 0, 18, 0],		! Status
	rec$v_index_update = [0, 0, 1, 0],	! Index update required
	rec$v_duplicate = [0, 1, 1, 0],		! Key already in bucket (see SAME)
	rec$v_empty = [0, 2, 1, 0],		! Bucket is empty
	rec$v_past = [0, 3, 1, 0],		! Search past last record in bucket
	rec$v_less = [0, 4, 1, 0],		! Search key less than found key
	rec$v_delete = [0, 5, 1, 0],		! Found record is deleted
	rec$v_index_error = [0, 6, 1, 0],	! Index update error occurred
	rec$v_no_hi_key = [0, 7, 1, 0],		! No high key in old bucket (on split)
	rec$v_new_in_new = [0, 8, 1, 0],	! Sequential access, 2-way
						! split, and new record in new bucket
	rec$v_same = [0, 9, 1, 0],		! Existing rec has same key as new rec
	rec$h_flags = [0, 18, 18, 0],		! Processing flags
	rec$v_segmented_key = [0, 18, 1, 0],	! Segmented search key
	rec$v_retex = [0, 19, 1, 0],		! Tells CHKDUP to return immediately
	rec$v_horizontal_ok = [0, 20, 1, 0],	! Horizontal search OK
	rec$h_count = [1, 0, 18, 0],		! Count field
	rec$h_user_size = [1, 18, 18, 0],	! Size of record/key
	rec$h_level = [2, 0, 18, 0],		! Input level number
	rec$h_last_level = [2, 18, 18, 0],	! Last level processed
	rec$a_user = [3, 0, 36, 0],		! User record/key
	rec$a_last_record = [4, 0, 36, 0],	! Last record in bucket
	rec$a_record = [5, 0, 36, 0],		! RMS record
	rec$g_rfa = [6, 0, 36, 0],		! Record RFA
	rec$g_rrv = [7, 0, 36, 0],		! Record RRV
	rec$h_sidr_element = [8, 0, 18, 0],	! Offset of current record ptr
	rec$h_length = [8, 18, 18, 0]		! Length of record to insert
	TES;

LITERAL
    rec$k_bln = 9;				! Length of record descriptor

MACRO
    $rms_record_descriptor =
		! Define a record descriptor
BLOCK [rec$k_bln] FIELD (rec$r_fields) %;

LITERAL
    !
    !	Status bits
    !
    rec$m_index_update = 1^0,			! Index update required
    rec$m_duplicate = 1^1,			! Key already in bucket (see SAME)
    rec$m_empty = 1^2,				! Bucket is empty
    rec$m_past = 1^3,				! Search past last record in bucket
    rec$m_less = 1^4,				! Search key less than found key
    rec$m_deleted = 1^5,			! Record is deleted
    rec$m_index_error = 1^6,			! Index update error occurred
    rec$m_no_hi_key = 1^7,			! No high key in old bucket (for split)
    rec$m_new_in_new = 1^8,			! Sequential access, 2-way split,
    						! and new record in new bucket
    rec$m_same = 1^9,				! Existing record with same key
    						! as new record
    !
    !	Flag bits
    !
    rec$m_segmented_key = 1^0,			! Search key is segmented
    rec$m_retex = 1^1,				! Tell CHKDUP to return immediately
    rec$m_horizontal_ok = 1^2;			! Horizontal search is OK

%SBTTL'Enqueue Block'
!<BLF/PAGE>
!+
!	ENQUEUE BLOCK
!
!  	There are several different types of logical resources
!	which are locked by RMS-36 during the course of its
!	processing.  The following types of locks are defined
!	within RMS-36:
!
!		1.	File locks when the file is opened.
!		2.	Record locks for sequential or relative files
!		3.	Bucket locks for indexed files.
!		4.	Capability locks for indexed files.
!
!	All of these logical resources conform to the same format
!	of lock names. This mechanism insures that resource names
!	do not conflict (e.g., a record lock does not have the same
!	format as a file lock, etc.). Each resource name is in
!	the following format:
!
!		!-------------------------------------!
!		! 5   !lock !          lock           !
!		!     !type !       identifier        !
!		!-------------------------------------!
!
!	the "5" is required by ENQ/DEQ. The lock-type is 3 bits
!	and represents the generic type (file, record, bucket, capability)
!	of this lock. The "lock identifier" is the actual resource
!	name (e.g, record id, bucket number, etc.). Care must be
!	used in the choice of both lock type-codes and identifiers
!	to insure that a future conflict does not arise.
!-

FIELD
    qhd$r_fields =
	SET
	qhd$h_length = [0, 0, 18, 0],		! Length of argument block
	qhd$h_count = [0, 18, 18, 0],		! Count of locks
						! (really bits 18-29)
	qhd$v_header_length = [0, 30, 6, 0],	! Length of header (2=1=0)
	qhd$h_request_id = [1, 0, 18, 0],	! Request ID
	qhd$h_psi_channel = [1, 18, 18, 0]	! PSI channel for interrupt
	TES;

LITERAL
    qhd$k_bln = 2;				! Define length

MACRO
    $rms_enqblk_header =
		! Define enqueue block header
BLOCK [qhd$k_bln] FIELD (qhd$r_fields) %;

FIELD
!
!   ENQ request block
!
    enq$r_fields =
	SET
	enq$h_jfn = [0, 0, 18, 1],		! JFN
	enq$b_level = [0, 18, 9, 0],		! Level number
	enq$v_flags = [0, 32, 4, 0],		! Flags
	enq$v_shr = [0, 35, 1, 0],		! Share this resource
	enq$v_bln = [0, 34, 1, 0],		! Bypass level number
	enq$v_nst = [0, 33, 1, 0],		! Allow nested locks
	enq$v_ltl = [0, 32, 1, 0],		! Allow long-term lock
	enq$g_user_code = [1, 0, 36, 0],	! User code
	enq$h_group = [2, 0, 18, 0],		! Group number
	enq$h_pool = [2, 18, 18, 0],		! Resources in pool
	enq$a_mask = [3, 0, 36, 0]		! Mask block
	TES;

LITERAL
    enq$k_bln = 4;				! Length of request

MACRO
    $rms_enq_request =
				! Define block
BLOCK [enq$k_bln] FIELD (enq$r_fields) %;

%SBTTL'File Prologue Table'
!<BLF/PAGE>
!+
!	FILE PROLOGUE TABLE
!
!	FPT... symbols define the file prologue values.
!	Each RMS file begins with a "File Prologue Table"
!	which contains all information (such as file organization,
!	record format, etc.) that is common to all types
!	of RMS files.  This block is created when a $CREATE
!	is issued, and is read in and processed when the file
!	is opened.
!
!	For sequential and relative files, this block is the
!	only one contained in the entire file prologue (with
!	the exception of a 1-word block indicating the end of
!	the file header).
!
!	For indexed and direct [Note: From RMSLIB] files there
!	may be other blocks (such as the Index Descriptor Block,
!	Area Descriptor Block, etc.).
!-

FIELD
    fpt$r_fields =
	SET
	fpt$h_bln = [0, 0, 18, 0],		! Block length
	fpt$h_bid = [0, 18, 18, 0],		! Block ID
	fpt$v_org = [1, 0, 4, 0],		! File organization
	fpt$v_bks = [1, 4, 8, 0],		! Bucket size
	fpt$v_bsz = [1, 12, 6, 0],		! Byte size
	fpt$v_rfm = [1, 18, 5, 0],		! Record format
	! Bits 23-35 are unused
	fpt$h_mrs = [2, 0, 18, 0],		! Maximum record size
	fpt$h_rat = [2, 18, 18, 0],		! Record attributes
	fpt$v_blk = [2, 18, 1, 0],		! Blocked records
	fpt$g_mrn = [3, 0, 36, 0],		! Maximum number of records
	fpt$h_next_bucket = [4, 0, 18, 0],	! Next bucket
	fpt$b_idb = [5, 0, 9, 0],		! Offset to first IDB
	fpt$b_keys = [5, 9, 9, 0],		! Number of keys
	fpt$b_adb = [5, 18, 9, 0],		! Offset to first ADB
	fpt$b_areas = [5, 27, 9, 0],		! Number of areas
	fpt$z_reserved = [6, 0, 0, 0],		! Words 6-12 reserved
	fpt$z_last_word = [12, 0, 0, 0]		! Last word of FPT
	TES;

LITERAL
    fpt$k_bln = 13;				! Length of FPT

MACRO
    $rms_fpt =
			! Define block
BLOCK [fpt$k_bln] FIELD (fpt$r_fields) %;

%SBTTL'Area Descriptor Block'
!<BLF/PAGE>
!+
!	AREA DESCRIPTOR BLOCK
!
!	The ADB appears in the file prologue table.  It is
!	a standard BID,,BLN header followed by one or more
!	5-word area descriptors, for which the only interesting
!	part is the bucketsize field in the first word.
!-

STRUCTURE
    $rms$adb [wrd, pos, siz, ext, area; no_of_areas] =
	[1 + (no_of_areas*5)]			! -
	(IF area LSS 0 THEN ($rms$adb + wrd)	! -
	ELSE ($rms$adb + 1 + (area*5) + wrd))<pos, siz, ext>;

FIELD
    adb$r_fields =
	SET
	adb$h_bid = [0, 18, 18, 0, -1],
	adb$h_bln = [0, 0, 18, 0, -1],
	adb$v_bkz = [0, 0, 9, 0]
	TES;

MACRO
    $rms_adb (number_of_areas) =
 
$rms$adb [number_of_areas] FIELD (adb$r_fields) %;

!<BLF/MACRO>
%SBTTL'Linkage Macros'
!<BLF/PAGE>
!+
!	MACROS USED FOR SUBROUTINE LINKAGE CONVENTIONS
!-

MACRO
    !
    !	To return to user after processing a command
    !
    $rms$user_exit =
	$rms$exit (usrret) %,
    !
    !	To return to user after error is detected
    !
    $rms$user_error_exit =
	$rms$exit (usrerr) %,
    !
    !	Successful return from a routine
    !
    $rms$good_return =
	RETURN -1 %,
    !
    !	Unsuccessful return from a routine
    !
    $rms$bad_return =
	RETURN 0 %;

%SBTTL'Error Processing Macros'
!<BLF/PAGE>
!+
!	ERROR PROCESSING MACROS
!
!-

MACRO
    !
    !	Macro to set up address of user block for status
    !
    $rms$error_block (a) = 			! Set up block for error status
	pb = .a %,
    !
    !	Macro to define a user error and exit to user
    !
    $rms$process_error (CODE, action) = 	! Macro to describe error
	BEGIN
	usrsts = CODE;

	%IF rms$k_debug
	%THEN
	    $rms$begin_debug (dbg$m_errors);	! Special debugging trace
!+
! Allow user to return the error code in a variable called "ERRORCODE"
!  if he doesn't want to return the immediate value. This allows compilation
!  to succeed with RMS$K_DEBUG=1.
!-

	    %IF %IDENTICAL (CODE, .errorcode)
	    %THEN
		$rms$print_value (%STRING ('?User error found: '), errorcode)
	    %ELSE
		$rms$text_out(mf$uef, UPLIT (%ASCIZ'Code'))
	    %FI

	    $rms$end_debug;
	%FI

	action
	END
    %,
    !
    !	Define user error return
    !
    $rms$user_error (CODE) =
	$rms$process_error (CODE, ($user_error_exit)) %,
    !
    !	Return status code
    !
    $rms$return_status (CODE) =
	$rms$process_error (CODE, ($bad_return)) %,
    !
    !	Macro to declare an internal error condition
    !
    $rms$bug (ercod) = 				! Internal consistency error
	BEGIN
	$rms$exit (crash, $rms$name, ercod)
	END
    %;

%SBTTL'Debugging Macros'
!<BLF/PAGE>
!+
!	DEBUGGING MACROS
!-

MACRO
    !
    !	Check the value of subroutine input argument
    !
    $check_input (argnam, optr, argval) =

	%IF rms$k_debug
	%THEN
	    BEGIN

	    IF NOT (.argnam optr argval) THEN $rms$bug (msginput)

	    END
	%FI

    %,
    !
    !	Debugging macro
    !
    $rms$debug_out (case$) =

	%IF rms$k_debug
	%THEN
	    $rms$begin_debug (case$);
	    $rms$type (%STRING (%REMAINING));
	    $rms$end_debug;
	%FI

    %,
    !
    !	Debugging macro
    !
    $rms$begin_debug (flagname) =
	BEGIN

	IF ((.bugflg AND flagname) NEQ 0)
	THEN
	    BEGIN

    %,
    $rms$end_debug =
	END
	END
    %,
    !
    !    Macro to trace the entry to an RMS verb processor.
    !   This macro must appear after the last declaration
    !	and before the first expression in a routine
    !	because of the BIND outside this block.
    !
    $rms$entry (verbname) =

	BIND
	    $rms$name = UPLIT (%ASCIZ %STRING(verbname));

	BEGIN
	$rms$begin_debug (dbg$m_entry);
	$rms$text_out (mf$ent, $rms$name);
	$rms$end_debug;
	END
    %,
    !
    !	Perform an entry trace of a specific routine
    !   This macro must appear after the last declaration
    !	and before the first expression in a routine
    !	because of the BIND outside this block.
    !
    $rms$trace (rname) = 			! Trace RMS execution

	BIND
	    $rms$name = UPLIT (%ASCIZ rname);	! Save routine name

	BEGIN
	$rms$begin_debug (dbg$m_trace);
	$rms$text_out (mf$enr, $rms$name);
	$rms$end_debug;
	END
    %,
    !
    !	Macro to print the contents of a variable <always>
    !
    $rms$print_value (text, fld) =

	%IF rms$k_debug
	%THEN
	    BEGIN

	    EXTERNAL
		dextr1;

	    $rms$text_out (mf$con, UPLIT (%ASCIZ text));	!Message continues..
	    dextr1 = .fld;
	    calldump (1, .dextr1)		!Type value and CRLF
	    END
	%FI

    %,
    !
    !   Macro to print value of a field if DEBUG is on and DBG$M_LOCAL is set
    !
    $rms$look_at (text, fld) =

	%IF rms$k_debug
	%THEN
	    $rms$begin_debug (dbg$m_local);
	    $rms$print_value (text, fld);
	    $rms$end_debug
	%FI

    %,
    !
    !	Trace execution of a single routine
    !
    $rms$routine_trace (text) = 		! Use this for routine tracing
	$rms$debug_out (dbg$m_routine_trace, text);
    %,
    !
    !	Macro for un-implemented functions
    !
    $rms$not_done (a) =
	BEGIN
	$rms$type (%STRING (a, ' is not implemented yet.'));
	END
    %,
    !
    !	Macro to declare a file consistency problem
    !
    $rms$file_problem (errcode) =
	BEGIN
	usrsts = er$udf;
	usrstv = errcode
	END
    %;

MACRO
    !
    !	These macros increment and decrement variables.
    !	Leave the DEC and INC macros alone until we decide
    !	to use them or to remove them; in case they appear
    !	in code somewhere, leave a message.
    !
    dec (what, amt) = 				! Leave a message
	%MESSAGE ('DEC macro being used here from RMSSYS')what = .what - amt %,
    inc (what, amt) =
	%MESSAGE ('INC macro being used here from RMSSYS')what = .what + amt %;

MACRO
    !
    !	Return the value of the RMS call
    !
    $rms$current_jsys =
	(.ujsys<0, 18> AND %O'77') %;

%SBTTL'Debugging Verbosity Flags'
!<BLF/PAGE>
!+
!	DEBUGGING VERBOSITY FLAGS
!
!	These flag bits define the verbosity of the debugging
!	output typed to the TTY.  They exist in the word BUGFLG.
!
!	[Ancient sources: These bit definitions must correspond to
!		the same bits defined in RMSSYM.MTB.  In fact,
!		these bits should be eliminated altogether.]
!-

LITERAL
    dbg$m_trace = 1^0,				! Module trace
    dbg$m_errors = 1^1,				! User errors
    dbg$m_routine_trace = 1^2,			! Routine trace
    dbg$m_local = 1^3,				! Local variables
    dbg$m_blocks = 1^4,				! Dump of various blocks
    dbg$m_lock = 1^5,				! Print trace of record locks
    dbg$m_io = 1^6,				! Trace I/O activity
    dbg$m_entry = 1^7;				! Trace entry to RMS

%SBTTL'Text Output Macros'
!<BLF/PAGE>
!+
!	TEXT OUTPUTTING MACROS
!-

MACRO
    !
    !	Type out a string using a format statement
    !
    $rms$text_out (fmt) =
	BEGIN

	EXTERNAL
	    %NAME (fmt),
	    tx$out;

	%IF %LENGTH NEQ 1			! Some other args?
	%THEN
	    $callm (tx$out, %REMAINING, %NAME (fmt))
	%ELSE
	    $callm(tx$out, %NAME (fmt))
	%FI

	END
    %,
    !
    !	Type out a text string
    !
    $rms$type (text) = 				! Type a message on the TTY
	BEGIN
	$rms$text_out (mf$asz, UPLIT (%ASCIZ text));
	END
    %,
    !
    !	Output debugging messages
    !
    bugout =
	$rms$type %,				! Output debugging stuff
    !
    !	Macro used in DPSS argument macros
    !
    debugerror =
	$rms$type %,
    !
    !	Macro for error messages in extreme situations
    !
    $rms$msg (text) = 				! Used primarily in
						! unit tests
	BEGIN
	$rms$type (%STRING ('?', text));
	END
    %,
    !
    !	Perform block transfer of data
    !
    $move_words (fromloc, toloc, size) =
	BEGIN

	REGISTER
	    bltac,
	    xxxxac;

	xxxxac<lh> = fromloc;
	xxxxac<rh> = toloc;
	bltac = .xxxxac + size - 1;
	$blt (xxxxac, 0, bltac);
	END
    %,
    !
    !	Clear a block of memory
    !
    $clear (ptr, len) = 			! Clear series of locations
	BEGIN

	REGISTER
	    temp1,
	    temp2;

	temp1 = ptr;				! Block address
	temp2 = .temp1 + len - 1;
	(.temp1)<wrd> = 0;

	IF len GTR 1				! BLT necessary?
	THEN
	    BEGIN				! Yes, multi-word
	    $hrl (temp1, temp1);
	    $aoj (temp1);
	    $blt (temp1, 0, temp2);
	    END;

	END
    %;

%SBTTL'Miscellaneous Values'
!<BLF/PAGE>
!+
!	MISCELLANEOUS VALUES THAT ALL MODULES USE
!-

LITERAL
    rms$k_page_size = 512;			! Size of physical page

%SBTTL'Computation Macros'
!<BLF/PAGE>
!+
!	MACROS TO SIMPLIFY VARIOUS COMPUTATIONS
!-

MACRO
    !
    !	Compute total size of data record (in words
    !
    $size_in_words (record_size, byte_size) =
	BEGIN

	LOCAL
	    bytes;

	bytes = 36/byte_size;			! Number of bytes/word
	(record_size + (.bytes - 1))/.bytes	! Return words
	END
    %;

%SBTTL'Open Abort Flags'
!<BLF/PAGE>
!+
!	OPEN ABORT FLAGS
!
!	These values are bit definitions which are passed to
!	certain routines as "abort flags".  Each bit represents
!	a particular operation whcih has been performed and must
!	be undone.  Currently, OABORT and CLEANUP are the only
!	routines which use these bits.
!-

LITERAL
    rms$k_abort_unlock = 1^0,			! Unlock the file
    rms$k_abort_close = 1^1,			! Close the file
    rms$k_abort_fpt = 1^2,			! Release File Prologue Table
    rms$k_abort_fst = 1^3,			! Release the File Status Table
    rms$k_abort_plogpage = 1^4,			! Release the free page
    rms$k_abort_adb = 1^5,			! Release the ADB
    rms$k_abort_ulindex = 1^6,			! Unlock the current index
    rms$k_abort_bucket = 1^7;			! Flush the current bucket

%SBTTL'MACHOPs and other hardware symbols'
!<BLF/PAGE>
!+
!	MACHOPS AND OTHER MACHINE-LEVEL SYMBOLS
!-

MACRO
    $z [] =
	machop (%O'0', %REMAINING) %,
    $sub [] =
	machop (%O'274', %REMAINING) %,
    $skipe [] =
	machop (%O'332', %REMAINING) %,
    $tlc [] =
	machop (%O'641', %REMAINING) %,
    $lsh [] =
	machop (%O'242', %REMAINING) %,
    $jumpl [] =
	machop (%O'321', %REMAINING) %,
    $cai [] =
	machop (%O'300', %REMAINING) %,
    $jsp [] =
	machop (%O'265', %REMAINING) %,
    $blt [] =
	machop (%O'251', %REMAINING) %,
    $jrst [] =
	machop (%O'254', %REMAINING) %,
    $move [] =
	machop (%O'200', %REMAINING) %,
    $movem [] =
	machop (%O'202', %REMAINING) %,
    $sojg [] =
	machop (%O'377', %REMAINING) %,
    $movei [] =
	machop (%O'201', %REMAINING) %,
    $ldb [] =
	machop (%O'135', %REMAINING) %,
    $ildb [] =
	machop (%O'134', %REMAINING) %,
    $idpb [] =
	machop (%O'136', %REMAINING) %,
    $adjbp [] =
	machop (%O'133', %REMAINING) %,
    $hrl [] =
	machop (%O'504', %REMAINING) %,
    $aoj [] =
	machop (%O'340', %REMAINING) %,
    $hlre [] =
	machop (%O'574', %REMAINING) %,
    $idivi [] =
	machop (%O'231', %REMAINING) %,
    $idiv [] =
	machop (%O'230', %REMAINING) %,
    $pushj [] =
	machop (%O'260', %REMAINING) %,
    $dmove [] =
	machop (%O'120', %REMAINING) %,
    $dmovem [] =
	machop (%O'124', %REMAINING) %,
    $fixop [] =
	machop (%O'122', %REMAINING) %,
    $setzb [] =
	machop (%O'403', %REMAINING) %,
    $jump [] =
	machop (%O'320', %REMAINING) %,
    $aos [] =
	machop (%O'350', %REMAINING) %,
    $extend [] =
	machskip (%O'123', %REMAINING) %;

%SBTTL'Linkages and Calling Macros'
!<BLF/PAGE>
!+
!	CALLING MACROS
!-

LINKAGE
    !
    !   Linkage for call of MACRO subroutine
    !
    macrosub = PUSHJ : LINKAGE_REGS (15, 13, 1)
    PRESERVE (6, 7, 8, 9, 10, 11, 12)
    NOPRESERVE (0, 2, 3, 4, 5, 14),
    !
    !	Linkage for call of routine that doesn't return
    !
    exitsub = PUSHJ : LINKAGE_REGS (15, 13, 0)
    PRESERVE (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14),
    !
    !	Linkage for calling EXTEND instruction routine
    !
    extend_linkage = PUSHJ 			! Normal call
    (REGISTER = 7, REGISTER = 8, 		! Use these for EXTEND
    REGISTER = 9, REGISTER = 10, 		! to help BLISS along
    REGISTER = 11, REGISTER = 12; 		! So much for input
    REGISTER = 7, REGISTER = 8, 		! Now list output regs
    REGISTER = 9, REGISTER = 10, 		! To get the stuff back
    REGISTER = 11, REGISTER = 12)		! These get ACs back
    : LINKAGE_REGS (15, 13, 1)			! Normal call ACs
    PRESERVE (5, 14);

!+
!	CALL MACROS
!-

MACRO
    !
    ! ORDINARY BLISS TO BLISS CALLS (ANY NUMBER OF ARGS)
    !
    $call (fn) =
	BEGIN
	%INFORM ('$CALL macro invoked')

	EXTERNAL ROUTINE
	    fn;

	fn (%REMAINING)
	END
    %,
    !
    ! CALL TO OS ROUTINE THAT WONT RETURN IF THERE IS MONITOR ERROR
    !
    $callos (code$, call$) = 			! Use OS, but return special
						! code if call fails
	BEGIN
	%INFORM ('$CALLOS macro invoked')

	EXTERNAL
	    ustosf;				! OS failure code word

	ustosf = code$;				! Provide failure status code
	call$;					! Do the call
	ustosf = 0;				! Returned, so clear
						! suggested error code
	END
    %;

%SBTTL'Long name synonyms'
!<BLF/PAGE>
!+
!   Synonyms for long names in RMS
!-

MACRO
    put_ascii =
	putasc %,
    put_lsn =
	putlsn %,
    get_ascii =
	getasc %,
    get_lsn =
	getlsn %,
    rms_section_number =
	rmssec %,
    user_block_section =
	blksec %,
    user_status =
	usrsts %,
    user_status_value =
	usrstv %,
    move_ascii_record =
	movasc %,
    write_buffer =
	writeb %,
    read_buffer =
	readbu %;

%SBTTL'External declarations'
!<BLF/PAGE>
!+
!	EXTERNAL DECLARATIONS FOR ALL OF RMS
!-
!external routine
!    !
!    !	Routines in RMSASC
!    !
!    put_ascii : novalue,			! Write ASCII record
!    put_lsn : novalue,				! Output an LSN
!    get_ascii,					! Read an ASCII record
!    get_lsn : novalue,				! Pick up an LSN
!    move_ascii_record : extend_linkage,		! Move record with MOVST
!    !
!    !	Routines in RMSIO
!    !
!    write_buffer : novalue,			! Write ASCII buffer
!    read_buffer : novalue;			! Read an ASCII buffer
!
!external
!    rms_section_number,				! Section for RMS
!    user_block_section,				! User blocks in this section
!    user_status,				! STS return
!    user_status_value;				! STV return




%SBTTL'EXTEND Instruction Macros'
!<BLF/PAGE>
!+
!	Macros for use in EXTEND instruction
!-

LITERAL
    !
    !	Various flag values
    !
    ext$k_significance = 1^17,			! Significance flag
    ext$k_abort = 1^15;				! Abort flag

LITERAL
    !
    !	EXTEND opcode values
    !
    cmpsl = %O'001'^27,				! Compare strings, skip LSS
    cmpse = %O'002'^27,				! Compare strings, skip EQL
    cmpsle = %O'003'^27,			! Compare strings, skip LEQ
    edit = %O'004'^27,				! Edit string
    cmpsge = %O'005'^27,			! Compare strings, skip GEQ
    cmpsn = %O'006'^27,				! Compare strings, skip NEQ
    cmpsg = %O'007'^27,				! Compare strings, skip GTR
    cvtdbo = %O'010'^27,			! Decimal to binary, offset
    cvtdbt = %O'011'^27,			! Decimal to binary, translated
    cvtbdo = %O'012'^27,			! Binary to decimal, offset
    cvtbdt = %O'013'^27,			! Binary to decimal, translated
    movso = %O'014'^27,				! Move string offset
    movst = %O'015'^27,				! Move string translated
    movslj = %O'016'^27,			! Move string, left-justified
    movsrj = %O'017'^27,			! Move string, right-justified
    xblt = %O'020'^27;				! Extended BLT

MACRO
    !
    !	Register declaration macro for normal addressing
    !
    $rms$bis_regs =

	REGISTER
	    R1 = 5,
	    R2 = 6,
	    R3 = 7,
	    R4 = 8,
	    R5 = 9;

    %,
    !
    !	Register declaration macro for extended addressing
    !
    $rms$bis_regs_ea = 				! For Extended addressing,
						! use 2-word byte pointers

	REGISTER
	    R1 = 5,
	    R2 = 6,
	    R3 = 7,
	    R4 = 8,
	    R5 = 9,
	    R6 = 10;

    %,
!<BLF/MACRO>
    !
    !	Convert binary to decimal (for LSNs, among other things)
    !
    $rms$binary_to_decimal (number, dest, size) =
	BEGIN
	$rms$bis_regs;

	BIND
	    extend_block = UPLIT (cvtbdo + %C'0', 	! Offset from "0"
				%C'0');		! Leading zeroes

	R1 = 0;					! Clear top half of number
	R2 = number;				! Fetch lower half of number
	R4 = size + 				! Setup size and
	rms$k_ext_significance^18;		! set significance
	R5 = dest;				! String pointer

	IF $extend (R1, extend_block)		! Do the conversion
	THEN 					!
	    true				! No error
	ELSE
	    false				! Number too large for space
	END

    %,
    !
    !	Decimal to binary conversion
    !
    $rms$decimal_to_binary (SOURCE, argsize, result) =
	BEGIN
	$rms$bis_regs;

	LOCAL
	    val;

	BIND
	    extend_block = UPLIT (		! Block for CVTDBO
		cvtdbo + ( -%C'0' AND %O'777777'));	! Negative offset

	R1 = argsize;				! Length of string
	R2 = SOURCE;				! Pointer to string
	R3 = 0;					! More pointer
	R4 = 0;					! Double-length
	R5 = 0;					! binary result
	val = $extend (R1, extend_block);	! Do the deed
	result = .R5;				! Assume single-word output
	.val					! Return skip code
	END
    %,
    !
    !	Move a string until <LF>,<FF>,<VT> encountered
    !
    $rms$move_ascii_record (from_addr, to_addr, from_size, to_size) =
	BEGIN
	$rms$bis_regs;				! Regs for EXTEND instructions

	EXTERNAL
	    table1;				! Translation table

	LOCAL
	    val,
	    extend_block : VECTOR [2];

	extend_block [0] = movst + table1;
	extend_block [1] = 0;
	R1 = .from_size;
	R2 = .from_addr;
	R3 = 0;
	R4 = .to_size;
	R5 = .to_addr;
	val = $extend (R1, extend_block);
	from_addr = .R2;			! Return values
	to_addr = .R5;
	from_size = .R1;
	to_size = .R4;
	.val
	END
    %,
    !
    !	Extended addressing form of $RMS$MOVE_ASCII_RECORD
    !
    $rms$move_ascii_record_ea (from_addr, to_addr, from_size, to_size) =
	BEGIN
	$rms$bis_regs_ea;

	EXTERNAL
	    table1;

	LOCAL
	    val,
	    extend_block : VECTOR [2];

	extend_block [0] = movst + table1;
	extend_block [1] = 0;
	R1 = .from_size;
	R2 = .from_addr [0];
	R3 = .from_addr [1];
	R4 = .to_size;
	R5 = .to_addr [0];
	R6 = .to_addr [1];
	val = $extend (R1, extend_block);
	from_addr [0] = .R2;			! Return values
	from_addr [1] = .R3;
	to_addr [0] = .R5;
	to_addr [1] = .R6;
	from_size = .R1;
	to_size = .R4;
	.val
	END
    %,
    !
    !	Compare two strings, skip on LEQ
    $rms$c_string_leq (source_addr, dest_addr, source_size, dest_size) =
	BEGIN
	$rms$bis_regs;

	LOCAL
	    val;

	BIND
	    csblock = UPLIT (cmpsle, 0, 0);	! No fill on comparison

	R1 = .source_size;			! Set up ACs
	R2 = .source_addr;
	R4 = .dest_size;
	R5 = .dest_addr;
	val = $extend (R1, csblock);
	dest_addr = .R5;			! Return address
						! where comparison stopped
	source_addr = .R2;
	.val
	END
    %,
    !
    !	Move string with justification
    !
    $rms$move_left (from_addr, to_addr, from_size, to_size) =
	BEGIN
	$rms$bis_regs;

	LOCAL
	    val;

	BIND
	    extend_block = UPLIT (movslj, 0);

	R1 = .from_size;			! Source string size
	R2 = .from_addr;			! Source pointer
	R4 = .to_size;				! Destination size
	R5 = .to_addr;				! Destination pointer
	val = $extend (R1, extend_block);
	from_size = .R1;			! Return values
	from_addr = .R2;
	to_size = .R4;
	to_addr = .R5;
	.val
	END
    %,
    !
    !	Extended addressing form of $RMS$MOVE_LEFT
    !
    $rms$move_left_ea (from_addr, to_addr, from_size, to_size) =
	BEGIN
	$rms$bis_regs_ea;

	LOCAL
	    val;

	BIND
	    extend_block = UPLIT (movslj, 0);

	R1 = .from_size;			! Source string size
	R2 = .from_addr [0];			! Source pointer
	R3 = .from_addr [1];			! (both words)
	R4 = .to_size;				! Destination size
	R5 = .to_addr [0];			! Destination pointer
	R6 = .to_addr [1];
	val = $extend (R1, extend_block);
	from_size = .R1;			! Leftover bytes
	from_addr [0] = .R2;			! Both words of
	from_addr [1] = .R3;			! source pointer
	to_size = .R4;				! Should contain 0
	to_addr [0] = .R5;			! Both words of
	to_addr [1] = .R6;			! destination pointer
	.val					! Return skip value
	END
    %,
    !
    ! $RMS$XCOPY - Copy a block of words, possibly between sections.
    !	Do not call unless running in a non-zero section.
    !
    $rms$xcopy (from_addr, to_addr, size) =
	BEGIN

	BIND
	    extend_block = UPLIT (xblt);

	REGISTER
	    tmpac1 = 5,
	    tmpac2 = 6,
	    tmpac3 = 7;

	tmpac1 = size;
	tmpac2 = from_addr;
	tmpac3 = to_addr;

	IF .tmpac2<18, 18> EQL 0 THEN tmpac2 = .tmpac2 OR .rmssec;

	IF .tmpac3<18, 18> EQL 0 THEN tmpac3 = .tmpac3 OR .rmssec;

	$extend (tmpac1, extend_block)
	END
    %;