Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-BB_1985_short
-
lexsup.bli
There are 12 other files named lexsup.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: D. B. TOLMAN/DCE/SJW/TFV/CKS/EDS/AHM/AlB
MODULE LEXSUP(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN %LEXSUP%
GLOBAL BIND LEXSUV = #10^24 + 0^18 + #2506; ! Version Date: 30-Nov-84
%(
***** Begin 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, (DCE)
9 366 18210 FIX SAVLINE CLOBBERING NAME, (DCE)
10 477 QA831 MAKE ERROR MESSAGE NAMLEX'S MORE READABLE
***** Begin Version 5A *****
11 573 ----- REQUIRE DBUGIT.REQ, (SJW)
***** Begin Version 5B *****
12 737 ----- IMPLEMENT .NEQV. OPERATOR, (DCE)
13 746 13673 ALLOW FORMAT STMNT NUMBERS TO BE ASSIGNED TO VARS,
(DCE)
***** Begin Version 6 *****
17 1100 EDS 9-Jun-81 10-31141
Build label definition entry for statement even
if the label is multiply defined or used in executable
context and gets a ENF error (E91). This will prevent
an NNF error (E70) and an undefined label error.
***** Begin Version 7 *****
14 1212 TFV 29-Apr-81 ------
Replace LITCONST with HOLLCONST
16 1221 CKS 4-Jun-81
Use LTLSIZ instead of 3 to get size of literal table node.
18 1224 CKS 12-Jun-81
Calculate LITSIZ right; use LTLSIZ to subtract off node header size
instead of magic numbers.
19 1245 TFV 3-Aug-81 ------
Fix LITDEF and ENDOFLIT to handle character/hollerith constants.
20 1243 CKS 8-Sep-81
Add // to LEXNAM plit
21 1402 CKS 23-Oct-81
Allow declaration statements to be labeled, catch in LABDEF and LABREF
15 1453 CKS 14-May-81 (formerly edit 1070)
In SAVLINE, replace @BACKLINE<LEFT> with .BACKLINE<LEFT>. Except you
have to say (.BACKLINE<LEFT>)<FULL> or BLISS blows it.
22 1470 CKS 2-Feb-82
Add tic lexeme (') to LEXNAM plit
1526 AHM 10-May-82
Make LABDEF set SNPSECT to PSCODE or PSDATA depending on
whether the label is being set on a FORMAT statement or code.
1712 AHM 7-Jan-83
Set the psect index for labels on declaration statements to
PSCODE in LABDEF so that we don't ICE from a PSOOPS when
dumping the labels (SUBROUTINE and friends can actually
produce code that gets labeled).
***** End V7 Development *****
1751 CDM 16-May-83
Don't put out <source line><cr><cr><lf> to listings, surpress
the second <cr> by not setting NOCR. Saved listing lines in
BACKLINE sometimes point to <source line><cr> rather than just
<source line>, as is expected. This happens when LEXICAL is
called with LOOK4CHAR set to something, finds the string, then
immediately finds a <cr><lf> before anything else.
2241 TFV 7-Dec-83
Rework the lexical debugging trace facility to generate symbolic
output. To use this facility, DRIVER, INOUT, LEXICA and LEXSUP
must be compiled with DBUGIT=1 (this bind is in DBUGIT.REQ),
Specifying the /BUGOUT switch outputs the data to the listing
file.
***** Begin Version 10 *****
2412 TFV 2-Jul-84
Split LEXICA into two modules. The classifier is in the new
module LEXCLA. The lexeme scanner is in LEXICA. LEXCLA is
called to initialize each program unit, to classify each
statement, to classify the consequent statement of a logical IF,
and to do the standard end of program and missing end of program
actions.
2420 TFV 9-Jul-84
Compact the split LEXICA, LEXCLA modules. Remove the dead
states and macros from each. Redo the PLITS of smalstates and
bigstates. Change the lexical tracing routines for debugging so
they typeout the correct names. Also fix flagger warnings so
that each gets printed once instead of twice. Finally, fix the
line numbers for the warnings, they were wrong and could ICE the
compiler.
2431 TFV 18-Jul-84
Fix processing of line sequence numbers for second and later
program units. When a statement consisting of END is scanned,
it is the end statement for the program unit. The beginning of
the next line must be scanned for a LSN before returning from
LEXCLA.
2474 TFV 21-Sep-84, AlB 5-Oct-84
Fix continuation processing to handle unlimited numbers of blank
and comment lines between continuation lines. The macro
ACTCLABLT has been replaced by ACTCALCLT to handle the case of
line terminators detected as the first character on a line.
Add a mark on the transition trace listing to differentiate
classifier calls from the lexeme calls.
Change BACKPRINT call to PRINT to pass a zero argument to specify
that the line is not necessarily in the linked list of source lines.
2505 AlB 28-Nov-84
Move the BACKPRINT routine to LISTNG.BLI, since it needed some
definitions supplied by LEXAID, and LEXAID.BLI conflicts with
FIRST and/or TABLES.
A rewrite of the SAVLINE routine made it so trivial that it was
removed, and calls from LEXCLA and LEXICA were replaced by in-line
code.
2506 AlB 30-Nov-84
When the classifier found the 'no continue' condition, it was not
backing up LINLCURR when it backed up the pointers.
***** End V10 Development *****
***** End Revision History *****
)%
EXTERNAL
%2420% CBIGSTATE, ! First classifier bigstate
CHAROUT,
%2420% CSMALSTATE, ! First classifier smalstate
DECODELINE,
ENDOFILE,
%2420% LBIGSTATE, ! First lexeme bigstate
LINENO,
%2420% LSMALSTATE, ! First lexeme smalstate
STBITS,
STPACK,
STRNGOUT;
EXTERNAL
%2506% LINELINE,LINEPTR,CHARPOS,CLASLINE,CLASPTR,CLASLPT,CLASPOS,CLASLCUR,
%2506% LINLCURR,CURPTR,DECREMENT,BACKLINE,CREFIT;
REQUIRE DBUGIT.REQ;
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,
GLOGI = LOGICAL,
GINTEGER = INTEGER,
GDOUBLPREC = DOUBLPREC,
GDUBOCT = DOUBLOCT,
GOCTAL = OCTAL;
BIND DUMM = UPLIT (
GIDTAB GLOBALLY NAMES IDTAB,
GCONTAB GLOBALLY NAMES CONTAB
);
BIND VECTOR NAMLEX=UPLIT( LEXNAME GLOBALLY NAMES
%0% UPLIT'unknown?0',
%1% UPLIT'identifier?0',
%2% UPLIT'constant?0',
%3% UPLIT'lit string?0',
%4% UPLIT'label?0',
%5% UPLIT'statement end?0',
%6% UPLIT'relational op?0',
%7% UPLIT'.NOT.?0',
%8% UPLIT'.AND.?0',
%9% UPLIT'.OR.?0',
%10% UPLIT'.EQV. or .XOR.?0',
%11% UPLIT'"**" or "^"?0',
%12% UPLIT'"&"?0',
%13% UPLIT'"("?0',
%14% UPLIT'")"?0',
%15% UPLIT'":" ?0',
%16% UPLIT'","?0',
%17% UPLIT'"$"?0',
%18% UPLIT'"-"?0',
%19% UPLIT'"/"?0',
%20% UPLIT'"+"?0',
%21% UPLIT'"*"?0',
%22% UPLIT'"="?0',
%23% UPLIT'"//"?0', ! [1243]
%24% UPLIT'"''"?0' ! [1470]
);
! 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 = UPLIT (
% THIS IS A TABLE USED TO SCAN FOR AND IDENTIFY THE "."ED OPERATORS %
NDOTOP GLOBALLY NAMES 'EQV', LOGICALMATCH^18+2, ![737]
'E', DOTNE,
'OT', LOGICALNOT^18,
0,
'.NE. OR .NOT. OR .NEQV.?0', ![737]
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 = UPLIT ( 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 BAKSAV=
BEGIN
% SAVE THE CURRENT POSITION FOR POSSIBLE BACKUP %
CLASPTR _ .CURPTR;
CLASLINE _ .LINELINE;
CLASPOS _ .CHARPOS;
CLASLPT _ .LINEPTR;
%2506% CLASLCUR = .LINLCURR;
END; ! of BAKSAV
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;
%2506% LINLCURR = .CLASLCUR;
BACKLINE _ 0;
END; ! of BACKUP
GLOBAL ROUTINE LITDEF(CHARS,TYPE)=
BEGIN
% MAKE A LITERAL TABLE ENTRY FOR .CHARS CHARACTERS %
LOCAL WDS;
LOCAL PEXPRNODE LITENTRY;
EXTERNAL NAME,NEWENTRY;
WDS _ ( .CHARS -1 ) /5 + 2;
%1221% NAME<LEFT> _ ( IF .WDS LEQ 2 THEN 2 ELSE .WDS ) + LTLSIZ;
NAME<RIGHT> _ LITTAB;
LITENTRY _ NEWENTRY();
LITENTRY[LITSIZ] _ .WDS;
%1245% LITENTRY[LITLEN] _ .CHARS; ! Set up length for character constant
%1245% ! Set operator field to HOLLCONST or CHARCONST
%1245% IF .TYPE EQL HOLLDEF
%1245% THEN LITENTRY[OPERATOR] _ HOLLCONST
%1245% ELSE LITENTRY[OPERATOR] _ CHARCONST;
LITENTRY[LITEXWDFLG] _ 1; ! TRAILING NULL FLAG
RETURN .LITENTRY
END; ! of LITDEF
GLOBAL ROUTINE ENDOFLIT(POINT,LITENTRY,LASTWORD,CHARS)=
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 STORAGE %
MAP PEXPRNODE LITENTRY;
EXTERNAL SAVSPACE;
LOCAL WDS;
(.POINT<RIGHT>+1)<FULL> _ 0; ! ZERO LAST WORD
LITENTRY[LITSIZ] _ .POINT - .LITENTRY + 2 - LTLSIZ;
%1245% LITENTRY[LITLEN] _ .CHARS; ! Set up length for character constant
SAVSPACE ( .LASTWORD - .POINT - 1 , .POINT+2 );
END; ! of ENDOFLIT
GLOBAL ROUTINE LABDEF=
BEGIN
% MAKE A STATEMENT LABEL DEFINITION ENTRY %
%1402% ! For error messages
%1402% BIND VECTOR IOEXPLIT = UPLIT (UPLIT ' FORMAT?0', UPLIT 'n executable statement?0');
REGISTER T1,T2;
EXTERNAL LABLOFSTATEMENT,TBLSEARCH,STALABL,NAME,ENTRY,FATLERR,STMNDESC,GFORMAT,ISN;
EXTERNAL E171;
MAP BASE T1:T2;
BIND LABDF = 3; !CREFIT PARAMETER
IF .FLGREG<CROSSREF> THEN CREFIT( .STALABL, LABDF);
% MAKE THE ENTRY %
NAME _ LABTAB;
ENTRY[0] _ .STALABL;
T1 _ TBLSEARCH();
IF ( T2 _ .T1[SNHDR] ) NEQ 0
THEN
BEGIN % MULTIPLY DEFINED %
FATLERR ( .T2[SRCISN], .T1[SNUMBER], .ISN,E20<0,0>);
%[1100]% LABLOFSTATEMENT _ .T1;
END
ELSE
BEGIN % CHECK FORMAT VS EXECUTABLE VS DECLARATION %
EXTERNAL GFORMAT,GILLEGAL,DOCHECK;
IF .ORDERCODE(@STMNDESC) EQL GFORMAT<0,0>
THEN
BEGIN % FORMAT STATEMENT LABEL %
IF .T1[SNEXECU]
THEN FATLERR(.STALABL,.ISN,E91<0,0>)
%[1100]% ELSE T1[SNIO] _ 1;
%[1100]% LABLOFSTATEMENT _ .T1;
%1526% T1[SNPSECT] = PSDATA; ! FORMATs live in the lowseg
END
ELSE
%1402% IF .LABOK(@STMNDESC) EQL GILLEGAL<0,0>
%1402% THEN
%1402% BEGIN % DECLARATION STATEMENT %
%1402% IF .T1[SNEXECU] OR .T1[SNIO]
%1402% THEN FATLERR(.IOEXPLIT[.T1[SNEXECU]],.STALABL,
%1402% .ISN,E171<0,0>);
%1402% T1[SNDECL] _ 1;
%1712% T1[SNPSECT] = PSCODE; ! Declarations can generate
%1712% ! code in the hiseg
%1402% LABLOFSTATEMENT _ .T1;
%1402% END
%1402% ELSE
BEGIN % EXECUTABLE STATEMENT %
IF .T1[SNIO]
THEN
BEGIN
FATLERR( .STALABL,.ISN,E113<0,0> );
%[1100]% LABLOFSTATEMENT _ .T1;
END
ELSE
BEGIN
EXTERNAL FATLEX,E67;
T1[SNEXECU] _ 1;
LABLOFSTATEMENT _ .T1 ;
% DO NEST CHECKING %
IF .T1[SNDOLVL] NEQ 0
THEN % CHECK FOR RATIONAL DOLOOP TERMINATION STATEMENT %
IF .BADOTERM( @STMNDESC ) THEN FATLEX(E67<0,0>);
%1526% T1[SNPSECT] = PSCODE; ! Statements live in
%1526% ! the hiseg
END
END;
END
END; ! of LABDEF
GLOBAL ROUTINE LABREF=
BEGIN
GLOBAL NONIOINIO; ! IF SET IT INDICATES THAT THE LABEL IS OK EVEN THOUGH ITS AN
! EXECUTABLE LABEL IN AN IO STATEMENT
% THIS ROUTINE HANDLES LABEL REFERENCES %
% THE LABEL IS IN ENTRY[1] , IN DECIMAL %
EXTERNAL FATLEX,LEXLINE,NAME,ENTRY,TBLSEARCH,GIOCODE,STMNDESC,LOOK4LABEL;
EXTERNAL E172;
REGISTER T1,T2;
MAP BASE T1;
BIND LABRF = 4; !CREFIT PARAMETER
LOOK4LABEL _ 0;
% CHECK FOR LEGAL LABEL %
IF .ENTRY[1] LEQ 0 OR .ENTRY[1] GTR 99999
THEN ( FATLEX(E19<0,0>); ENTRY[1] _ 0);
% ONE DOES NOT RETURN HERE ON AN ERROR BECAUSE
THEN NO LABEL IS RETURNED AND WHEN THE COMPILER
CHECKS AT THE END FOR UNDEFINED LABELS THERE
IS A BIG HOLE AND WE GO OFF THE DEEP END.
SO ITS SEEMS BEST TO SUFFER THOROUGH A FEW
UNLIKELY EXTRANEOUS MESSAGES ASSOCIATED WITH
MORE THAN ONE OCCURRANCE OF LARGE OR 0 LABELS %
IF .FLGREG<CROSSREF> THEN CREFIT( .ENTRY[1], LABRF );
ENTRY[0] _ .ENTRY[1];
NAME _ LABTAB;
T1 _ TBLSEARCH();
% CHECK LEGALITY OF REFERENCE %
%1402% IF .T1[SNDECL]
%1402% THEN FATLEX (.ENTRY[0], E172<0,0>)
%1402% ELSE
IF ( T2 _ .ORDERCODE(@STMNDESC) ) EQL GIOCODE<0,0> AND NOT .NONIOINIO
THEN
BEGIN % IN IO STATEMENT %
IF .T1[SNEXECU]
%[1100]% THEN FATLEX ( .ENTRY[0], E156<0,0> )
ELSE % OK %
T1[ SNIO ] _ 1;
END
ELSE
BEGIN % NON- IO STATEMENTS %
![746] ALLOW ASSIGN STATEMENTS TO PICK UP FORMAT STATEMENT LABELS.
![746] THIS IS IN PREPARATION FOR USING THEM IN I/O STATEMENTS FOR
![746] THE FORTRAN-77 STANDARD.
%[746]% EXTERNAL ASSISTA;
%[746]% NONIOINIO _ 0;
%[746]% ! ASSIGN STATEMENT COULD MEAN EITHER TYPE, SO JUST GET OUT...
%[746]% IF .(@STMNDESC)<RIGHT> EQL ASSISTA<0,0> THEN RETURN .T1;
%1402% IF .T1[SNIO] OR .T1[SNDECL]
%1402% THEN FATLEX ( .ENTRY[0],E157<0,0> )
ELSE %OK%
T1[ SNEXECU ] _ 1;
END;
RETURN .T1
END; ! of LABREF
!***************************************************************
! Routines to trace LEXICAL processing. In order to use them,
! DBUGIT.REQ must bind DBUGIT to 1. Then DRIVER.BLI, INOUT.BLI,
! LEXCLA.BLI, LEXICA.BLI and LEXSUP.BLI must be recompiled.
! Finally, specifying the /BUGOUT switch outputs the following
! data (values are octal and additive):
!
! 1 - output buffer immediately. In module INOUT routines
! LINEOUT, CHAROUT, STRNGOUT.
! 2 - output transitions in the finite state machine, the
! current character, the CODE for the character, the
! ACTION routine, and the STATE. In module LEXSUP,
! routine TRACE.
! 4 - output the classification of the statement. In
! module DRIVER, routine MRP1.
! 10 - output the type of lexeme returned from LEXICA. In
! module LEXSUP, routine TRACLEX.
! 20 - output internal calls and returns from lexical
! states. In module LEXSUP, routines TRACPUSH,
! TRACPOP.
!
!***************************************************************
IF DBUGIT
THEN
BEGIN ! Lexical tracing
%2241% ! Add binds for code names, action names, and state names. They
%2241% ! must agree with the definitions in LEXAID and LEXICA. They
%2241% ! will be used to type symbolic debugging information.
EXTERNAL BUGOUT;
%2241% BIND NEXTPLIT = UPLIT(
%2241% UPLIT ASCIZ 'NONEW ',
%2241% UPLIT ASCIZ 'NEWCASE ',
%2241% UPLIT ASCIZ 'NEWSTATE',
%2241% UPLIT ASCIZ 'NEWBIG ',
%2241% UPLIT ASCIZ 'NEWSMALL');
BIND
%2241% CODEPLIT = UPLIT( ! SMALCODE and BIGCODE names
UPLIT ASCIZ 'ILL ', ! 1 SMALCODE and BIGCODE
UPLIT ASCIZ 'TAB ', ! 2
UPLIT ASCIZ 'LT ', ! 3
UPLIT ASCIZ 'BLANK ', ! 4
UPLIT ASCIZ 'SPEC ', ! 5
UPLIT ASCIZ 'DIGIT ', ! 6
UPLIT ASCIZ 'UPPER ', ! 7
UPLIT ASCIZ 'LOWER ', ! 8
UPLIT ASCIZ 'FOS ', ! 9
UPLIT ASCIZ 'EOB ', ! 10
UPLIT ASCIZ 'REMARK ', ! 11 last SMALCODE
UPLIT ASCIZ 'ANDSGN ', ! 12 BIGCODE
UPLIT ASCIZ 'LPAREN ', ! 13
UPLIT ASCIZ 'RPAREN ', ! 14
UPLIT ASCIZ 'COLON ', ! 15
UPLIT ASCIZ 'COMMA ', ! 16
UPLIT ASCIZ 'DOLLAR ', ! 17
UPLIT ASCIZ 'MINUS ', ! 18
UPLIT ASCIZ 'SLASH ', ! 19
UPLIT ASCIZ 'PLUS ', ! 20
UPLIT ASCIZ 'ASTERISK', ! 21
UPLIT ASCIZ 'EQUAL ', ! 22
UPLIT ASCIZ 'LTSGN ', ! 23
UPLIT ASCIZ 'GTSGN ', ! 24
UPLIT ASCIZ 'NEQSGN ', ! 25
UPLIT ASCIZ 'DOT ', ! 26
UPLIT ASCIZ 'SEMICOL ', ! 27
UPLIT ASCIZ 'LITSGN ', ! 28
UPLIT ASCIZ 'OCTSGN ', ! 29
UPLIT ASCIZ 'COMNTSGN', ! 30
UPLIT ASCIZ 'DEBUGSGN', ! 31
UPLIT ASCIZ 'UPAROW ' ! 32 last BIGCODE
),
%2420% CACTIONPLIT = UPLIT( ! Classifier ACTION names
UPLIT ASCIZ 'ACTEOB ', ! 0
UPLIT ASCIZ 'ACTINIT ', ! 1
UPLIT ASCIZ 'ACTANY ', ! 2
UPLIT ASCIZ 'ACTTAB ', ! 3
UPLIT ASCIZ 'ACTSTSKIP ', ! 4
UPLIT ASCIZ 'ACTREMEND ', ! 5
UPLIT ASCIZ 'ACTGOBAKNOW', ! 6
UPLIT ASCIZ 'ACTLT ', ! 7
UPLIT ASCIZ 'ACTSTMNTFOS', ! 8
UPLIT ASCIZ 'ACTGOBAKNXT', ! 9
UPLIT ASCIZ 'ACTEXPLT ', ! 10
UPLIT ASCIZ 'ACTRETNOW ', ! 11
UPLIT ASCIZ 'ACTCONTLT ', ! 12
UPLIT ASCIZ 'ACTCALCONT ', ! 13
UPLIT ASCIZ 'ACTCONTDIG ', ! 14
UPLIT ASCIZ 'ACTCLABSKP ', ! 15
UPLIT ASCIZ 'ACTNOEND ', ! 16
UPLIT ASCIZ 'ACTSTEOP ', ! 17
UPLIT ASCIZ 'ACTENTREMAR', ! 18
UPLIT ASCIZ 'ACTMULTST ', ! 19
UPLIT ASCIZ 'ACTCLASF1 ', ! 20
UPLIT ASCIZ 'ACTMULTNULL', ! 21
UPLIT ASCIZ 'ACTILLCHAR ', ! 22
UPLIT ASCIZ 'ACTCOMNT ', ! 23
UPLIT ASCIZ 'ACTDEBUG ', ! 24
UPLIT ASCIZ 'ACTCOMNTFOS', ! 25
UPLIT ASCIZ 'ACTINTERR ', ! 26
UPLIT ASCIZ 'ACTNOCONT ', ! 27
UPLIT ASCIZ 'ACTNULLFOS ', ! 28
UPLIT ASCIZ 'ACTCITCONT ', ! 29
%2474% UPLIT ASCIZ 'ACTCALCLT ', ! 30
UPLIT ASCIZ 'ACTENTCLABS', ! 31
UPLIT ASCIZ 'ACTCBUGCHK ', ! 32
UPLIT ASCIZ 'ACTENTLAB ', ! 33
UPLIT ASCIZ 'ACTILABILL ', ! 34
UPLIT ASCIZ 'ACTILABEDCK', ! 35
UPLIT ASCIZ 'ACTILITCONT', ! 36
UPLIT ASCIZ 'ACTILABDIG ', ! 37
UPLIT ASCIZ 'ACTILNTC ', ! 38
UPLIT ASCIZ 'ACTILNTI ', ! 39
UPLIT ASCIZ 'ACTILNTD ', ! 40
UPLIT ASCIZ 'ACTILITNC ', ! 41
UPLIT ASCIZ 'ACTILITC ', ! 42
UPLIT ASCIZ 'ACTILABLT ', ! 43
UPLIT ASCIZ 'ACTUPLOW ', ! 44
UPLIT ASCIZ 'ACTCONSTSKP', ! 45
UPLIT ASCIZ 'ACTSKNAME ', ! 46
UPLIT ASCIZ 'ACTSKLPAREN', ! 47
UPLIT ASCIZ 'ACTSKRPAREN', ! 48
UPLIT ASCIZ 'ACTSKCOMMA ', ! 49
UPLIT ASCIZ 'ACTGETLIT ', ! 50
UPLIT ASCIZ 'ACTENDLIT ', ! 51
UPLIT ASCIZ 'ACTBAKTOTER', ! 52
UPLIT ASCIZ 'ACTSKCONBLD', ! 53
UPLIT ASCIZ 'ACTSKPHOLX ', ! 54
UPLIT ASCIZ 'ACTSKPHOL ', ! 55
UPLIT ASCIZ 'ACTHOLTAB ', ! 56
UPLIT ASCIZ 'ACTENTERM ', ! 57
UPLIT ASCIZ 'ACTUNMATEOS', ! 58
UPLIT ASCIZ 'ACTSKILL ', ! 59
UPLIT ASCIZ 'ACTCLASLT ', ! 60
UPLIT ASCIZ 'ACTCLASUNRE', ! 61
UPLIT ASCIZ 'ACTCLILLCHA', ! 62
UPLIT ASCIZ 'ACTCLASBACK', ! 63
UPLIT ASCIZ 'ACTCOMPAR ', ! 64
UPLIT ASCIZ 'ACTCLASAL1 ', ! 65
UPLIT ASCIZ 'ACTASGNMNT ', ! 66
UPLIT ASCIZ 'ACTCLASF2 ', ! 67
UPLIT ASCIZ 'ACTIFCHK ', ! 68
UPLIT ASCIZ 'ACTDOCHK ', ! 69
UPLIT ASCIZ 'ACTARITHIF ', ! 70
UPLIT ASCIZ 'ACTLOGICIF ', ! 71
UPLIT ASCIZ 'ACTDOCHK1 ', ! 72
UPLIT ASCIZ 'ACTDOSTMNT ', ! 73
UPLIT ASCIZ 'ACTENDCHK ', ! 74
UPLIT ASCIZ 'ACTCLASF3 ', ! 75
UPLIT ASCIZ 'ACTCLASF4 ', ! 76
UPLIT ASCIZ 'ACTKEYTERM ', ! 77
UPLIT ASCIZ 'ACTUNMATKEY', ! 78
UPLIT ASCIZ 'ACTSPELLING', ! 79
UPLIT ASCIZ 'ACTBADCHAR ', ! 80
UPLIT ASCIZ 'ACTTHENCHK ', ! 81
UPLIT ASCIZ 'ACTBLOCKIF ', ! 82
UPLIT ASCIZ 'ACTSUBCHK ', ! 83
UPLIT ASCIZ 'ACTSUBASSIG', ! 84
UPLIT ASCIZ 'ACTCLAS1A ', ! 85
UPLIT ASCIZ 'ACTSKCOLON ', ! 86
UPLIT ASCIZ 'ACTKEYSUB ', ! 87
UPLIT ASCIZ 'ACTDOCHK2 ', ! 88
UPLIT ASCIZ 'ACTWHILECHK', ! 89
UPLIT ASCIZ 'ACTCONTBLAN', ! 90
UPLIT ASCIZ 'ACTLTENDCHK', ! 91
UPLIT ASCIZ 'ACTENDLTCHK', ! 92
%2431% UPLIT ASCIZ 'ACTENDLSN', ! 92
),
%2420% LACTIONPLIT = UPLIT( ! Lexeme ACTION names
UPLIT ASCIZ 'ACTEOB ', ! 0
UPLIT ASCIZ 'ACTANY ', ! 1
UPLIT ASCIZ 'ACTTAB ', ! 2
UPLIT ASCIZ 'ACTHOLCONDO', ! 3
UPLIT ASCIZ 'ACTFMTHOLPK', ! 4
UPLIT ASCIZ 'ACTHOLCON ', ! 5
UPLIT ASCIZ 'ACTREMEND ', ! 6
UPLIT ASCIZ 'ACTGOBAKNOW', ! 7
UPLIT ASCIZ 'ACTLT ', ! 8
UPLIT ASCIZ 'ACTFMTHOLCK', ! 9
UPLIT ASCIZ 'ACTGOBAKNXT', ! 10
UPLIT ASCIZ 'ACTEXPLT ', ! 11
UPLIT ASCIZ 'ACTLEXFOS ', ! 12
UPLIT ASCIZ 'ACTRETNOW ', ! 13
UPLIT ASCIZ 'ACTCONTLT ', ! 14
UPLIT ASCIZ 'ACTCALCONT ', ! 15
UPLIT ASCIZ 'ACTCONTDIG ', ! 16
UPLIT ASCIZ 'ACTCLABSKP ', ! 17
UPLIT ASCIZ 'ACTENTREMAR', ! 18
UPLIT ASCIZ 'ACTMULTST ', ! 19
UPLIT ASCIZ 'ACTINTERR ', ! 20
UPLIT ASCIZ 'ACTNOCONT ', ! 21
UPLIT ASCIZ 'ACTCITCONT ', ! 22
%2474% UPLIT ASCIZ 'ACTCALCLT ', ! 23
UPLIT ASCIZ 'ACTENTCLABS', ! 24
UPLIT ASCIZ 'ACTCBUGCHK ', ! 25
UPLIT ASCIZ 'ACTUPLOW ', ! 26
UPLIT ASCIZ 'ACTCONSTSKP', ! 27
UPLIT ASCIZ 'ACTSKNAME ', ! 28
UPLIT ASCIZ 'ACTSKLPAREN', ! 29
UPLIT ASCIZ 'ACTSKRPAREN', ! 30
UPLIT ASCIZ 'ACTSKCOMMA ', ! 31
UPLIT ASCIZ 'ACTGETLIT ', ! 32
UPLIT ASCIZ 'ACTENDLIT ', ! 33
UPLIT ASCIZ 'ACTBAKTOTER', ! 34
UPLIT ASCIZ 'ACTSKCONBLD', ! 35
UPLIT ASCIZ 'ACTSKPHOLX ', ! 36
UPLIT ASCIZ 'ACTSKPHOL ', ! 37
UPLIT ASCIZ 'ACTHOLTAB ', ! 38
UPLIT ASCIZ 'ACTENTERM ', ! 39
UPLIT ASCIZ 'ACTUNMATEOS', ! 40
UPLIT ASCIZ 'ACTFMTQT1 ', ! 41
UPLIT ASCIZ 'ACTSKILL ', ! 42
UPLIT ASCIZ 'ACTCLASLT ', ! 43
UPLIT ASCIZ 'ACTBADCHAR ', ! 44
UPLIT ASCIZ 'ACTSINGLEX ', ! 45
UPLIT ASCIZ 'ACTDOUBLEX ', ! 46
UPLIT ASCIZ 'ACTNOTDOUB ', ! 47
UPLIT ASCIZ 'ACTMAYBDOUB', ! 48
UPLIT ASCIZ 'ACTENTIDENT', ! 49
UPLIT ASCIZ 'ACTPKUPID ', ! 50
UPLIT ASCIZ 'ACTENDID ', ! 51
UPLIT ASCIZ 'ACTENTDOT ', ! 52
UPLIT ASCIZ 'ACTTRYREAL ', ! 53
UPLIT ASCIZ 'ACTMISOPER ', ! 54
UPLIT ASCIZ 'ACTGETOPER ', ! 55
UPLIT ASCIZ 'ACTOPCHK ', ! 56
UPLIT ASCIZ 'ACTMISOP1 ', ! 57
UPLIT ASCIZ 'ACTENTGETCO', ! 58
UPLIT ASCIZ 'ACTGOTINT ', ! 59
UPLIT ASCIZ 'ACTCHECKLET', ! 60
UPLIT ASCIZ 'ACTBILDDBLI', ! 61
UPLIT ASCIZ 'ACTREALCON ', ! 62
UPLIT ASCIZ 'ACTENTRLBLD', ! 63
UPLIT ASCIZ 'ACTGOTREAL ', ! 64
UPLIT ASCIZ 'ACTEXDBCHK ', ! 65
UPLIT ASCIZ 'ACTGOTOP ', ! 66
UPLIT ASCIZ 'ACTCHKPLMI ', ! 67
UPLIT ASCIZ 'ACTNOEXP ', ! 68
UPLIT ASCIZ 'ACTINTEXP1 ', ! 69
UPLIT ASCIZ 'ACTFMTQT ', ! 70
UPLIT ASCIZ 'ACTGOTIEXP ', ! 71
UPLIT ASCIZ 'ACTHOLCHAR ', ! 72
UPLIT ASCIZ 'ACTHOLEND ', ! 73
UPLIT ASCIZ 'ACTENTLITLE', ! 74
UPLIT ASCIZ 'ACTLITEDCHK', ! 75
UPLIT ASCIZ 'ACTTIC2CHK ', ! 76
UPLIT ASCIZ 'ACTENTOCTQ ', ! 77
UPLIT ASCIZ 'ACTNOOCT ', ! 78
UPLIT ASCIZ 'ACTCHKOCPM ', ! 79
UPLIT ASCIZ 'ACTOCTQ1 ', ! 80
UPLIT ASCIZ 'ACTGOTOCT ', ! 81
UPLIT ASCIZ 'ACTNOTIC ', ! 82
UPLIT ASCIZ 'ACTSCANCHAR', ! 83
UPLIT ASCIZ 'ACTSTRCHK ', ! 84
UPLIT ASCIZ 'ACTSTOPLIT ', ! 85
UPLIT ASCIZ 'ACTFLEX1 ', ! 86
UPLIT ASCIZ 'ACTFMTEOS ', ! 87
UPLIT ASCIZ 'ACTFMTCHAR ', ! 88
UPLIT ASCIZ 'ACTRIS ', ! 89
UPLIT ASCIZ 'ACTSTOPINT ', ! 90
UPLIT ASCIZ 'ACTGOT6INT ', ! 91
UPLIT ASCIZ 'ACT6DIGIT ', ! 92
UPLIT ASCIZ 'ACTSKCOLON ', ! 93
UPLIT ASCIZ 'ACTKEYCHK ', ! 94
UPLIT ASCIZ 'ACTKEY1CHK ', ! 95
UPLIT ASCIZ 'ACTCONTBLAN', ! 96
),
%2420% CBIGSTPLIT = UPLIT( ! Classifier BIGSTATE names
UPLIT ASCIZ 'STSTMNT ', ! 0
UPLIT ASCIZ 'STILINE ', ! 1
UPLIT ASCIZ 'STSKIP ', ! 2
UPLIT ASCIZ 'STCONTINUE', ! 3
UPLIT ASCIZ 'STNOEND ', ! 4
UPLIT ASCIZ 'STEOP ', ! 5
UPLIT ASCIZ 'STTERM ', ! 6
UPLIT ASCIZ 'STCLASF2 ', ! 7
UPLIT ASCIZ 'STCLASAL1 ', ! 8
UPLIT ASCIZ 'STIFCHK ', ! 9
UPLIT ASCIZ 'STDOCHK1 ', ! 10
UPLIT ASCIZ 'STDOCHK2 ', ! 11
UPLIT ASCIZ 'STCLASAL2 ', ! 12
UPLIT ASCIZ 'STCLASAL2A', ! 13
UPLIT ASCIZ 'STCLASF4 ', ! 14
UPLIT ASCIZ 'STCLASAL1A', ! 15
UPLIT ASCIZ 'STCLASAL1B', ! 16
),
%2420% LBIGSTPLIT = UPLIT( ! Lexeme BIGSTATE names
UPLIT ASCIZ 'STLEXEME ', ! 0
UPLIT ASCIZ 'STSKIP ', ! 1
UPLIT ASCIZ 'STCONTINUE', ! 2
UPLIT ASCIZ 'STTERM ', ! 3
UPLIT ASCIZ 'STDOUBLEX ', ! 4
UPLIT ASCIZ 'STGETCONST', ! 5
UPLIT ASCIZ 'STFMTLEX ', ! 6
),
%2420% CSMALSTPLIT = UPLIT( ! Classifier SMALSTATE NAMES
UPLIT ASCIZ 'STREMARK ', ! 0
UPLIT ASCIZ 'STINIT ', ! 1
UPLIT ASCIZ 'STRETNX ', ! 2
UPLIT ASCIZ 'STNULLST ', ! 3
UPLIT ASCIZ 'STCOMNT ', ! 4
UPLIT ASCIZ 'STCALCONT ', ! 5
UPLIT ASCIZ 'STCLABSKP ', ! 6
UPLIT ASCIZ 'STCNTCONT ', ! 7
UPLIT ASCIZ 'STCITCONT ', ! 8
UPLIT ASCIZ 'STILABEL ', ! 9
UPLIT ASCIZ 'STLABSKP ', ! 10
UPLIT ASCIZ 'STILNTCONT ', ! 11
UPLIT ASCIZ 'STILITCONT ', ! 12
UPLIT ASCIZ 'STGETLIT ', ! 13
UPLIT ASCIZ 'STSKNAME ', ! 14
UPLIT ASCIZ 'STCONSTSKP ', ! 15
UPLIT ASCIZ 'STSKPHOL ', ! 16
UPLIT ASCIZ 'STCLASF3 ', ! 17
UPLIT ASCIZ 'STSPELLING ', ! 18
UPLIT ASCIZ 'STIFCLASIF ', ! 19
UPLIT ASCIZ 'STTHENCHK ', ! 20
UPLIT ASCIZ 'STDOCHK3 ', ! 21
UPLIT ASCIZ 'STCONTBLANK', ! 22
%2431% UPLIT ASCIZ 'STENDLSN', ! 22
),
%2420% LSMALSTPLIT = UPLIT( ! Lexeme SMALSTATE NAMES
UPLIT ASCIZ 'STREMARK ', ! 0
UPLIT ASCIZ 'STRETNX ', ! 1
UPLIT ASCIZ 'STCALCONT ', ! 2
UPLIT ASCIZ 'STCLABSKP ', ! 3
UPLIT ASCIZ 'STCNTCONT ', ! 4
UPLIT ASCIZ 'STCITCONT ', ! 5
UPLIT ASCIZ 'STGETLIT ', ! 6
UPLIT ASCIZ 'STSKNAME ', ! 7
UPLIT ASCIZ 'STCONSTSKP ', ! 8
UPLIT ASCIZ 'STSKPHOL ', ! 9
UPLIT ASCIZ 'STIDENT ', ! 10
UPLIT ASCIZ 'STDOT ', ! 11
UPLIT ASCIZ 'STSCANOP ', ! 12
UPLIT ASCIZ 'STBLDDBLINT', ! 13
UPLIT ASCIZ 'STREALCON ', ! 14
UPLIT ASCIZ 'STREALCON1 ', ! 15
UPLIT ASCIZ 'STOPCHK ', ! 16
UPLIT ASCIZ 'STINTEXPONE', ! 17
UPLIT ASCIZ 'STINTEXP0 ', ! 18
UPLIT ASCIZ 'STINTEXP1 ', ! 19
UPLIT ASCIZ 'STHOLEX ', ! 20
UPLIT ASCIZ 'STLITLEX ', ! 21
UPLIT ASCIZ 'STLITEND ', ! 22
UPLIT ASCIZ 'STOCTQ ', ! 23
UPLIT ASCIZ 'STOCTQ0 ', ! 24
UPLIT ASCIZ 'STOCTQ1 ', ! 25
UPLIT ASCIZ 'STCSCAN ', ! 26
UPLIT ASCIZ 'STSSCAN ', ! 27
UPLIT ASCIZ 'STOPOBJ ', ! 28
UPLIT ASCIZ 'STFMTQT ', ! 29
UPLIT ASCIZ 'STFHOLCON ', ! 30
UPLIT ASCIZ 'STFHOLPKUP ', ! 31
UPLIT ASCIZ 'STSIXDIGIT ', ! 32
UPLIT ASCIZ 'STKEYSCAN ', ! 33
UPLIT ASCIZ 'STKEY1CHK ', ! 34
UPLIT ASCIZ 'STCONTBLANK', ! 35
);
%2241% BIND
LASTBIGCODE = 32,
LASTSMALCODE = 11,
CRLF = UPLIT ASCIZ '?M?J';
ROUTINE TRACSTATE(STATE, CLASS)=
!++
! FUNCTIONAL DESCRIPTION:
! Output the name of the state to the listing. There are four
! different PLITs of state names, bigstates in the classifier,
! smalstates in the classifier, bigstates in the lexeme scanner,
! and smalstates in the lexeme scanner.
!
! FORMAL PARAMETERS:
!
! STATE pointer to the state
! CLASS non zero if this is a classifier state, otherwise
! it is a lexeme state
!
! IMPLICIT INPUTS:
!
! CBIGSTATE first classifier bigstate
! CSMALSTATE first classifier smalstate
! LBIGSTATE first lexeme bigstate
! LSMALSTATE first lexeme smalstate
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! Outputs state name to the listing.
!
!--
![2420] New
BEGIN
REGISTER STNUM; ! State number
! Compute offset from start of state table, then adjust by
! number of codes and packing factor.
IF @@STATE EQL 1
THEN
BEGIN ! A Bigstate
IF .CLASS NEQ 0
THEN STNUM = .STATE<RIGHT> - CBIGSTATE<0,0> ! Classifier
ELSE STNUM = .STATE<RIGHT> - LBIGSTATE<0,0>; ! Lexeme
STNUM = (.STNUM / (LASTBIGCODE + 1)) * STPACK<0,0>;
END ! A Bigstate
ELSE
BEGIN ! A Smalstate
IF .CLASS NEQ 0
THEN STNUM = .STATE<RIGHT> - CSMALSTATE<0,0> ! Classifier
ELSE STNUM = .STATE<RIGHT> - LSMALSTATE<0,0>; ! Lexeme
STNUM = (.STNUM / (LASTSMALCODE + 1)) * STPACK<0,0>;
END; ! A Smalstate
! Add in offset in word from P field of byte pointer
STNUM = .STNUM + STPACK<0,0> - .STATE<30,6>/STBITS<0,0> - 1;
! Typeout appropriate state name plit entry
IF @@STATE EQL 1
THEN
BEGIN ! A Bigstate
IF .CLASS NEQ 0
THEN STRNGOUT(.CBIGSTPLIT[.STNUM]) ! Classifier state
ELSE STRNGOUT(.LBIGSTPLIT[.STNUM]); ! Lexeme state
END ! A Bigstate
ELSE
BEGIN ! A Smalstate
IF .CLASS NEQ 0
THEN STRNGOUT(.CSMALSTPLIT[.STNUM]) ! Classifier state
ELSE STRNGOUT(.LSMALSTPLIT[.STNUM]); ! Lexeme state
END; ! A Smalstate
END; ! of TRACSTATE
GLOBAL ROUTINE TRACPUSH(NXTSTATE, RETURNTO, CLASS)=
BEGIN
%2241% ! Written by TFV on 11-Oct-83
%2241% IF NOT .FLGREG<LISTING> THEN RETURN; ! No listing
%2241% IF (.BUGOUT AND #20) EQL 0 THEN RETURN; ! No push trace
%2474% IF .CLASS NEQ 0
%2474% THEN STRNGOUT(UPLIT ASCIZ '- ') ! Classifier
%2474% ELSE STRNGOUT(UPLIT ASCIZ ' '); ! Lexeme
%2420% STRNGOUT(UPLIT ASCIZ ' push - nextstate ');
%2420% TRACSTATE(.NXTSTATE, .CLASS); ! Typeout return state name
STRNGOUT(UPLIT ASCIZ ' return to ');
%2420% TRACSTATE(.RETURNTO, .CLASS); ! Typeout next state name
STRNGOUT(CRLF);
END; ! of TRACPUSH
GLOBAL ROUTINE TRACPOP(STATE, CLASS)=
BEGIN
%2241% ! Written by TFV on 11-Oct-83
%2241% IF NOT .FLGREG<LISTING> THEN RETURN; ! No listing
%2241% IF (.BUGOUT AND #20) EQL 0 THEN RETURN; ! No push trace
%2474% IF .CLASS NEQ 0
%2474% THEN STRNGOUT(UPLIT ASCIZ '- ') ! Classifier
%2474% ELSE STRNGOUT(UPLIT ASCIZ ' '); ! Lexeme
STRNGOUT(UPLIT ASCIZ ' pop - STATE ');
%2420% TRACSTATE(.STATE, .CLASS); ! Typeout return state name
STRNGOUT(CRLF);
END; ! of TRACPOP
GLOBAL ROUTINE TRACLEX(VALUE)=
BEGIN
REGISTER LEXEME;
%2241% IF NOT .FLGREG<LISTING> THEN RETURN; ! No listing
%2241% IF (.BUGOUT AND #10) EQL 0 THEN RETURN; ! No lex tracing
LEXEME = .VALUE;
IF .VALUE<LEFT> GEQ IDENTIFIER AND .VALUE<LEFT> LEQ LASTLEX
THEN
BEGIN
STRNGOUT(.LEXNAME[.VALUE<LEFT>]);
IF .VALUE<LEFT> EQL LITSTRING
THEN
BEGIN
STRNGOUT(CRLF);
STRNGOUT(.VALUE<RIGHT> + 3);
STRNGOUT(CRLF);
END
END
ELSE
IF .VALUE EQL ENDOFILE<0,0>
THEN STRNGOUT(UPLIT ASCIZ 'endofile')
ELSE IF .VALUE EQL (NOT ENDOFILE<0,0>)
THEN STRNGOUT(UPLIT ASCIZ 'not endofile')
ELSE IF .VALUE EQL 1
THEN STRNGOUT(UPLIT ASCIZ 'true')
ELSE IF .VALUE EQL 0
THEN STRNGOUT(UPLIT ASCIZ 'false')
ELSE STRNGOUT(UPLIT ASCIZ 'unknown');
STRNGOUT(UPLIT ASCIZ ' returned?M?J');
END; ! of TRACLEX
GLOBAL ROUTINE TRACE(NEXT,STATE,CHAR,CODE,ACTION, CLASS)=
BEGIN
%2241% IF NOT .FLGREG<LISTING> THEN RETURN; ! No listing
%2241% IF (.BUGOUT AND #2) EQL 0 THEN RETURN; ! No transition tracing
%2474% IF .CLASS NEQ 0
%2474% THEN STRNGOUT(UPLIT ASCIZ '- ') ! Classifier
%2474% ELSE STRNGOUT(UPLIT ASCIZ ' '); ! Lexeme
%2241% STRNGOUT(.NEXTPLIT[.NEXT+1]); ! type out LEAVE type
STRNGOUT(PLIT(' CHAR '));
%2241% IF .CHAR LSS " " OR .CHAR GEQ #177
%2241% THEN CHAROUT (" ")
%2241% ELSE CHAROUT(.CHAR);
CHAROUT("/");
DECODELINE(.CHAR);
STRNGOUT(LINENO<0,0>);
STRNGOUT(PLIT(' CODE '));
%2241% STRNGOUT(.CODEPLIT[.CODE - 1]);
STRNGOUT(PLIT(' ACTION '));
%2420% IF .CLASS NEQ 0
%2420% THEN STRNGOUT(.CACTIONPLIT[.ACTION]) ! Classifier action
%2420% ELSE STRNGOUT(.LACTIONPLIT[.ACTION]); ! Lexeme action
%2241% STRNGOUT(PLIT(' STATE '));
%2420% TRACSTATE(.STATE, .CLASS); ! Typeout state name
STRNGOUT(CRLF);
END; ! of TRACE
END ! Lexical tracing
END
ELUDOM