Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-compiler/left72.bli
There are 12 other files named left72.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/DCE

MODULE LF72(STACK)= %LEFT%
BEGIN

GLOBAL BIND LF72V = #10^24 + 0^18 + 24;		!VERSION DATE: 8-Sep-81

%(

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

***** Begin Version 5B *****

23	751	-----	CHANGE THE LOOKAHEAD TABLE FORMAT, DO MUCH CLEANUP.
			ERROR CHECKING ENHANCEMENTS, ETC.

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

***** Begin Version 7 *****

24	1243	CKS	8-Sep-81
	Add // to LEXNAM plit	

ENDV7

)%

REQUIRE LEXNAM.BLI;


MACRO	LEXEME=		1$,
	META=		2$,
	ALL=		3$,
	ONE=		4$,
	OPTION=		5$,
	LIST=		6$,
	REPEAT=		7$,
	ACTION=		8$,
	TERMINAL=	9$;
STRUCTURE STRING[I]=@(.STRING + .I);
STRUCTURE VECTX[I]=[I](.VECTX+.I);
BIND VECTOR LEXNAME=PLIT(
%0%	PLIT'UNKNOWN?0',
%1%	PLIT'IDENTIFIER?0',
%2%	PLIT'CONSTANT?0',
%3%	PLIT'LITSTRING?0',
%4%	PLIT'STATEMENT END?0',
%5%	PLIT'RELATIONALOP?0',
%6%	PLIT'.NOT.?0',
%7%	PLIT'.AND.?0',
%8%	PLIT'.OR.?0',
%9%	PLIT'.EQV. OR .XOR.?0',
%10%	PLIT'"**" OR "^"?0',
%11%	PLIT'LABEL',
%12%	PLIT'"&"?0',
%13%	PLIT'"("?0',
%14%	PLIT'")"?0',
%15%	PLIT'":" ?0',
%16%	PLIT'","?0',
%17%	PLIT'"$"?0',
%18%	PLIT'"-"?0',
%19%	PLIT'"/"?0',
%20%	PLIT'"+"?0',
%21%	PLIT'"*"?0',
%22%	PLIT'"="?0',
%23%	PLIT'"//"?0',		! [1243]
);
!******************************************************************************************************************

BIND LEFTBUILD = 1;
REQUIRE	F72BNF.BLI;		!GENERATE 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 ');
![751] GET THE RIGHT ERROR MESSAGE FOR VARIOUS CONFLICTS -
![751] SHOULD MAKE FUTURE BNF CHANGES EASIER TO DEBUG!
%[751]%	OUTZ(3, IF .S LEQ 0 THEN PLIT' PASS TWO METANAME ' ELSE .METANAME[.S]);
	OUTZ(3,PLIT' AT NODE ');
	DECOUT(3,4,.N);
	OUTZ(3,PLIT' WITH ');
%[751]%	VREG_36-FIRSTONE(.L);
	IF .VREG GTR LASTLEX THEN
	BEGIN
		OUTZ(3,PLIT'ACTION ?0');
%[751]%		OUTZ(3,.ACTIONNAME[.L/(1^(LASTLEX+1))])
	END
	ELSE
	BEGIN
		OUTZ(3,PLIT'LEXEME ');
%[751]%		OUTZ(3,.LEXNAME[.VREG])
	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 IGHT 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);
![751] BE CAREFUL IN CONFLICT CHECKING, ESPECIALLY NOW THAT ACTION
![751] ROUTINES DO NOT OCCUPY A SINGLE BIT POSITION...
%[751]%				IF ((@LEFTLEX[@NODE] AND NOT 1^35) GEQ 1^(LASTLEX+1)) AND
%[751]%				   (( LEX_(@LEFTLEX[@SON] AND NOT 1^35)) GEQ 1^(LASTLEX+1))  ! BOTH ACTIONS
%[751]%				THEN CERR(@NAME,@NODE,.LEX) ELSE
				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);
%[751]%				IF ((@LEFTLEX[@NODE] AND NOT 1^35) GEQ 1^(LASTLEX+1)) AND
%[751]%				   (( LEX_(@LEFTLEX[@SON] AND NOT 1^35)) GEQ 1^(LASTLEX+1))  ! BOTH ACTIONS
%[751]%				THEN CERR(@NAME,@NODE,.LEX) ELSE
				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;
![751] HERE IS THE BIG CHANGE - FOR AN ACTION ROUTINE, DO NOT USE A
![751] BIT POSITION, USE A VALUE FIELD INSTEAD.  THIS SETS THE VALUE
![751] UP CORRECTLY INITIALLY, AND ALL THE PROPAGATION OCCURS CORRECTLY!
%[751]%%CASE 8-ACTION%	LEFTLEX[@NODE]_(.SUBP[@NODE])^(LASTLEX+1);
%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 
![751] FOR SECOND PASS AT ALL PRODUCTIONS WHERE THE METANAME MIGHT NOT
![751] BE AVAILIBLE, USE THE -1 TO INDICATE SAME.  THIS WILL CAUSE AN
![751] APPROPRIATE ERROR MESSAGE IF A CONFLICT IS DETECTED DURING THIS
![751] PASS SO THAT DEBUGGING THE MONSTER IS MADE MUCH EASIER - IF WE
![751] TRY TO BE CLEVER, THE ERROR MESSAGE BECOMES MISLEADING!
	BEGIN
%[751]%		LEFT(.I,0,-1); !WE DON'T KNOW THE METANAME (-1)
		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 "LEFT72.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