Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - faz1.bli
There are 12 other files named faz1.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1973, 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: F.J. INFANTE /HPW /DBT /DCE

MODULE FAZ1(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN

GLOBAL BIND FAZ1V = #10^24 + 0^18 + #1634;	! Version Date:	3-Sep-82


%(

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

32	-----	-----	FIX ORERROR SO THAT IF TYPESPEC FAILS IT
			WILL NOTE THAT "FUNCTION" WAS THE OTHER POSSIBLE
			LEGAL SYNTACTICAL ELEMENT

33	-----	-----	FIX SYNTAX SO THAT IT WILL WORK FOR INFINITE LISTS
			 AND REPEATS

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

34	751	-----	HANDLE THE NEW LOOKAHEAD TABLE FORMAT WITH ACTION
			ROUTINES TAKING MORE THAN A SINGLE BIT.  CLEAN
			UP MASK TO RUN FASTER., (DCE)

35	756	-----	ADDITION TO EDIT 751 - SMALL FIX TO MASK, (DCE)

***** Begin Version 6 *****

36	1073	DCE	22-May-81	-----
	Fix ORERROR so that REAL+ gives reasonable error msg.

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

37	1215	DCE	22-May-81	-----
	In MASK, save a lexeme to handle more interesting BNF constructs.

1546	CKS	31-May-82
	Change MASK to always call an action routine when it sees one.
	It formerly only did so when no lexeme had been read.  This
	change makes action routines like NOTEOL and OPTCOMMA work.

1604	CKS	21-Jul-82
	Remove STKSIZ bind; use the one in FIRST.  Make routine MOVSTK global.

1634	CKS	2-Sep-82
	Fix dot error.

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

 )%

REQUIRE LEXNAM.BLI;

BIND	LEXEME	= 0,
	META	= 1,
	ALL	= 2,
	ONE	= 3,
	OPTION	= 4,
	LIST	= 5,
	REPEAT	= 6,
	ACTION	= 7,
	TERMINAL= 8;
STRUCTURE STRING[I]=@(.STRING + .I);
STRUCTURE VECTX[I]=[I](.VECTX+.I);

EXTERNAL  LEXNAME;

!******************************************************************************************************************

BIND LEFTBUILD = 0;
REQUIRE F72BNF.BLI;
REQUIRE LOOK72.BLI;
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
SWITCHES LIST;


EXTERNAL E0,E2,E3,E82,E61;
!
!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>,
!	VECTX	OPNUM[0]=	BNFTBL<18,6>;
!
STRUCTURE	TYPSTR[I] = (.TYPSTR+.I)<24,12>;
STRUCTURE	SUBSTR[I] = (.SUBSTR +.I)<12,12>;
STRUCTURE	NUMSTR[I] = (.NUMSTR+.I)<0,12>;
STRUCTURE	LEXSTR[I] = (.LEXSTR+.I)<12,6>;
STRUCTURE	OPNSTR[I] = (.OPNSTR+.I)<18,6>;
!
BIND	TYPSTR	TYPE	=	BNFTBL,
	SUBSTR	SUBP	=	BNFTBL,
	NUMSTR	NUMBER	=	BNFTBL,
	LEXSTR	LEXNUM	=	BNFTBL,
	OPNSTR	OPNUM	=	BNFTBL;
!


! THIS MASK DEFINES THE LEXEMES WHICH ARE TO BE PLACED INTO THE SYNTAX
! TREES.  THE OTHER LEXEMES ARE DISCARDED.

BIND  INTREE  = 1^IDENTIFIER + 1^CONSTLEX + 1^LITSTRING + 1^LABELEX
			+ 1^COLON + 1^PLUS + 1^MINUS + 1^TIMES + 1^DIVIDE ;




!**;[1215], FAZ1, DCE, 22-May-81
%[1215]% OWN MASKLSAVE,MASKLEXL;
EXTERNAL  GSTLEXEME,GSTCSCAN,LEXL,LSAVE,STK[100],SP,LEXICAL;
EXTERNAL  FATLEX,LOOK4CHAR;
FORWARD  ORERROR;

	GLOBAL ROUTINE
		% WHEN SPACE IS BETTER THEN SPEED  %
LEXEMEGEN  =  RETURN LEXICAL( .GSTLEXEME ) ;


	GLOBAL ROUTINE 
SYNTAX (NODE) =
BEGIN
	EXTERNAL SAVSPACE;

	ROUTINE MASK (N) =
	BEGIN
		!--------------------------------------------------------------------------------------------------
		!IF THERE IS CURRENTLY NO LEXEME LOOKAHEAD, MASK GETS THE NEXT ACTION OR LEXEME.
		!RETURNS THE LOOKAHEAD MASK OF THE ACTION OR LEXEME FOUND OR THE LEXEME
		!ALREADY SEEN.
		!--------------------------------------------------------------------------------------------------
		REGISTER R1,R2;
![751] REWRITE MASK TO BE FASTER AND BETTER - HANDLE THE NEW FORMAT
![751] OF LOOKAHEAD WORD WITH ACTIONS TAKING MORE THAN A SINGLE BIT.
![751] NOTICE THAT ONLY A SINGLE ACTION ROUTINE CAN OCCUR IN A LOOKAHEAD
![751] WORD, SO THERE IS NO NEED TO HANDLE MORE THAN ONE.  ANY ATTEMPT
![751] TO GET MORE THAN ONE WILL CAUSE LEFT72 TO COMPLAIN!
%[751]%		MACRO ACTNUM=LASTLEX+1,35-LASTLEX$;
%[751]%		R1_@LOOKAHEAD[@N];
%[751]%		IF .R1 GEQ 1^(LASTLEX+1) THEN
%[751]%		BEGIN
%[751]%			R2_.R1<ACTNUM>;
%[751]%			IF (@ACTIONCASE[.R2])() GEQ 0 THEN
%[1215]%			(MASKLEXL_.LEXL;
%[1215]%			MASKLSAVE_.LSAVE;
%[1215]%			LEXL_(.R2+LASTLEX)^18;
%[751]%				LSAVE_-1;
%[751]%				RETURN (.R2)^(LASTLEX+1))
%[751]%		END;
%[751]%		IF .LSAVE EQL 0 THEN !ACTION ROUTINE DID NOT GET A NEW LEXEME
%[751]%		(LEXL_LEXICAL( .GSTLEXEME ); LSAVE_-1);
%[756]%		R2_.LEXL<LEFT>;
%[756]%		IF .R2 LEQ LASTLEX
%[756]%			THEN RETURN 1^(.R2)
%[756]%			ELSE RETURN (.R2)^(LASTLEX+1);
	END;


	GLOBAL ROUTINE  MOVSTK  (PLSP,PSTKSV,PCOUNT)  =
	BEGIN
		% THIS ROUTINE MOVES THE CURRENT LIST OR REPEAT TO
		  FREE STORAGE AND THUS ALLOWS LARGER LISTS %

		MACRO  LSP = (@PLSP)$,  STKSV = (@PSTKSV)$, COUNT = (@PCOUNT)$;
		
		% .COUNT CONTAINS THE TOTAL NUMBER OF WORDS OF STACK
		  CURRENTLY SAVED IN FREE CORE %

		% STKSV CONTAINS POINTERS TO THE SAVED PORTIONS  "LAST,FIRST"%

		EXTERNAL CORMAN,NAME;
		MACHOP  BLT = #251;
		REGISTER R;

		NAME<LEFT> _ .SP -  .LSP + 1;
		R _ CORMAN();	!GET SOME SPACE
		(@R)<LEFT> _ .NAME<LEFT> - 1;	!NUMBER OF STK WORDS TRANSFERED
		IF .STKSV  EQL  0
		THEN
		BEGIN
			COUNT _ 0;
			STKSV _ .R;
			STKSV<LEFT> _ .R;
			(@R)<RIGHT> _ 0
		END
		ELSE
		BEGIN
			(.STKSV<LEFT>)<RIGHT> _ .R;
			(@R)<RIGHT> _ 0;
			STKSV<LEFT> _ .R
		END;
		COUNT _ .COUNT + .NAME<LEFT> - 1;

		%TRANSFER THE STK%
		R<LEFT> _ STK[.LSP+1];
		R _ .R+1;
		VREG _ .NAME<LEFT> + .R<RIGHT>;
		BLT ( R, -1, VREG );

		SP _ .LSP	!RESTORE STACK POINTER
	END;

	GLOBAL ROUTINE COPYXLIST ( LSP , STKSV,COUNT) =
	BEGIN
		%THIS ROUTINE COPIES THE CURRENT PORTION OF THE LIST
		 OR REPEAT THAT IS ON THE STACK AND ALL THE SAVED PORTIONS
		 INTO A SINGLE BLOCK IN FREE STORAGE AND PLACES A POINTER
		 TO THE BLOCK ON THE STACK%

		EXTERNAL CORMAN %()%;
		LOCAL  NEWPT;	!SAVE THE POINTER TO NEW BLOCK
		MACHOP BLT=#251;
		REGISTER T1,T2;
		NAME<LEFT>_ (T2_.SP-.LSP) +.COUNT;
		NAME<RIGHT>_CORMAN();
		NEWPT _ .NAME-1^18;

		%COPY THE SAVED PORTIONS%
		UNTIL  .STKSV<RIGHT>  EQL  0
		DO
		BEGIN
			VREG<LEFT> _ .STKSV<RIGHT>+1;	!COPY FROM
			VREG<RIGHT> _ .NAME;
			T1 _ .VREG+.(@STKSV)<LEFT>;
			BLT(VREG,-1,T1);
			T1 _ .STKSV;
			NAME _ .NAME+.(@STKSV)<LEFT>;
			STKSV _ @@STKSV;
			SAVSPACE(.(@T1)<LEFT>,@T1);	!GIVE THE BLOCK BACK
		END;

		IF .T2  NEQ  0	%PORTION CURRENTLY ON THE STACK%
		THEN
		BEGIN	%TRANSFER IT%
			VREG<RIGHT> _ .NAME;
			VREG<LEFT>_STK[.LSP+1]<0,0>;
			T1_.VREG+.T2;
			BLT(VREG,-1,T1);
		END;
		STK[SP_.LSP+1]_.NEWPT;	!MAKES ALL LISTS RELATIVE TO 0
		RETURN 0
	END;


	GLOBAL ROUTINE COPYLIST ( LSP ) =
	BEGIN
		EXTERNAL CORMAN %()%;
		MACHOP BLT=#251;
		REGISTER T1,T2;
		IF (NAME<LEFT>_T2_.SP-.LSP) EQL 0 THEN RETURN;
		NAME<RIGHT>_CORMAN();
		VREG<LEFT>_STK[.LSP+1]<0,0>;
		T1_.VREG+.T2-1;
		BLT(VREG,0,T1);
		STK[SP_.LSP+1]_.NAME-1^18;	!MAKES ALL LISTS RELATIVE TO 0
		RETURN 0
	END;
	LOCAL SUBNODE;

	IF .SP  GEQ  STKSIZ  THEN RETURN  FATLEX(E82<0,0>);
	SUBNODE_.SUBP[.NODE];
	CASE .TYPE[.NODE] OF SET
!
!CASE 0-LEXEME
!
	BEGIN
		IF .LSAVE NEQ 0 THEN LSAVE_0 ELSE LEXL_LEXICAL( .GSTLEXEME );
		IF .LEXL<LEFT> NEQ @SUBNODE THEN 
		BEGIN
			IF .LEXL<LEFT> GTR LASTLEX  
			THEN	FATLEX ( PLIT'SYNTAXACT?0',E61<0,0>);

			FATLEX( .LEXNAME[.SUBNODE],.LEXNAME[.LEXL<LEFT>], E0<0,0> );
			LEXL<LEFT> _ EOSLEX; !LINEND;
			RETURN -1
		END;
		IF ( VREG _  INTREE AND 1^.LEXL<LEFT> )  NEQ 0 THEN STK[SP_.SP+1]_.LEXL
	END;
!
!CASE 1-META
!
	BEGIN
		IF SYNTAX(.SUBNODE) LSS 0 THEN RETURN .VREG;
	END;
!
!CASE 2-ALL
!
	BEGIN
		LOCAL LSP;
		LSP_.SP;
		INCR I FROM .SUBNODE TO .SUBNODE+.NUMBER[.NODE] DO
		BEGIN
			IF SYNTAX(.I) LSS 0 THEN RETURN .VREG;
		END;
		COPYLIST(.LSP)
	END;
!
!CASE 3-ONE
!
	BEGIN
		EXTERNAL  LOOK4LABEL;
		LABEL  ONE;
		MASK(@NODE);

		ONE:BEGIN
			INCR I FROM .SUBNODE TO .SUBNODE+.NUMBER[.NODE] DO 
			BEGIN
				IF (.LOOKAHEAD[ .I] AND .VREG) NEQ 0 THEN LEAVE ONE WITH (VREG_.I) ;
			END;
			 RETURN ORERROR (.NODE) ;	!NO ALTERNATIVES CORRECT
		END;	% ONE %
		LOOK4LABEL _ 0;	! THIS MUST BE CLEARED IN CASE LABELX FAILED IN GOTO
		STK[SP_.SP+1]_.VREG-.SUBNODE+1;
		IF SYNTAX(.VREG) LSS 0 THEN RETURN .VREG;
	END;
!
!CASE 4-OPTION
!
	BEGIN
		LABEL OPTION;
		MASK(@NODE);
		OPTION:BEGIN
			INCR I FROM .SUBNODE TO .SUBNODE+.NUMBER[.NODE] DO 
			BEGIN
				IF (.LOOKAHEAD[ .I] AND .VREG) NEQ 0 THEN LEAVE OPTION WITH (VREG_.I);
			END;
			STK[SP_.SP+1]_0;RETURN;	!NO ALTERNATIVES CORRECT
		END;	% OPTION %

		STK[SP_.SP+1]_.VREG-.SUBNODE+1;
		IF SYNTAX(.VREG) LSS 0 THEN RETURN -1;
	END;
!
!CASE 5-LIST
!
	BEGIN
		LOCAL LSP,STKSV,COUNT;
		STKSV_0;
		LSP_.SP;
		WHILE 1 DO
		BEGIN
			IF SYNTAX(.SUBNODE) LSS 0 THEN RETURN .VREG;

			IF .LSAVE NEQ  0 
			THEN
			BEGIN	
				IF .LEXL<LEFT>  NEQ  COMMA 
				THEN  EXITLOOP
				ELSE  LSAVE _ 0
			END
			ELSE
			BEGIN
				LOOK4CHAR _ ",";
				IF LEXICAL( .GSTCSCAN ) EQL 0  THEN  EXITLOOP
			END;
			%CHECK FOR STACK OVERFLOW%
			IF .SP  GEQ STKSIZ-20
			THEN	MOVSTK( LSP , STKSV , COUNT );	!MOVE THIS PORTION OF THE LIST
		END;
		IF .STKSV  NEQ  0
		THEN	COPYXLIST( .LSP, .STKSV , .COUNT )
			% THERE WAS OVERFLOW THAT WAS SAVED%
		ELSE	COPYLIST( .LSP);
	END;
!
!CASE 6-REPEAT
!
	BEGIN
		LOCAL LSP,STKSV,COUNT;
		STKSV_0;
		LSP_.SP;
		DO
		BEGIN
			%CHECK FOR STACK OVERFLOW%
			IF .SP  GEQ STKSIZ-20
			THEN	MOVSTK( LSP , STKSV , COUNT );	!MOVE THIS PORTION OF THE LIST
			IF SYNTAX(.SUBNODE) LSS 0 THEN RETURN .VREG;
			MASK(@NODE)
		END
		WHILE (@VREG AND @LOOKAHEAD[@NODE]) NEQ 0;
		IF .STKSV  NEQ  0
%1634%		THEN	COPYXLIST( .LSP, .STKSV , .COUNT )
			% THERE WAS OVERFLOW THAT WAS SAVED%
		ELSE	COPYLIST( .LSP);
	END;
!
!CASE 7-ACTION
!
	BEGIN
		VREG_IF .LSAVE EQL 0 THEN (@ACTIONCASE[.SUBNODE])()	!EXECUTE ACTION
			ELSE
			BEGIN
				IF ( .LEXL<LEFT> - LASTLEX )  NEQ  .SUBNODE
				THEN
				BEGIN
					(@ACTIONCASE[.SUBNODE])()
				END
!**;[1215], SYNTAX, DCE, 22-May-81
%[1215]%			ELSE	(LSAVE_.MASKLSAVE;
%[1215]%				LEXL_.MASKLEXL; !Restore saved lexeme
%[1215]%				MASKLSAVE_0)
			END
	END
	TES;
	.VREG
END;
ROUTINE ORERROR(NODE) =
%(-----------------------------------------------------------------------------------------------------------------
	NONE OF A SET  OF "OR" CHOICES WERE FOUND
	OUTPUT SUITABLE MESSAGE
-----------------------------------------------------------------------------------------------------------------)%
BEGIN
	LOCAL L,N;
%[1073]% MACRO ACTNUM=LASTLEX+1,35-LASTLEX$;
	N_0;L_.LOOKAHEAD[.NODE];
	UNTIL .L DO (L_.L^(-1);N_.N+1);
	FATLEX(.LEXNAME[.N],.LEXNAME[.LEXL<LEFT>],E2<0,0>);
	UNTIL (N_.N+1;L_.L^(-1)) EQL 0 DO
	BEGIN
		EXTERNAL NUMFATL;
		%DON'T COUNT THE OR'S%
		NUMFATL _ .NUMFATL-1;
		UNTIL .L DO (L_.L^(-1);N_.N+1);
%[1073]%	IF .N LEQ LASTLEX THEN FATLEX ( .LEXNAME[.N],E3<0,0>)
%[1073]%	ELSE
%[1073]%	BEGIN
%[1073]%		N=.LOOKAHEAD[.NODE]<ACTNUM>;
%[1073]%		IF .N EQL 3 THEN RETURN FATLEX(PLIT'"FUNCTION"?0',E3<0,0>);
%[1073]%		RETURN
%[1073]%	END
	END
END;
!****************************************
END ELUDOM