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

MODULE UNRESERVE	(
		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:
!
!	Remove a file reservation and delete the file from the working area.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 10-Nov-78
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	UNRESERVE,			!Basic UNRESERVE algorithm
	DELFIL;

!
! INCLUDE FILES:
!

%if %bliss(bliss32)

%then library 'sys$library:starlet';

%else require 'jsys:';

%fi

LIBRARY 'XPORT:';			!XPORT I/O macros

REQUIRE 'SCONFG:';			!CMS configuration options

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'LOGUSR:';

REQUIRE 'HOSUSR:';

REQUIRE 'RESV:';

REQUIRE 'SHRUSR:';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!
OWN
    S_GEN: VECTOR[CH$ALLOCATION(GEN_SIZE)] ;
!
! EXTERNAL REFERENCES:
!

external literal

	s_elunres,
	s_notyours,
	s_rfail;
external
	res_head;			!pointer to reservation text area

EXTERNAL ROUTINE
	badlib,
	BEGTRN,				!Mark start of transaction
	BUG,
	CHKRES,				!Check file reservation
	COMAND,
	DELRES,				!Delete old reservation file
	DELVRS,				!Delete multiple versions of a file
	DONLIB,				!Unlock library
	ENDTRN,				!Mark end of transaction
	ERS,				!Error message to user's error stream
	exits,				!exit silently
	GETACT,				!Get user account name
	GETELM,				!Process element list
	GET_LXM,
	LOGTRN,				! write entry to log file
	REMRES,				!Remove file reservation
	SAFLIB,				!Lock library
	sysmsg,
	TRNFIL;				!Set protection, etc. for file to be written

GLOBAL ROUTINE UNRESERVE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	The UNRESERVE algorithm is used to remove a reservation and delete the
!	previously reserved files from the working area.  This is generally
!	done when a reservation was done in error.
!
!	Deletion is done only if the user gives /DELETE.
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	K_SILENT_ERROR if the user made a mistake.
!
! SIDE EFFECTS:
!
!	The reservation is removed, and user files may be deleted.
!
!--

    BEGIN

    LOCAL
	CMD,
	GEN_MSG : VECTOR[CH$ALLOCATION(50)],
	GEN_PTR,
	KEEP,					!User files won't be deleted.
	LIST_PTR: REF BLOCK FIELD(RES_FLD),	!Cell to store reservation list pointer

	L_GEN,					! Length of gen string
	P_GEN,					! Pointer to gen string
	PAR: REF PARAMETER_BLOCK,
	QUAL: REF QUALIFIER_BLOCK,
	RESULT,				!Result of GETELM call
	SUB_CMD,
	USR_REM : REF DESC_BLOCK;

    !Parse the command line
    IF
	NOT COMAND(CMD,SUB_CMD,QUAL,PAR,USR_REM)
    THEN
	RETURN K_SILENT_ERROR;

    !Default is to keep the user's files.
    KEEP=TRUE;

    WHILE 
	.QUAL NEQ K_NULL
    DO
	BEGIN
	SELECTONE .QUAL[QUA_CODE] OF
	SET
	    [K_DELETE_QUAL]: KEEP=FALSE;
	    [K_NODELETE_QUAL] : KEEP = TRUE;
	TES;
	! move to next qual
	QUAL = .QUAL[QUA_A_NEXT] ;
	END;

    !Lock the library
    IF
	NOT SAFLIB(K_UPDATE_LIB)
    THEN
	RETURN K_SILENT_SEVERE ;

    !Make sure element is already reserved by caller
    IF
	CHKRES(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],LIST_PTR)
    THEN
	!Make sure reservation belongs to this user
	BEGIN

	LOCAL
	    U_NAME : VECTOR[CH$ALLOCATION(40)], !Save user's name here
	    U_NAM_LGT;			!Length of user's name

	!Pick up name of user who is running this routine
	U_NAM_LGT=GETACT(U_NAME);

	!See if user is among the reservers
	REPEAT
	    BEGIN

	    LOCAL
		RES_NAM : VECTOR[CH$ALLOCATION(40)],
		RES_N_LGT,
		RES_PTR,
		STG_LGT,
		STG_PTR;

	    IF
		.LIST_PTR[CUR_RES] AND
		NOT .LIST_PTR[REP_MKR]
	    THEN
		BEGIN

		!Length of this reservation line
		STG_LGT=.LIST_PTR[STG_SIZ];

		!String pointer to the line
		STG_PTR=ch$plus(.res_head,.LIST_PTR[STG_ADR]);

		!Advance over known element name
		STG_PTR=CH$PLUS(.STG_PTR,.PAR[PAR_TEXT_LEN]+2);
		STG_LGT=.STG_LGT-.PAR[PAR_TEXT_LEN]-2;

		!save the generation number 
		P_GEN=CH$PTR(S_GEN);
		L_GEN=GET_LXM(STG_PTR,%C' ',.STG_LGT,P_GEN);
		if
		    .l_gen gtr gen_size
		then
		    badlib(lit('Generation field too large in reservation file'));
		STG_LGT=.STG_LGT-.L_GEN;
		P_GEN=CH$PTR(S_GEN) ;

		!Pick up reserver's name
		RES_PTR=CH$PTR(RES_NAM);
		RES_N_LGT=GET_LXM(STG_PTR,%C' ',.STG_LGT,RES_PTR);

		!Compare the two names
		IF
		    CH$EQL(.U_NAM_LGT,CH$PTR(U_NAME),.RES_N_LGT,CH$PTR(RES_NAM))
		THEN
		    !We have the reservation, remove it and go away
		    BEGIN
		    LIST_PTR[REM_FLG]=TRUE;
		    EXITLOOP
		    END
		END;

	    !Advance to the next element in the list
	    LIST_PTR=.LIST_PTR[LINK_ADR];

	    !Have we reached the end of the list?
	    IF
		.LIST_PTR EQL 0
	    THEN
		!Someone else owns it
		BEGIN
		DONLIB();
		ERS(S_NOTYOURS, CAT('Element ',PAR[PAR_TEXT],
				' is not reserved by you'));
		RETURN K_SILENT_ERROR
		END
	    END
	END
    ELSE
	!The element is not reserved, therefore it cannot be replaced.
	BEGIN
	DONLIB();
	ERS(s_rfail, LIT('Cannot UNRESERVE an element that is not reserved'));
	RETURN K_SILENT_ERROR
	END;

    !Now the critical phase starts
    BEGTRN();

    !Mark the element unreserved
    REMRES(NOTREPL,0,0);

    ! log this transaction
    IF
	NOT LOGTRN(K_NORMAL_LOG,.L_GEN,.P_GEN)
    THEN
	BUG(CAT('Unable to write log file;  routine UNRES ',
		'of module UNRES')) ;

    !End of critical phase
    ENDTRN();

    !Delete the old reservation file
    DELRES();

    !Unlock the library
    DONLIB();

    !Process the element list
    IF
	NOT .KEEP
    THEN
	RESULT=GETELM(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],DELFIL)
    ELSE
	RESULT=G_OK;

    !Something other than success was found
    IF
	.RESULT EQL G_NO_ELM
    THEN
	BUG(CAT(('Element '),PAR[PAR_TEXT],(' does not exist')))
    ELSE
    IF
	.RESULT EQL G_ERMSG OR
	.RESULT EQL G_ERROR
    THEN
	!Disastrous error
	BUG(LIT('Error in element processing (UNRESERVE)'));

    !Tell user which element he discarded
    sysmsg(s_elunres,CAT(('Element '),PAR[PAR_TEXT],(' unreserved')),0);

    exits(s_elunres)

    END;				!End of UNRESERVE

ROUTINE DELFIL (FIL_NAM_LGT,FIL_NAM_STR) =

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

    BEGIN

    !Delete all versions of the file
    DELVRS(0,.FIL_NAM_LGT,.FIL_NAM_STR);

    G_OK

    END;				!End of DELFIL

END				!End of Module UNRESERVE
ELUDOM