Google
 

Trailing-Edge - PDP-10 Archives - BB-JF18A-BM - sources/rms/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
!