Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/compiler/left72.bli
There are 12 other files named left72.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: T.E. OSTEN/DCE
MODULE LF72(STACK)= %LEFT%
BEGIN
GLOBAL BIND LF72V = 7^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