Trailing-Edge
-
PDP-10 Archives
-
TOPS-20_V6.1_DECnetSrc_7-23-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