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