Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/lexsup.bli
There are 12 other files named lexsup.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: D. B. TOLMAN/DCE/SJW
MODULE LEXSUP(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN %LEXSUP%
GLOBAL BIND LEXSV = 5^24 + 1^18 + 11; ! VERSION DATE: 16-MAY-77
%(
REVISION HISTORY
2 ----- ----- MOVE CREFIT TO NEW MODULE UNEND IN ORDER TO
FIX ONCE AND FOR ALL THE SAVING
THE LAST GETSEG TO FORTB PROBLEM
3 ----- ----- ROUTINE BACKUP - THE CHARACTER POSITION COUNTER
CHARPOS WAS BEING DECREMENTED RATHER
THAN INCREMENTD BY 1 AS IT SHOULD HAVE BEEN
4 ----- ----- RETURN FROM LABREF WHEN LABEL TOO LARGE OR
TOO SMALL TO AVOID ADDITIONAL SPURIOUS ERROR
MESSAGES
5 ----- ----- REMOVE EDIT 4 BECAUSE WORSE THINGS HAPPEN
WHEN THE FINAL LIST OF UNDEFINED LABELS IS
COMPILED IF NOTHING IS DEFINED. LIKE INTERNAL
COMPILER ERRORS.
6 ----- ----- ENDOFLIT WAS NOT ZEROING LAST
WORD OF THE LITERAL PROPERLY
7 ----- ----- IN LABDEF - DON'T CALL DOCHECK JUST CHECK
TO SEE IF LIGIT DO TERMINATOR
DOCHECK CALLED AFTER SEMANTICS NOW
8 362 18245 SEPARATE LOGICAL AND OCTAL REPRESENTATIONS
9 366 18210 FIX SAVLINE CLOBBERING NAME
10 477 QA831 MAKE ERROR MESSAGE NAMLEX'S MORE READABLE
********** BEGIN VERSION 5A **********
11 573 ----- REQUIRE DBUGIT.REQ
)%
EXTERNAL E19,E20,E91,E113;
EXTERNAL LINELINE,LINEPTR,CHARPOS,CLASLINE,CLASPTR,CLASLPT,CLASPOS,CURPTR,DECREMENT,BACKLINE,CREFIT;
REQUIRE DBUGIT.REQ; ![573] SJW 16-MAY-77
REQUIRE LEXNAM.BLI;
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
% THESE BINDS ARE REQUIRED BY LEXICAL BECAUSE ITS GETTING TO
BIG TO COMPILE WITH FIRST AND TABLES %
GLOBAL BIND
GREAL = REAL,
!**;[362], LEXSUP @3295, DCE, 26-MAR-76
!**;[362], MAKE LOGICAL VARIABLES DISTINCT CONSTANTS
GLOGI = LOGICAL, %[362]%
GINTEGER = INTEGER,
GDOUBLPREC = DOUBLPREC,
GDUBOCT = DOUBLOCT,
GOCTAL = OCTAL;
BIND DUMM = PLIT (
GIDTAB GLOBALLY NAMES IDTAB,
GCONTAB GLOBALLY NAMES CONTAB
);
BIND VECTOR NAMLEX=PLIT( LEXNAME GLOBALLY NAMES
%0% PLIT'UNKNOWN?0',
%1% PLIT'IDENTIFIER?0',
%2% PLIT'CONSTANT?0',
%3% PLIT'LIT STRING?0', ![477]
%4% PLIT'LABEL',
%5% PLIT'STATEMENT END?0',
%6% PLIT'RELATIONAL OP?0', ![477]
%7% PLIT'.NOT.?0',
%8% PLIT'.AND.?0',
%9% PLIT'.OR.?0',
%10% PLIT'.EQV. OR .XOR.?0',
%11% PLIT'"**" OR "^"?0',
%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',
);
! MACROS WHICH DEFINE THE RELATIONAL LEXEME CODES
MACRO
REL(N) = RELATIONLOP^18+N$,
DOTNE = REL(6)$,
DOTEQ = REL(2)$,
DOTGT = REL(7)$,
DOTLT = REL(1)$,
DOTGE = REL(5)$,
DOTLE = REL(3)$;
BIND DUMMIE = PLIT (
% THIS IS A TABLE USED TO SCAN FOR AND IDENTIFY THE "."ED OPERATORS %
NDOTOP GLOBALLY NAMES 'E', DOTNE,
'OT', LOGICALNOT^18,
0,
'.NE. OR .NOT.?0',
ADOTOP GLOBALLY NAMES 'ND', LOGICALAND^18,
0,
'.AND.?0',
ODOTOP GLOBALLY NAMES 'R', LOGICALOR^18,
0,
'.OR.?0',
XDOTOP GLOBALLY NAMES 'OR', LOGICALMATCH^18+2,
0,
'.XOR.?0',
EDOTOP GLOBALLY NAMES 'QV', LOGICALMATCH^18+1,
'Q', DOTEQ,
0,
'.EQ. OR .EQV.?0',
GDOTOP GLOBALLY NAMES 'T', DOTGT,
'E', DOTGE,
0,
'.GT. OR .GE.?0',
LDOTOP GLOBALLY NAMES 'T', DOTLT,
'E', DOTLE,
0,
'.LT. OR .LE.?0',
TDOTOP GLOBALLY NAMES 'RUE', -2,
0,
'.TRUE.?0',
FDOTOP GLOBALLY NAMES 'ALSE', -1,
0,
'.FALSE.?0'
);
BIND DUMDUM = PLIT ( DOTOPTAB GLOBALLY NAMES
% THIS TABLE GIVES A POINTER TO THE VALID CHARACTER STRINGS
WHICH COULD FOLLOW THE FIRST LETTER OF A DOTTED OPERATOR%
%A% ADOTOP<36,7>,
%B% 0,
%C% 0,
%D% 0,
%E% EDOTOP<36,7>,
%F% FDOTOP<36,7>,
%G% GDOTOP<36,7>,
%H% 0,
%I% 0,
%J% 0,
%K% 0,
%L% LDOTOP<36,7>,
%M% 0,
%N% NDOTOP<36,7>,
%O% ODOTOP<36,7>,
%P% 0,
%Q% 0,
%R% 0,
%S% 0,
%T% TDOTOP<36,7>,
%U% 0,
%V% 0,
%W% 0,
%X% XDOTOP<36,7>,
%Y%0,
%Z% 0
);
GLOBAL ROUTINE
BACKPRINT =
BEGIN
LOCAL TLINE,TCUR,TPTR,ADJUST;
EXTERNAL LINELINE,CURPTR,LINEPTR,BACKLINE,NOCR,PRINT,CLASLPT;
% THIS ROUTINE IS CALLED IF A LINE TERMINATOR WAS ENCOUNTERED
DURING SOME LOOKAHEAD AND NO BACKUP WAS REQUIRED %
% SAVE CURRENT LINE ATTRIBUTES %
TLINE_ .LINELINE;
TCUR _ .CURPTR;
TPTR _ .LINEPTR;
ADJUST _ @(@BACKLINE<RIGHT>+3) - .CLASLPT; ! CHECK TO SEE IF BUFFER WAS MOVED
% PRINT THOSE LINES THAT WERE MISSED %
DO
BEGIN
LINELINE _ @(@BACKLINE<RIGHT>+1) - .ADJUST;
CURPTR _ @(@BACKLINE<RIGHT>+2) - .ADJUST;
LINEPTR _ @(@BACKLINE<RIGHT> + 3) - .ADJUST;
NOCR _ 1;
PRINT();
END
UNTIL ( BACKLINE<RIGHT> _ @(@BACKLINE<RIGHT>)) EQL 0;
BACKLINE _ 0;
LINELINE _ .TLINE;
CURPTR _ .TCUR;
LINEPTR _ .TPTR;
END;
GLOBAL ROUTINE
SAVLINE =
BEGIN
LOCAL ADDR;
!**;[366], SAVLINE @3471, DCE, 2-APR-76
LOCAL NAMESAVE; ![366]
EXTERNAL NAME,CORMAN,LINELINE,CURPTR,LINEPTR,BACKLINE;
% THIS LINE IS BEING PASSED OVER DURING A LOOKAHEAD WITHOUT PRINTING
IF NO BACKUP IS NEEDED THEN THIS LINE WILL HAVE TO BE PRINTED %
% SAVE THE LINE ATTRIBUTES %
!**;[366], SAVLINE @3477, DCE, 2-APR-76
!**;[366], SAVE AND RESTORE NAME AROUND THIS CALL
NAMESAVE_.NAME; ![366]
NAME<LEFT> _ 4;
ADDR _ CORMAN();
NAME_.NAMESAVE; ![366]
(@ADDR)<FULL> _ 0; ! LINK
((@ADDR)+1)<FULL> _ .LINELINE;
((@ADDR)+2)<FULL> _ .CURPTR ;
((@ADDR)+3)<FULL> _ .LINEPTR ;
IF .BACKLINE EQL 0
THEN
BEGIN
BACKLINE<LEFT> _ @ADDR;
BACKLINE<RIGHT> _ @ADDR;
END
ELSE
BEGIN
(@BACKLINE<LEFT>) _ @ADDR;
BACKLINE<LEFT> _ @ADDR
END
END;
GLOBAL ROUTINE
BAKSAV =
BEGIN
% SAVE THE CURRENT POSITION FOR POSSIBLE BACKUP %
EXTERNAL CLASPTR,CLASLINE,CLASPOS,CLASLPT,CHARPOS;
CLASPTR _ .CURPTR;
CLASLINE _ .LINELINE;
CLASPOS _ .CHARPOS;
CLASLPT _ .LINEPTR;
END;
GLOBAL ROUTINE
BACKUP =
BEGIN
% BACKUP TO JUST BEFORE THE SAVED CHARACTER POSITION %
CURPTR _ .CLASPTR;
DECREMENT ( CURPTR<0,0> );
LINELINE _ .CLASLINE;
CHARPOS _ .CLASPOS + 1;
LINEPTR _ .CLASLPT;
BACKLINE _ 0;
END;
GLOBAL ROUTINE
LITDEF ( CHARS ) =
BEGIN
% MAKE A LITERAL TABLE ENTRY FOR .CHARS CHARACTERS %
LOCAL WDS;
LOCAL PEXPRNODE LITENTRY;
EXTERNAL NAME,NEWENTRY;
WDS _ ( .CHARS -1 ) /5 + 2;
NAME<LEFT> _ ( IF .WDS LEQ 2 THEN 5 ELSE 3 + .WDS );
NAME<RIGHT> _ LITTAB;
LITENTRY _ NEWENTRY();
LITENTRY[LITSIZ] _ .WDS;
LITENTRY[OPERATOR] _ LITCONST;
LITENTRY[LITEXWDFLG] _ 1; ! TRAILING NULL FLAG
RETURN .LITENTRY
END;
GLOBAL ROUTINE
ENDOFLIT ( POINT, LITENTRY, LASTWORD ) =
BEGIN
% CLEAN UP THE LITERAL ENTRY AND RETURN ANY UNUSED STORAGE %
% POINT < RIGHT> IS ADDRESS OF ZERO WORD TERMINATOR
ZERO THE WORD, CALCULATE THE LENGTH OF THE LITERAL, SET
THE SIZE, AND RETURN UNUSED PORTION TO FREE S