Trailing-Edge
-
PDP-10 Archives
-
AP-D480B-SB_1978
-
faz1.bli
There are 12 other files named faz1.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) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F.J. INFANTE /HPW /DBT
MODULE FAZ1(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
GLOBAL BIND FAZ1V = 2^24+0^18+33; !VERSION DATE: 25-APR-1974
%(
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
)%
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 ;
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;
IF .LSAVE EQL 0 THEN
BEGIN
LSAVE_-1;R1_@LOOKAHEAD[@N];
WHILE (R2_35-FIRSTONE(.R1)) GTR LASTLEX DO
BEGIN
!----------------------------------------------------------------------------------
!A LOOKAHEAD WORD BY DEFINITION IS NON-ZERO, THEREFORE THE RESULT OF THE
!FIRSTONE WILL ALWAYS BE LESS THAN 36
!----------------------------------------------------------------------------------
R2_.R2-LASTLEX;
IF (@ACTIONCASE[.R2])() LSS 0 THEN
(IF (R1_.R1 XOR ((1^LASTLEX)^.R2)) EQL 0 THEN EXITLOOP)
ELSE ( LEXL _ (.R2+LASTLEX)^18;
RETURN 1^(.LEXL<LEFT>)
)
END;
LEXL_LEXICAL( .GSTLEXEME )
END;
RETURN 1^(.LEXL<LEFT>)
END;
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;
BIND STKSIZ=250;
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 -1;
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
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
ELSE LSAVE _ 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;
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;
UNTIL .L DO (L_.L^(-1);N_.N+1);
IF .N EQL 25 %FUNCTIONSCAN%
THEN FATLEX(PLIT'"FUNCTION"?0',E3<0,0>)
ELSE FATLEX ( .LEXNAME[.N],E3<0,0>);
%DON'T COUNT THE OR'S%
NUMFATL _ .NUMFATL-1
END
END;
!****************************************
END ELUDOM