Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/utllib.r36
There are 3 other files named utllib.r36 in the archive. Click here to see a list.
! UTLLIB.R36 - RMS UTLINT utility interface definitions
!<BLF/REQUIRE 'BLI:BLF.REQ'>
!
!
!
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 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.
!
!
!++
! FACILITY: RMS
!
! ABSTRACT:
!
! UTLLIB contains symbols for use of the UTLINT
! utility interface to RMS-20.
!
! ENVIRONMENT: DEC products only!
!
! AUTHOR: Ron Lusk , CREATION DATE: 19-Jul-83
!
! MODIFIED BY:
!
! , : VERSION
! 01 -
!--
!<BLF/PAGE>
!
! TABLE OF CONTENTS
!
! None!
!
! INCLUDE FILES:
!
LIBRARY 'bli:xport';
!<BLF/PAGE>
!
! MACROS:
!
$field
!
! $UTLINT argument block definitions
!
uab$r_fields =
SET
uab$g_return = [$integer], !
$overlay (uab$g_return) !
uab$h_function = [$bytes (2)], ! $UTLINT function
uab$h_no_of_args = [$short_integer], ! Number of arguments
$continue !
uab$g_arg_1 = [$integer], !
uab$g_arg_2 = [$integer], !
uab$g_arg_3 = [$integer],
uab$g_arg_4 = [$integer],
uab$g_arg_5 = [$integer],
uab$g_arg_6 = [$integer]
TES;
LITERAL
uab$k_bln = $field_set_size;
MACRO
$uab =
BLOCK [uab$k_bln] FIELD (uab$r_fields) %;
!<BLF/PAGE>
!<BLF/MACRO>
MACRO
!
! Internal macro to set up UAB
!
$$uab_arg_entry [argument] =
%ASSIGN ($map$arg_count, $map$arg_count + 1) !
uab$$ptr [%NAME ('UAB$G_ARG_', %NUMBER ($map$arg_count))] = !
argument %,
!
! Set up a UAB
!
$uab_setup (arg_block, function, argument) =
BEGIN
COMPILETIME
$map$arg_count = 0;
BIND
uab$$ptr = (arg_block) : $uab;
uab$$ptr [uab$h_no_of_args] = -(%LENGTH - 2);
uab$$ptr [uab$h_function] = function;
$$uab_arg_entry (argument, %REMAINING);
END
%;
!<BLF/PAGE>
!
! EQUATED SYMBOLS:
!
$literal
!
! $UTLINT function codes
!
uin$k_setenv = 0, ! Set up RAB, etc.
uin$k_gmem = $distinct, ! Get chunk of memory
uin$k_gpage = $distinct, ! Get a page or more
uin$k_pmem = $distinct, ! Free random chunk
uin$k_ppage = $distinct, ! Free some pages
uin$k_unused_1 = $distinct, ! Not used yet
uin$k_chkdup = $distinct, ! Call CHKDUP
uin$k_ckeyku = $distinct, ! Call CKEYKU
uin$k_ckeykk = $distinct, ! Call CKEYKK
uin$k_fbyrrv = $distinct, ! Find record by RRV
uin$k_fbyrfa = $distinct, ! Find record by RFA
uin$k_fnddata = $distinct, ! Find data level
uin$k_followpath = $distinct, ! Call FOLLOWPATH
uin$k_getbkt = $distinct, ! Get a bucket
uin$k_getidb = $distinct, ! Get index descriptor block
uin$k_getkdb = $distinct, ! Get KDB for this KRF
uin$k_getroot = $distinct, ! Set up root bucket
uin$k_gtbktptr = $distinct, ! ?
uin$k_movekey = $distinct, ! Move a key around
uin$k_path = $distinct, ! Returns path
uin$k_putbkt = $distinct, ! Puts a bucket back
uin$k_putsidr = $distinct, ! Does something to a SIDR
uin$k_alcbkt = $distinct; ! Create a new bucket
!<BLF/PAGE>
!<BLF/MACRO>
MACRO
$utl$declare_arglst (arglst) =
%IF %NULL (arglst)
%THEN
LOCAL
utlargs : $uab;
%ELSE
BIND
utlargs = (arglst) : $uab;
%FI
%;
%SBTTL 'Set up environment'
KEYWORDMACRO
!
! Set up the utility interface environment
!
$utl_setenv (
rab,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_setenv, (rab));
$utlint (uab = utlargs, err = error);
END
%;
%SBTTL 'Get memory'
KEYWORDMACRO
!
! Get some memory
!
$utl_gmem (
words,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_gmem, (words));
IF $utlint (uab = utlargs, err = error) ! Get memory
THEN
.utlargs [uab$g_return]
ELSE
0
END
%;
%SBTTL 'Get a page of memory'
KEYWORDMACRO
!
! Get a page of memory
!
$utl_gpage (
pages,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_gpage, (pages));
IF $utlint (uab = utlargs, err = error) ! Get some pages
THEN
.utlargs [uab$g_return]
ELSE
0
END
%;
%SBTTL 'Free some memory'
KEYWORDMACRO
!
! Return a block of memory
!
$utl_pmem (
address,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_pmem, (address));
IF $utlint (uab = utlargs, err = error) ! Free some memory
THEN
.utlargs [uab$g_return]
ELSE
0
END
%;
%SBTTL 'Free a page'
KEYWORDMACRO
!
! Return a page
!
$utl_ppage (
address,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_ppage, (address));
IF $utlint (uab = utlargs, err = error) ! Free some pages
THEN
.utlargs [uab$g_return]
ELSE
0
END
%;
%SBTTL 'Check for duplicate keys'
KEYWORDMACRO
!
! Check for duplicate keys
!
$utl_chkdup (
recdesc,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_chkdup, (recdesc), (bucket));
IF $utlint (uab = utlargs, err = error) ! Check for dup SIDRs
THEN
.utlargs [uab$g_return]
ELSE
0
END
%;
%SBTTL 'Compare a key with user record'
KEYWORDMACRO
!
! Compare a key with a user record:
! Record descriptor points to key, UDR
! points to user record.
!
$utl_ckeyku (
recdesc,
udr,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_ckeyku, (recdesc), (udr));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Compare two key strings'
KEYWORDMACRO
!
! Compare key string with key string
!
$utl_ckeykk (
recdesc,
keybuf,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_ckeykk, (recdesc), (keybuf));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Find record by RRV'
KEYWORDMACRO
!
! Find record by RRV: RFA in RECDESC,
! bucket descriptor for new bucket
!
$utl_fbyrrv (
recdesc,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_fbyrrv, (recdesc), (bucket));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Find record by RFA'
KEYWORDMACRO
!
! Find record by RFA
!
$utl_fbyrfa (
recdesc,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_fbyrfa, (recdesc), (bucket));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Find data level'
KEYWORDMACRO
!
! Find data level
!
$utl_fnddata (
recdesc,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_fnddata, (recdesc), (bucket));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Follow path'
KEYWORDMACRO
!
! Follow path down index (?)
!
$utl_followpath (
recdesc,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_followpath, (recdesc), (bucket));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Get a bucket'
KEYWORDMACRO
!
! Get an existing file bucket
!
$utl_getbkt (
bucket_no, ! Bucket number
bucket_size = 1, ! Size of bucket
locking = 0, ! Lock the bucket?
bucket, ! Desc for returned bucket
arglst = ,
error = ) =
!
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, ! ...
uin$k_getbkt, ! ...
(bucket_no), ! ...
(bucket_size), ! ...
(locking), ! ...
(bucket)); ! ...
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Get an Index Descriptor Block'
KEYWORDMACRO
!
! Get an IDB
!
$utl_getidb (
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_getidb, (bucket));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Set up the Key Descriptor Block'
KEYWORDMACRO
!
! Get a KDB
!
$utl_getkdb (
key_of_reference,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_getkdb, (key_of_reference));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Get root of index'
KEYWORDMACRO
!
! Get the index root
!
$utl_getroot (
recdesc,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_getroot, (recdesc), (bucket));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Get a bucket specified by an index entry'
KEYWORDMACRO
!
! Get a bucket pointed to by something
!
$utl_gtbktptr (
recdesc,
current_bucket,
next_bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_gtbktptr, ! ...
(recdesc), ! ...
(current_bucket), ! ...
(next_bucket)); ! ...
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Move a key'
KEYWORDMACRO
!
! Move a key from a record to a key buffer
!
$utl_movekey (
recptr,
keybuf,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_movekey, (recptr), (keybuf));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Return the PATH vector'
KEYWORDMACRO
!
! Return the path vector address
!
$utl_path (
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_path);
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Output a bucket'
KEYWORDMACRO
!
! Put a bucket to a file
!
$utl_putbkt (
update = 1,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_putbkt, (update), (bucket));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Put a SIDR'
KEYWORDMACRO
!
! Create a SIDR entry
!
$utl_putsidr (
recdesc,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, uin$k_putsidr, (recdesc));
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
%SBTTL 'Allocate a new bucket'
KEYWORDMACRO
!
! Allocate a bucket
!
$utl_alcbkt (
type,
flags,
level,
bucket,
arglst = ,
error = ) =
BEGIN
$utl$declare_arglst (arglst);
$uab_setup (utlargs, ! Arglst
uin$k_alcbkt, ! .
(type), ! .
(flags), ! .
(level), ! .
(bucket)); ! .
IF $utlint (uab = utlargs, err = error) THEN .utlargs [uab$g_return] ELSE 0
END
%;
!
! OWN STORAGE:
!
! None.
!
! EXTERNAL REFERENCES:
!
! None
!