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