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

MODULE CHKRES	(
		IDENT = '1',
		%IF
		    %BLISS(BLISS32)
		%THEN
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				    NONEXTERNAL=LONG_RELATIVE)
		%ELSE
		    LANGUAGE(BLISS36)
		%FI
		) =
BEGIN

!
!			COPYRIGHT (c) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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:	CMS Library Processor
!
! ABSTRACT:
!
!	Element reservation control.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 29-Nov-78
!
!--

!++
!			General Description
!
!	CHKRES handles the manipulation of the reservation file.  No other
!	utility is allowed to modify the file.
!
!			File Structures
!
!	Each line in the file consists of 8 fields.  The first, in column one,
!	specifies whether the entry is a reservation or a replacement entry.
!	If it contains an "*" the line is a replacement field.  (The replacement
!	line will only exist if there are multiple reservations outstanding for
!	an element).  Field 2 contains the name of the element.  Field 3 holds
!	the generation reserved.  Field 4 has the user name of the reserver.
!	The 5th and 6th fields contain the date and time of the entry.
!	Field 7 holds the comment specified by the user, if any.  If non-existent,
!	it will be an empty quoted string.  The 8th field has any special qualifiers
!	that may need to be remembered.  Currently, only the "/NONOTES" qualifier
!	is possible.
!
!	Except for the first field, which is exactly one character long and
!	is in column one, all fields are variable length and terminated by
!	a single blank.
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	CHKRES,
	DELRES: NOVALUE,
	DMPRES: NOVALUE,
	MRKRES: NOVALUE,
	REMRES: NOVALUE,
	REPREP: NOVALUE,
	REPRES: NOVALUE,
	UPDRES: NOVALUE,
	WRT_STG: NOVALUE;

!
! INCLUDE FILES:
!

%if 
    %bliss(bliss32)
%then
    LIBRARY 'sys$library:starlet';
%else
    require 'jsys:';
%fi

LIBRARY 'XPORT:';

REQUIRE 'SCONFG:';

REQUIRE 'BLISSX:';

require 'condit:';

REQUIRE 'RESV:';

!
! MACROS:
!

MACRO
	STG(L,M) = WRT_STG(CH$PTR(UPLIT(L)),%CHARCOUNT(L),M) %;

!
! EQUATED SYMBOLS:
!

LITERAL
	LINE_SIZE=500,			!Reservation line max. length
	res_max=150,			!Maximum number of multiple reservations
					!of a single element
	txt_max=5000;			!Number of characters allocated
					! each time text storage is needed.

!
! OWN STORAGE:
!

global
	res_head;			!Pointer to reservation text table

OWN
	cur_tab_siz,			!current size of character storage
	END_MARK,
	MARK,				!Position where reservation line would be placed
	NEW_CRC,			!Total CRC for new reservation file
	$IO_BLOCK(RD),			!Input IOB
	RES_LST : REF BLOCKVECTOR[RES_MAX,ENT_SIZ] FIELD(RES_FLD), !List space
	STRING: VECTOR[CH$ALLOCATION(extended_file_spec)], !File name storage
	STRING_SIZ,			!File name size
	TXT_PTR,
	$IO_BLOCK(WRT);

!
! EXTERNAL REFERENCES:
!

external literal
	s_invcksum,			!reserv file has invalid checksum
	s_nocksum,			!reservation file has no checksum
	s_repby,
	s_resby;

EXTERNAL
	GEN_BUF,
	GEN_LGT;

EXTERNAL ROUTINE
	ASCHEX,				!CONVERT ASCII TO hex
	BADLIB,
	badxpo,
	BUG,
	CRCTABLE:NOVALUE,		!Set up polynomial table
	CRCCALC,			!Calculate CRC of a string
    	DEQUOT,				!Take quotes away from user remark
	DATTIM,				!Get date and time
	DELVRS,				! delete file(FILOPS)
    	ENQUOT,				!Surround user remark and appended string with quotes
	GETACT,				!Get user name
	GET_LXM,
	GET_STG_CT,			!Get string size
	HEXASZ,
	PUT_STG_CT,			!Put away string size
	SAY,
	SAYLP,
	sysmsg,
	TRNFIL;

GLOBAL ROUTINE CHKRES (ELM,SIZE,LIST) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Check for element reservation.
!
!	If one or more elements is reserved, return
!	a pointer to the list of reservation lines.  In any case,
!	position the reservation file to the proper place to allow
!	insertion or modification to the reservation status.  (This
!	is done using the MRKRES or REMRES routines).  Note that either
!	MRKRES or REMRES must always be called following a
!	CHKRES call.
!
! FORMAL PARAMETERS:
!
!	ELM - string pointer to element name to be found
!	SIZE - length of element name
!	LIST - cell address where list of reservations will be remembered
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	TRUE - reservations have been seen
!	FALSE - no reservations have been seen
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	CRC_COUNT,
	CHAIN_PTR,
	FILE_CRC,
	found_crc,
	LAST_LINE,
	status,
	TOTAL_CRC ;

    ! Initialize polynomial table
    crctable();
    TOTAL_CRC = 0;
    FILE_CRC = 0;
    found_crc = false;

    !Open reservation control file
    if
	(status=$STEP_OPEN(IOB=RD_IOB,FILE_SPEC=(%STRING(LIB,RES)),
		OPTIONS=INPUT,failure=0)) neq step$_normal
    then
	badxpo(.status,lit('Cannot open reservation file'));

    !Set up the reservation text buffer
    $XPO_GET_MEM(CHARACTERS=TXT_MAX,RESULT=res_head);
    cur_tab_siz=txt_max;

    !set up reservation list space also
    $xpo_get_mem(fullwords=res_max*ent_siz,result=res_lst);

    !Set up for text walk-through
    TXT_PTR=.res_head;
    CHAIN_PTR=0;
    MARK=-1;
    END_MARK=-1;

    !Search for the correct name
    UNTIL
	$step_get(IOB=RD_IOB) EQL STEP$_EOF
    DO
	BEGIN

	LOCAL
	    CTL_CHAR,
	    CRC_COUNT,
	    ELM_NAM : VECTOR[CH$ALLOCATION(EL_NAM_SIZE)],
	    ELM_PTR,
	    ELM_SIZ,
	    TMP_PTR;

	!Check for the last CRC line
	IF CH$EQL(4,CH$PTR(UPLIT('*/C:')),4,.RD_IOB[IOB$A_STRING])
	THEN
	    BEGIN
	    LOCAL
		LEN,
		PTR;
	    FOUND_CRC =TRUE;
	    LEN=.RD_IOB[IOB$H_STRING];
	    PTR=CH$PLUS(.RD_IOB[IOB$A_STRING],4);
	    FILE_CRC = ASCHEX(PTR,LEN);
	    exitloop ;
	    END;

	!See if there is room left for the new line
	IF
	    CH$DIFF(CH$PLUS(.res_head,.cur_tab_siz),CH$PLUS(.TXT_PTR,.RD_IOB[IOB$H_STRING]+1)) LEQ 0
	THEN
	    !get more room by reallocating the table
	    begin

	    local
		t_ptr;

	    !specify how much more to obtain
	    cur_tab_siz=.cur_tab_siz+txt_max;

	    !allocate new storage block
	    $xpo_get_mem(characters=.cur_tab_siz,result=t_ptr);

	    !move data from old to new table
	    txt_ptr=ch$move(ch$diff(.txt_ptr,.res_head),.res_head,.t_ptr);

	    !release old table
	    $xpo_free_mem(string=(.cur_tab_siz-txt_max,.res_head));

	    !point to new table
	    res_head=.t_ptr

	    end;

	!Place the line in the buffer
	LAST_LINE=.TXT_PTR;
	PUT_STG_CT(.RD_IOB[IOB$H_STRING],TXT_PTR);
	TMP_PTR=.TXT_PTR;
	TXT_PTR=CH$MOVE(.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING],.TXT_PTR);

	!Pick up the control character
	CTL_CHAR=CH$RCHAR_A(TMP_PTR);

	!Make sure it is at least plausible
	IF
	    .CTL_CHAR NEQ %C' ' AND
	    .CTL_CHAR NEQ %C'*'
	THEN
	    BADLIB(LIT('Illegal reservation file format. '));


	! Calculate the CRC of the line
	CRC_COUNT = CRCCALC(.RD_IOB[IOB$H_STRING],.RD_IOB[IOB$A_STRING]);
	TOTAL_CRC = .TOTAL_CRC + .CRC_COUNT ;

    	!Get the element name from the control line
    	ELM_PTR=CH$PTR(ELM_NAM);
    	ELM_SIZ=GET_LXM(TMP_PTR,%C' ',.RD_IOB[IOB$H_STRING],ELM_PTR);

    	IF
    	    CH$EQL(.SIZE,.ELM,.ELM_SIZ,CH$PTR(ELM_NAM))
    	THEN
	    !We have arrived at a point where we must either
	    !find a reservation or be in a position to insert a
	    !new one, or both
    	    BEGIN

	    !Make sure there is room to make the entry
	    IF
	        .CHAIN_PTR GEQ res_max
	    THEN
		bug(lit('Table overflow in CHKRES'));

	    !Remember start of reservations
	    IF
	        .MARK EQL -1
	    THEN
	        MARK=ch$diff(.LAST_LINE,.res_head);

	    !There is a reservation, construct a reservation
	    !chain entry containing this element
	    IF
	       .CHAIN_PTR EQL 0
	    THEN
	        .LIST=.RES_LST
	    ELSE
	        RES_LST[.CHAIN_PTR-1,LINK_ADR]=RES_LST[.CHAIN_PTR,LINK_ADR];

    	    !Enter line into reservation list
	    RES_LST[.CHAIN_PTR,STG_SIZ]=GET_STG_CT(LAST_LINE);
	    RES_LST[.CHAIN_PTR,STG_ADR]=ch$diff(.LAST_LINE,.res_head);
	    RES_LST[.CHAIN_PTR,LINK_ADR]=0;
	    RES_LST[.CHAIN_PTR,REP_MKR]=FALSE;
	    RES_LST[.CHAIN_PTR,CUR_RES]=TRUE;
	    RES_LST[.CHAIN_PTR,REM_FLG]=FALSE;

	    !See if the entry was a replace marker
	    IF
	       .CTL_CHAR EQL %C'*'
	    THEN
	         BEGIN

		 LOCAL
		    C_PTR,
		    CHAR_CT,
		    FLD_CT;

		!Set header to "replace"
		RES_LST[.CHAIN_PTR,REP_MKR]=TRUE;

		!Skip over first three fields to allow limited comparison
		CHAR_CT=0;
		FLD_CT=0;
		C_PTR=.LAST_LINE;

		UNTIL
		    .FLD_CT EQL 3
		DO 
		    BEGIN

		    LOCAL
		        CH;

		   CH=CH$RCHAR_A(C_PTR);
		   CHAR_CT=.CHAR_CT+1;

		   IF
		       .CH EQL %C' '
		   THEN
		       FLD_CT=.FLD_CT+1
		   END;

		!Look for matching reserve marker
		INCR I FROM 0 TO .CHAIN_PTR-1 DO
		    BEGIN

		    IF
			.RES_LST[.I,CUR_RES] AND
			NOT .RES_LST[.I,REP_MKR]
		    THEN
			!See if the reserve matches the replace
			BEGIN
			IF
			    CH$EQL(.CHAR_CT-1,
				CH$PLUS(.res_head,.RES_LST[.I,STG_ADR]+1),
				   .CHAR_CT-1,
				CH$PLUS(.res_head,.RES_LST[.CHAIN_PTR,STG_ADR]+1))
			THEN
			    BEGIN
			    !Set reserve entry as non-current and go away
			    RES_LST[.I,CUR_RES]=FALSE;
			    EXITLOOP
			    END
			END
		    END
		END;

	    !Advance to next entry in table
	    CHAIN_PTR=.CHAIN_PTR+1

	    END
	ELSE
	IF
	    CH$LSS(.SIZE,.ELM,.ELM_SIZ,CH$PTR(ELM_NAM)) AND
	    .END_MARK EQL -1
	THEN
	    !Save end of reservations
	    END_MARK=ch$diff(.LAST_LINE,.res_head)

	END;

    IF NOT .FOUND_CRC
    THEN
	SYSMSG(S_nocksum,CAT('No checksum found in reservation file'),0) 
    ELSE
	IF .FILE_CRC NEQ .TOTAL_CRC
   	THEN
	    sysmsg(s_invcksum,cat('Invalid checksum found in ',
			'reservation file'),0);

    !Close file and remember it for later deletion
    $step_close(IOB=RD_IOB,OPTIONS=REMEMBER);

    !Check for any reservations seen
    IF
	.CHAIN_PTR EQL 0
    THEN
	FALSE
    ELSE
	TRUE

    END;				!End of CHKRES

GLOBAL ROUTINE DELRES :NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Delete the obsolete reservation file
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	RD_IOB - IOB set up with file data
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	D_FIL_SPC: DESC_BLOCK ;

    $STR_DESC_INIT(DESCRIPTOR=D_FIL_SPC,STRING=(%STRING(LIB,RES))) ;
    DELVRS(FILVRS,.D_FIL_SPC[DESC_LEN],.D_FIL_SPC[DESC_PTR]) ;

    END;				!End of DELRES

ROUTINE DMPRES (STLOC,ENLOC) :NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Dump a specified section of the information stored in the
!	reservations table.
!
! FORMAL PARAMETERS:
!
!	STLOC - offset (from .res_head) to start of area to be dumped
!		(if -1 then the routine is a no-op)
!	ENLOC - offset (from .res_head) to end of area to be dumped
!		(if -1 then go to end of table)
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	TEXT;

    if
	.stloc eql -1
    then
	return;

    !Remember starting location
    TEXT=ch$plus(.res_head,.stloc);

    !Dump successive records until ENLOC is reached
    REPEAT
	BEGIN

	LOCAL
	    CHAR_COUNT;

	!Make sure some text is left over
	IF
	    CH$DIFF(.TEXT,.TXT_PTR) GEQ 0
	THEN
	    EXITLOOP;

	CHAR_COUNT=GET_STG_CT(TEXT);

	!Quit if the destination has been reached
	IF
	    .ENLOC NEQ -1 AND
	    CH$DIFF(.TEXT,ch$plus(.res_head,.enloc)) GEQ 0
	THEN
	    EXITLOOP;

	WRT_STG(.TEXT,.CHAR_COUNT,TRUE);

	TEXT=CH$PLUS(.TEXT,.CHAR_COUNT)

	END

    END;				!End of DMPRES

GLOBAL ROUTINE MRKRES (ELM,SIZE,GEN,GENSIZ,REM,REMSIZ,QUAL,QUALSIZ) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Mark the file reserved.
!
! FORMAL PARAMETERS:
!
!	ELM - String pointer to same element name used in CHKRES
!	SIZE - element name size
!	GEN - String pointer to generation to be reserved
!	GENSIZ - size of generation string
!	REM - String pointer to accompanying remark
!	REMSIZ - size of remark
!	QUAL - pointer to any qualifier string to be remembered
!	QUALSIZ - length of qualifier string, 0 if none.
!
! IMPLICIT INPUTS:
!
!	END_MARK - end of text including reservations
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	COUNT,
	LEN,
	NUM_BUF : VECTOR[CH$ALLOCATION(MAX_NUM_SIZE+5)],
	PTR,
	TXBUF: VECTOR[CH$ALLOCATION(40)],
	status;

    !Open output file
    if
	(status=$STEP_OPEN(IOB=WRT_IOB,FILE_SPEC=(%STRING(LIB,RES)),
		OPTIONS=OUTPUT,failure=0)) neq step$_created
    then
	badxpo(.status,lit('Cannot open new reservation file. '));

    !Set protection, etc.
    TRNFIL(WRT_IOB);

    DMPRES(0,.END_MARK);

    !Save file name
    STG(' ',FALSE);
    WRT_STG(.ELM,.SIZE,FALSE);
    STG(' ',FALSE);

    !Remember generation
    WRT_STG(.GEN,.GENSIZ,FALSE);
    STG(' ',FALSE);

    !Add user name
    COUNT=GETACT(TXBUF);
    WRT_STG(CH$PTR(TXBUF),.COUNT,FALSE);
    STG(' ',FALSE);

    !Add date and time
    COUNT=DATTIM(TXBUF);
    WRT_STG(CH$PTR(TXBUF),.COUNT,FALSE);
    STG(' ',FALSE);

    !Put in the remark
    WRT_STG(.REM,.REMSIZ,FALSE);

    !Output the qualifiers, if any
    IF
	.QUALSIZ NEQ 0
    THEN
	BEGIN
	STG(' ',FALSE);
	WRT_STG(.QUAL,.QUALSIZ,TRUE)
	END
    ELSE
	WRT_STG(0,0,TRUE);

    !Now output the remainder of the file
    DMPRES(.END_MARK,-1);

    !Write out the new CRC
    PTR = CH$MOVE(4,CH$PTR(UPLIT('*/C:')),CH$PTR(NUM_BUF));
    LEN = HEXASZ(.NEW_CRC, .PTR, 8) ;
    PTR = CH$PLUS(.PTR, .LEN);
    CH$WCHAR(%C' ',.PTR);
    LEN = .LEN +5 ;
    $step_PUT ( IOB = WRT_IOB, STRING = (.LEN, CH$PTR(NUM_BUF)),
		FAILURE = 0) ;

    !Close new reservation file
    $step_close(IOB=WRT_IOB);

    !relinquish the storage used
    $xpo_free_mem(binary_data=(res_max*ent_siz,.res_lst));
    $xpo_free_mem(string=(.cur_tab_siz,.res_head))

    END;				!End of MRKRES

GLOBAL ROUTINE REMRES (R_FLG,REM,REMSIZ) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Remove a file reservation.
!
! FORMAL PARAMETERS:
!
!	R_FLG - If "REPL", keep track of replaces
!		If "NOT REPL" do not keep track of replaces
!		(for instance, used in UNRESERVE)
!	REM - pointer to remark (used only for concurrent replacement)
!	REMSIZ - Size of remark
!
! IMPLICIT INPUTS:
!
!	END_MARK - end of text including reservations
!	MARK - end of text excluding reservations
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	ALL_GONE,
	LIN : VECTOR[CH$ALLOCATION(LINE_SIZE)],
	LIN_SIZ,
	LEN,
	NUM_BUF : VECTOR[CH$ALLOCATION(MAX_NUM_SIZE+5)],
	PTR,
	REC_PTR: REF BLOCK FIELD(RES_FLD),
	status;

    ALL_GONE=TRUE;
    REC_PTR=.RES_LST;


    !Open output file
    if
	(status=$STEP_OPEN(IOB=WRT_IOB,FILE_SPEC=(%STRING(LIB,RES)),
		OPTIONS=OUTPUT,failure=0)) neq step$_created
    then
	badxpo(.status,lit('Cannot open new reservation file'));

    !Set protection, etc.
    TRNFIL(WRT_IOB);

    DMPRES(0,.MARK);

    !See if any active records remain for this reservation
    UNTIL
	.REC_PTR EQL 0
    DO
	BEGIN
	!Examine this reservation for currency
	IF
	    .REC_PTR[CUR_RES] AND
	    NOT .REC_PTR[REM_FLG] AND
	    NOT .REC_PTR[REP_MKR]
	THEN
	    ALL_GONE=FALSE;

	REC_PTR=.REC_PTR[LINK_ADR]

	END;

    !Leave tracks if any current reservations still exist for this element
    IF
	NOT .ALL_GONE
    THEN
	BEGIN
	REC_PTR=.RES_LST;

	!Mark record deleted
	REPEAT
	    BEGIN

	    IF
		.REC_PTR[REM_FLG]
	    THEN
		BEGIN
		LIN_SIZ=.REC_PTR[STG_SIZ];
		CH$MOVE(.REC_PTR[STG_SIZ],ch$plus(.res_head,.REC_PTR[STG_ADR]),CH$PTR(LIN));
		CH$WCHAR(%C'*',CH$PTR(LIN))
		END;

	    IF
		NOT (.REC_PTR[REM_FLG] AND
		     .R_FLG NEQ REPL)
	    THEN
		WRT_STG(ch$plus(.res_head,.REC_PTR[STG_ADR]),.REC_PTR[STG_SIZ],TRUE);

	    IF
		.REC_PTR[LINK_ADR] EQL 0
	    THEN
		EXITLOOP;

	    REC_PTR=.REC_PTR[LINK_ADR]
	    END;

	!Now output the removed flag
	IF
	    .R_FLG EQL REPL
	THEN
	    BEGIN

	    LOCAL
		CHAR_CT,
		FLD_CT,
		LIN_PTR,
		TX_BUF : VECTOR[CH$ALLOCATION(40)],
		TX_LEN;

	    LIN_PTR=CH$PTR(LIN);
	    CHAR_CT=0;
	    FLD_CT=0;

	    !Pick up the first three fields
	    UNTIL
		.FLD_CT EQL 3
	    DO
		BEGIN
		LOCAL
		    CH;

		CH=CH$RCHAR_A(LIN_PTR);
		CHAR_CT=.CHAR_CT+1;

		IF
		    .CH EQL %C' '
		THEN
		    FLD_CT=.FLD_CT+1
		END;

	    !Output field
	    WRT_STG(CH$PTR(LIN),.CHAR_CT,FALSE);

	    !Output new generation
	    WRT_STG(CH$PTR(GEN_BUF),.GEN_LGT,FALSE);
	    STG(' ',FALSE);

	    !Put in current date and time
	    TX_LEN=DATTIM(TX_BUF);
	    WRT_STG(CH$PTR(TX_BUF),.TX_LEN,FALSE);
	    STG(' ',FALSE);

	    !Put in the remark, if any
	    WRT_STG(.REM,.REMSIZ,TRUE)

	    END

	END;

    DMPRES(.END_MARK,-1);

    !Write out new CRC    
    PTR = CH$MOVE(4,CH$PTR(UPLIT('*/C:')),CH$PTR(NUM_BUF));
    LEN = HEXASZ(.NEW_CRC, .PTR, 8) ;
    PTR = CH$PLUS(.PTR, .LEN);
    CH$WCHAR(%C' ',.PTR);
    LEN = .LEN +5 ;
    $step_PUT ( IOB = WRT_IOB, STRING = (.LEN, CH$PTR(NUM_BUF)),
		FAILURE = 0) ;

    !Close file
    $step_close(IOB=WRT_IOB);

    !relinquish the storage used
    $xpo_free_mem(binary_data=(res_max*ent_siz,.res_lst));
    $xpo_free_mem(string=(.cur_tab_siz,.res_head))

    END;				!End of REMRES

GLOBAL ROUTINE REPREP (LIST_ARG) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Report the information about the replacements.
!
! FORMAL PARAMETERS:
!
!	LIST_ARG - address of list of reservations
!		   starting with reservation for current element
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	LIST_PTR : REF BLOCK FIELD(RES_FLD),
	MSG_PRT;

    LIST_PTR=.LIST_ARG;
    MSG_PRT=FALSE;

    UNTIL
	.LIST_PTR EQL 0
    DO
	BEGIN

	IF
	    .LIST_PTR[REP_MKR]
	THEN
	    BEGIN

	    LOCAL
		NAME_B : VECTOR[CH$ALLOCATION(40)],
		NAME_LEN,
		NAME_PTR,
		STG_L,
		STG_P,
		TXT_B : VECTOR[CH$ALLOCATION(40)],
		TXT_LEN,
		TXT_PTR;

	    IF
		NOT .MSG_PRT
	    THEN
		BEGIN
		sysmsg(s_repby,LIT('Replaced by'),0);
		MSG_PRT=TRUE
		END;

	    STG_L=.LIST_PTR[STG_SIZ];
	    STG_P=ch$plus(.res_head,.LIST_PTR[STG_ADR]);

	    !skip over marker character
	    CH$RCHAR_A(STG_P);
	    STG_L=.STG_L-1;

	    !Skip the element name
	    TXT_PTR=CH$PTR(TXT_B);
	    TXT_LEN=GET_LXM(STG_P,%C' ',.STG_L,TXT_PTR);
	    STG_L=.STG_L-.TXT_LEN-1;

	    !Skip the generation reserved
	    TXT_PTR=CH$PTR(TXT_B);
	    TXT_LEN=GET_LXM(STG_P,%C' ',.STG_L,TXT_PTR);
	    STG_L=.STG_L-.TXT_LEN-1;
	    TXT_PTR=CH$PTR(TXT_B);

	    !And the user name
	    NAME_PTR=CH$PTR(NAME_B);
	    NAME_LEN=GET_LXM(STG_P,%C' ',.STG_L,NAME_PTR);
	    STG_L=.STG_L-.NAME_LEN-1;
	    NAME_PTR=CH$PTR(NAME_B);

	    !Get the generation replaced
	    TXT_PTR=CH$PTR(TXT_B);
	    TXT_LEN=GET_LXM(STG_P,%C' ',.STG_L,TXT_PTR);
	    STG_L=.STG_L-.TXT_LEN-1;
	    TXT_PTR=CH$PTR(TXT_B);

	    !Now output the revised message
	    SAY(CAT(('  '),(.NAME_LEN,.NAME_PTR),(' Generation '),(.TXT_LEN,.TXT_PTR),(' '),(.STG_L,.STG_P)))

	    END;

	LIST_PTR=.LIST_PTR[LINK_ADR]
	END

    END;				!End of REPREP

GLOBAL ROUTINE REPRES (LIST_ARG,MY_RES) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Report the information about the reservations.
!
! FORMAL PARAMETERS:
!
!	LIST_ARG - address of list of reservations
!	MY_RES - address of reservation line to be ignored
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	LIST_PTR : REF BLOCK FIELD(RES_FLD);

    LIST_PTR=.LIST_ARG;

    sysmsg(s_resby,LIT('Currently Reserved by'),0);

    UNTIL
	.LIST_PTR EQL 0
    DO
	BEGIN
	IF
	    .LIST_PTR NEQ .MY_RES AND
	    .LIST_PTR[CUR_RES] AND
	    NOT .LIST_PTR[REP_MKR]
	THEN
	    BEGIN

	    LOCAL
		NAME_B : VECTOR[CH$ALLOCATION(40)],
		NAME_LEN,
		NAME_PTR,
		STG_L,
		STG_P,
		TXT_B : VECTOR[CH$ALLOCATION(40)],
		TXT_LEN,
		TXT_PTR;

	    STG_L=.LIST_PTR[STG_SIZ];
	    STG_P=ch$plus(.res_head,.LIST_PTR[STG_ADR]);

	    !skip over marker character
	    CH$RCHAR_A(STG_P);
	    STG_L=.STG_L-1;

	    !Skip the element name
	    TXT_PTR=CH$PTR(TXT_B);
	    TXT_LEN=GET_LXM(STG_P,%C' ',.STG_L,TXT_PTR);
	    STG_L=.STG_L-.TXT_LEN-1;

	    !Get the generation reserved
	    TXT_PTR=CH$PTR(TXT_B);
	    TXT_LEN=GET_LXM(STG_P,%C' ',.STG_L,TXT_PTR);
	    STG_L=.STG_L-.TXT_LEN-1;
	    TXT_PTR=CH$PTR(TXT_B);

	    !And the user name
	    NAME_PTR=CH$PTR(NAME_B);
	    NAME_LEN=GET_LXM(STG_P,%C' ',.STG_L,NAME_PTR);
	    STG_L=.STG_L-.NAME_LEN-1;
	    NAME_PTR=CH$PTR(NAME_B);

	    !Now output the revised message
	    SAY(CAT(('  '),(.NAME_LEN,.NAME_PTR),(' Generation '),(.TXT_LEN,.TXT_PTR),(' '),(.STG_L,.STG_P)))

	    END;

	LIST_PTR=.LIST_PTR[LINK_ADR]
	END

    END;				!End of REPRES

GLOBAL ROUTINE UPDRES (ELM,SIZE,GEN,GENSIZ,REM,REMSIZ,QUAL,QUALSIZ) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Replace a file reservation.
!
! FORMAL PARAMETERS:
!
!	ELM - String pointer to same element name used in CHKRES
!	SIZE - element name size
!	GEN - String pointer to generation to be re-reserved
!	GENSIZ - size of generation string
!	REM - String pointer to accompanying remark
!	REMSIZ - size of remark
!	QUAL - pointer to any qualifier string to be remembered
!	QUALSIZ - length of qualifier string, 0 if none.
!
! IMPLICIT INPUTS:
!
!	END_MARK - end of text including reservations
!	MARK - end of text excluding reservations
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN
    
    OWN
    	D_NEW_STRING : DESC_BLOCK ,  		!Descriptor for appended string on remark
    	r_remark : ref desc_block ;

    LOCAL
    	ALL_GONE,
    	COUNT,
    	LIN : VECTOR[CH$ALLOCATION(LINE_SIZE)] ,
    	LIN_SIZ,
	LEN,
	NUM_BUF : VECTOR[CH$ALLOCATION(MAX_NUM_SIZE+5)],
	PTR,    
	REC_PTR: REF BLOCK FIELD(RES_FLD),
	status,
	TXBUF : VECTOR[CH$ALLOCATION(40)] ;

    REC_PTR=.RES_LST;
    ALL_GONE = TRUE ;

    !Open output file
    if
	(status=$STEP_OPEN(IOB=WRT_IOB,FILE_SPEC=(%STRING(LIB,RES)),
		OPTIONS=OUTPUT,failure=0)) neq step$_created
    then
	badxpo(.status,lit('Cannot open new reservation file (UPDRES)'));

    !Set protection, etc.
    TRNFIL(WRT_IOB);

    DMPRES(0,.MARK);

    !See if any active records remain for this reservation
    UNTIL 
    	.REC_PTR EQL 0
    DO
    	BEGIN
    	!Examine this record for currency
    	IF 
    	    .REC_PTR[CUR_RES] AND
    	    NOT .REC_PTR[REM_FLG] AND
    	    NOT .REC_PTR[REP_MKR]
    	THEN
    	    ALL_GONE = FALSE ;
    	
    	REC_PTR = .REC_PTR[LINK_ADR] ;
    	 
    	END ;

    !Leave tracks if any current reservations still exist for this element
    if
    	NOT .ALL_GONE
    THEN
    	BEGIN
    	REC_PTR = .RES_LST ;

	!Mark record deleted
	REPEAT
	    BEGIN

	    IF
		.REC_PTR[REM_FLG]
	    THEN
		BEGIN
		LIN_SIZ=.REC_PTR[STG_SIZ];
		CH$MOVE(.REC_PTR[STG_SIZ],ch$plus(.res_head,.REC_PTR[STG_ADR]),CH$PTR(LIN));
		CH$WCHAR(%C'*',CH$PTR(LIN))
		END;

            WRT_STG(ch$plus(.res_head,.REC_PTR[STG_ADR]),.REC_PTR[STG_SIZ],TRUE);

	    IF
		.REC_PTR[LINK_ADR] EQL 0
	    THEN
		EXITLOOP;

	    REC_PTR=.REC_PTR[LINK_ADR]
	    END;

	!Now output the removed flag

	    BEGIN

	    LOCAL
		CHAR_CT,
		FLD_CT,
		LIN_PTR,
		TX_BUF : VECTOR[CH$ALLOCATION(40)],
		TX_LEN;

	    LIN_PTR=CH$PTR(LIN);
	    CHAR_CT=0;
	    FLD_CT=0;

	    !Pick up the first three fields
	    UNTIL
		.FLD_CT EQL 3
	    DO
		BEGIN
		LOCAL
		    CH;

		CH=CH$RCHAR_A(LIN_PTR);
		CHAR_CT=.CHAR_CT+1;

		IF
		    .CH EQL %C' '
		THEN
		    FLD_CT=.FLD_CT+1
		END;

	    !Output field
	    WRT_STG(CH$PTR(LIN),.CHAR_CT,FALSE);

	    !Output new generation
	    WRT_STG(CH$PTR(GEN_BUF),.GEN_LGT,FALSE);
	    STG(' ',FALSE);

	    !Put in current date and time
	    TX_LEN=DATTIM(TX_BUF);
	    WRT_STG(CH$PTR(TX_BUF),.TX_LEN,TRUE)

	    END ;

    END ;

    !Save file name
    STG(' ',FALSE);
    WRT_STG(.ELM,.SIZE,FALSE);
    STG(' ',FALSE);

    !Remember generation
    WRT_STG(.GEN,.GENSIZ,FALSE);
    STG(' ',FALSE);

    !Add user name
    COUNT=GETACT(TXBUF);
    WRT_STG(CH$PTR(TXBUF),.COUNT,FALSE);
    STG(' ',FALSE);

    !Add date and time
    COUNT=DATTIM(TXBUF);
    WRT_STG(CH$PTR(TXBUF),.COUNT,FALSE);
    STG(' ',FALSE);

    !Put in the user remark with 'Changes after:' tacked on the front

    $STR_DESC_INIT (DESCRIPTOR = D_NEW_STRING,
    		    STRING = (.REMSIZ,.REM) ) ;

    DEQUOT (D_NEW_STRING) ;

    R_REMARK = ENQUOT(CAT('Changes after: ',D_NEW_STRING )) ;

    WRT_STG (.R_REMARK[DESC_PTR],.R_REMARK[DESC_LEN],FALSE ) ;

    !Output the qualifiers, if any
    IF
	.QUALSIZ NEQ 0
    THEN
	BEGIN
	STG(' ',FALSE);
	WRT_STG(.QUAL,.QUALSIZ,TRUE)
	END
    ELSE
	WRT_STG(0,0,TRUE);

    DMPRES(.END_MARK,-1);

    !Write out new CRC    
    PTR = CH$MOVE(4,CH$PTR(UPLIT('*/C:')),CH$PTR(NUM_BUF));
    LEN = HEXASZ(.NEW_CRC, .PTR, 8) ;
    PTR = CH$PLUS(.PTR, .LEN);
    CH$WCHAR(%C' ',.PTR);
    LEN = .LEN +5 ;
    $step_PUT ( IOB = WRT_IOB, STRING = (.LEN, CH$PTR(NUM_BUF)),
		FAILURE = 0) ;

    !Close file
    $step_close(IOB=WRT_IOB);

    !relinquish the storage used
    $xpo_free_mem(binary_data=(res_max*ent_siz,.res_lst));
    $xpo_free_mem(string=(.cur_tab_siz,.res_head))

    END;				!End of UPDRES

GLOBAL ROUTINE WRT_STG (PTR,LGT,TERM) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Put a string into the output buffer and output it if desired.
!
! FORMAL PARAMETERS:
!
!	PTR - Pointer to string
!	LGT - length of string
!	TERM - if true, output the complete line
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Length of line output
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    LOCAL
	CNT;

    OWN
	INIT : INITIAL(FALSE),
	LINE_BUF,
	LINEPTR;

    IF
	NOT .INIT
    THEN
	BEGIN
	$xpo_GET_MEM(CHARACTERS=LINE_SIZE,RESULT=LINE_BUF);
	LINEPTR=.LINE_BUF;
	INIT=TRUE
	END;

    CNT=0;

    !Move text into buffer if there is any
    IF
	.PTR NEQ 0 AND
	.LGT GTR 0
    THEN
	BEGIN

	!See if room exists
	IF
	    CH$DIFF(.LINEPTR,.LINE_BUF)+.LGT GTR LINE_SIZE
	THEN
	    BUG(LIT('Text buffer overflow in WRT_STG (CHKRES)'));

	LINEPTR=CH$MOVE(.LGT,.PTR,.LINEPTR)

	END;

    !See if line is to be terminated and output
    IF
	.TERM
    THEN
	BEGIN
	LOCAL
	    CRC;

	!See how many characters there are
	CNT=CH$DIFF(.LINEPTR,.LINE_BUF);

 	!Calculate the CRC of this line
	CRC = 0;
	CRC = CRCCALC(.CNT, .LINE_BUF);
	NEW_CRC = .NEW_CRC + .CRC ;
	!Output the entire line
	$step_put(IOB=WRT_IOB,STRING=(.CNT,.LINE_BUF));

	!Now reset the buffer pointer
	LINEPTR=.LINE_BUF

	END

    END;				!End of WRT_STG

END				!End of Module CHKRES
ELUDOM