Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-compiler/leftfm.bli
There are 12 other files named leftfm.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!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.

!AUTHOR: T.E. OSTEN

MODULE LFFM(STACK)= %SYNTAX%
BEGIN

GLOBAL BIND	LFFMV = #10^24 + 0^18 + 23;	!VERSION DATE: 21-Jul-81

%(

***** Begin Revision History *****

23	536	-----	ADD RCHAR TO ERR NAME PLIT

***** End Revision History *****

)%

REQUIRE  FMTLEX.BLI;



	STRUCTURE STRING[I]=@(.STRING+.I);
	STRUCTURE VECTX[I]=[I] .VECTX+.I;

	BIND VECTOR LEXNAME=PLIT(
%1%	PLIT'DOLLAR',
%2%	PLIT'LITSTRING',
%3%	PLIT'LPAREN',
%4%	PLIT'RPAREN',
%5%	PLIT'LINEND',
%6%	PLIT'PLUS',
%7%	PLIT'COMMA',
%8%	PLIT'MINUS',
%9%	PLIT'PERIOD',
%10%	PLIT'SLASH',
%11%	PLIT'COLON',
%12%	PLIT'CONSTANT',
%13%	PLIT'ACHAR',
%14%	PLIT'BCHAR',
%15%	PLIT'DCHAR',
%16%	PLIT'ECHAR',
%17%	PLIT'FCHAR',
%18%	PLIT'GCHAR',
%19%	PLIT'ICHAR',
%20%	PLIT'LCHAR',
%21%	PLIT'NCHAR',
%22%	PLIT'OCHAR',
%23%	PLIT'PCHAR',
%24%	PLIT'QCHAR',
%25%	PLIT'RCHAR',
%26%	PLIT'SCHAR',
%27%	PLIT'TCHAR',
%28%	PLIT'XCHAR',
%29%	PLIT'ZCHAR')-1;

BIND LEFTBUILD = 1;
REQUIRE	FRMBNF.BLI;		!BUILD FORMAT SYNTAX TABLES

REGISTER R;
MACHOP BLT=#251,TTCALL=#051;
BIND	VECTX	TYPE[0]=	BNFTBL<24,12>,
	VECTX	SUBP[0]=	BNFTBL<12,12>,
	VECTX	NUMBER[0]=	BNFTBL<0,12>,
	VECTX	LEXNUM[0]=	BNFTBL<12,6>;
FORWARD
	CERR,		%(S,N,L)= OUTPUT THE MESSAGE: "CONFLICT IN ",.METANAME[.S]," AT NODE ",.N,
			"WITH LEXEME" .L
			)%
	LEFT;		%(NODE,LAST,NAME)= CHECKS CONFLICTS WITH THE LEFT SON
			OF EACH NODE
			)%
EXTERNAL OUTZ,INIT,OCTOUT,DECOUT;
!******************************************************************************************************************
ROUTINE DEC(N)=
BEGIN
	LOCAL A;
	A_((.N MOD 10)+"0")^29;
	N_.N/10;
	IF .N NEQ 0 THEN DEC(.N);
	TTCALL(3,A)
END;
!******************************************************************************************************************
ROUTINE CERR(S,N,L)=
%(-----------------------------------------------------------------------------------------------------------------
	S=	NUMBER OF THE METANAME STRING FROM THE LAST METASYMBOL
	N=	NODE AT WHICH CONFLICT OCCURED
	L=	LEXEME (OR TERMINAL) WHICH CONFLICTED
		(RESULT OF THE AND)
-----------------------------------------------------------------------------------------------------------------)%
BEGIN
	OUTZ(3,PLIT'%CONFLICT IN ');
	OUTZ(3,.METANAME[.S]);
	OUTZ(3,PLIT' AT NODE ');
	DECOUT(3,4,.N);
	OUTZ(3,PLIT' WITH ');
	VREG_FIRSTONE(.L);
	IF .VREG GTR LASTLEX THEN
	BEGIN
		VREG_.VREG-LASTLEX;
		OUTZ(3,PLIT'ACTION ?0');
		OUTZ(3,.ACTIONNAME[.VREG])
	END
	ELSE
	BEGIN
		OUTZ(3,PLIT'LEXEME ');
		OUTZ(3,.LEXNAME[.N])
	END;
	OUTZ(3,PLIT'%?M?J');
	R_.R+1
END;
!******************************************************************************************************************
BIND VECTOR TFIELD=PLIT(
%1%	PLIT'LEXEME',
%2%	PLIT'META',
%3%	PLIT'ALL',
%4%	PLIT'ONE',
%5%	PLIT'OPTION',
%6%	PLIT'LIST',
%7%	PLIT'REPEAT',
%8%	PLIT'ACTION',
%9%	PLIT'TERMINAL')-1;
OWN VECTOR LEFTLEX[LLSIZE],RIGHT,LEX,TRACE,START;
%(-----------------------------------------------------------------------------------------------------------------
	LEFTLEX=A BIT MASK OF THE LEXEMES COMPRISING THE LEFT SON OF EACH
		NODE IN THE BNF TABLE.
	RIGHT=	THE RIGHT BROTHER OF THE CURRENT SON OF AN ALL.
	LEX=	THE RESULT OF A LEXEME CONFLICT CHECK.
-----------------------------------------------------------------------------------------------------------------)%
ROUTINE TYPEOUT(N)=
!------------------------------------------------------------------------------------------------------------------
!	N= NODE TO BE TYPED
!
!TYPES: NODE(.N)= .TYPE, .SUBP, .NUMBER - .LEFTLEX
!------------------------------------------------------------------------------------------------------------------
BEGIN
	OUTZ(3,PLIT'NODE(');DECOUT(3,4,@N);OUTZ(3,PLIT')= ');
	OUTZ(3,.TFIELD[.TYPE[@N]]);
	OUTZ(3,PLIT', ');DECOUT(3,4,.SUBP[@N]);OUTZ(3,PLIT', ');
	IF .TYPE[@N] EQL LEXEME OR .TYPE[@N] EQL META THEN OUTZ(3,.METANAME[.NUMBER[@N]])
		ELSE DECOUT(3,4,.NUMBER[@N]);
	IF @LEFTLEX[@N] NEQ 0 THEN
	BEGIN
		OUTZ(3,PLIT'?M?J	');
		INCR I FROM -35 TO 0 DO
		BEGIN
			IF @LEFTLEX[@N]^@I THEN OUTZ(3,PLIT'X') ELSE OUTZ(3,PLIT'O');
			IF (.I MOD 3) EQL 0 THEN OUTZ(3,PLIT' ')
		END;
	END;
	OUTZ(3,PLIT'?M?J')
END;
!******************************************************************************************************************
ROUTINE DECIN=
BEGIN
	REGISTER R1,R2;
	R1_R2_0;
	UNTIL (TTCALL(4,R1);.R1) EQL #015 OR .R1 EQL #012 DO
		R2_(.R2*10)+(.R1-"0");
	.R2
END;
!******************************************************************************************************************
ROUTINE LEFT(NODE,LAST,NAME)=
%(-----------------------------------------------------------------------------------------------------------------
	NODE=	THE CURRENT LOCATION IN THE BNF TABLE (BNFTBL).
	LAST=	THE RIGHT BROTHER OF THE CURRENT NODE AT THE LAST ALL.
		INITIALLY SET TO ZERO.
	NAME=	LOCATION IN THE METANAME TABLE OF THE LAST META.
-----------------------------------------------------------------------------------------------------------------)%
BEGIN
	LOCAL SON;
	IF .TRACE THEN (OUTZ(3,PLIT'BEGIN - ');TYPEOUT(@NODE));
	CASE .TYPE[@NODE] OF SET
%CASE 0%		EXITCASE;
%CASE 1-LEXEME%	LEFTLEX[@NODE]_1^.LEXNUM[@NODE];
%CASE 2-META%	BEGIN
			IF .LEFTLEX[.SUBP[@NODE]] EQL 0 THEN
			BEGIN
				LEFTLEX[.SUBP[@NODE]]<35,1>_1;	!INDICATE NODE ALREADY SEEN
				LEFT(.SUBP[@NODE],@LAST,.NUMBER[@NODE]);
			END;
			LEFTLEX[@NODE]_@LEFTLEX[.SUBP[@NODE]];
		END;
%CASE 3-ALL%	BEGIN
			RIGHT_@LAST;
			SON_.SUBP[@NODE]+.NUMBER[@NODE]+1;
			WHILE (SON_.SON-1) GEQ .SUBP[@NODE] DO
			BEGIN
				LEFT(@SON,@RIGHT,@NAME);
				RIGHT_@SON
			END;
			WHILE (SON_.SON+1) LEQ .SUBP[@NODE]+.NUMBER[@NODE] DO
			BEGIN
				LEFTLEX[@NODE]_@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
				IF .TYPE[@SON] NEQ OPTION THEN EXITLOOP	
			END;
			LEFTLEX[@NODE]_@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
		END;
%CASE 4-ONE%	BEGIN
			SON_.SUBP[@NODE]+.NUMBER[@NODE]+1;
			WHILE (SON_.SON-1) GEQ .SUBP[@NODE] DO
			BEGIN
				LEFT(@SON,@LAST,@NAME);
				IF (LEX_@LEFTLEX[@NODE] AND @LEFTLEX[@SON] AND NOT 1^35) NEQ 0
					THEN CERR(@NAME,@NODE,.LEX);
				LEFTLEX[@NODE]_@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
			END;
		END;
%CASE 5-OPTION%	BEGIN
			SON_.SUBP[@NODE]+.NUMBER[@NODE]+1;
			WHILE (SON_.SON-1) GEQ .SUBP[@NODE] DO
			BEGIN
				LEFT(@SON,@LAST,@NAME);
				IF (LEX_@LEFTLEX[@NODE] AND @LEFTLEX[@SON] AND NOT 1^35) NEQ 0
					THEN CERR(@NAME,@NODE,.LEX);
				LEFTLEX[@NODE]_@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
			END;
		END;
%CASE 6-LIST%	BEGIN
			LEFT(.SUBP[@NODE],@LAST,@NAME);
			LEFTLEX[@NODE]_@LEFTLEX[.SUBP[@NODE]];
		END;
%CASE 7-REPEAT%	BEGIN
			LEFT(.SUBP[@NODE],@LAST,@NAME);
			LEFTLEX[@NODE]_@LEFTLEX[.SUBP[@NODE]];
			RIGHT_IF @LAST NEQ 0 THEN @LEFTLEX[@LAST] ELSE 0;
			IF (LEX_@LEFTLEX[@NODE] AND @RIGHT AND NOT 1^35) NEQ 0
				 THEN CERR(@NAME,@NODE,@LEX);
		END;
%CASE 8-ACTION%	LEFTLEX[@NODE]_(1^LASTLEX)^.SUBP[@NODE];
%CASE 9-TERMINAL%	LEFTLEX[@NODE]_1^.SUBP[@NODE]
		TES;
		IF .TRACE THEN (OUTZ(3,PLIT'  END - ');TYPEOUT(@NODE));
END;
OWN ANDS,ANDBRANCHES,ORS,ORBRANCHES;
LEFTLEX[0]_0;
R<18,18>_LEFTLEX[0];
R<0,18>_LEFTLEX[0]+1;
BLT(R,LEFTLEX[LLSIZE]);
!CLEAR LEFTLEX TABLE
INIT();	!3=DSK:LKAHD.BLI
R_0;
TTCALL(3,PLIT'?M?JSTART TRACE AT NODE #(0=NONE):');START_DECIN();
TTCALL(3,PLIT'?M?J');
TRACE_IF .START EQL 1 THEN 1 ELSE 0;
!------------------------------------------------------------------------------------------------------------------
!THE CODE THAT FOLLOWS ASSUMES THAT BNFTBL[1] IS THE BEGINNING OF THE
!DEFINITION OF THE FIRST METASYMBOL WHOSE NAME IS METANAME[1].
!------------------------------------------------------------------------------------------------------------------
LEFTLEX[1]<35,1>_1;	!INDICATES NODE ALREADY SEEN
LEFT(1,0,1);
ANDS_ANDBRANCHES_ORS_ORBRANCHES_0;
INCR I FROM 2 TO @BNFTBL-1 DO
BEGIN
	IF .START EQL .I THEN TRACE_1;
	IF .TYPE[@I] EQL META AND .LEFTLEX[@I]<0,35> EQL 0 THEN (LEFT(.I,0,.NUMBER[.I]);TRACE_0);
	IF .TYPE[@I] EQL ONE THEN (ORS_.ORS+1;ORBRANCHES_.ORBRANCHES+.NUMBER[@I]);
	IF .TYPE[@I] EQL ALL THEN (ANDS_.ANDS+1;ANDBRANCHES_.ANDBRANCHES+.NUMBER[@I]);
END;
INCR I FROM 2 TO @BNFTBL-1 DO
BEGIN
	IF .START EQL .I THEN TRACE_1;
	IF .LEFTLEX[@I]<0,35> EQL 0 THEN 
	BEGIN
		LEFT(.I,0,.NUMBER[.I]);
		TRACE_0;
		IF .TYPE[@I] EQL ONE THEN (ORS_.ORS+1;ORBRANCHES_.ORBRANCHES+.NUMBER[@I]);
		IF .TYPE[@I] EQL ALL THEN (ANDS_.ANDS+1;ANDBRANCHES_.ANDBRANCHES+.NUMBER[@I]);
	END
END;
DEC(.R);TTCALL(3,PLIT ' CONFLICTS EXIST?M?J');
TTCALL(3,PLIT'# OF ANDS: ');DEC(.ANDS);
TTCALL(3,PLIT'?M?J# OF AND BRANCHES: ');DEC(.ANDBRANCHES);
TTCALL(3,PLIT'?M?J# OF ORS: ');DEC(.ORS);
TTCALL(3,PLIT'?M?J# OF OR BRANCHES: ');DEC(.ORBRANCHES);TTCALL(3,PLIT'?M?J');
OUTZ(3,PLIT'?M?J!THE FOLLOWING TABLE WAS PRODUCED BY THE BLISS MODULE "LEFTFM.BLI"?M?J');
OUTZ(3,PLIT'?M?JBIND VECTOR LOOKAHEAD=PLIT(?M?J%');
INCR I FROM 1 TO @BNFTBL-1 DO
BEGIN
	DECOUT(3,4,@I);OUTZ(3,PLIT'%	#');OCTOUT(3,12,.LEFTLEX[@I]<0,35>);
	IF .LEFTLEX[@I]<0,30> LSS #100000 THEN OUTZ(3,PLIT',		%')
		ELSE OUTZ(3,PLIT',	%');
	OUTZ(3,.TFIELD[.TYPE[@I]]);OUTZ(3,PLIT', ');
	IF .TYPE[@I] EQL LEXEME THEN OCTOUT(3,4,.SUBP[@I]) ELSE DECOUT(3,4,.SUBP[@I]);
	OUTZ(3,PLIT', ');
	IF .TYPE[@I] EQL LEXEME OR .TYPE[@I] EQL META
		THEN OUTZ(3,.METANAME[.NUMBER[@I]])
		ELSE DECOUT(3,4,.NUMBER[@I]);
	OUTZ(3,PLIT'%?M?J%');
END;
DECOUT(3,4,@BNFTBL);
OUTZ(3,PLIT'%	0)-1;?M?J?L?0');
END
ELUDOM