Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

%TITLE 'R E O R G -- RMSLOD Reorganize module'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE reorg (IDENT = '1'
		) =
BEGIN
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 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:	RMSLOD
!
! ABSTRACT:
!
!	REORG is called when an RMS indexed file is to be reorganized.
!	It copies the file description from INFAB to OUTFAB, and then
!	calls LOADER to build the new indexed file.  The new file will
!	be structured like the old one, but will be reorganized for
!	more efficient access.
!
! ENVIRONMENT:	User mode
!
! AUTHOR: Ron Lusk , CREATION DATE: 25-Jul-84
!
! MODIFIED BY:
!
!	, : VERSION
! 01	-
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
    lodreo,
    add_key_xab : NOVALUE,
    add_area_xab : NOVALUE,
    freexabs : NOVALUE;

!
! INCLUDE FILES:
!

LIBRARY 'rmsint';

!
! MACROS:
!
!   None
!
! EQUATED SYMBOLS:
!
!   None
!
! OWN STORAGE:
!

OWN
    status,					! Status of LOAD operation
    infab : REF $fab_decl,			! Pointer to input file
    outfab : REF $fab_decl;			! New indexed file

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    getmem,
    fremem,
    lodlod;

%SBTTL 'LODREO - reorganization routine'

GLOBAL ROUTINE lodreo (p_infab, p_outfab) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	sumx : $xabsum_decl;

    !
    !	Set up our arguments
    !
    infab = .p_infab;
    outfab = .p_outfab;
    !
    !	Display the count of keys
    !
    $xabsum_init (xab = sumx);
    infab [fab$a_xab] = sumx;
    $open (fab = .infab);
    infab [fab$a_xab] = 0;

    !+
    !	Add key XABs
    !-

    INCR key_number FROM 0 TO (.sumx [xab$b_nok] - 1) DO
	add_key_xab (.infab, .key_number);

    !+
    !	Add area XABs
    !-

    INCR area_number FROM 1 TO (.sumx [xab$b_noa] - 1) DO
	add_area_xab (.infab, .area_number);

    !
    !	See what the file really looks like.
    !
    $display (fab = .infab);
    $close (fab = .infab);
    !
    !	Move the XAB chain to the file
    !	to be created.
    !
    outfab [fab$a_xab] = .infab [fab$a_xab];
    infab [fab$a_xab] = 0;
    !
    !	Set up the rest of the output FAB
    !
    outfab [fab$v_org] = fab$k_idx;		! Indexed file
    outfab [fab$v_bsz] = .infab [fab$v_bsz];	! Use same byte size
    outfab [fab$h_mrs] = .infab [fab$h_mrs];	! Record length
    outfab [fab$v_rfm] = .infab [fab$v_rfm];	! Same record format
    outfab [fab$v_bks] = .infab [fab$v_bks];	! Same basic bucket size
    !
    !	Load the file
    !
    status = lodlod (.infab, .outfab);
    !
    !	Return home
    !
    RETURN .status;
    END;					! End of LODREO

%SBTTL 'ADD_KEY_XAB'
ROUTINE add_key_xab (addfab : REF $fab_decl, key_ref) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	oldxab : REF $xabkey_decl,
	newxab : REF $xabkey_decl;

    newxab = getmem (xab$k_keylen);
    $xabkey_init (xab = .newxab, kref = .key_ref);

    IF .addfab [fab$a_xab] EQL 0		! Check FAB
    THEN
	addfab [fab$a_xab] = .newxab		! No XAB chain yet
    ELSE
	BEGIN					! Add to XAB chain
	oldxab = .addfab [fab$a_xab];

	UNTIL .oldxab [xab$a_nxt] EQL 0 DO
	    oldxab = .oldxab [xab$a_nxt];

	oldxab [xab$a_nxt] = .newxab;
	END;

    RETURN;
    END;					! End ADD_KEY_XAB

%SBTTL 'ADD_AREA_XAB'
ROUTINE add_area_xab (addfab : REF $fab_decl, area_id) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	oldxab : REF $xaball_decl,
	newxab : REF $xaball_decl;

    newxab = getmem (xab$k_alllen);
    $xaball_init (xab = .newxab, aid = .area_id);

    IF .addfab [fab$a_xab] EQL 0		! Check FAB
    THEN
	addfab [fab$a_xab] = .newxab		! No XAB chain yet
    ELSE
	BEGIN					! Add to XAB chain
	oldxab = .addfab [fab$a_xab];

	UNTIL .oldxab [xab$a_nxt] EQL 0 DO
	    oldxab = .oldxab [xab$a_nxt];

	oldxab [xab$a_nxt] = .newxab;
	END;

    RETURN;
    END;					! End ADD_AREA_XAB

%SBTTL 'FREEXABS'

GLOBAL ROUTINE freexabs (xab_to_free : REF $xabkey_decl) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    IF .xab_to_free NEQ 0			! More to free?
    THEN
	BEGIN
	freexabs (.xab_to_free [xab$a_nxt]);
	fremem (.xab_to_free, .xab_to_free [xab$h_bln]);
	END;
    END;					! End FREEXABS

END						! End of Module REORG

ELUDOM