Google
 

Trailing-Edge - PDP-10 Archives - BB-H138E-BM - 6-1-sources/prrange.bli
There are 10 other files named prrange.bli in the archive. Click here to see a list.
 %TITLE 'PRRANGE - Parse a range'
MODULE PRRANGE (
		IDENT = '3-003'		! File: PRRANGE.B36 Edit:CJG3003
		) =
BEGIN
!
!			  COPYRIGHT (c) 1983, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		ALL RIGHTS RESERVED.
!
! 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:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Parse a range
!
! ENVIRONMENT:	Runs on TOPS-20 only
!
! AUTHOR: Chris Gill, CREATION DATE: March 15, 1983
!
! MODIFIED BY:
!
! 3-001 - Creation. CJG 15-Mar-1983
! 3-002 - Fix "TYPE -1" so that it defaults to "TYPE .-1". CJG 9-Dec-1983
! 3-003 - Check for control-C being typed. CJG 5-Jan-1984
!--


%SBTTL 'DECLARATIONS'

!
! TABLE OF CONTENTS
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    PA_ENDRAN : NOVALUE,		! Complete a compound range
    EDT$$PA_RANGE;			! Parse a range specifier

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'EDTSRC:PARLITS';

REQUIRE 'SYS:JSYS';

!
! EXTERNAL REFERENCES:
!
!	In the routines
!
! MACROS:
!

MACRO
    BITS (VAL) [] =
	+(1 ^ (VAL - 1))
	BITS (%REMAINING) %;

!
! OWN DATA
!
! This table dictates which atoms are allowed to follow which other atoms.
! The table is indexed by the number of the atom just processed and
! consists of bits indicating which atom is legal next.
!
    OWN
	RAN_NEXT_TBL : VECTOR [NUM_RAN+1] INITIAL (

	    BITS (RAN_NUMBER, RAN_DOT, RAN_STR, RAN_BEGIN, RAN_END, RAN_ORIG,
			RAN_PLUS, RAN_MINUS, RAN_LAST, RAN_BUFFER, RAN_REST,
			RAN_BEFORE, RAN_SELECT, RAN_WHOLE, RAN_ALL),	! Start
	    BITS (RAN_DOT, RAN_PLUS, RAN_MINUS),			! Number
	    BITS (RAN_PLUS, RAN_MINUS),					! "."
	    BITS (RAN_PLUS, RAN_MINUS),					! String
	    BITS (RAN_PLUS, RAN_MINUS),					! BEGIN
	    BITS (RAN_PLUS, RAN_MINUS),					! END
	    BITS (RAN_PLUS, RAN_MINUS, RAN_NUMBER),			! ORIGINAL
	    0,
	    0,								! LAST
	    BITS (RAN_ALL),						! BEFORE
	    BITS (RAN_ALL),						! REST
	    BITS (RAN_ALL),						! WHOLE
	    0,								! SELECT
	    BITS (RAN_NUMBER, RAN_STR, RAN_BEGIN, RAN_END,
			RAN_LAST, RAN_BEFORE, RAN_REST,
			RAN_WHOLE, RAN_PLUS, RAN_DOT,
			RAN_MINUS, RAN_SELECT, RAN_ALL, RAN_ORIG),	! BUFFER
	    BITS (RAN_NUMBER),						! "+"
	    BITS (RAN_NUMBER, RAN_STR),					! "-"
	    BITS (RAN_NUMBER),						! FOR
	    BITS (RAN_NUMBER, RAN_DOT, RAN_STR, RAN_BEGIN, RAN_END,
			RAN_PLUS, RAN_MINUS, RAN_ORIG),			! THRU
	    0,
	    BITS (RAN_STR),						! ALL
	    BITS (RAN_NUMBER, RAN_DOT, RAN_STR, RAN_BEGIN, RAN_END,
			RAN_PLUS, RAN_MINUS, RAN_ORIG)			! AND
	    ),

!+
! RAN_SLR_NEXT has flags which are used when a single line range has
! been completed.
!-

	RAN_SLR_NEXT : VECTOR [4] INITIAL (
	    BITS (RAN_THRU, RAN_FOR, RAN_AND, RAN_ALL),			! Initial
	    BITS (RAN_ALL),						! THRU
	    BITS (RAN_ALL),						! FOR
	    BITS (RAN_AND, RAN_ALL)					! AND
	    );

%SBTTL 'EDT$$PA_RANGE - Parse a range node'

GLOBAL ROUTINE EDT$$PA_RANGE (			! Parse a range
		LOCATION ) =			! Where to put result pointer

BEGIN

!+
! FUNCTIONAL DESCRIPTION
!
! This subroutine is called to parse a range. Ranges may consist of
! two parts - a single line range, and a range type (such as AND, FOR, and
! THRU). A buffer name may, optionally, be present. Thus, the overall
! format of a range is,
!
!		  { LAST   }
!		  { SELECT }
!		  {
!		  { BEFORE			 }
! [ BUFFER name ] { REST			 }
!		  { WHOLE			 } [ ALL string ]
!		  {	 { THRU SLR	      }  }
!		  { SLR  { AND SLR [AND ... ] }  }
!		  {      { FOR number         }  }
!
! Where, SLR refers to a single line range.
!
! Single line ranges can have the following format,
!
! { line-number }
! { .           }  { + number     }  { + ... }
! { BEGIN       }  {		  }  {       }
! { END         }  { - { number } }  { - ... }
! { string      }  {   { string } }  {       }
! { -blank-     }
!
! The type of range being parsed is held in FLAGS2 and the type of atom
! just parsed is held in PRVCMD. These are used to index the tables
! RAN_NEXT_TBL, and RAN_SLR_NEXT which indicate which atom is allowed next.
! This routine operates in a loop until an error is detected or an atom does
! not parse.
!
! ROUTINE VALUE
!
!	-1 - JSYS error or next atom is disallowed
!	0  - Reparse required
!	+1 - All correct
!-

    EXTERNAL
	PA_BUFRNG : REF NODE_BLOCK,
	PA_ANDLSTHD : REF NODE_BLOCK,
	PA_CURCMD : REF NODE_BLOCK,		! Parse node
	PA_THRURNG : REF NODE_BLOCK,
	PA_CURRNG : REF NODE_BLOCK,
	PA_NUMVAL,
	PA_ERRNO,				! Error number
	PA_CURTOK,				! Pointer to current atom
	PA_CURTOKLEN,				! And its length
	CSB : VECTOR [10],
	FD_RC1,
	FD_RC2,
	FD_RC3,
	FD_RCM,
	FD_RS1,
	FD_RS2,
	FD_RS3,
	FD_RS4,
	FD_RS5,
	FD_R81,
	FD_R82,
	FD_RNM,
	FD_RNP,
	FD_RNA,
	FD_RSR,
	FD_RNS,
	FD_RNN,
	FD_RNG,
	FD_RNK,
	FD_RN8,
	FD_RN7,
	FD_RN6,
	FD_RN5,
	FD_RN4,
	FD_RN3,
	FD_RN2,
	FD_RN1,
	FD_AND,
	FD_ANC,
	FD_VAL,
	FD_QST,
	MAX_LINES,
	LNO0 : LNOVECTOR [14],
	CC;					! Control-C flag

    EXTERNAL ROUTINE
	EDT$$CMP_LNO,				! Compare line numbers
	EDT$$PA_SCANTOK,			! Get atom length
	EDT$$PA_BUFFER,				! Get buffer name
	EDT$$PA_LINE_NUM,			! Parse aline number
	EDT$$PA_NUMBER,				! Get a number
	EDT$$PA_NEW_NOD,			! Create a new node
	EDT$$PA_CRERNGNOD;			! Create a new range node

    LOCAL
	C_FLAG,					! COMND flags
	C_DATA,					! COMND data or pointer
	C_FDB,					! FDB used in parse
	CMDTYP,					! Type of current range atom
	PRVCMD,					! Save previous node type
	FLAGS2,					! Extra flags compound ranges
	FD_PTR,					! Pointer to current FDB
	MORE,					! Set TRUE if more to parse
	THRU_SEEN,				! Set TRUE if THRU keyword seen
	FOR_SEEN,				! Set TRUE if FOR keyword seen
	AND_SEEN,				! Set TRUE if AND keyword seen
	FLAG;					! Flags for next node allowed


    MESSAGES ((QUOSTRREQ, NUMVALREQ, ERRRANSPC, NUMVALILL));


!+
! Preset the flags and (previous) command, and parse the first atom
!

    CMDTYP = 0;
    FLAG = .RAN_NEXT_TBL [0];
    FLAGS2 = 0;
    FD_PTR = FD_RNG;
    THRU_SEEN = 0;
    AND_SEEN = 0;
    FOR_SEEN = 0;
    MORE = 1;

!+
! Loop parsing range spec until error or end of specification
!-

    WHILE .MORE DO
    BEGIN
	IF (NOT COMMAND (.FD_PTR)) THEN RETURN (-1);
	IF (.CC NEQ 0) THEN RETURN (-1);

!+
! Exit loop if no parse
!-

	IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN EXITLOOP;

!+
! The atom parsed OK and it is time to do the appropriate thing with it.
!-

	IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
	IF (.C_FDB<0,18> EQL FD_RNG) THEN
	    BEGIN

!+
! If a '%' was found the rescan for the keyword
!-

	    IF (NOT COMMAND (FD_RNK)) THEN RETURN (-1);
	    IF (.CC NEQ 0) THEN RETURN (-1);
	    IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
	    IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
	    END;

	PRVCMD = .CMDTYP;
	CMDTYP = (SELECTONE .C_FDB<0,18> OF
		SET
		[ FD_RNK, FD_RNA, FD_RCM, FD_RN8, FD_RSR, FD_AND ]  : .(.C_DATA)<0,18>;
		[ FD_RNN, FD_VAL, FD_RS5 ]  : RAN_NUMBER;
		[ FD_RNS, FD_QST, FD_RS4 ]  : RAN_STR;
		[ FD_RN4, FD_RNP, FD_R81, FD_RS1 ]  : RAN_PLUS;
		[ FD_RN5, FD_RNM, FD_R82, FD_RS2 ]  : RAN_MINUS;
		[ FD_RN6, FD_RS3 ]  : RAN_DOT;
		[ FD_RN1, FD_RC3 ]  : RAN_FOR;
		[ FD_RN2, FD_RC1 ]  : RAN_THRU;
		[ FD_RN3, FD_RC2, FD_ANC ]  : RAN_AND;
		[ FD_RN7 ]  : RAN_BUFFER;
		TES);

!+
! If this atom was not allowed - return an error
!-

	IF ((.FLAG AND 1 ^ (.CMDTYP - 1)) EQL 0) THEN
	    BEGIN
	    IF ((.RAN_SLR_NEXT [.FLAGS2 <0,18>] AND 1 ^ (.CMDTYP - 1)) EQL 0) THEN
		BEGIN
		PA_ERRNO = EDT$_ERRRANSPC;
		RETURN (-1);
		END;
	    PA_ENDRAN (.FLAGS2);
	    END;
	FLAG = .RAN_NEXT_TBL [.CMDTYP];

!+
! Now do the right things for each of the possible cases
!-

	CASE .CMDTYP FROM RAN_NUMBER TO NUM_RAN OF
	    SET

	[ RAN_NUMBER ] :

		BEGIN
!+
! Set up command table for legal items which can follow
!-
		IF ((.THRU_SEEN) OR (.FOR_SEEN)) THEN FD_PTR = FD_RNA ELSE
		    IF (.AND_SEEN) THEN FD_PTR = FD_AND ELSE
			FD_PTR = FD_RCM;


		IF ((.PRVCMD EQL RAN_PLUS) OR (.PRVCMD EQL RAN_MINUS) OR
			(.PRVCMD EQL RAN_FOR) OR (.PRVCMD EQL RAN_ORIG)) THEN

!+
! Treat a number following +, -, ORIGINAL, or FOR as a simple number.
!-

		    BEGIN
		    IF ((.C_DATA GEQ 2^17) OR (.C_DATA LSS 0)) THEN
			BEGIN
			PA_ERRNO = EDT$_NUMVALILL;
			RETURN (-1);
			END;
		    PA_CURRNG [RAN_VAL] = .C_DATA;
		    END
		ELSE

!+
! If the previous atom was not one of these, then build a line number
!-

		    BEGIN
		    LOCAL STS;
		    IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, .CMDTYP)) EQL 0)
			 THEN RETURN (-1);
		    STS = EDT$$PA_LINE_NUM (.C_DATA);
		    IF (.STS LEQ 0) THEN RETURN (.STS);
		    MOVELINE (PA_NUMVAL, PA_CURRNG [RAN_VAL]);
		    END;
		END;

	[ RAN_DOT ] :

		BEGIN
!+
! Set up command table for legal items which can follow
!-
		IF ((.THRU_SEEN) OR (.FOR_SEEN)) THEN FD_PTR = FD_RN8 ELSE
		    IF (.AND_SEEN) THEN FD_PTR = FD_AND ELSE
			FD_PTR = FD_RNP;

		IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, .CMDTYP)) EQL 0)
		    THEN RETURN (-1);
		END;

	[ RAN_STR ] :

		BEGIN
		IF (.PRVCMD EQL RAN_ALL) THEN MORE = 0 ELSE
		    IF (.THRU_SEEN) THEN FD_PTR = FD_RN8 ELSE
			IF (.AND_SEEN) THEN FD_PTR = FD_AND ELSE
			FD_PTR = FD_RNP;


!+
! Create a new node when necessary and store the pointer and length
!-

		IF ((.PRVCMD NEQ RAN_ALL) AND (.PRVCMD NEQ RAN_MINUS)) THEN
		    IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, .CMDTYP)) EQL 0)
			THEN RETURN (-1);
		EDT$$PA_SCANTOK (1,0);
		PA_CURRNG [RAN_VAL] = .PA_CURTOKLEN;
		PA_CURRNG [STR_PNT] = .PA_CURTOK;
		IF (.PRVCMD EQL RAN_MINUS) THEN PA_CURRNG [RAN_TYPE] = RAN_MINSTR;
		END;

	[ RAN_BEGIN, RAN_END, RAN_ORIG ] :

		BEGIN
		IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, .CMDTYP)) EQL 0)
		    THEN RETURN (-1);
		IF (.THRU_SEEN) THEN FD_PTR = FD_RN8 ELSE
		    IF (.AND_SEEN) THEN FD_PTR = FD_AND ELSE
			FD_PTR = FD_RNP;
		END;

	[ RAN_BEFORE, RAN_REST, RAN_WHOLE] :

		BEGIN
		IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, .CMDTYP)) EQL 0)
		    THEN RETURN (-1);
		FD_PTR = FD_RNA;
		END;

	[ RAN_LAST, RAN_SELECT ] :

		BEGIN
		IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, .CMDTYP)) EQL 0)
		    THEN RETURN (-1);
		MORE = 0;
		END;

	[ RAN_BUFFER ] :

		BEGIN
		LOCAL STS;

!+
! Parse a buffer name and set a flag for later
!-

		STS = EDT$$PA_BUFFER ();
		IF (.STS LEQ 0) THEN RETURN (.STS);
		FLAGS2 = .FLAGS2 OR F_BUFFER;
		END;

	[ RAN_FOR ] :

		BEGIN

!+
! Create a new node and set some flags for later. Create a default if required.
!-

		IF (.PRVCMD EQL 0) THEN
		    IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_DOT)) EQL 0)
			THEN RETURN (-1);
		IF (EDT$$PA_CRERNGNOD (.CMDTYP) EQL 0) THEN RETURN (-1);
		PA_ERRNO = EDT$_NUMVALREQ;
		FLAGS2 <0,18> = F_FOR;
		FOR_SEEN = 1;
		FD_PTR = FD_VAL;
		END;

	[ RAN_PLUS, RAN_MINUS ] :

		BEGIN

!+
! Create a default node if required.
!-

		IF (.PRVCMD EQL 0) THEN
		    IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_DOT)) EQL 0)
			THEN RETURN (-1);
		IF (EDT$$PA_CRERNGNOD (.CMDTYP) EQL 0) THEN RETURN (-1);
		FD_PTR = FD_VAL;
		END;

	[ RAN_THRU ] :

		BEGIN

!+
! Create a new node and set a flag for later. Create a default if required.
!-

		IF (.PRVCMD EQL 0) THEN
		    IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_DOT)) EQL 0)
			THEN RETURN (-1);
		IF ((PA_THRURNG = EDT$$PA_NEW_NOD (RANGE_NODE, 0)) EQL 0)
		    THEN RETURN (-1);
		PA_THRURNG [RANGE1] = .PA_CURRNG;
		FLAGS2 <0,18> = F_THRU;
		FD_PTR = FD_RSR;
		THRU_SEEN = 1;
		END;

	[ RAN_ALL ] :

		BEGIN
		LOCAL
		    SUB : REF NODE_BLOCK;

!+
! Complete any compound range outstanding and clear the flag.
! Then link the new range with the previous one
!-

		PA_ENDRAN (.FLAGS2);
		FLAGS2 <0,18> = 0;
		IF (.PRVCMD EQL 0) THEN
		    IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_WHOLE)) EQL 0)
			THEN RETURN (-1);
		SUB = .PA_CURRNG;
		IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, .CMDTYP)) EQL 0)
		    THEN RETURN (-1);
		PA_CURRNG [NEXT_RANGE] = .SUB;
		SUB [PREV_RANGE] = .PA_CURRNG;
		PA_ERRNO = EDT$_QUOSTRREQ;
		FD_PTR = FD_QST;
		END;

	[ RAN_AND ] :

!+
! Keep track of the current range for later linking
!-

		BEGIN
		IF (.PRVCMD EQL 0) THEN
		    BEGIN
		    PA_ERRNO = EDT$_ERRRANSPC;
		    RETURN (-1);
		    END;
		PA_ANDLSTHD = .PA_CURRNG;
		FLAGS2 <0,18> = F_AND;
		AND_SEEN = 1;
		FD_PTR = FD_RSR;
		END;

	[ INRANGE ] :

		;

	    TES;

    END;

!+
! Here when error parsing or logical end of specification reached
!  Complete specification and return
!-


!+
! If a buffer name was supplied, link it in now unless the last atom
! should have had something following it.
!-

    SELECTONE .CMDTYP OF
	SET

    [ 0 ] :

	BEGIN

!+
! This is a null range - make sure it is stored as such.
!-

	IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_NULL)) EQL 0)
	    THEN RETURN (-1);

	IF (.LOCATION EQL 1) THEN
	    PA_CURCMD [RANGE1] = .PA_CURRNG
	ELSE
	    PA_CURCMD [RANGE2] = .PA_CURRNG;
	RETURN (1);
	END;

    [ RAN_FOR ] :

	RETURN (-1);

    [ RAN_ALL ] :

	RETURN (-1);

    [ RAN_THRU ] :

	IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_DOT)) EQL 0)
	    THEN RETURN (-1);

    [ RAN_BUFFER ] :

	BEGIN

!+
! This is a null range - make sure it is marked as such
!-

	IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_NULL)) EQL 0)
	    THEN RETURN (-1);

	IF (.LOCATION EQL 1) THEN
	    PA_CURCMD [RANGE1] = .PA_CURRNG
	ELSE
	    PA_CURCMD [RANGE2] = .PA_CURRNG;
	END;
		
    [ OTHERWISE ] :

	;

	TES;

    PA_ENDRAN (.FLAGS2);
    IF ((.FLAGS2 AND F_BUFFER) NEQ 0) THEN
	BEGIN
	IF (.PA_BUFRNG NEQ .PA_CURRNG) THEN PA_BUFRNG [RANGE1] = .PA_CURRNG;
	PA_CURRNG = .PA_BUFRNG;
	END;

!+
! Finally, link the range to the command
!-

    IF (.LOCATION EQL 1) THEN
	PA_CURCMD [RANGE1] = .PA_CURRNG
    ELSE
	PA_CURCMD [RANGE2] = .PA_CURRNG;
    RETURN (1);

END;

%SBTTL 'PA_ENDRAN - Complete a compound range'

ROUTINE PA_ENDRAN (
		FLAG) : NOVALUE = 

!+
! FUNCTIONAL DESCRIPTION
!
! This routine tidies up the compound range which was being evaluated last.
! If no such range was in the command, then the right half of FLAG will
! be zero. The tidy-up operation depends on the type of compound range
! being processed.
!


BEGIN

    EXTERNAL
	PA_THRURNG : REF NODE_BLOCK,
	PA_ANDLSTHD : REF NODE_BLOCK,
	PA_CURRNG : REF NODE_BLOCK;

	BEGIN

!+
! Complete the previous compound range node before continuing
!-

	    CASE .FLAG<0,18> FROM F_SLR TO F_AND OF
		SET

	    [ F_SLR ] :

		;				! Nothing to do

	    [ F_THRU ] :

		BEGIN

!+
! Link the THRU range node in
!-

		PA_THRURNG [RAN_TYPE] = RAN_THRU;
		IF (.PA_CURRNG NEQ .PA_THRURNG) THEN
		    PA_THRURNG [RANGE2] = .PA_CURRNG;
		PA_CURRNG = .PA_THRURNG;
		END;

	    [ F_FOR ] :

		;				! Nothing to do

	    [ F_AND ] :

		BEGIN
		LOCAL ARANGE : REF NODE_BLOCK;
		ARANGE = .PA_ANDLSTHD;

!+
! Find the last range so we can add the new one to the end
!-

		WHILE (.ARANGE [NEXT_RANGE] NEQA 0) DO
		    ARANGE = .ARANGE [NEXT_RANGE];

		ARANGE [NEXT_RANGE] = .PA_CURRNG;
		PA_CURRNG [PREV_RANGE] = .ARANGE;
		PA_CURRNG = .PA_ANDLSTHD;
		END;

		TES;

	RETURN (1);
	END;

END;

END
ELUDOM