Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
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