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