github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-04-30 13:52:16 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/dil/dilsrc/rmsblk.r36
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1996 lines
54 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
%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, 1986.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
%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
%;
Reference in New Issue View Git Blame Copy Permalink