Google
 

Trailing-Edge - PDP-10 Archives - BB-R595B-SM_11-9-85 - mcb/utilities/lbrlib.bli
There is 1 other file named lbrlib.bli in the archive. Click here to see a list.
MODULE LBRLIB (					!Library manipulation
		IDENT = '001030',
		LANGUAGE (BLISS16, BLISS36)
		) =
BEGIN
!
!
!
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     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  which  is  not supplied by
!     DIGITAL.
!

!++
! FACILITY: LBR20 - Librarian Utility
!
! ABSTRACT:
!
!
! This module contains the routines to access and modify the library.
!
!
! ENVIRONMENT: ANY
!
! AUTHOR: ALAN D. PECKHAM, CREATION DATE: 6-MAY-80
!
! MODIFIED BY:
!
!	Alan D. Peckham, : VERSION 01
! 01	- Restructure file positioning to refer to block/offset.
!	  Use OBJ_MARK and OBJ_SET routines to mark the beginning
!	  of an object module and rewind the file to that position.
!	  Sort the GSD records to the beginning of the module
!	  by doing two passes on the object module.
! 02	- Data structure reformation (change from BLOCK_16 to BLOCK structure).
!	  Add COMPRESS function.
! 03    - Add support for EPT replacement in FILE_INSERT.
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    COPY,					!Copy word to library file
    ENTRY_DELETE,				!Delete an entry point
    EPT_INDEX,					!Check if entry exists in EPT
    EPT_INSERT,					!Insert an entry point
    EPT_PURGE : NOVALUE,			!Purge module entry points
    FILE_INSERT,				!Insert modules from a file
    HDR_DELETE : NOVALUE,			!Mark a module header as deleted.
    LIBCLS : NOVALUE,				!Close the library
    LIBUPD : NOVALUE,				!Update HDR, EPT and MNT
    LIBOPN,					!Open the library
    MNT_INDEX,					!Check if module exists in MNT
    MNT_INSERT,					!Insert a module name
    MNT_PURGE : NOVALUE,			!Purge module name(s)
    MODULE_DELETE;				!Delete a module

!
! INCLUDE FILES
!

LIBRARY 'LBRCOM';				!LBR COMMON DEFINITIONS

!
! MACROS:
!

MACRO
    CHAR2 (num) =
	%IF num LEQ 9
	%THEN '0', %NUMBER (num)
	%ELSE %NUMBER (num)
	%FI %;

!
! EQUATED SYMBOLS:
!

LITERAL
    BLOCK_SIZE = 512,
    EPTBUF_SIZE = 2048,
    MNTBUF_SIZE = 1024;

LITERAL
    OBJ_LOW = 1,				!Lowest object record type.
    OBJ_GSD = 1,				!Global Symbol Dictionary.
    OBJ_END_GSD = 2,				!End of GSD records.
    OBJ_TXT = 3,				!TeXT information.
    OBJ_RLD = 4,				!ReLocation Dictionary.
    OBJ_ISD = 5,				!Internal Symbol Dictionary.
    OBJ_END_MOD = 6,				!End of module.
    OBJ_HIGH = 6,				!Highest object record type.
    GSD_LOW = 0,				!Lowest GSD record type.
    GSD_MOD = 0,				!Module name.
    GSD_CSECT = 1,				!Control section name.
    GSD_INTERNAL = 2,				!Internal symbol name.
    GSD_TRANSFER = 3,				!Transfer address.
    GSD_GLOBAL = 4,				!Global symbol name.
    GSD_PSECT = 5,				!Program section name.
    GSD_VERSION = 6,				!Program version identification.
    GSD_ARRAY = 7,				!Mapped array declaration.
    GSD_HIGH = 7;				!Highest GSD record type.

!
! OWN STORAGE:
!

OWN
    EPTBUF : BLOCKVECTOR [EPTBUF_SIZE, EPT_LENGTH],
    EPT_CHANGED,
    HDR : BLOCK [HDR_LENGTH] FIELD (HDR_FIELDS),
    HDRBUF : BLOCK [LIB_LENGTH],
    HDR_CHANGED,
    LIB_FILBLK,
    MNTBUF : BLOCKVECTOR [MNTBUF_SIZE, MNT_LENGTH],
    MNT_CHANGED;

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    CLOSE,					!Close a file.
    FILNM : NOVALUE,				!Convert file name to ASCII.
    FILPOS,					!Get the current file position.
    GETFIL,					!Get a word from the file.
    GETTIM : NOVALUE,				!Get the current time.
    OBJ_CLOSE : NOVALUE,			!Close object file
    OBJ_MARK : NOVALUE,				!Mark current record position
    OBJ_OPEN,					!Open object file
    OBJ_RECORD,					!Read length of next record
    OBJ_SET : NOVALUE,				!Reset to marked position
    OBJ_WORD,					!Read next word of record
    OPEN,					!Open a file.
    POSFIL,					!Position to a word in the file
    PUTFIL : NOVALUE;				!Put a string to a file opened for output.

EXTERNAL
    FLAGS : BITVECTOR [M_MAX_BITS],
    LIBEPT : REF BLOCKVECTOR [1, EPT_LENGTH] FIELD (EPT_FIELDS),
    LIBHDR : REF BLOCK [LIB_LENGTH] FIELD (LIB_FIELDS),
    LIBMNT : REF BLOCKVECTOR [1, MNT_LENGTH] FIELD (MNT_FIELDS),
    NUMEPT,
    NUMMNT,
    SIZFIL;
ROUTINE COPY (VALUE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    OWN
	WORD_BUFFER;

    BIND
	WORD_PTR = CH$PTR (WORD_BUFFER,, 18);

    IF .VALUE GEQ 0
    THEN
	BEGIN
	CH$WCHAR (.VALUE, WORD_PTR);
	PUTFIL (.LIB_FILBLK, WORD_PTR, 1);
	HDR [HDR_SIZE_2] = .HDR [HDR_SIZE_2] + 2;

	IF .HDR [HDR_SIZE_2] EQL 0 THEN HDR [HDR_SIZE_1] = .HDR [HDR_SIZE_1] + 1;

	IF .LIBHDR [LIB_CONTIGUOUS_1] NEQ 0
	THEN
	    BEGIN

	    IF .LIBHDR [LIB_CONTIGUOUS_2] EQL 0
	    THEN
		LIBHDR [LIB_CONTIGUOUS_1] = .LIBHDR [LIB_CONTIGUOUS_1] - 1;

	    LIBHDR [LIB_CONTIGUOUS_2] = .LIBHDR [LIB_CONTIGUOUS_2] - 2;
	    END
	ELSE

	    IF .LIBHDR [LIB_CONTIGUOUS_2] NEQ 0
	    THEN
		LIBHDR [LIB_CONTIGUOUS_2] = .LIBHDR [LIB_CONTIGUOUS_2] - 1;

	END;

    .VALUE
    END;					!OF COPY
GLOBAL ROUTINE ENTRY_DELETE (NAME) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	NAME : REF VECTOR [2];

    LOCAL
	ENTRY_FOUND;

    ENTRY_FOUND = FALSE;

    INCR INDEX FROM 0 TO .LIBHDR [LIB_EPT_ALLOCATED] - .LIBHDR [LIB_EPT_AVAILABLE] - 1 DO

	IF .ENTRY_FOUND
	THEN

	    INCR SUB_INDEX FROM 0 TO EPT_LENGTH - 1 DO
		LIBEPT [.INDEX - 1, .SUB_INDEX, 0, %BPVAL, 0] = .LIBEPT [.INDEX, .SUB_INDEX, 0, %BPVAL, 0]

	ELSE

	    IF .LIBEPT [.INDEX, EPT_NAME_1] EQL .NAME [0] AND .LIBEPT [.INDEX, EPT_NAME_2] EQL .NAME [1]
	    THEN
		ENTRY_FOUND = TRUE;

    IF .ENTRY_FOUND
    THEN
	BEGIN
	LIBHDR [LIB_EPT_AVAILABLE] = .LIBHDR [LIB_EPT_AVAILABLE] + 1;
	HDR_CHANGED = EPT_CHANGED = TRUE;

	IF NOT .FLAGS [M_FAST] THEN LIBUPD ();

	TYPLN (0, CH$ASCIZ ('[Entry "%2R" deleted]'), .NAME [0], .NAME [1]);
	TRUE
	END
    ELSE
	BEGIN
	PUTLN (1, CH$ASCIZ (FATAL, 'No entry point named "%2R"'), .NAME [0], .NAME [1]);
	FALSE
	END

    END;					!OF ENTRY_DELETE
ROUTINE EPT_INDEX (NAME) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	NAME : REF VECTOR [2];

    INCR INDEX FROM 0 TO .LIBHDR [LIB_EPT_ALLOCATED] - .LIBHDR [LIB_EPT_AVAILABLE] - 1 DO

	IF .LIBEPT [.INDEX, EPT_NAME_1] EQL .NAME [0] AND .LIBEPT [.INDEX, EPT_NAME_2] EQL .NAME [1]
	THEN
	    RETURN .INDEX;

    -1
    END;					!OF EPT_INDEX
ROUTINE EPT_INSERT (NAME, BLOCK, OFFSET) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	NAME : REF VECTOR [2];

    IF .LIBHDR [LIB_EPT_AVAILABLE] LEQ 0 THEN RETURN FALSE;

    DECR INDEX FROM .LIBHDR [LIB_EPT_ALLOCATED] - .LIBHDR [LIB_EPT_AVAILABLE] TO 0 DO
	BEGIN

	IF .INDEX GTR 0
	THEN

	    INCR SUB_INDEX FROM 0 TO EPT_LENGTH - 1 DO
		LIBEPT [.INDEX, .SUB_INDEX, 0, %BPVAL, 0] = .LIBEPT [.INDEX - 1, .SUB_INDEX, 0, %BPVAL, 0];

	IF (.INDEX EQL 0) OR (.LIBEPT [.INDEX, EPT_NAME_1] LSS .NAME [0]) OR (.LIBEPT [.INDEX, EPT_NAME_1] EQL
	    .NAME [0] AND .LIBEPT [.INDEX, EPT_NAME_2] LSS .NAME [1])
	THEN
	    EXITLOOP
		BEGIN
		LIBEPT [.INDEX, EPT_NAME_1] = .NAME [0];
		LIBEPT [.INDEX, EPT_NAME_2] = .NAME [1];
		LIBEPT [.INDEX, EPT_BLOCK] = .BLOCK;
		LIBEPT [.INDEX, EPT_OFFSET] = .OFFSET;
		END;

	END;

    LIBHDR [LIB_EPT_AVAILABLE] = .LIBHDR [LIB_EPT_AVAILABLE] - 1;
    HDR_CHANGED = EPT_CHANGED = TRUE
    END;					!OF EPT_INSERT
ROUTINE EPT_PURGE (BLOCK, OFFSET) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	NEW_COUNT;

    NEW_COUNT = 0;

    INCR INDEX FROM 0 TO .LIBHDR [LIB_EPT_ALLOCATED] - .LIBHDR [LIB_EPT_AVAILABLE] - 1 DO
	BEGIN

	IF .LIBEPT [.INDEX, EPT_BLOCK] NEQ .BLOCK OR .LIBEPT [.INDEX, EPT_OFFSET] NEQ .OFFSET
	THEN
	    BEGIN

	    IF .INDEX NEQ .NEW_COUNT
	    THEN

		INCR SUB_INDEX FROM 0 TO EPT_LENGTH - 1 DO
		    LIBEPT [.NEW_COUNT, .SUB_INDEX, 0, %BPVAL, 0] = .LIBEPT [.INDEX, .SUB_INDEX, 0, %BPVAL, 0]

	    ;
	    NEW_COUNT = .NEW_COUNT + 1;
	    END;

	END;

    IF .LIBHDR [LIB_EPT_AVAILABLE] NEQ (.LIBHDR [LIB_EPT_ALLOCATED] - .NEW_COUNT)
    THEN
	BEGIN
	LIBHDR [LIB_EPT_AVAILABLE] = .LIBHDR [LIB_EPT_ALLOCATED] - .NEW_COUNT;
	HDR_CHANGED = EPT_CHANGED = TRUE;
	END;

    END;					!OF EPT_PURGE
GLOBAL ROUTINE FILE_INSERT (FILBLK, REPLACE, EPT, RG, SS) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MACRO
	ABORT (text) =
	    RETURN
		BEGIN
		%IF %NULL (%REMAINING)
		%THEN
		    TYPLN (1, CH$ASCIZ (FATAL, text))
		%ELSE
		    TYPLN (1, CH$ASCIZ (FATAL, text), %REMAINING)
		%FI;
		OBJ_CLOSE ();
		FALSE
		END %;

    LOCAL
	DELETE_BLOCK,
	DELETE_OFFSET,
	INSERT_BLOCK,
	INSERT_OFFSET,
	MODULE_NAME : VECTOR [2],
	OBJECT_BLOCK,
	OBJECT_OFFSET,
	RECORD_COUNT,
	RECORD_TYPE;

    IF NOT OBJ_OPEN (.FILBLK) THEN RETURN FALSE;

    WHILE TRUE DO
	BEGIN
	!
	! Mark this record position and check for EOF
	!
	OBJ_MARK ();

	IF OBJ_RECORD () LSS 0 THEN EXITLOOP;

	!
	! Set up the module header
	!
	BEGIN

	LOCAL
	    TIME_BLOCK : VECTOR [8];

	HDR [HDR_STATUS] = 0;
	HDR [HDR_ATTRIBUTES] = 0;
	HDR [HDR_SS] = .SS;
	HDR [HDR_SIZE_1] = 0;
	HDR [HDR_SIZE_2] = 2 + HDR_SIZE;
	GETTIM (TIME_BLOCK);
	HDR [HDR_YEAR] = .TIME_BLOCK [0];
	HDR [HDR_MONTH] = .TIME_BLOCK [1];
	HDR [HDR_DAY] = .TIME_BLOCK [2];
	END;
	!
	! Set library file insertion position
	!
	INSERT_BLOCK = .LIBHDR [LIB_INSERT_BLOCK];
	INSERT_OFFSET = .LIBHDR [LIB_INSERT_OFFSET];
	POSFIL (.LIB_FILBLK, .INSERT_BLOCK, .INSERT_OFFSET + 2 + HDR_SIZE);
	DELETE_BLOCK = DELETE_OFFSET = 0;
	!
	! Pass 1: Copy GSD records to END GSD record
	!
	!  If module name encountered, insert it in MNT
	!
	!  If entry point encountered, insert it in EPT
	!
	OBJ_SET ();

	WHILE TRUE DO
	    BEGIN

	    IF (RECORD_COUNT = OBJ_RECORD () - 2) LSS 0
	    THEN
		ABORT ('Invalid format for input object file "%@"', FILNM, .FILBLK);

	    CASE (RECORD_TYPE = OBJ_WORD ()) FROM OBJ_LOW TO OBJ_HIGH OF
		SET

		[OBJ_GSD] :
		    BEGIN
		    COPY (.RECORD_COUNT + 2);
		    COPY (.RECORD_TYPE);

		    WHILE (RECORD_COUNT = .RECORD_COUNT - 8) GEQ 0 DO
			BEGIN

			LOCAL
			    NAME : VECTOR [2],
			    TYPE;

			NAME [0] = COPY (OBJ_WORD ());
			NAME [1] = COPY (OBJ_WORD ());
			TYPE = COPY (OBJ_WORD ());
			COPY (OBJ_WORD ());

			CASE .TYPE<8, 8> FROM GSD_LOW TO GSD_HIGH OF
			    SET

			    [GSD_MOD] :
				BEGIN

				LOCAL
				    INDEX;

				MODULE_NAME [0] = .NAME [0];
				MODULE_NAME [1] = .NAME [1];

				IF (INDEX = MNT_INDEX (NAME)) GEQ 0
				THEN

				    IF .REPLACE
				    THEN
					BEGIN
					DELETE_BLOCK = .LIBMNT [.INDEX, MNT_BLOCK];
					DELETE_OFFSET = .LIBMNT [.INDEX, MNT_OFFSET];
					EPT_PURGE (.DELETE_BLOCK, .DELETE_OFFSET);
					MNT_PURGE (.DELETE_BLOCK, .DELETE_OFFSET);
					END
				    ELSE
					ABORT ('Duplicate module name "%2R" in library "%@"', .NAME [0],
					    .NAME [1], FILNM, .LIB_FILBLK);

				IF NOT MNT_INSERT (NAME, .INSERT_BLOCK, .INSERT_OFFSET)
				THEN
				    ABORT ('MNT exceeded in library "%@"', FILNM, .LIB_FILBLK);

				END;

			    [GSD_GLOBAL] :

				IF .EPT AND .TYPE<3, 1>
				THEN
				    BEGIN

                                    local
                                         INDEX;

				    IF (INDEX = EPT_INDEX (NAME)) GEQ 0
				    THEN
                                        begin

                                        if .RG
                                        then
                                            begin
                                            LIBEPT [.INDEX, EPT_BLOCK] = .INSERT_BLOCK;
                                            LIBEPT [.INDEX, EPT_OFFSET] = .INSERT_OFFSET;
                                            end
                                        else
                                            ABORT ('Duplicate entry point "%2R" in library "%@"',
                                                   .NAME [0], .NAME [1], FILNM, .LIB_FILBLK);

                                        end
                                    else

                                       IF NOT EPT_INSERT (NAME, .INSERT_BLOCK, .INSERT_OFFSET)
                                       THEN
                                           ABORT ('EPT exceeded in library "%@"', FILNM, .LIB_FILBLK);

				    END;

			    [GSD_VERSION] :
				BEGIN
				HDR [HDR_IDENT_1] = .NAME [0];
				HDR [HDR_IDENT_2] = .NAME [1];
				END;

			    [INRANGE] :
				0;

			    [OUTRANGE] :
				ABORT ('Invalid format for input object file "%@"', FILNM, .FILBLK);
			    TES

			END;

		    END;

		[INRANGE] :
		    0;

		[OBJ_END_GSD] :
		    EXITLOOP
			BEGIN
			COPY (.RECORD_COUNT + 2);
			COPY (.RECORD_TYPE);
			END;

		[OUTRANGE] :
		    ABORT ('Invalid format for input object file "%@"', FILNM, .FILBLK);
		TES;

	    END;

	!
	! Pass 2: Copy non-GSD records to END MOD record
	!
	OBJ_SET ();

	WHILE TRUE DO
	    BEGIN
	    RECORD_COUNT = OBJ_RECORD () - 2;

	    CASE (RECORD_TYPE = OBJ_WORD ()) FROM OBJ_LOW TO OBJ_HIGH OF
		SET

		[OBJ_GSD, OBJ_END_GSD] :
		    0;

		[INRANGE] :
		    BEGIN
		    COPY (.RECORD_COUNT + 2);
		    COPY (.RECORD_TYPE);

		    WHILE (RECORD_COUNT = .RECORD_COUNT - 2) GEQ 0 DO
			COPY (OBJ_WORD ());

		    END;

		[OBJ_END_MOD] :
		    EXITLOOP
			BEGIN
			COPY (.RECORD_COUNT + 2);
			COPY (.RECORD_TYPE);
			END;
		TES;

	    END;

	!
	! Set new insert position
	!
	BEGIN

	LOCAL
	    BLOCK,
	    OFFSET;

	FILPOS (.LIB_FILBLK, BLOCK, OFFSET);
	LIBHDR [LIB_INSERT_BLOCK] = .BLOCK;
	LIBHDR [LIB_INSERT_OFFSET] = .OFFSET;
	HDR_CHANGED = TRUE;
	END;
	!
	! Write out header record
	!
	BEGIN

	LOCAL
	    LENGTH;

	POSFIL (.LIB_FILBLK, .INSERT_BLOCK, .INSERT_OFFSET);
	CH$WCHAR (HDR_SIZE, CH$PTR (LENGTH,, 18));
	PUTFIL (.LIB_FILBLK, CH$PTR (LENGTH,, 18), 1);
	PUTFIL (.LIB_FILBLK, CH$PTR (HDR,, 18), HDR_SIZE/2);
	END;
	!
	! Delete replaced module
	!

	IF .DELETE_BLOCK NEQ 0 THEN HDR_DELETE (.DELETE_BLOCK, .DELETE_OFFSET);

	IF NOT .FLAGS [M_FAST] THEN LIBUPD ();

	TYPLN (0,
	    (IF .DELETE_BLOCK EQL 0 THEN CH$ASCIZ ('[Module "%2R" inserted]') ELSE CH$ASCIZ (
		    '[Module "%2R" replaced]')), .MODULE_NAME [0], .MODULE_NAME [1]);
	END;

    !
    ! Finished with object file
    !
    OBJ_CLOSE ();
    TRUE
    END;					!OF FILE_INSERT
ROUTINE HDR_DELETE (BLOCK, OFFSET) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN
    POSFIL (.LIB_FILBLK, .BLOCK, .OFFSET + 2);
    GETFIL (.LIB_FILBLK, CH$PTR (HDR,, 18), HDR_SIZE/2);
    HDR [HDR_DELETED] = 1;
    POSFIL (.LIB_FILBLK, .BLOCK, .OFFSET + 2);
    PUTFIL (.LIB_FILBLK, CH$PTR (HDR,, 18), HDR_SIZE/2);
    !
    ! Add module size to deleted space
    !
    BEGIN

    LOCAL
	OLD;

    OLD = .LIBHDR [LIB_DELETED_2];
    LIBHDR [LIB_DELETED_2] = .LIBHDR [LIB_DELETED_2] + .HDR [HDR_SIZE_2];

    IF .LIBHDR [LIB_DELETED_2] LSS MIN (.OLD, .HDR [HDR_SIZE_2])
    THEN
	LIBHDR [LIB_DELETED_1] = .LIBHDR [LIB_DELETED_1] + 1;

    LIBHDR [LIB_DELETED_1] = .LIBHDR [LIB_DELETED_1] + .HDR [HDR_SIZE_1];
    END;
    HDR_CHANGED = TRUE;
    END;					!OF HDR_DELETE
GLOBAL ROUTINE LIBCLS : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN
    LIBMNT = 0;
    LIBEPT = 0;
    LIBHDR = 0;
    CLOSE (.LIB_FILBLK);
    END;					!OF LIBCLS
GLOBAL ROUTINE LIBUPD : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    IF .MNT_CHANGED
    THEN
	BEGIN

	INCR INDEX FROM 0 TO .LIBHDR [LIB_MNT_ALLOCATED] - .LIBHDR [LIB_MNT_AVAILABLE] - 1 DO
	    BEGIN
	    POSFIL (.LIB_FILBLK, .LIBHDR [LIB_MNT_BLOCK], .INDEX*.LIBHDR [LIB_MNT_SIZE]);
	    PUTFIL (.LIB_FILBLK, CH$PTR (LIBMNT [.INDEX, 0, 0, 0, 0],, 18), MNT_SIZE/2);
	    END;

	MNT_CHANGED = FALSE;
	END;

    IF .EPT_CHANGED
    THEN
	BEGIN

	INCR INDEX FROM 0 TO .LIBHDR [LIB_EPT_ALLOCATED] - .LIBHDR [LIB_EPT_AVAILABLE] - 1 DO
	    BEGIN
	    POSFIL (.LIB_FILBLK, .LIBHDR [LIB_EPT_BLOCK], .INDEX*.LIBHDR [LIB_EPT_SIZE]);
	    PUTFIL (.LIB_FILBLK, CH$PTR (LIBEPT [.INDEX, 0, 0, 0, 0],, 18), EPT_SIZE/2);
	    END;

	EPT_CHANGED = FALSE;
	END;

    IF .HDR_CHANGED
    THEN
	BEGIN
	POSFIL (.LIB_FILBLK, 1, 0);
	PUTFIL (.LIB_FILBLK, CH$PTR (.LIBHDR,, 18), LIB_SIZE/2);
	HDR_CHANGED = FALSE;
	END;

    END;					!OF LIBUPD
GLOBAL ROUTINE LIBOPN (FILBLK) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MACRO
	ABORT (text) =
	    RETURN
		BEGIN
		%IF %NULL (%REMAINING)
		%THEN
		    TYPLN (1, CH$ASCIZ (FATAL, text))
		%ELSE
		    TYPLN (1, CH$ASCIZ (FATAL, text), %REMAINING)
		%FI;
		CLOSE (.LIB_FILBLK);
		FALSE
		END %;

    LIB_FILBLK = .FILBLK;

    IF .FLAGS [M_CREATE] OR .FLAGS [M_COMPRESS]
    THEN
	BEGIN
	LIBHDR = HDRBUF;
	BEGIN
	LIBHDR [LIB_TYPE] = LIB_OBJECT;
	LIBHDR [LIB_IDENTIFICATION] = LIB_ID_2;
	LIBHDR [LIB_VERSION_1] = RAD50_WORD (%STRING (%CHAR (LBR_SUPPORT), CHAR2 (LBR_VERSION)));
	LIBHDR [LIB_VERSION_2] = RAD50_WORD (%STRING ('.', CHAR2 (LBR_EDIT)));
	BEGIN

	LOCAL
	    TIME_BLOCK : VECTOR [8];

	GETTIM (TIME_BLOCK);
	LIBHDR [LIB_YEAR] = .TIME_BLOCK [0];
	LIBHDR [LIB_MONTH] = .TIME_BLOCK [1];
	LIBHDR [LIB_DAY] = .TIME_BLOCK [2];
	LIBHDR [LIB_HOUR] = .TIME_BLOCK [3];
	LIBHDR [LIB_MINUTE] = .TIME_BLOCK [4];
	LIBHDR [LIB_SECOND] = .TIME_BLOCK [5];
	END;
	LIBHDR [LIB_EPT_SIZE] = EPT_SIZE;
	LIBHDR [LIB_EPT_BLOCK] = 2;
	LIBHDR [LIB_EPT_ALLOCATED] = .NUMEPT;
	LIBHDR [LIB_EPT_AVAILABLE] = .NUMEPT;
	LIBHDR [LIB_MNT_SIZE] = MNT_SIZE;
	LIBHDR [LIB_MNT_BLOCK] = .LIBHDR [LIB_EPT_BLOCK] + (EPT_SIZE*.NUMEPT + BLOCK_SIZE - 1)/BLOCK_SIZE;
	LIBHDR [LIB_MNT_ALLOCATED] = .NUMMNT;
	LIBHDR [LIB_MNT_AVAILABLE] = .NUMMNT;
	LIBHDR [LIB_DELETED_1] = 0;
	LIBHDR [LIB_DELETED_2] = 0;
	LIBHDR [LIB_INSERT_BLOCK] = .LIBHDR [LIB_MNT_BLOCK] + (MNT_SIZE*.NUMMNT + BLOCK_SIZE - 1)/BLOCK_SIZE;
	LIBHDR [LIB_INSERT_OFFSET] = 0;
	LIBHDR [LIB_CONTIGUOUS_1] = 0;
	LIBHDR [LIB_CONTIGUOUS_2] = 0;
	HDR_CHANGED = TRUE;
	END;

	IF .LIBHDR [LIB_EPT_ALLOCATED] LEQ EPTBUF_SIZE
	THEN
	    LIBEPT = EPTBUF
	ELSE
	    ABORT ('Insufficient buffer space for EPT table');

	EPT_CHANGED = FALSE;

	IF .LIBHDR [LIB_MNT_ALLOCATED] LEQ MNTBUF_SIZE
	THEN
	    LIBMNT = MNTBUF
	ELSE
	    ABORT ('Insufficient buffer space for MNT table');

	MNT_CHANGED = FALSE;

	IF NOT OPEN (.LIB_FILBLK, F_UPDATE, F_BINARY)
	THEN
	    ABORT ('Open failure on library file "%@"', FILNM,
		.LIB_FILBLK);

	END
    ELSE
	BEGIN

	IF NOT OPEN (.LIB_FILBLK, F_UPDATE, F_BINARY)
	THEN

	    IF OPEN (.LIB_FILBLK, F_READ, F_BINARY)
	    THEN
		TYPLN (1,
		    CH$ASCIZ (WARNING,
			'Library file "%@" open for input only%/'), FILNM, .LIB_FILBLK)
	    ELSE
		ABORT ('Open failure on library file "%@"', FILNM, .LIB_FILBLK);

	LIBHDR = HDRBUF;
	BEGIN
	POSFIL (.LIB_FILBLK, 1, 0);
	GETFIL (.LIB_FILBLK, CH$PTR (.LIBHDR,, 18), LIB_SIZE/2);
	HDR_CHANGED = FALSE;

	IF .LIBHDR [LIB_EPT_ALLOCATED] LEQ EPTBUF_SIZE
	THEN
	    BEGIN
	    LIBEPT = EPTBUF;

	    INCR INDEX FROM 0 TO .LIBHDR [LIB_EPT_ALLOCATED] - .LIBHDR [LIB_EPT_AVAILABLE] - 1 DO
		BEGIN
		POSFIL (.LIB_FILBLK, .LIBHDR [LIB_EPT_BLOCK], .INDEX*.LIBHDR [LIB_EPT_SIZE]);
		GETFIL (.LIB_FILBLK, CH$PTR (LIBEPT [.INDEX, 0, 0, 0, 0],, 18), EPT_SIZE/2);
		END;

	    EPT_CHANGED = FALSE;
	    END
	ELSE
	    ABORT ('Insufficient buffer space for EPT table');

	IF .LIBHDR [LIB_MNT_ALLOCATED] LEQ MNTBUF_SIZE
	THEN
	    BEGIN
	    LIBMNT = MNTBUF;

	    INCR INDEX FROM 0 TO .LIBHDR [LIB_MNT_ALLOCATED] - .LIBHDR [LIB_MNT_AVAILABLE] - 1 DO
		BEGIN
		POSFIL (.LIB_FILBLK, .LIBHDR [LIB_MNT_BLOCK], .INDEX*.LIBHDR [LIB_MNT_SIZE]);
		GETFIL (.LIB_FILBLK, CH$PTR (LIBMNT [.INDEX, 0, 0, 0, 0],, 18), MNT_SIZE/2);
		END;

	    MNT_CHANGED = FALSE;
	    END
	ELSE
	    ABORT ('Insufficient buffer space for MNT table');

	END;
	END;

    TRUE
    END;					!OF LIBOPN
ROUTINE MNT_INDEX (NAME) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	NAME : REF VECTOR [2];

    INCR INDEX FROM 0 TO .LIBHDR [LIB_MNT_ALLOCATED] - .LIBHDR [LIB_MNT_AVAILABLE] - 1 DO

	IF .LIBMNT [.INDEX, MNT_NAME_1] EQL .NAME [0] AND .LIBMNT [.INDEX, MNT_NAME_2] EQL .NAME [1]
	THEN
	    RETURN .INDEX;

    -1
    END;					!OF MNT_INDEX
ROUTINE MNT_INSERT (NAME, BLOCK, OFFSET) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	NAME : REF VECTOR [2];

    IF .LIBHDR [LIB_MNT_AVAILABLE] LEQ 0 THEN RETURN FALSE;

    DECR INDEX FROM .LIBHDR [LIB_MNT_ALLOCATED] - .LIBHDR [LIB_MNT_AVAILABLE] TO 0 DO
	BEGIN

	IF .INDEX GTR 0
	THEN

	    INCR SUB_INDEX FROM 0 TO MNT_LENGTH - 1 DO
		LIBMNT [.INDEX, .SUB_INDEX, 0, %BPVAL, 0] = .LIBMNT [.INDEX - 1, .SUB_INDEX, 0, %BPVAL, 0];

	IF (.INDEX EQL 0) OR (.LIBMNT [.INDEX, MNT_NAME_1] LSS .NAME [0]) OR (.LIBMNT [.INDEX, MNT_NAME_1] EQL
	    .NAME [0] AND .LIBMNT [.INDEX, MNT_NAME_2] LSS .NAME [1])
	THEN
	    EXITLOOP
		BEGIN
		LIBMNT [.INDEX, MNT_NAME_1] = .NAME [0];
		LIBMNT [.INDEX, MNT_NAME_2] = .NAME [1];
		LIBMNT [.INDEX, MNT_BLOCK] = .BLOCK;
		LIBMNT [.INDEX, MNT_OFFSET] = .OFFSET;
		END;

	END;

    LIBHDR [LIB_MNT_AVAILABLE] = .LIBHDR [LIB_MNT_AVAILABLE] - 1;
    HDR_CHANGED = MNT_CHANGED = TRUE
    END;					!OF MNT_INSERT
ROUTINE MNT_PURGE (BLOCK, OFFSET) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	NEW_COUNT;

    NEW_COUNT = 0;

    INCR INDEX FROM 0 TO .LIBHDR [LIB_MNT_ALLOCATED] - .LIBHDR [LIB_MNT_AVAILABLE] - 1 DO
	BEGIN

	IF .LIBMNT [.INDEX, MNT_BLOCK] NEQ .BLOCK OR .LIBMNT [.INDEX, MNT_OFFSET] NEQ .OFFSET
	THEN
	    BEGIN

	    IF .INDEX NEQ .NEW_COUNT
	    THEN

		INCR SUB_INDEX FROM 0 TO MNT_LENGTH - 1 DO
		    LIBMNT [.NEW_COUNT, .SUB_INDEX, 0, %BPVAL, 0] = .LIBMNT [.INDEX, .SUB_INDEX, 0, %BPVAL, 0]

	    ;
	    NEW_COUNT = .NEW_COUNT + 1;
	    END;

	END;

    IF .LIBHDR [LIB_MNT_AVAILABLE] NEQ (.LIBHDR [LIB_MNT_ALLOCATED] - .NEW_COUNT)
    THEN
	BEGIN
	LIBHDR [LIB_MNT_AVAILABLE] = .LIBHDR [LIB_MNT_ALLOCATED] - .NEW_COUNT;
	HDR_CHANGED = MNT_CHANGED = TRUE;
	END;

    END;					!OF MNT_PURGE
GLOBAL ROUTINE MODULE_DELETE (NAME) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	NAME : REF VECTOR [2];

    LOCAL
	ENTRY_FOUND;

    ENTRY_FOUND = FALSE;

    INCR INDEX FROM 0 TO .LIBHDR [LIB_MNT_ALLOCATED] - .LIBHDR [LIB_MNT_AVAILABLE] - 1 DO

	IF .ENTRY_FOUND
	THEN

	    INCR SUB_INDEX FROM 0 TO MNT_LENGTH - 1 DO
		LIBMNT [.INDEX - 1, .SUB_INDEX, 0, %BPVAL, 0] = .LIBMNT [.INDEX, .SUB_INDEX, 0, %BPVAL, 0]

	ELSE

	    IF .LIBMNT [.INDEX, MNT_NAME_1] EQL .NAME [0] AND .LIBMNT [.INDEX, MNT_NAME_2] EQL .NAME [1]
	    THEN
		BEGIN
		ENTRY_FOUND = TRUE;
		LIBHDR [LIB_MNT_AVAILABLE] = .LIBHDR [LIB_MNT_AVAILABLE] + 1;
		MNT_CHANGED = TRUE;
		EPT_PURGE (.LIBMNT [.INDEX, MNT_BLOCK], .LIBMNT [.INDEX, MNT_OFFSET]);
		HDR_DELETE (.LIBMNT [.INDEX, MNT_BLOCK], .LIBMNT [.INDEX, MNT_OFFSET]);
		END;

    IF .ENTRY_FOUND
    THEN
	BEGIN

	IF NOT .FLAGS [M_FAST] THEN LIBUPD ();

	TYPLN (0, CH$ASCIZ ('[Module "%2R" deleted]'), .NAME [0], .NAME [1]);
	TRUE
	END
    ELSE
	BEGIN
	PUTLN (1, CH$ASCIZ (FATAL, 'No module named "%2R"'), .NAME [0], .NAME [1]);
	FALSE
	END

    END;					!OF MODULE_DELETE

END

ELUDOM