Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-compiler/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