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

MODULE REPLACE	(
		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:
!
!	Compare a master file with a variation file and generate an updated
!	master file showing all of the corrections or changes implied by the
!	variation.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 10-Nov-78
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	REPLACE,			!Basic REPLACE algorithm
	CHKOPN,
	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 'HOSUSR:';

REQUIRE 'LOGUSR:';

REQUIRE 'RESV:';

REQUIRE 'SHRUSR:';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

OWN
    	KEEP,				!/KEEP SPECIFIED
	HOLD,				!/RESERVE (UPDATE)
	RESRGEN : VECTOR[CH$ALLOCATION(GEN_SIZE)];

GLOBAL
	CHANGES,			!TRUE if changes seen in file replaced
	USE_NOTES,			!Process notes if true, don't if false
	RESRPTR,			!Pointer to reserved generation
	RESRSIZ,			!Size of reserved generation string
	USR_REM : REF DESC_BLOCK,
	VARIANT;			!Variant to be generated, 0 if none.

!
! EXTERNAL REFERENCES:
!

external literal
	s_errfile,			!file is missing or invalid
	s_gencreate,			!generation created
	s_gecreres,			!generation created and reserved
	s_nochanges,			!no changes
	s_noelem,			!no such element exists in directory
	s_nofile,			!file does not exist
	s_notyours;			!element not reserved by you

EXTERNAL
	GEN_BUF,
	GEN_LGT,
	res_head;			!pointer to reservation text area

EXTERNAL ROUTINE
	badlib,
	BEGTRN,				!Mark start of transaction
	BUG,				!bug in CMS
	CANTRN,				!Cancel transaction
	CHKRES,				!Check file reservation
	COMAND,
	DELRES,				!Delete old reservation file
	DELVRS,				!Delete multiple versions of file
	DONLIB,				!Unlock library
	ENDTRN,				!Mark end of transaction
	ERS,				!User error
	ERSXPO,				!Error with xport message
	exits,				!exit silently
	FILTYP,				!Check for correct record attributes
	GETACT,				!Get user account name
	GETELM,				!Process element list
	GET_LXM,
        get_stg_ct,
	LOGTRN,				! write log record(IOLOG)
	REMRES,				!Remove file reservation
	REPFIL,				!Do the actual replace
	REPREP,				!Report replacements
	REPRES,				!Report reservations
	sysmsg,
	SAFLIB,				!Lock library
        trnlog,				!translate a logical name
	UPDRES,				!Update reservation
	YES;

GLOBAL ROUTINE REPLACE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	The REPLACE algorithm is used to generate a new master file
!	using the information from the old master and the modified
!	working file.
!
!	Initialize the tables, get the command line, then call REPLACE proper.
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	CMD,
	F_UNUSUAL,			! set when unusual occurance
	LIST_PTR: REF BLOCK FIELD(RES_FLD),	!Cell used to store reservation list pointer
	LIST_SAV,
	PAR: REF PARAMETER_BLOCK,
	P_QUAL : REF QUALIFIER_BLOCK,
	QUAL : REF QUALIFIER_BLOCK,
	REP_PTR,
	REP_CNT,
	RES_CNT,
	RES_OK,
	RESULT,				!Result of GETELM call
	SUB_CMD;

    ! initialize flag
    F_UNUSUAL = FALSE ;
    CHANGES=FALSE;
    KEEP = FALSE ;
    HOLD = FALSE ;
    USE_NOTES=TRUE;

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

    !Initialize qualifiers
    VARIANT=0;

    !Check parameter qualifier /VARIANT
    P_QUAL=.PAR[PAR_A_QUAL];
    WHILE
	.P_QUAL NEQ K_NULL
    DO
	BEGIN
	SELECTONE .P_QUAL[QUA_CODE] OF
	    SET
	    [K_VARIANT_QUAL]: VARIANT=CH$RCHAR(.P_QUAL[QUA_VALUE_PTR]);

	    [K_NOVARIANT_QUAL]: VARIANT = 0;
	    TES;

	P_QUAL=.P_QUAL[QUA_A_NEXT];
	END;

    !Set up command qualifiers, if any
    WHILE
	.QUAL NEQ K_NULL
    DO
	BEGIN
	SELECTONE .QUAL[QUA_CODE] OF
	    SET

	    [K_RESERVE_QUAL]:
    		HOLD = TRUE ;

	    [K_KEEP_QUAL]:
    		KEEP = TRUE ;

	    [K_NORESERVE_QUAL]:
    		HOLD = FALSE;

	    [K_NOKEEP_QUAL]:
    		KEEP = FALSE;

	    TES;

	QUAL=.QUAL[QUA_A_NEXT]

	END;

    !Set count of number of reservations seen to start and
    !reservation OK to failure
    REP_CNT=0;
    RES_CNT=0;
    RES_OK=FALSE;

    !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
	    RES_NM : VECTOR[CH$ALLOCATION(gen_size)],
	    RES_LN,
	    RES_PT,
	    U_NAME : VECTOR[CH$ALLOCATION(40)], !Save user's name here
	    U_NAM_LGT;			!Length of user's name

	LIST_SAV=.LIST_PTR;

	!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;

		!Pick up generation reserved..
		RES_PT=CH$PTR(RES_NM);
		RES_LN=GET_LXM(STG_PTR,%C' ',.STG_LGT,RES_PT);
		if
		    .res_ln gtr gen_size
		then
		    badlib(lit('Generation field too large in reservation file'));
		STG_LGT=.STG_LGT-.RES_LN-1;
		RES_PT=CH$PTR(RES_NM);

		!Pick up reserver's name
		RES_PTR=CH$PTR(RES_NAM);
		RES_N_LGT=GET_LXM(STG_PTR,%C' ',.STG_LGT,RES_PTR);
		if
		    .res_n_lgt gtr 40
		then
		    badlib(lit('Username field in reservation file is too large.'));
		STG_LGT=.STG_LGT-.RES_N_LGT-1;

		RES_CNT=.RES_CNT+1;

		!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, remember it
		    BEGIN
		    RESRSIZ=.RES_LN;
		    RESRPTR=CH$PTR(RESRGEN);
		    CH$MOVE(.RESRSIZ,CH$PTR(RES_NM),.RESRPTR);
		    LIST_PTR[REM_FLG]=TRUE;
		    REP_PTR=.LIST_PTR;
		    RES_OK=TRUE;

		    !Find the qualifier field, if any
		    UNTIL
			.STG_LGT LEQ 0
		    DO
			BEGIN

			LOCAL
			    CHAR;

			CHAR=CH$RCHAR_A(STG_PTR);
			STG_LGT=.STG_LGT-1;

			!This assumes for now that /NONOTES is the last qualifier
			!on the line
			IF
			    .CHAR EQL %C'/' AND
			    CH$EQL(.STG_LGT,.STG_PTR,7,CH$PTR(UPLIT('NONOTES')))
			THEN
			    BEGIN
			    USE_NOTES=FALSE;
			    EXITLOOP
			    END
			END
		    END
		END;

	    !Keep track of nested replaces as well
	    IF
		.RES_OK AND
		.LIST_PTR[REP_MKR]
	    THEN
		REP_CNT=.REP_CNT+1;

	    !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 (also?)
		BEGIN

		IF
		    NOT .RES_OK
		THEN
		    BEGIN
		    ERS(s_notyours,CAT(('Element '),
			PAR[PAR_TEXT],(' is not reserved by you')));
		    DONLIB();
		    RETURN K_SILENT_ERROR
		    END
		ELSE
		    EXITLOOP
		END
	    END
	END
    ELSE
	!The element is not reserved, therefore it cannot be replaced.
	BEGIN
	!See if it doesn't exist
	IF
	    GETELM(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],0)
		EQL G_NO_ELM
	THEN
 	    BEGIN
 	    local
 		d_log_nam : $str_desc(),
 		d_log_trn : $str_desc(),
 		log_trn_buf : vector[ch$allocation(log_nam_value_size)];
 	    $str_desc_init(descriptor = d_log_nam,
 			   string=(len_comma_ptr(lib)));
 	    $str_desc_init(descriptor = d_log_trn,
 			   string=(log_nam_value_size,ch$ptr(log_trn_buf)));
 	    trnlog(d_log_nam,d_log_trn);
	    ERS(s_noelem,CAT(('Element '),PAR[PAR_TEXT],
		(' does not exist in the CMS library '),d_log_trn));
    	    END
	ELSE
	    ERS(s_notyours,CAT(('Element '),
		PAR[PAR_TEXT],(' is not reserved by you')));
	DONLIB();
	RETURN K_SILENT_ERROR
	END;

    !Check for multiple reservations
    IF
	.RES_CNT GTR 1 OR
	.REP_CNT GTR 0
    THEN
	BEGIN
	!Report reservations
	IF
	    .RES_CNT GTR 1
	THEN
	    REPRES(.LIST_SAV,.REP_PTR);

	!Report replacements
	IF
	    .REP_CNT GTR 0
	THEN
	    REPREP(.REP_PTR);

	!Ask him if he wishes to continue
	IF
	    NOT YES(LIT('Proceed'))
	THEN
	    BEGIN
	    DONLIB();
	    RETURN K_SILENT_ERROR;
	    END;

	! set flag for logging
	F_UNUSUAL = TRUE ;

	END;

    !Make sure the files for the element exist
    RESULT=GETELM(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],CHKOPN);

    IF
	.RESULT EQL G_NO_ELM
    THEN
	BEGIN
 	local
 	    d_log_nam : $str_desc(),
 	    d_log_trn : $str_desc(),
 	    log_trn_buf : vector[ch$allocation(log_nam_value_size)];
 	$str_desc_init(descriptor = d_log_nam,
 		       string=(len_comma_ptr(lib)));
 	$str_desc_init(descriptor = d_log_trn,
 		       string=(log_nam_value_size,ch$ptr(log_trn_buf)));
 	trnlog(d_log_nam,d_log_trn);
	ERS(s_noelem,CAT(('Element '),PAR[PAR_TEXT],(' does not exist in the CMS library '),d_log_trn));
	END
    ELSE
    IF
	.RESULT EQL G_ERMSG
    THEN
	BEGIN
	DONLIB();
	RETURN K_SILENT_ERROR
	END
    ELSE
    IF
	.RESULT NEQ G_OK
    THEN
	BUG(LIT('Error in element processing (REPLACE)'));

    !Start critical part of transaction
    BEGTRN();

    !Process the element list
    RESULT=GETELM(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],REPFIL);

    !Check for success
    IF
	.RESULT EQL G_OK
    THEN
	BEGIN
	!Mark element unreserved
	IF
	    .HOLD
	THEN
	    BEGIN
	    IF
		.USE_NOTES
	    THEN
		UPDRES(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],
		    CH$PTR(GEN_BUF),.GEN_LGT,.USR_REM[DESC_PTR],
		    .USR_REM[DESC_LEN],0,0)
	    ELSE
		UPDRES(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],
		    CH$PTR(GEN_BUF),.GEN_LGT,.USR_REM[DESC_PTR],
		    .USR_REM[DESC_LEN],CH$PTR(UPLIT('/NONOTES')),8)
	    END
	ELSE
	    REMRES(REPL,.USR_REM[DESC_PTR],.USR_REM[DESC_LEN])
	END
    ELSE
    !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
    THEN
	BEGIN
	CANTRN();
	DONLIB();
	RETURN K_SILENT_ERROR
	END
    ELSE
	!Disastrous error
	BUG(LIT('Error in element processing (REPLACE)'));

    ! log this transaction
    IF
	.F_UNUSUAL
    THEN
	BEGIN	! log it as unusual

	IF
	    NOT LOGTRN(K_UNUSUAL_LOG,.GEN_LGT,CH$PTR(GEN_BUF))
	THEN
	    BUG(CAT('Unable to write unusual log record. error occurred ',
		    'in routine REPLACE of module REPLAC.')) ;

	END	! log it as unusual
    ELSE
	BEGIN	! write normal log record

	IF
	    NOT LOGTRN(K_NORMAL_LOG,.GEN_LGT,CH$PTR(GEN_BUF))
	THEN
	    BUG(CAT('Unable to write log record. error occurred in ',
		    'routine REPLACE of module REPLAC.')) ;

	END ;	! write normal log record
    
    ENDTRN();

    !Remove old reservation file
    DELRES();

    !Now delete the old files from the work and/or library area
    GETELM(.PAR[PAR_TEXT_PTR],.PAR[PAR_TEXT_LEN],DELFIL);

    !We are done with the library
    DONLIB();

    !Tell user if no changes were recorded
    IF
	NOT .CHANGES
    THEN
	sysmsg(s_nochanges,LIT('No changes'),0);

    IF .HOLD
    THEN
	begin
        sysmsg(s_gecreres,CAT(('Element '),PAR[PAR_TEXT],(', Generation '),
        (.GEN_LGT,CH$PTR(GEN_BUF)),(' created and reserved')),0);
	exits(s_gecreres)
	end
    ELSE
	!Tell user which generation was created
	begin
	sysmsg(s_gencreate,
	    CAT(('Element '),PAR[PAR_TEXT],(', Generation '),
	    (.GEN_LGT,CH$PTR(GEN_BUF)),(' created')),0);
	exits(s_gencreate)
	end

    END;				!End of REPLACE

ROUTINE CHKOPN (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

    LOCAL
	$io_block_decl(OPN),
	STS;

    $IO_BLOCK_INIT(OPN);

    STS=$STEP_OPEN(IOB=OPN_IOB,FILE_SPEC=(.FIL_NAM_LGT,.FIL_NAM_STR),
		    FAILURE=0);

    IF
	NOT .STS
    THEN
	BEGIN
	!Check if file is protected from access
	IF
	    step$_no_access eql .STS
	THEN
	    ERSXPO(s_nofile,.STS,CAT(('File '),(.FIL_NAM_LGT,.FIL_NAM_STR),
	    	(' is protected from access')))

	!Check if file does not exist
	ELSE
	    ERSXPO(s_nofile,.STS,CAT(('File '),(.FIL_NAM_LGT,.FIL_NAM_STR),
	    (' does not exist')));
	RETURN G_ERMSG
	END;

    !Check for correct characteristics
    IF
	NOT FILTYP(OPN_IOB)
    THEN
	BEGIN
	$step_close(IOB=OPN_IOB);
	ERS(s_errfile,CAT(('File '),(.FIL_NAM_LGT,.FIL_NAM_STR),
	    (' has incorrect record format or attributes')));
	RETURN G_ERMSG
	END;

    $step_close(IOB=OPN_IOB);

    G_OK

    END;				!End of CHKOPN

ROUTINE DELFIL (FIL_NAM_LGT,FIL_NAM_STR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	FIL_NAM_LGT - length of file
!	FIL_NAM_STR - pointer to file
!
! IMPLICIT INPUTS:
!
!	HOLD - if true, do not delete user files
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	FIL : VECTOR[CH$ALLOCATION(EXTENDED_FILE_SPEC)],
	FIL_PTR,
	FIL_SIZ;

    !Delete old files from user area if HOLD is not specified
    IF
	NOT (.HOLD OR .KEEP)
    THEN
	DELVRS(0,.FIL_NAM_LGT,.FIL_NAM_STR);

    !Point to master file of same name in the library
    FIL_PTR=CH$PTR(FIL);
    FIL_PTR=CH$MOVE(%CHARCOUNT(LIB),CH$PTR(UPLIT(LIB)),.FIL_PTR);
    FIL_PTR=CH$MOVE(.FIL_NAM_LGT,.FIL_NAM_STR,.FIL_PTR);
    FIL_SIZ=CH$DIFF(.FIL_PTR,CH$PTR(FIL));

    !Delete all except most recent version(s) of file in library
    DELVRS(FILVRS,.FIL_SIZ,CH$PTR(FIL));

    G_OK

    END;				!End of DELFIL

END				!End of Module REPLACE
ELUDOM