Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - codeta.bli
There are 12 other files named codeta.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/MD/DCE/CKS/RVM

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

GLOBAL BIND CODETV = 7^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