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