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

MODULE CHKGEN	(
		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:
!
!	Check the generation value against the command line in the text.
!	Set the KEEP flag according to what is seen.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 01-May-79
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	CHKGEN : NOVALUE,		!Check generation value against text
	CMPGEN,				!Compare two generalized expressions
	G_NUM_LGT,			!Get length of numeric string
	GEN_SETUP : NOVALUE;		!Set up CHKGEN

!
! INCLUDE FILES:
!

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

LIBRARY 'XPORT:';

REQUIRE 'SCONFG:';			!CMS configuration options

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'HOSUSR:';

!
! MACROS:
!

FIELD
    INX_FLD =
	SET
	G_KEEP	= [0,0,%BPVAL/2,0],
	G_ONPATH= [0,%BPVAL/2,%BPVAL/2,0],
	G_PTR	= [1,0,%BPVAL,0],
	G_LEN	= [2,0,%BPVAL/2,0],
	G_INS	= [2,%BPVAL/2,%BPVAL/2,0]
	TES;

!
! EQUATED SYMBOLS:
!

LITERAL
	GEN_S_SIZE = 200,		!GET_CUR_MST stack size
	INDEX_SIZE = 3;			!Size of entry in stack

!
! OWN STORAGE:
!

GLOBAL
	LGEN,				!generation
	LGEN_L,				!generation length
	ONPATH;

OWN
	GEN,				!generation
	GEN_L,				!generation length
	GEN_INDEX,			!stack pointer
	GEN_PTR,
	GEN_STATUS: BLOCKVECTOR[GEN_S_SIZE,INDEX_SIZE] FIELD(INX_FLD), !stack
	GEN_STRING: VECTOR[CH$ALLOCATION(GEN_S_SIZE*gen_size)],
	INS_MKR;

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
	ASCDEC,
	BADLIB,
	BUG,
	GET_LXM;

GLOBAL ROUTINE CHKGEN (S_L_PTR,S_L_LGT,KEEP,GENERATION,G_LGT) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Keep track of any lines in the master file which have been
!	inserted or deleted by the respective generations.
!	Note that this routine keeps its own stack of information about
!	the input data, so don't try to process lines not in sequence, or
!	don't try to back up using it.
!
! FORMAL PARAMETERS:
!
!	S_L_PTR - Address of character pointer to line
!	S_L_LGT - Length of line
!	KEEP - Address of keep/discard flag
!	GENERATION - master generation pointer
!	G_LGT - length of master generation pointer
!
! IMPLICIT INPUTS:
!
!	Information is kept about the previous lineage commands which have
!	been encountered, this is used to keep overall track of the insertion
!	or deletion status.
!
! IMPLICIT OUTPUTS:
!
!	The stack is updated to reflect the current insertion or deletion status.
!	GEN - current generation of line scanned
!	KEEP - keep/discard line flag
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	CTL_CHAR,
	TMP_GEN,
	TMP_G_LGT;

    !Get the generation this record applies to
    TMP_GEN=.GEN_PTR;
    TMP_G_LGT=GET_LXM(.S_L_PTR,%C' ',.S_L_LGT,TMP_GEN)-1;

    !Back up over control character
    .S_L_PTR=CH$PLUS(..S_L_PTR,-1);

    !There must be a value here
    IF
	.TMP_G_LGT LEQ 0
    THEN
	BADLIB(LIT('Illegal control record.' ));

    !Pick up control character
    CTL_CHAR=CH$RCHAR_A(.S_L_PTR);

    !Check for end of correction entry which matches current generation
    IF
	.CTL_CHAR EQL %C'E' AND
	CH$EQL(.TMP_G_LGT,.GEN_PTR,.GEN_L,.GEN)
    THEN
	!End of change, pop previous level and continue
	BEGIN

	IF
	    .GEN_INDEX EQL -1
	THEN
	    !Something is badly wrong
	    BADLIB(LIT('Mismatched control records.'));

	!Pop generation and keep flag from stack
	.KEEP=.GEN_STATUS[.GEN_INDEX,G_KEEP];
	GEN=.GEN_STATUS[.GEN_INDEX,G_PTR];
	GEN_L=.GEN_STATUS[.GEN_INDEX,G_LEN];
	ONPATH=.GEN_STATUS[.GEN_INDEX,G_ONPATH];
	INS_MKR=.GEN_STATUS[.GEN_INDEX,G_INS];

	!Find the generation for listing which is on the correct
	!path and an insertion
	DECR I FROM .GEN_INDEX TO 0 DO
	    BEGIN
	    IF
		.GEN_STATUS[.I,G_KEEP] AND
		.GEN_STATUS[.I,G_ONPATH] AND
		.GEN_STATUS[.I,G_INS]
	    THEN
		BEGIN
		LGEN=.GEN_STATUS[.I,G_PTR];
		LGEN_L=.GEN_STATUS[.I,G_LEN];
		EXITLOOP
		END
	    END;

	GEN_PTR=CH$PLUS(.GEN,.GEN_L);
	GEN_INDEX=.GEN_INDEX-1;
	RETURN
	END
    ELSE
	!Examine the deletion and insertion control records
	!and set up the stack accordingly
	BEGIN
	IF
	    .CTL_CHAR EQL %C'D' OR
	    .CTL_CHAR EQL %C'I'
	THEN
	    !Deletion and insertion control records
	    BEGIN

	    !Push old control record on stack
	    GEN_INDEX=.GEN_INDEX+1;
	    if
		.gen_index geq gen_s_size
	    then
		bug(lit('Generation stack overflow in CHKGEN.'));
	    GEN_STATUS[.GEN_INDEX,G_KEEP]=..KEEP;
	    GEN_STATUS[.GEN_INDEX,G_PTR]=.GEN;
	    GEN_STATUS[.GEN_INDEX,G_LEN]=.GEN_L;
	    GEN_STATUS[.GEN_INDEX,G_ONPATH]=.ONPATH;
	    GEN_STATUS[.GEN_INDEX,G_INS]=.INS_MKR;

	    !Remember whether this is an insertion or deletion
	    IF
		.CTL_CHAR EQL %C'D'
	    THEN
		INS_MKR=FALSE
	    ELSE
		INS_MKR=TRUE;

	    !Assume reverse sense for generation counting
	    LGEN=.GEN;
	    LGEN_L=.GEN_L;

	    !Set up new control record
	    GEN=.GEN_PTR;
	    GEN_PTR=CH$PLUS(.GEN_PTR,.TMP_G_LGT);
	    if
		ch$diff(.gen_ptr,ch$plus(ch$ptr(gen_string),gen_s_size*gen_size))
			geq 0
	    then
		bug(lit('Generation string table overflow in CHKGEN.'));
	    GEN_L=.TMP_G_LGT;

	    !Keep only those lines that will show up in the final text
	    ONPATH=CMPGEN(.GEN,.GEN_L,.GENERATION,.G_LGT);

	    IF
		!On branch deletion
		.ONPATH AND .CTL_CHAR EQL %C'D' OR
		!Off branch insertion
		NOT .ONPATH AND .CTL_CHAR EQL %C'I' OR
		!Off branch anything nested in an on branch deletion
		NOT .ONPATH AND NOT .GEN_STATUS[.GEN_INDEX,G_KEEP] OR
		!On branch insertion nested in on branch deletion with
		! generation less than the deletion
		(.ONPATH AND
		 .CTL_CHAR EQL %C'I' AND
		 NOT .GEN_STATUS[.GEN_INDEX,G_KEEP] AND
		 NOT CMPGEN(.GEN_STATUS[.GEN_INDEX,G_PTR],.GEN_STATUS[.GEN_INDEX,G_LEN],.GEN,.GEN_L))
	    THEN
		BEGIN
		.KEEP=FALSE;
		!Normal generation sense
		IF
		    .CTL_CHAR NEQ %C'I'
		THEN
		    BEGIN
		    LGEN=.GEN;
		    LGEN_L=.GEN_L
		    END
		END
	    ELSE
		BEGIN
		.KEEP=TRUE;

		!See if generation is reversed in sense
		!(user asked for earlier generation than the latest)
		IF
		    .CTL_CHAR NEQ %C'D'
		THEN
		    !Normal sense, use current generation
		    BEGIN
		    LGEN=.GEN;
		    LGEN_L=.GEN_L
		    END
		ELSE
		    !Use the generation from a prior incarnation
		    !which is on the correct path
		    BEGIN
		    DECR I FROM .GEN_INDEX TO 0 DO
			BEGIN
			IF
			    .GEN_STATUS[.I,G_KEEP] AND
			    .GEN_STATUS[.I,G_ONPATH] AND
			    .GEN_STATUS[.I,G_INS]
			THEN
			    BEGIN
			    LGEN=.GEN_STATUS[.I,G_PTR];
			    LGEN_L=.GEN_STATUS[.I,G_LEN];
			    EXITLOOP
			    END
			END
		    END

		END;

	    RETURN
	    END
	ELSE
	    !Error
	    BEGIN
	    IF
		.CTL_CHAR EQL %C'E'
	    THEN
		BADLIB(LIT('Mismatched control records.'))
	    ELSE
		BADLIB(LIT('Unrecognized control character.' ))
	    END
	END

    END;				!End of CHKGEN

GLOBAL ROUTINE CMPGEN (G1,G1_L,G2,G2_L) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Compare two generalized expressions.  G1 is the generation from
!	the file or text, G2 is the generation requested by the caller.
!	Success is returned if G1 is on a direct path to G2.
!
! FORMAL PARAMETERS:
!
!	G1 - pointer to generation in text
!	G1_L - length of generation in text
!	G2 - pointer to generation requested
!	G2_L - length of generation requested
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	TRUE - Generation is on correct line of descent
!	FALSE - Generation is not on correct line of descent
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	G1_CHR,
	G1_LGT,
	G1_PTR,
	G1_TMP,
	G1_VAL,
	G2_CHR,
	G2_LGT,
	G2_PTR,
	G2_TMP,
	G2_VAL;

    !Setup
    G1_PTR=.G1;
    G1_LGT=.G1_L;
    G2_PTR=.G2;
    G2_LGT=.G2_L;

    !Process entire generation expression
    REPEAT
	BEGIN

	!Get length of integer parts
	G1_TMP=G_NUM_LGT(.G1_PTR,.G1_LGT);
	G2_TMP=G_NUM_LGT(.G2_PTR,.G2_LGT);

	!The lengths of both must be non-zero
	IF
	    .G1_TMP EQL 0 OR
	    .G2_TMP EQL 0
	THEN
	    BUG(LIT('Illegal generation expression in CHKGEN'));

	!Values
	G1_VAL=ASCDEC(G1_PTR,.G1_TMP);
	G1_LGT=.G1_LGT-.G1_TMP;
	G2_VAL=ASCDEC(G2_PTR,.G2_TMP);
	G2_LGT=.G2_LGT-.G2_TMP;

	IF
	    .G1_VAL EQL .G2_VAL
	THEN
	    !Integer parts match
	    BEGIN

	    !Pick up which branch for G1
	    IF
		.G1_LGT NEQ 0
	    THEN
		BEGIN
		G1_CHR=CH$RCHAR_A(G1_PTR);
		G1_LGT=.G1_LGT-1
		END
	    ELSE
		G1_CHR=0;

	    !Pick up which branch for G2
	    IF
		.G2_LGT NEQ 0
	    THEN
		BEGIN
		G2_CHR=CH$RCHAR_A(G2_PTR);
		G2_LGT=.G2_LGT-1
		END
	    ELSE
		G2_CHR=0;

	    !Quit successfully if we are at the end of the G1 branch
	    IF
		.G1_CHR EQL 0 AND
		.G2_CHR NEQ 0
	    THEN
		RETURN TRUE;

	    !No match if the branches are not the same
	    IF
		.G1_CHR NEQ .G2_CHR
	    THEN
		RETURN FALSE;

	    !Error if nothing follows branch marker
	    IF
		.G1_LGT EQL 0 AND
		.G2_LGT EQL 0 AND
		.G1_CHR NEQ 0 AND
		.G2_CHR NEQ 0
	    THEN
		!Error, illegal expression
		BUG(LIT('Illegal generation expression in CHKGEN'))

	    END
	ELSE
	    BEGIN

	    IF
		.G1_VAL GTR .G2_VAL
	    THEN
		!No match
		RETURN FALSE;

	    !Is this the end of G1?
	    IF
		.G1_LGT EQL 0
	    THEN
		RETURN TRUE;

	    !Can't possibly match
	    RETURN FALSE
	    END;

	IF
	    .G1_LGT EQL 0 AND
	    .G2_LGT EQL 0
	THEN
	    RETURN TRUE

	END

    END;				!End of CMPGEN

ROUTINE G_NUM_LGT (PTR,LGT) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Get the length of a decimal string
!
! FORMAL PARAMETERS:
!
!	PTR - pointer to string
!	LGT - length of string
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Size of integer string
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	C_PTR,
	CNT;

    CNT=0;
    C_PTR=.PTR;

    INCR I FROM 1 TO .LGT DO
	BEGIN

	LOCAL
	    CHAR;

	CHAR=CH$RCHAR_A(C_PTR);

	IF
	    .CHAR GEQ %C'0' AND
	    .CHAR LEQ %C'9'
	THEN
	    CNT=.CNT+1
	ELSE
	    EXITLOOP
	END;

    .CNT

    END;				!End of G_NUM_LGT

GLOBAL ROUTINE GEN_SETUP (KEEP) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	KEEP - keep/nokeep flag
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	GEN_INDEX, GEN_PTR, GEN, and GEN_L are initialized
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    GEN_INDEX=-1;

    GEN_PTR=CH$PTR(GEN_STRING);

    GEN=.GEN_PTR;

    GEN_L=0;

    ONPATH=TRUE;

    INS_MKR=TRUE;

    .KEEP=TRUE

    END;				!End of GEN_SETUP

END				!End of Module CHKGEN
ELUDOM