Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-compiler/codeta.bli
There are 12 other files named codeta.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/MD/DCE/CKS/RVM

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

GLOBAL BIND CODETV = #10^24 + 0^18 + #1677;	! Version Date: 20-Nov-82

%(

***** Begin Revision History *****

1	-----	-----	ADD SYNOW FIELD TO THE STATEMENT DESCRIPTIONS
			SO THAT CERTIAN STATEMENTS CAN HAVE THEIR
			"SYNTAX" EXECUTED BEFORE THE CALL TO THEIR
			SEMANTICS

2	242	15010	CONTINUE IS A VALID SUBSTATEMENT OF A LOGICAL IF

***** Begin Version 6 *****

3	1044	EGM	20-Jan-81	20-15467
	Define a new error action code (fatal statement out of order)
	and place it in the statement order transition table at the proper
	point.

***** Begin Version 7 *****

4	1201	DCE	19-JUN-80	-----
	Add new keywords - CHARACTER, ELSE, ENDIF, THEN, INQUIRE, INTRINSIC,
	SAVE.

5       1214    CKS      8-May-81
        Add statement description block for block IF, remove THEN statement.
        Remove TERMBAD from ENDIF statement so it is allowed to terminate a DO.

6	1247	CKS	6-Aug-81
	Add SUBASSIGN statement

7	1456	CKS	11-Jan-82
	Add IOINPUT flag to READ, ACCEPT, REREAD statements.  This bit is
	needed so EXPRESS can know whether to call NAMREF or NAMSET when it
	sees a name in an IO list.  This flag shoves over the SYNTX field
	to bit 27, so this field is now only 9 bits long.

8	1464	RVM	26-Jan-82
	Connect the entry for the INTRINSIC statement with its BNF.

9	1466	CDM	1-Feb-82
	Connect the entry for the SAVE statement with its BNF.

1527	CKS	9-Apr-82
	Modify the statement order requirements for PARAMETER statements.
	PARAMETER may now appear before IMPLICIT, between IMPLICIT and
	specification, or after specification statements.

1536	CKS	19-May-82
	Allow DATA statements to be freely mixed with type specification
	statements and PARAMETER statements.

1556	CKS	14-Jun-82
	Allow ENTRY statements anyplace FORMAT statements are.  (Ie, anyplace.)

1573	CKS	1-Jul-82
	Add statement description blocks for END DO and DO WHILE.

1610	CKS	5-Aug-82
	Allow NAMELIST statements anyplace after the IMPLICITs.  (Like DATA.)

1621	CKS	24-Aug-82
	1556 caused labels on ENTRY statements to be marked as FORMAT statement
	labels, because LABDEF trickily checks the order code to decide if a
	statement is a FORMAT or not.  Add an order code ENTR for entry
	statements, identical to FORMAT but with a different number so LABDEF
	won't freak out.

1665	CKS	8-Nov-82
	Allow GOTO as the last statement in a DO loop.  We catch non-computed
	GOTOs in the semantic routine.

1677	CKS	16-Nov-82
	Set IOINPUT for DECODE to prohibit expressions in its IO list.

***** End Revision History *****

)%


% CODETAB IS THE TABLE WHICH CLASSIFIES EACH POSSIBLE
   ASCII CHARACTER INTO ONE OF THE CODES  %
% THERE ARE 11 CLASSIFICATIONS FOR THE SMALL STATES AND
     32 FOR THE LARGE STATES  %

!  FIRST WE NEED THE CLASSIFICATION CODE DEFINITIONS

REQUIRE LEXNAM.BLI;
REQUIRE LEXAID.BLI;
REQUIRE IOFLG.BLI;
REQUIRE META72.BLI;

 BIND CODES = PLIT(  CODETAB GLOBALLY NAMES 

		% 000	NULL	%	EOB^18 + EOB ,
		% 001	^A	%	ILL^18 + ILL ,
		% 002	^B	%	ILL^18 + ILL ,
		% 003	^C	%	ILL^18 + ILL ,
		% 004	^D	%	ILL^18 + ILL ,
		% 005	^E	%	ILL^18 + ILL ,
		% 006	^F	%	ILL^18 + ILL ,
		% 007	^G	%	ILL^18 + ILL ,
		% 010	^H	%	ILL^18 + ILL ,
		% 011	<TAB>	%	TAB^18 + TAB ,
		% 012	<LF>	%	LT^18 + LT ,
		% 013	<VT>	%	LT^18 + LT ,
		% 014	<FF>	%	LT^18 + LT ,
		% 015	<CR>	%	LT^18 + LT ,
		% 016	^N	%	ILL^18 + ILL ,
		% 017	^M	%	ILL^18 + ILL ,
		% 020	^P	%	ILL^18 + ILL ,
		% 021	^Q	%	ILL^18 + ILL ,
		% 022	^R	%	ILL^18 + ILL ,
		% 023	^S	%	ILL^18 + ILL ,
		% 024	^T	%	ILL^18 + ILL ,
		% 025	^U	%	ILL^18 + ILL ,
		% 026	^V	%	ILL^18 + ILL ,
		% 027	^W	%	ILL^18 + ILL ,
		% 030	^X	%	ILL^18 + ILL ,
		% 031	^Y	%	ILL^18 + ILL ,
		% 032	^Z	%	EOB^18 + EOB ,
		% 033	ESCAPE	%	ILL^18 + ILL ,
		% 034	^-\	%	ILL^18 + ILL ,
		% 035	^-]	%	ILL^18 + ILL ,
		% 036	^-^	%	ILL^18 + ILL ,
		% 037	^-_	%	EOB^18 + ILL ,
		% 040	BLANK	%	BLANK^18 + BLANK ,
		% 041	!	%	REMARK^18 + REMARK ,
		% 042	"	%	SPEC^18 + OCTSGN ,
		% 043	#	%	SPEC^18 + NEQSGN ,
		% 044	$	%	SPEC^18 + DOLLAR ,
		% 045	%		ILL^18 + ILL ,
		% 046	&	%	SPEC^18 + ANDSGN ,
		% 047	'	%	SPEC^18 + LITSGN ,
		% 050	(	%	SPEC^18 + LPAREN ,
		% 051	)	%	SPEC^18 + RPAREN ,
		% 052	*	%	SPEC^18 + ASTERISK ,
		% 053	+	%	SPEC^18 + PLUS ,
		% 054	,	%	SPEC^18 + COMMA ,
		% 055	-	%	SPEC^18 + MINUS ,
		% 056	.	%	SPEC^18 + DOT ,
		% 057	/	%	SPEC^18 + SLASH ,
		% 060	0	%	DIGIT^18 + DIGIT ,
		% 061	1	%	DIGIT^18 + DIGIT ,
		% 062	2	%	DIGIT^18 + DIGIT ,
		% 063	3	%	DIGIT^18 + DIGIT ,
		% 064	4	%	DIGIT^18 + DIGIT ,
		% 065	5	%	DIGIT^18 + DIGIT ,
		% 066	6	%	DIGIT^18 + DIGIT ,
		% 067	7	%	DIGIT^18 + DIGIT ,
		% 070	8	%	DIGIT^18 + DIGIT ,
		% 071	9	%	DIGIT^18 + DIGIT ,
		% 072	:	%	SPEC^18 + COLON ,
		% 073	;	%	SPEC^18 + SEMICOL ,
		% 074	<	%	SPEC^18 + LTSGN ,
		% 075	=	%	SPEC^18 + EQUAL ,
		% 076	>	%	SPEC^18 + GTSGN ,
		% 077	?	%	ILL^18 + ILL ,
		% 100	@	%	ILL^18 + ILL ,
		% 101	A	%	UPPER^18 + UPPER ,
		% 102	B	%	UPPER^18 + UPPER ,
		% 103	C	%	UPPER^18 + COMNTSGN ,
		% 104	D	%	UPPER^18 + DEBUGSGN ,
		% 105	E	%	UPPER^18 + UPPER ,
		% 106	F	%	UPPER^18 + UPPER ,
		% 107	G	%	UPPER^18 + UPPER ,
		% 110	H	%	UPPER^18 + UPPER ,
		% 111	I	%	UPPER^18 + UPPER ,
		% 112	J	%	UPPER^18 + UPPER ,
		% 113	K	%	UPPER^18 + UPPER ,
		% 114	L	%	UPPER^18 + UPPER ,
		% 115	M	%	UPPER^18 + UPPER ,
		% 116	N	%	UPPER^18 + UPPER ,
		% 117	O	%	UPPER^18 + UPPER ,
		% 120	P	%	UPPER^18 + UPPER ,
		% 121	Q	%	UPPER^18 + UPPER ,
		% 122	R	%	UPPER^18 + UPPER ,
		% 123	S	%	UPPER^18 + UPPER ,
		% 124	T	%	UPPER^18 + UPPER ,
		% 125	U	%	UPPER^18 + UPPER ,
		% 126	V	%	UPPER^18 + UPPER ,
		% 127	W	%	UPPER^18 + UPPER ,
		% 130	X	%	UPPER^18 + UPPER ,
		% 1311	Y	%	UPPER^18 + UPPER ,
		% 132	Z	%	UPPER^18 + UPPER ,
		% 133	[	%	ILL^18 + ILL ,
		% 134	\	%	ILL^18 + ILL ,
		% 135	]	%	ILL^18 + ILL ,
		% 136	^	%	SPEC^18 + UPAROW ,
		% 137	_	%	ILL^18 + ILL ,
		% 140		%	ILL^18 + ILL ,
		% 141	A	%	LOWER^18 + LOWER ,
		% 142	B	%	LOWER^18 + LOWER ,
		% 143	C	%	LOWER^18 + LOWER ,
		% 144	D	%	LOWER^18 + LOWER ,
		% 145	E	%	LOWER^18 + LOWER ,
		% 146	F	%	LOWER^18 + LOWER ,
		% 147	G	%	LOWER^18 + LOWER ,
		% 150	H	%	LOWER^18 + LOWER ,
		% 151	I	%	LOWER^18 + LOWER ,
		% 152	J	%	LOWER^18 + LOWER ,
		% 153	K	%	LOWER^18 + LOWER ,
		% 154	L	%	LOWER^18 + LOWER ,
		% 155	M	%	LOWER^18 + LOWER ,
		% 156	N	%	LOWER^18 + LOWER ,
		% 157	O	%	LOWER^18 + LOWER ,
		% 160	P	%	LOWER^18 + LOWER ,
		% 161	Q	%	LOWER^18 + LOWER ,
		% 162	R	%	LOWER^18 + LOWER ,
		% 163	S	%	LOWER^18 + LOWER ,
		% 164	T	%	LOWER^18 + LOWER ,
		% 165	U	%	LOWER^18 + LOWER ,
		% 166	V	%	LOWER^18 + LOWER ,
		% 167	W	%	LOWER^18 + LOWER ,
		% 170	X	%	LOWER^18 + LOWER ,
		% 171	Y	%	LOWER^18 + LOWER ,
		% 172	Z	%	LOWER^18 + LOWER ,
		% 173	[	%	ILL^18 + ILL ,
		% 174	\	%	ILL^18 + ILL ,
		% 175		%	ILL^18 + ILL ,
		% 176		%	ILL^18 + ILL ,
		% 177	DEL	%	EOB^18 + EOB ,
		% 200	EOF	%	FOS^18 + FOS ,
		% 201	OVRFLO	%	FOS^18 + FOS ,
		% 202	EOS	%	FOS^18 + FOS
		);

	%ORDER CODES FOR STATEMENTS%

	BIND
		HEAD=0,		!PROGRAM, SUBROUTINE, FUNCTION
		BLOCKD=1,	!BLOCK DATA STATEMENT
		IMPLICT=2,	!
		FORMAT=3,	!FORMAT/ENTRY
		PARAMETER=4,	!
		SPECIF=5,	!GLOBAL, DIMENSION,EQUIV,COMMON, SAVE
		TYPE = 6,	!ALL TYPE STATEMENTS INCLUDING "TYPE" FUNCTION
%1610%		NAMEXT=7,	!EXTERNAL
		STFNARAS=8,	!STATEMENT FUNCTION OR ARRAY ASSIGNMENT
%1610%		DATAA=9,	!DATA/NAMELIST
		EXECU=10,	!EXECUTABLE
		IOSTMN=11,
		STAEND=12,	!
		STINCLUDE=13,	!
%1621%		ENTR=14;	!ENTRY 

	%ERROR ACTION CODES%
%1527%	! Must start with PSTEND+1 and increase consecutively.  
%1527%	! Do not change order without fixing case statement in DRIVER.

	BIND
%1527%		OW=9,		!STATEMENT OUT OF ORDER
%1527%		ED=10,		!ENCOUNTERED PROGRAM
				!		SUBROUTINE
				!		FUNCTION
				!		BLOCK DATA
				!BEFORE AN END
%1527%		BD=11,		!STATEMENT NOT LEGAL IN BLOCK DATA
%1527%		IE=12,		!INTERNAL COMPILER ERROR
%1527%		FO=13;		!Fatal statement out of order

% GLOBAL BINDS FOR EXTERNAL REFERENCES TO PSTATE STATES  %
GLOBAL BIND  
	PST1ST = 0,	! FIRST STATE
	PSTIMPL = 1,	! IMPLICIT STATE
%1527%	PSTSPF = 2,	! SPECIFICATION STATE
%1527%	PSTEXECU = 4,	! EXECUTABLE STATE
%1527%	PSTBKIMP = 5,	! BLOCK DATA IMPLICIT
%1527%	PSTEND = 8;	! NUMBER OF THE "END" STATE

% GLOBAL BINDS FOR REFERENCES  TO ORDER CODES  %
GLOBAL BIND  
	GIOCODE = IOSTMN,	! IOSTATEMENT CODE
	GTYPCOD = TYPE,		! TYPE STATEMENT
	GFORMAT = FORMAT;	! FORMAT STATEMENT




!----------------------------------------------------------------------

! STATEMENT ORDER TRANSITION AND ERROR ACTION TABLE  

BIND  DUMM  =  PLIT  ( STMNSTATE  GLOBALLY NAMES

%
			----  STATE  ----

		1ST	IMPLICT	SPECIF	STMFN	EXECU	BLKD	BLKD	BLKD	END
		STMNT	STMNT	STMNT		STMNT	IMPLCT	SPECIF	DATA	
		0	1	2	3	4	5	6	7	8
ORDER CODE
%
%0.HEAD%	1,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	IE,

%1.BLOCKD%	5,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	IE,

%2.IMPLICT%	1,	1,	OW,	OW,	OW,	5,	OW,	OW,	IE,

%3.FORMAT%	1,	1,	2,	3,	4,	BD,	BD,	BD,	IE,

%4.PARAMETER%	1,	1,	2,	OW,	OW,	5,	6,	OW,	IE,

%5.SPECIF%	2,	2,	2,	OW,	OW,	6,	6,	OW,	IE,

%6.TYPE%	0,	2,	2,	OW,	FO,	6,	6,	OW,	IE,

%7.NAMEXT%	2,	2,	2,	OW,	OW,	BD,	BD,	BD,	IE,

%8.STFN-ARRAY%	3,	3,	3,	3,	4,	BD,	BD,	BD,	IE,

%9.DATAA%	2,	2,	2,	3,	4,	6,	6,	7,	IE,

%10.EXECU%	4,	4,	4,	4,	4,	BD,	BD,	BD,	IE,

%11.IOSTMN%	4,	4,	4,	4,	4,	BD,	BD,	BD,	IE,

%12.END%	8,	8,	8,	8,	8,	8,	8,	8,	IE,

%13.INCLUDE%	0,	1,	2,	3,	4,	5,	6,	7,	IE,

%14.ENTRY%	1,	1,	2,	3,	4,	BD,	BD,	BD,	IE

);




!----------------------------------------------------------------------

! LEGALITY OF LABELS ACCORDING TO ORDER CODE

GLOBAL BIND
	GLEGAL = 0,
	GILLEGAL = 1,
	DELAYED = 2;




EXTERNAL
!******************************************************************************************************************
!
!THE NUMBER IN COMMENTS IS THE STATEMENTS LOCATION IN THE HASH TABLE
!
%  1%	PUNCSTA,
%  3%	DATASTA,
%  4%	PROTSTA,
%  8%	PRINSTA,
% 13%	SAVESTA,	![1201]
% 16%	SUBRSTA,
% 18%	OPENSTA,
% 19%	INTESTA,
% 29%	LOGISTA,
% 30%	IMPLSTA,
% 32%	INTRSTA,	![1201]
% 34%	FINDSTA,
% 37%	REWISTA,
% 38%	CALLSTA,
% 39%	INQUSTA,	![1201]
% 41%	PARASTA,
% 43%	ELSESTA,	![1201]
% 45%	RERESTA,
% 49%	GOTOSTA,
% 51%	DIMESTA,
% 53%	PAUSSTA,
% 54%	LOGICALIF,
% 57%	RETUSTA,
% 58%	DOUBSTA,
% 59%	FORMSTA,
% 60%	INCLSTA,
% 63%	BKSPST,
% 64%	ENTRSTA,
% 65%	EQUISTA,
% 67%	DECOSTA,
% 71%	NAMESTA,
% 73%	ACCESTA,
% 75%	BLOCSTA,
% 78%	READSTA,
% 79%	UNLOSTA,
% 81%	FUNCSTA,
% 83%	CLOSSTA,
% 84%	ENDFSTA,
% 86%	REALSTA,
% 87%	ENDISTA,	![1201]
% 88%	SKIPSTA,
% 90%	WRITSTA,
% 91%	EXTESTA,
% 93%	COMMSTA,
% 94%	CHARSTA,	![1201]
% 95%	ENCOSTA,
% 96%	COMPSTA,
% 98%	CONTSTA,
%109%	ASSISTA,
%113%	TYPESTA,
%114%	STOPSTA,
%121%	PROGSTA,
	ENDDSTA;	![1573]




!  THE FOLLOWING DESCRIPTION BLOCKS ARE KNOWN INTERNALLY TO THE
! CLASSIFIER AND ARE NOT IN THE HASH TABLE

EXTERNAL
	ASSIGNMENT,
	ARITHIF,
	BLOCKIF,	! [1214]
	STATEFUNC,	! STATEMENT FUNCTION OR ARRAY REFERENCE
	DOLOOP,
	WHILSTA,	! [1573]
	ENDSTA,
	LOGICALIF,
	SUBASSIGN;	! [1247]

% MACROS WHICH DEFINE THE STATEMENT DESCRIPTION ENTRY VALUES  %
MACRO
	OBJBAD  =  1^22+  $,	! ILLEGAL AS OBJECT OF LOGICAL IF STATEMENT
	TERMBAD =  1^23+  $,	! ILLEGAL AS TERMINAL FOR DO STATEMENT
	LABAD   =  1^24+  $,	! CANNOT BE LABELLED AT ALL
	LABDFR  = 2^24+  $,	! DEFER LABEL DECISION UNTIL LATER
%1456%	IOINPUT =  1^26+  $,	! IO STATEMENT WHICH DOES INPUT
	SYNTX	= ^27+  $;

BIND  DUM  =  PLIT  (

	DSCASGNMT	GLOBALLY NAMES
			ASSIGNSPEC SYNTX EXECU^18 + ASSIGNMENT<0,0>, ' ASSIGNMENT?0',
	DSCIFARITH	GLOBALLY NAMES
			ARITHIFSPEC SYNTX TERMBAD	EXECU^18 + ARITHIF<0,0>, ' IF?0',
	DSCSFAY		GLOBALLY NAMES
			LABDFR	STFNARAS^18 + STATEFUNC<0,0>, 'STFN OR ARRAY ASSIGNMENT',
	DSCDO		GLOBALLY NAMES
			DOSPEC SYNTX OBJBAD	TERMBAD	EXECU^18 + DOLOOP<0,0> , ' DO?0',
	DSCWHILE	GLOBALLY NAMES
			DOWHILE SYNTX OBJBAD TERMBAD EXECU^18 + WHILSTA<0,0>, ' DO?0',
	DSCEND		GLOBALLY NAMES
			OBJBAD	TERMBAD	STAEND^18 + ENDSTA<0,0>, ' END?0',
	DSCSTFN		GLOBALLY NAMES
			OBJBAD	TERMBAD	LABAD	0, SFPLIT GLOBALLY NAMES  ' STATEMENT FUNCTION?0',
	DSCIFLOGIC	GLOBALLY NAMES
			LOGICALIFSPEC SYNTX OBJBAD	EXECU^18 + LOGICALIF<0,0> , ' IF?0',
%1214%	DSCIFBLOCK	GLOBALLY NAMES
			LOGICALIFSPEC SYNTX OBJBAD TERMBAD EXECU^18 + BLOCKIF<0,0> , ' IF?0',
%1247%	DSCSUBASSIGN	GLOBALLY NAMES
%1247%			EXECU^18 + SUBASSIGN<0,0>, ' SUBSTRING ASSIGNMENT?0',

	% SOME MISCELANEOUS MESSAGE PLITS  %
	ARGPLIT GLOBALLY NAMES 'Argument?0',

	ARPLIT GLOBALLY NAMES 'An array?0',


% HERE ARE THE STATEMENT DESCRIPTION BLOCKS REFERENCED BY THE HASH TABLE %

%  1%	DSCPUNCSTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + PUNCSTA<0,0>,' PUNCH?0',
%  3%	DSCDATASTA NAMES DATA SYNTX  OBJBAD	LABAD	DATAA^18 + DATASTA<0,0>,' DATA?0',
%  4%		%DSCPROTSTA NAMES SPECIF^18 + PROTSTA<0,0>,' PROTECT?0',%
% 10%	DSCPRINSTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + PRINSTA<0,0>,' PRINT?0',
% 13%	DSCSAVESTA NAMES SAVESPEC SYNTX OBJBAD LABAD TYPE^18 + SAVESTA<0,0>, SAVEPLIT GLOBALLY NAMES ' SAVE?0', ![1466]
% 16%	DSCSUBRSTA NAMES SUBROUTINE SYNTX   OBJBAD	LABAD	HEAD^18 + SUBRSTA<0,0>,' SUBROUTINE?0',
% 18%	DSCOPENSTA NAMES IOSTMN^18 + OPENSTA<0,0>,' OPEN?0',
% 19%	DSCINTESTA NAMES  OBJBAD	LABAD	TYPE^18 + INTESTA<0,0>, INTGPLIT GLOBALLY NAMES ' INTEGER?0',
% 29%	DSCLOGISTA NAMES  OBJBAD	LABAD	TYPE^18 + LOGISTA<0,0>, LOGIPLIT GLOBALLY NAMES ' LOGICAL?0',
% 30%	DSCIMPLSTA NAMES IMPLICIT SYNTX   OBJBAD	LABAD	IMPLICT^18 + IMPLSTA<0,0>,' IMPLICIT?0',
% 32%		%DSCGLOBSTA NAMES  OBJBAD	LABAD	SPECIF^18 + GLOBSTA<0,0>,' GLOBAL?0',	!CONFLICTS WITH FIND%
% 32%	DSCINTRSTA NAMES INTRINSPEC SYNTX OBJBAD LABAD NAMEXT^18 + INTRSTA<0,0>, INTRPLIT GLOBALLY NAMES ' INTRINSIC?0', ![1464]
% 34%	DSCFINDSTA NAMES FIND SYNTX  IOSTMN^18 + FINDSTA<0,0>,' FIND?0',	!
% 37%	DSCREWISTA NAMES UTILSPEC SYNTX  IOSTMN^18 + REWISTA<0,0>,' REWIND?0', ![1201]
% 38%	DSCCALLSTA NAMES CALL SYNTX  EXECU^18 + CALLSTA<0,0>,' CALL?0',
% 39%	DSCINQUSTA NAMES IOSTMN^18 + INQUSTA<0,0>,' INQUIRE?0', ![1201]
%41%	DSCPARAMT GLOBALLY NAMES PARAMSPEC SYNTX OBJBAD LABAD PARAMETER^18 + PARASTA<0,0>, ' PARAMETER?0',
% 43%	DSCELSESTA NAMES OBJBAD TERMBAD EXECU^18 + ELSESTA<0,0>,' ELSE?0', ![1201]
% 45%	DSCRERESTA NAMES IOSPEC1 SYNTX  IOINPUT IOSTMN^18 + RERESTA<0,0>,' REREAD?0',
% 49%	DSCGOTOSTA NAMES GOTO SYNTX	EXECU^18 + GOTOSTA<0,0>,' GOTO?0',
% 51%	DSCDIMESTA NAMES DIMENSION SYNTX   OBJBAD	LABAD	SPECIF^18 + DIMESTA<0,0>,' DIMENSION?0',	!CONFLICTS WITH ENTRY PAUS
% 53%	DSCPAUSSTA NAMES  TERMBAD	EXECU^18 + PAUSSTA<0,0>,' PAUSE?0',
% 57%	DSCRETUSTA NAMES  TERMBAD	EXECU^18 + RETUSTA<0,0>,' RETURN?0',
% 58%	DSCDOUBSTA GLOBALLY NAMES  OBJBAD	LABAD	TYPE^18 + DOUBSTA<0,0>, DOUBPLIT GLOBALLY NAMES ' DOUBLEPRECISION?0',
% 59%	DSCFORMSTA NAMES  OBJBAD	FORMAT^18 + FORMSTA<0,0>,' FORMAT?0',
% 60%	DSCINCLSTA GLOBALLY NAMES  OBJBAD	LABAD	STINCLUDE^18 + INCLSTA<0,0>,' INCLUDE?0',
% 63%	DSCBKSPST NAMES IOSTMN^18 + BKSPST<0,0>,' BACK?0',
% 64%	DSCENTRSTA NAMES SUBROUTINE SYNTX   OBJBAD	TERMBAD	ENTR^18 + ENTRSTA<0,0>,' ENTRY?0', ![1556]
% 65%	DSCEQUISTA NAMES EQUIVALENCE SYNTX   OBJBAD	LABAD	SPECIF^18 + EQUISTA<0,0>,' EQUIVALENCE?0',
% 67%	DSCDECOSTA NAMES ENCODECODESPEC SYNTX IOINPUT IOSTMN^18 + DECOSTA<0,0>,' DECODE?0',
% 71%	DSCNAMESTA NAMES  NAMELIST SYNTX  OBJBAD	LABAD	DATAA^18 + NAMESTA<0,0>,' NAMELIST?0', ![1610]
% 73%	DSCACCESTA NAMES IOSPEC1 SYNTX IOINPUT  IOSTMN^18 + ACCESTA<0,0>,' ACCEPT?0',
% 75%	DSCBLOCSTA NAMES  OBJBAD	LABAD	BLOCKD^18 + BLOCSTA<0,0>,' BLOCKDATA?0',
% 78%	DSCREADSTA NAMES RWSPEC SYNTX IOINPUT  IOSTMN^18 + READSTA<0,0>,' READ?0',
% 79%	DSCUNLOSTA NAMES UTILSPEC SYNTX  IOSTMN^18 + UNLOSTA<0,0>,' UNLOAD?0',
% 81%	DSCFUNCSTA NAMES SUBROUTINE SYNTX   OBJBAD	LABAD	HEAD^18 + FUNCSTA<0,0>, FNPLIT GLOBALLY NAMES ' FUNCTION?0',
% 82%	DSCENDDSTA NAMES OBJBAD EXECU^18 + ENDDSTA<0,0>, ' ENDDO?0', ![1573]
% 83%	DSCCLOSSTA NAMES IOSTMN^18 + CLOSSTA<0,0>,' CLOSE?0',
% 84%	DSCENDFSTA NAMES UTILSPEC SYNTX  IOSTMN^18 + ENDFSTA<0,0>,' ENDFILE?0',
% 86%	DSCREALSTA NAMES  OBJBAD	LABAD	TYPE^18 + REALSTA<0,0>, REALPLIT GLOBALLY NAMES ' REAL?0',
% 87%	DSCENDISTA NAMES OBJBAD  EXECU^18 + ENDISTA<0,0>,' ENDIF?0', ![1201]
% 88%	DSCSKIPSTA NAMES IOSTMN^18 + SKIPSTA<0,0>,' SKIP?0',	!CONFLICTS WITH WRITE
% 90%	DSCWRITSTA NAMES RWSPEC SYNTX  IOSTMN^18 + WRITSTA<0,0>,' WRITE?0',
% 91%	DSCEXTESTA NAMES EXTERNSPEC SYNTX   OBJBAD	LABAD	NAMEXT^18 + EXTESTA<0,0>,' EXTERNAL?0',
% 93%	DSCCOMMSTA NAMES COMMON SYNTX   OBJBAD	LABAD	SPECIF^18 + COMMSTA<0,0>,' COMMON?0',
% 94%	DSCCHARSTA NAMES OBJBAD LABAD TYPE^18 + CHARSTA<0,0>,CHARPLIT GLOBALLY NAMES ' CHARACTER?0', ![1201]
% 95%	DSCENCOSTA NAMES ENCODECODESPEC SYNTX  IOSTMN^18 + ENCOSTA<0,0>,' ENCODE?0',
% 96%	DSCCOMPSTA NAMES  OBJBAD	LABAD	TYPE^18 + COMPSTA<0,0>, COMPLIT GLOBALLY NAMES ' COMPLEX?0',
% 98%	DSCCONTSTA NAMES	EXECU^18 + CONTSTA<0,0>,' CONTINUE?0',
%109%	DSCASSISTA NAMES ASSIGN SYNTX  EXECU^18 + ASSISTA<0,0>,' ASSIGN?0',
%113%	DSCTYPESTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + TYPESTA<0,0>,' TYPE?0',
%114%	DSCSTOPSTA NAMES  TERMBAD	EXECU^18 + STOPSTA<0,0>,' STOP?0',
%121%	DSCPROGSTA NAMES  OBJBAD	LABAD	HEAD^18 + PROGSTA<0,0>,' PROGRAM?0'

);


GLOBAL ROUTINE CLASHASH ( NAME ) =
!------------------------------------------------------------------------------------------------------------------
!DEVELOPS HASH CODE FOR STATEMENT IDENTIFICATION IN CLASSIFIER.
!CALLED BY CLASSIFIER- WITH 1ST 4 CHAR OF KEY WORD (RIGHT JUSTIFIED,BLANK FILLED). RETURNS THE NAME OF THE STATEMENT ROUTINE
!FOR THE STATEMENT CURRENTLY BEING PARSED, OR 0 IF NO MATCH.
!
!THE FOLLOWING IS THE TABLE OF UNIQUE FIRST LETTERS FOR ALL THE
!STATEMENTS IN THE FORTRAN LANGUAGE, FOLLOWED BY THE CORRESPONDING STATEMENT ROUTINE., STATEMENT ORDERING CODE,
! AND THE KEY WORD LEFT JUSTIFIED, PRECEEDED BY 1 BLANK.
!------------------------------------------------------------------------------------------------------------------
BEGIN
!THIS HASH TABLE WAS CREATED BY THE FORTRAN PROGRAM HASHGEN.F4.
MACRO	STEP=( -2)$;
BIND
VECTOR	CLASLIST=PLIT(
%  0%	0,
%  1%	DSCPUNCSTA,
%  2%	0,
%  3%	DSCDATASTA,
%  4%	0,	%DSCPROTSTA,%
%  5%	0,
%  6%	0,
%  7%	0,
%  8%	0,
%  9%	0,
% 10%	DSCPRINSTA,
% 11%	0,
% 12%	0,
% 13%	DSCSAVESTA,	![1201]
% 14%	0,
% 15%	0,
% 16%	DSCSUBRSTA,
% 17%	0,
% 18%	DSCOPENSTA,
% 19%	DSCINTESTA,
% 20%	0,
% 21%	0,
% 22%	0,
% 23%	0,
% 24%	0,
% 25%	0,
% 26%	0,
% 27%	0,
% 28%	0,
% 29%	DSCLOGISTA,
% 30%	DSCIMPLSTA,
% 31%	0,
% 32%	DSCINTRSTA,	![1201]
% 33%	0,
% 34%	DSCFINDSTA,
% 35%	0,
% 36%	0,
% 37%	DSCREWISTA,	![1201] CONFLICTS WITH INQUIRE
% 38%	DSCCALLSTA,
% 39%	DSCINQUSTA,	![1201] CONFLICTS WITH PARAMETER
% 40%	0,
% 41%	DSCPARAMT,
% 42%	0,
% 43%	DSCELSESTA,	![1201] CONFLICTS WITH REREAD
% 44%	0,
% 45%	DSCRERESTA,
% 46%	0,
% 47%	0,
% 48%	0,
% 49%	DSCGOTOSTA,
% 50%	0,
% 51%	DSCDIMESTA,	!CONFLICTS WITH ENTRY PAUS
% 52%	0,
% 53%	DSCPAUSSTA,
% 54%	0,
% 55%	0,
% 56%	0,
% 57%	DSCRETUSTA,
% 58%	DSCDOUBSTA,
% 59%	DSCFORMSTA,
% 60%	DSCINCLSTA,
% 61%	0,
% 62%	0,
% 63%	DSCBKSPST,
% 64%	DSCENTRSTA,
% 65%	DSCEQUISTA,
% 66%	0,
% 67%	DSCDECOSTA,
% 68%	0,
% 69%	0,
% 70%	0,
% 71%	DSCNAMESTA,
% 72%	0,
% 73%	DSCACCESTA,
% 74%	0,
% 75%	DSCBLOCSTA,
% 76%	0,
% 77%	0,
% 78%	DSCREADSTA,
% 79%	DSCUNLOSTA,
% 80%	0,
% 81%	DSCFUNCSTA,
% 82%	DSCENDDSTA,
% 83%	DSCCLOSSTA,
% 84%	DSCENDFSTA,
% 85%	0,
% 86%	DSCREALSTA,
% 87%	DSCENDISTA,	![1201]
% 88%	DSCSKIPSTA,	!CONFLICTS WITH WRITE
% 89%	0,
% 90%	DSCWRITSTA,
% 91%	DSCEXTESTA,
% 92%	0,
% 93%	DSCCOMMSTA,
% 94%	DSCCHARSTA,	![1201]
% 95%	DSCENCOSTA,
% 96%	DSCCOMPSTA,
% 97%	0,
% 98%	DSCCONTSTA,
% 99%	0,
%100%	0,
%101%	0,
%102%	0,
%103%	0,
%104%	0,
%105%	0,
%106%	0,
%107%	0,
%108%	0,
%109%	DSCASSISTA,
%110%	0,
%111%	0,
%112%	0,
%113%	DSCTYPESTA,
%114%	DSCSTOPSTA,
%115%	0,
%116%	0,
%117%	0,
%118%	0,
%119%	0,
%120%	0,
%121%	DSCPROGSTA,
%122%	0,
%123%	0,
%124%	0,
%125%	0,
%126%	0,
%127%	0,
%128%	0,
%129%	0,
	0);



	REGISTER R1,R2;

	R1 _ .NAME MOD  130;
	IF ( R2_  .CLASLIST[.R1] ) EQL  0  THEN RETURN 0;

	NAME _ (.NAME^1)  +  ' '   ;  ! LEFT JUSTIFY WITH PRECEEDING BLANK

	IF .NAME   EQL  @KEYWRD (.R2)
	THEN
	BEGIN	% MATCH %
		VREG _ .CLASLIST [.R1 ]<RIGHT>
	END
	ELSE
	BEGIN	% TRY AGAIN - ONLY 2 CHANCES  %
		IF ( R2 _  .CLASLIST[ .R1 + STEP ] ) EQL  0  THEN RETURN 0;
		IF .NAME EQL @KEYWRD(.R2)
		THEN	RETURN .CLASLIST [ .R1 + STEP ]<RIGHT>
		ELSE	RETURN 0	! NO MATCH
	END;

	  .VREG

END;

END
ELUDOM