PDP-10 Archive: cms/sources/seqctl.bli from DEC_CMS-20_V1.0

Trailing-Edge - PDP-10 Archives - DEC_CMS-20_V1.0_SRC - cms/sources/seqctl.bli

There are no other files named seqctl.bli in the archive.

MODULE SEQCTL	(
		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:
!
!	Sequenced file control routines
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 15-Jan-80
!
!--

!++
!			General Description
!
!	This module contains the routines which manage the internal
!	sequence number control sub-records.  These records are part
!	of each line of user text in the library element, and describe
!	what line numbers, if any, there are on each line of each file
!	for each generation of the element.
!
!			File Structures
!
!	The format of the sequence number sub-record is as follows:
!	tbs.
!
!			Data Structures
!
!	NYI
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	CMP_TEXT,			!Compare two packed lines
	GET_CGEN,			!Get sequence number matching current generation
	GET_MLINE;

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

LIBRARY 'XPORT:';

REQUIRE 'SCONFG:';

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

EXTERNAL
	INPUT_IOB : $XPO_IOB(),
	LIB_RD_FLG,			!Master file comes from library flag
	MASTER_IOB : $XPO_IOB(),
	MST_SEQ;

EXTERNAL ROUTINE
	ASCDEC,
	BADLIB,
	BUG,
	CMPGEN;				!Check for generations on same line of descent

GLOBAL ROUTINE CMP_TEXT (M_LEN,M_PTR,V_LEN,V_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Compare two lines of packed text.  If .MST_SEQ or .MASTER_IOB[IOB$V_SEQUENCED]
!	is set, the explicit sequence number in the master line
!	must be skipped over to find the text.  If .INPUT_IOB[IOB$V_SEQUENCED]
!	is set, the sequence number in the variation line must be skipped.
!
! FORMAL PARAMETERS:
!
!	M_LEN	- length of master line to be compared
!	M_PTR	- pointer to master line to be compared
!	V_LEN	- length of variation line to be compared
!	V_PTR	- pointer to variation line to be compared
!
! IMPLICIT INPUTS:
!
!	MST_SEQ
!	INPUT_IOB
!	MASTER_IOB
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	TRUE  - match
!	FALSE - no match
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	M1_LEN,
	M1_PTR,
	V1_LEN,
	V1_PTR;

    M1_LEN=.M_LEN;
    M1_PTR=.M_PTR;
    V1_LEN=.V_LEN;
    V1_PTR=.V_PTR;

    !Point to text in master
    IF
	.MST_SEQ OR
	.MASTER_IOB[IOB$V_SEQUENCED]
    THEN
	!Skip past the ";"
	BEGIN
	DO
	    M1_LEN=.M1_LEN-1
	UNTIL
	    CH$RCHAR_A(M1_PTR) EQL %C';'
	END
    ELSE
	!Skip over first character only if master comes from library
	BEGIN
	IF
	    .LIB_RD_FLG
	THEN
	    BEGIN
	    CH$RCHAR_A(M1_PTR);
	    M1_LEN=.M1_LEN-1
	    END
	END;

    !Point to text in variation
    IF
	.INPUT_IOB[IOB$V_SEQUENCED]
    THEN
	BEGIN
	DO
	    V1_LEN=.V1_LEN-1
	UNTIL
	    CH$RCHAR_A(V1_PTR) EQL %C';'
	END;

    !Compare the text proper
    CH$EQL(.M1_LEN,.M1_PTR,.V1_LEN,.V1_PTR)

    END;				!End of CMP_TEXT

GLOBAL ROUTINE GET_CGEN (LEN,PTR,G_LEN,G_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Get the sequence number that matches the current
!	generation being processed.
!
! FORMAL PARAMETERS:
!
!	LEN - length of line to be scanned
!	PTR - pointer to line to be scanned
!	G_LEN - length of generation requested
!	G_PTR - pointer to generation requested
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Sequence number is returned (0 if none.)
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	CHAR,
	L_LEN,
	L_PTR,
	T_PTR;

    L_LEN=.LEN;
    L_PTR=.PTR;

    REPEAT
	BEGIN

	!Remember starting position
	T_PTR=.L_PTR;

	!Get the length of the generation field
	REPEAT
	    BEGIN

	    CHAR=CH$RCHAR_A(L_PTR);

	    IF
		.CHAR EQL %C':' OR
		.CHAR EQL %C',' OR
		.CHAR EQL %C';'
	    THEN
		EXITLOOP

	    END;

	!A null generation field means no sequence number
	! and generation 1 (which is on ALL desired branches)
	IF
	    CH$DIFF(.L_PTR,.T_PTR) LEQ 1
	THEN
	    RETURN 0;

	!Is this generation on the desired branch?
	IF
	    CMPGEN(.T_PTR,CH$DIFF(.L_PTR,.T_PTR)-1,.G_PTR,.G_LEN)
	THEN
	    BEGIN

	    LOCAL
		T1_PTR;

	    !Check for no sequence number
	    IF
		.CHAR EQL %C',' OR
		.CHAR EQL %C';'
	    THEN
		RETURN 0;

	    !Pick up the sequence number
	    T1_PTR=.L_PTR;

	    REPEAT
		BEGIN
		CHAR=CH$RCHAR_A(L_PTR);

		IF
		    .CHAR EQL %C',' OR
		    .CHAR EQL %C';'
		THEN
		    EXITLOOP;

		IF
		    .CHAR GTR %C'9' OR
		    .CHAR LSS %C'0'
		THEN
		    BADLIB(LIT('Illegal sequence number.'));

		END;

	    !Convert ASCII sequence number to decimal and return
	    RETURN ASCDEC(T1_PTR,CH$DIFF(.L_PTR,.T1_PTR))
	    END;

	!Skip to the next separator
	REPEAT
	    BEGIN
	    CHAR=CH$RCHAR_A(L_PTR);

	    IF
		.CHAR EQL %C';'
	    THEN
		RETURN 0;

	    IF
		.CHAR EQL %C','
	    THEN
		EXITLOOP;

	    !Disallow any characters except alphas, numerics and ":"
	    !nyi

	    END

	END

    END;				!End of GET_CGEN

GLOBAL ROUTINE GET_MLINE (G_LEN,G_PTR,TXT_PTR,LEN_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Get a line of text and its related line number which is
!	appropriate for the generation being obtained.
!
! FORMAL PARAMETERS:
!
!	G_LEN - length of generation number being processed
!	G_PTR - pointer to generation number being processed
!	TXT_PTR - address of pointer to the working line of text
!	LEN_PTR - address of cell containing length of working line
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Value of line number found, -1 if none.
!
! SIDE EFFECTS:
!
!	The pointer and length passed are adjusted to skip over the control
!	field.
!
!--

    BEGIN

    LOCAL
	C_BUF : VECTOR[CH$ALLOCATION(GEN_SIZE)],
	C_PTR;

    !Is this a null field?
    IF
	CH$RCHAR(..TXT_PTR) EQL %C';'
    THEN
	BEGIN
	.TXT_PTR=CH$PLUS(..TXT_PTR,1);
	.LEN_PTR=..LEN_PTR-1;
	RETURN -1
	END;

    !Pick up the proper line number for the specified generation
    REPEAT
	BEGIN

	LOCAL
	    CHAR;

	!Pick up the generation number field
	C_PTR=CH$PTR(C_BUF);
	UNTIL
	    BEGIN
	    CHAR=CH$RCHAR(..TXT_PTR);
	    .CHAR EQL %C':' OR
	    .CHAR EQL %C',' OR
	    .CHAR EQL %C';'
	    END
	DO
	    BEGIN
	    CH$WCHAR_A(CH$RCHAR_A(.TXT_PTR),C_PTR);
	    .LEN_PTR=..LEN_PTR-1;

	    IF
		..LEN_PTR LEQ 0 or
		ch$diff(.c_ptr,ch$ptr(c_buf)) gtr gen_size
	    THEN
		BUG(LIT('Length error in generation number (GET_MLINE)'))

	    END;

	!See if this generation is acceptable
	IF
	    CMPGEN(CH$PTR(C_BUF),CH$DIFF(.C_PTR,CH$PTR(C_BUF)),.G_PTR,.G_LEN)
	THEN
	    !This is the correct one to use
	    BEGIN

	    LOCAL
		L_NUM : VECTOR[CH$ALLOCATION(MAX_NUM_SIZE)],
		L_PTR,
		L_SIZ,
		L_VAL;

	    L_PTR=CH$PTR(L_NUM);

	    !If it is a null field, this generation has no line number
	    IF
		.CHAR EQL %C';' OR
		.CHAR EQL %C','
	    THEN
		!Skip to ';' and return
		BEGIN
		DO
		    .LEN_PTR=..LEN_PTR-1
		UNTIL
		    CH$RCHAR_A(.TXT_PTR) EQL %C';';

		IF
		    ..LEN_PTR LSS 0
		THEN
		    BUG(LIT('Length error in generation number (GET_MLINE)'));

		RETURN -1

		END;

	    !Skip over the ":"
	    .TXT_PTR=CH$PLUS(..TXT_PTR,1);
	    .LEN_PTR=..LEN_PTR-1;

	    !Get the line number value
	    UNTIL
		BEGIN
		CHAR=CH$RCHAR(..TXT_PTR);
		NOT (.CHAR GEQ %C'0' AND
		     .CHAR LEQ %C'9')
		END
	    DO
		BEGIN
		CH$WCHAR_A(.CHAR,L_PTR);
		.TXT_PTR=CH$PLUS(..TXT_PTR,1);
		.LEN_PTR=..LEN_PTR-1
		END;

	    L_SIZ=CH$DIFF(L_PTR,CH$PTR(L_NUM));
	    L_PTR=CH$PTR(L_NUM);
	    L_VAL=ASCDEC(L_PTR,L_SIZ);

	    IF
		.L_VAL EQL -1
	    THEN
		BUG(LIT('Illegal value (GET_MLINE)'));

	    !Skip to the ';'
	    DO
		.LEN_PTR=..LEN_PTR-1
	    UNTIL
		CH$RCHAR_A(.TXT_PTR) EQL %C';';

	    IF
		..LEN_PTR LSS 0
	    THEN
		BUG(LIT('Length error in sequence field (GET_MLINE)'));

	    !Return the correct line number
	    RETURN .L_VAL

	    END
	ELSE
	    !Skip to the next separator
	    BEGIN

	    UNTIL
		BEGIN
		CHAR=CH$RCHAR(..TXT_PTR);
		.CHAR EQL %C',' OR
		.CHAR EQL %C';'
		END
	    DO
		BEGIN
		.TXT_PTR=CH$PLUS(..TXT_PTR,1);
		.LEN_PTR=..LEN_PTR-1;

		IF
		    ..LEN_PTR LEQ 0
		THEN
		    BUG(LIT('Length error in generation number (GET_MLINE)'))

		END;

	    .TXT_PTR=CH$PLUS(..TXT_PTR,1);
	    .LEN_PTR=..LEN_PTR-1;

	    IF
		.CHAR EQL %C';'
	    THEN
		RETURN -1

	    END
	END

    END;				!End of GET_MLINE

END				!End of Module SEQCTL
ELUDOM