Google
 

Trailing-Edge - PDP-10 Archives - BB-4157F-BM_1983 - fortran/compiler/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) DIGITAL EQUIPMENT CORPORATION 1973, 1983
!AUTHOR: D. B. TOLMAN/DCE/SJW/TFV/CKS/EDS/AHM

MODULE LEXSUP(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN %LEXSUP%

GLOBAL BIND LEXSUV = 7^24 + 0^18 + #1712;	! Version Date:	7-Jan-83


%(

***** 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 Revision History *****

)%


EXTERNAL  LINELINE,LINEPTR,CHARPOS,CLASLINE,CLASPTR,CLASLPT,CLASPOS,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
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;
	LOCAL NAMESAVE;
	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 %
	NAMESAVE_.NAME;
	NAME<LEFT> _ 4;
	ADDR _ CORMAN();
	NAME_.NAMESAVE;

	(@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
%1453%		(.BACKLINE<LEFT>)<FULL> _ @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 , 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;	! 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;	! 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;	%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;





BEGIN	% TRACE ROUTINES %

	IF DBUGIT
	THEN
	BEGIN


		GLOBAL ROUTINE
	TRACLEX  ( VALUE )  =
	BEGIN
		EXTERNAL  STRNGOUT,ENDOFILE,LEXNAME;

		OWN LEXEME;
		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
				EXTERNAL  CHAROUT;
				BIND CR=#15,LF=#12;
				CHAROUT(CR);CHAROUT(LF);
				STRNGOUT( .VALUE<RIGHT>+3 );
				CHAROUT(CR);CHAROUT(LF)
			END
		END
		ELSE
			IF .VALUE  EQL ENDOFILE<0,0>
			THEN	STRNGOUT(UPLIT'ENDOFILE?0')
			ELSE
				IF .VALUE  EQL ( NOT ENDOFILE<0,0>)
				THEN	STRNGOUT(UPLIT'NOT ENDOFILE?0')
				ELSE
					IF .VALUE   EQL  1
					THEN	STRNGOUT(UPLIT'TRUE?0')
					ELSE
						IF .VALUE  EQL  0
						THEN	STRNGOUT(UPLIT'FALSE?0')
						ELSE	STRNGOUT(UPLIT'UNKNOWN?0');

	STRNGOUT ( UPLIT'	RETURNED?M?J?0');

	RETURN .VALUE
	END;	% TRACLEX%
	GLOBAL ROUTINE 
TRACE(STATE,CHAR,CODE,ACTION)  =
BEGIN
	BIND CR = 13, LF = 10;
	EXTERNAL LINENO;
	BIND LASTBIGCODE = 32,LASTSMALCODE=11;
	EXTERNAL BIGSTATE,SMALSTATE,STBITS,STPACK;
	EXTERNAL STRNGOUT,CHAROUT,DECODELINE;
	LOCAL TMP;

	STRNGOUT ( PLIT( 'CHAR	'));
	IF .CHAR LSS " " THEN CHAROUT (" ") ELSE CHAROUT(.CHAR);
	CHAROUT("/");
	DECODELINE (.CHAR);
	STRNGOUT(LINENO<0,0>);
	STRNGOUT ( PLIT('CODE	'));
	DECODELINE(.CODE);
	STRNGOUT(LINENO<0,0>);
	STRNGOUT (PLIT('ACTION	'));
	DECODELINE (.ACTION);
	STRNGOUT(LINENO<0,0>);
	STRNGOUT (PLIT('STATE	'));

	IF @@STATE EQL  1	% CODETYPE BIG %
	THEN
	BEGIN	% BIGSTATE %
		TMP _ ((.STATE<RIGHT> - BIGSTATE<0,0>  ) /( LASTBIGCODE+1 )) * STPACK<0,0>
			+ (STPACK<0,0>-(.STATE<30,6>/STBITS<0,0>)-1);
		DECODELINE(.TMP);
		STRNGOUT (LINENO<0,0>);
		CHAROUT("B")
	END
	ELSE
	BEGIN	% SMALSTATE %
		TMP _ ((.STATE<RIGHT> - SMALSTATE<0,0>  ) /( LASTSMALCODE+1 )) * STPACK<0,0>
			+ (STPACK<0,0>-(.STATE<30,6>/STBITS<0,0>)-1);
		DECODELINE(.TMP);
		STRNGOUT (LINENO<0,0>);
		CHAROUT("S")
	END;

	CHAROUT(CR);  CHAROUT (LF);

END;	%ROUTINE TRACE %

	END
END;


END
ELUDOM