Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_Alpha_31-jul-86 - 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, 1986
!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/MEM

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

GLOBAL BIND CODETV = #11^24 + 0^18 + #4530;	! Version Date: 17-Feb-86

%(

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

***** Begin Version 11 *****

4502	MEM	22-Jan-85
	Changed size of hash table in CLASHASH from 130 to 154 and reordered
	entires of external routines and entries of routine descriptions.
	This was done because adding the entrys for the DELETE, REWRITE and
	UNLOCK statements would cause there to be more than 2 levels of
	collisions. With the new ordering there are no collisions.
	Descriptions of GLOBSTA and PROTSTA were removed since they don't exist
	Add entry for routine DELESTA.	

4503	MEM	22-Jan-85
	Add entry for routine REWRSTA.

4504	MEM	22-Jan-85
	Modify entry for routine UNLOSTA so it can be used by both UNLOAD and
	UNLOCK.

4530	MEM	17-Feb-86
	Add long symbol support: Add underline as legal fortran character.
	
ENDV11
)%


% 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 ,
%4530%		% 137	_	%	SPEC^18 + UNDRLIN ,
		% 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
! ORDER OF ROUTINE NAMES WAS CHANGED WHEN CLASHASH REORDERED [4502]
%  3%	REWISTA,
%  4%	DOUBSTA,
%  5%	UNLOSTA,
%  9%	DIMESTA,
% 12%	REWRSTA,	![4503]
% 13%	ELSESTA,	![1201]
% 14%	INCLSTA,
% 17%	CLOSSTA,
% 19%	PAUSSTA,
% 20%	STOPSTA,
% 21%	BLOCSTA,
% 27%	INTESTA,
% 39%	DECOSTA,
% 40%	INTRSTA,	![1201]
% 44%	CALLSTA,
% 45%	FUNCSTA,
% 53%	FORMSTA,
% 55%	ASSISTA,
% 60%	ENDDSTA,	![1573]
% 61%	LOGISTA,
% 62%	ENDFSTA,
% 65%	ENDISTA,	![1201]
% 70%	CONTSTA,
% 73%	SAVESTA,	![1201]
% 78%	IMPLSTA,
% 79%	PARASTA,
% 89%	COMMSTA,
% 91%	EXTESTA,
% 92%	COMPSTA,
% 93%	RETUSTA,
% 96%	FINDSTA,	
% 97%	ENCOSTA,
% 98%	SKIPSTA,
% 99%	NAMESTA,
%103%	DELESTA,	![4502]
%105%	PROGSTA,
%108%	READSTA,
%109%	TYPESTA,
%111%	EQUISTA,
%112%	SUBRSTA,
%113%	DATASTA,
%114%	PRINSTA,
%116%	REALSTA,
%118%	OPENSTA,
%120%	ENTRSTA,
%121%	INQUSTA,	![1201]
%123%	ACCESTA,
%129%	RERESTA,
%134%	WRITSTA,
%137%	GOTOSTA,
%140%	CHARSTA,	![1201]
%143%	BKSPST,
%153%	PUNCSTA;



!  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',

! ORDER OF THESE ENTRIES WAS CHANGED WHEN CLASHASH REORDERED [4502]
% HERE ARE THE STATEMENT DESCRIPTION BLOCKS REFERENCED BY THE HASH TABLE %

%  3%	DSCREWISTA NAMES UTILSPEC SYNTX  IOSTMN^18 + REWISTA<0,0>,' REWIND?0', ![1201]
%  4%	DSCDOUBSTA GLOBALLY NAMES  OBJBAD	LABAD	TYPE^18 + DOUBSTA<0,0>, DOUBPLIT GLOBALLY NAMES ' DOUBLEPRECISION?0',
%  5%	DSCUNLOSTA NAMES IOSTMN^18 + UNLOSTA<0,0>,' UNLO?0',	![4504]
%  9%	DSCDIMESTA NAMES DIMENSION SYNTX   OBJBAD	LABAD	SPECIF^18 + DIMESTA<0,0>,' DIMENSION?0',	
% 12%	DSCREWRSTA NAMES RWSPEC SYNTX IOSTMN^18 + REWRSTA<0,0>,' REWRITE?0',	![4503]
% 13%	DSCELSESTA NAMES OBJBAD TERMBAD EXECU^18 + ELSESTA<0,0>,' ELSE?0', ![1201]
% 14%	DSCINCLSTA GLOBALLY NAMES  OBJBAD	LABAD	STINCLUDE^18 + INCLSTA<0,0>,' INCLUDE?0',
% 17%	DSCCLOSSTA NAMES IOSTMN^18 + CLOSSTA<0,0>,' CLOSE?0',
% 19%	DSCPAUSSTA NAMES  TERMBAD	EXECU^18 + PAUSSTA<0,0>,' PAUSE?0',
% 20%	DSCSTOPSTA NAMES  TERMBAD	EXECU^18 + STOPSTA<0,0>,' STOP?0',
% 21%	DSCBLOCSTA NAMES  OBJBAD	LABAD	BLOCKD^18 + BLOCSTA<0,0>,' BLOCKDATA?0',
% 27%	DSCINTESTA NAMES  OBJBAD	LABAD	TYPE^18 + INTESTA<0,0>, INTGPLIT GLOBALLY NAMES ' INTEGER?0',
% 39%	DSCDECOSTA NAMES ENCODECODESPEC SYNTX IOINPUT IOSTMN^18 + DECOSTA<0,0>,' DECODE?0',
% 40%	DSCINTRSTA NAMES INTRINSPEC SYNTX OBJBAD LABAD NAMEXT^18 + INTRSTA<0,0>, INTRPLIT GLOBALLY NAMES ' INTRINSIC?0', ![1464]
% 44%	DSCCALLSTA NAMES CALL SYNTX  EXECU^18 + CALLSTA<0,0>,' CALL?0',
% 45%	DSCFUNCSTA NAMES SUBROUTINE SYNTX   OBJBAD	LABAD	HEAD^18 + FUNCSTA<0,0>, FNPLIT GLOBALLY NAMES ' FUNCTION?0',
% 53%	DSCFORMSTA NAMES  OBJBAD	FORMAT^18 + FORMSTA<0,0>,' FORMAT?0',
% 55%	DSCASSISTA NAMES ASSIGN SYNTX  EXECU^18 + ASSISTA<0,0>,' ASSIGN?0',
% 60%	DSCENDDSTA NAMES OBJBAD EXECU^18 + ENDDSTA<0,0>, ' ENDDO?0', ![1573]
% 61%	DSCLOGISTA NAMES  OBJBAD	LABAD	TYPE^18 + LOGISTA<0,0>, LOGIPLIT GLOBALLY NAMES ' LOGICAL?0',
% 62%	DSCENDFSTA NAMES UTILSPEC SYNTX  IOSTMN^18 + ENDFSTA<0,0>,' ENDFILE?0',
% 63%	DSCENDISTA NAMES OBJBAD  EXECU^18 + ENDISTA<0,0>,' ENDIF?0', ![1201]
% 70%	DSCCONTSTA NAMES	EXECU^18 + CONTSTA<0,0>,' CONTINUE?0',
% 73%	DSCSAVESTA NAMES SAVESPEC SYNTX OBJBAD LABAD TYPE^18 + SAVESTA<0,0>, SAVEPLIT GLOBALLY NAMES ' SAVE?0', ![1466]
% 78%	DSCIMPLSTA NAMES IMPLICIT SYNTX   OBJBAD	LABAD	IMPLICT^18 + IMPLSTA<0,0>,' IMPLICIT?0',		
% 79%	DSCPARASTA GLOBALLY NAMES PARAMSPEC SYNTX OBJBAD LABAD PARAMETER^18 + PARASTA<0,0>, ' PARAMETER?0',![4502] 
% 89%	DSCCOMMSTA NAMES COMMON SYNTX   OBJBAD	LABAD	SPECIF^18 + COMMSTA<0,0>,' COMMON?0',
% 91%	DSCEXTESTA NAMES EXTERNSPEC SYNTX   OBJBAD	LABAD	NAMEXT^18 + EXTESTA<0,0>,' EXTERNAL?0',
% 92%	DSCCOMPSTA NAMES  OBJBAD	LABAD	TYPE^18 + COMPSTA<0,0>, COMPLIT GLOBALLY NAMES ' COMPLEX?0',
% 93%	DSCRETUSTA NAMES  TERMBAD	EXECU^18 + RETUSTA<0,0>,' RETURN?0',
% 96%	DSCFINDSTA NAMES FIND SYNTX  IOSTMN^18 + FINDSTA<0,0>,' FIND?0',	
% 97%	DSCENCOSTA NAMES ENCODECODESPEC SYNTX  IOSTMN^18 + ENCOSTA<0,0>,' ENCODE?0',
% 98%	DSCSKIPSTA NAMES IOSTMN^18 + SKIPSTA<0,0>,' SKIP?0',	
% 99%	DSCNAMESTA NAMES  NAMELIST SYNTX  OBJBAD	LABAD	DATAA^18 + NAMESTA<0,0>,' NAMELIST?0', ![1610]
%103%	DSCDELESTA NAMES FIND SYNTX  IOSTMN^18 + DELESTA<0,0>,' DELETE?0',  ![4502]
%105%	DSCPROGSTA NAMES  OBJBAD	LABAD	HEAD^18 + PROGSTA<0,0>,' PROGRAM?0',
%108%	DSCREADSTA NAMES RWSPEC SYNTX IOINPUT  IOSTMN^18 + READSTA<0,0>,' READ?0',
%109%	DSCTYPESTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + TYPESTA<0,0>,' TYPE?0',
%111%	DSCEQUISTA NAMES EQUIVALENCE SYNTX   OBJBAD	LABAD	SPECIF^18 + EQUISTA<0,0>,' EQUIVALENCE?0',
%112%	DSCSUBRSTA NAMES SUBROUTINE SYNTX   OBJBAD	LABAD	HEAD^18 + SUBRSTA<0,0>,' SUBROUTINE?0',
%113%	DSCDATASTA NAMES DATA SYNTX  OBJBAD	LABAD	DATAA^18 + DATASTA<0,0>,' DATA?0',
%114%	DSCPRINSTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + PRINSTA<0,0>,' PRINT?0',
%116%	DSCREALSTA NAMES  OBJBAD	LABAD	TYPE^18 + REALSTA<0,0>, REALPLIT GLOBALLY NAMES ' REAL?0',
%118%	DSCOPENSTA NAMES IOSTMN^18 + OPENSTA<0,0>,' OPEN?0',
%120%	DSCENTRSTA NAMES SUBROUTINE SYNTX   OBJBAD	TERMBAD	ENTR^18 + ENTRSTA<0,0>,' ENTRY?0', ![1556]
%121%	DSCINQUSTA NAMES IOSTMN^18 + INQUSTA<0,0>,' INQUIRE?0', ![1201]
%123%	DSCACCESTA NAMES IOSPEC1 SYNTX IOINPUT  IOSTMN^18 + ACCESTA<0,0>,' ACCEPT?0',
%129%	DSCRERESTA NAMES IOSPEC1 SYNTX  IOINPUT IOSTMN^18 + RERESTA<0,0>,' REREAD?0',
%134%	DSCWRITSTA NAMES RWSPEC SYNTX  IOSTMN^18 + WRITSTA<0,0>,' WRITE?0',
%137%	DSCGOTOSTA NAMES GOTO SYNTX	EXECU^18 + GOTOSTA<0,0>,' GOTO?0',
%140%	DSCCHARSTA NAMES OBJBAD LABAD TYPE^18 + CHARSTA<0,0>,CHARPLIT GLOBALLY NAMES ' CHARACTER?0', ![1201]
%143%	DSCBKSPST NAMES IOSTMN^18 + BKSPST<0,0>,' BACK?0',
%153%	DSCPUNCSTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + PUNCSTA<0,0>,' PUNCH?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.
!------------------------------------------------------------------------------------------------------------------
! [4502] THIS TABLE WAS REOREDERED
BEGIN
MACRO	STEP=( -2)$;
BIND
VECTOR	CLASLIST=PLIT(
%  0%	0,
%  1%	0,
%  2%	0,
%  3%	DSCREWISTA,
%  4%	DSCDOUBSTA,
%  5%	DSCUNLOSTA,	![4504]
%  6%	0,
%  7%	0,
%  8%	0,
%  9%	DSCDIMESTA,
% 10%	0,
% 11%	0,
% 12%	DSCREWRSTA,	![4503]
% 13%	DSCELSESTA,
% 14%	DSCINCLSTA,
% 15%	0,
% 16%	0,
% 17%	DSCCLOSSTA,
% 18%	0,
% 19%	DSCPAUSSTA,
% 20%	DSCSTOPSTA,
% 21%	DSCBLOCSTA,
% 22%	0,
% 23%	0,
% 24%	0,
% 25%	0,
% 26%	0,
% 27%	DSCINTESTA,
% 28%	0,
% 29%	0,
% 30%	0,
% 31%	0,
% 32%	0,
% 33%	0,
% 34%	0,
% 35%	0,
% 36%	0,
% 37%	0,
% 38%	0,
% 39%	DSCDECOSTA,
% 40%	DSCINTRSTA,
% 41%	0,
% 42%	0,
% 43%	0,
% 44%	DSCCALLSTA,
% 45%	DSCFUNCSTA,
% 46%	0,
% 47%	0,
% 48%	0,
% 49%	0,
% 50%	0,
% 51%	0,
% 52%	0,
% 53%	DSCFORMSTA,
% 54%	0,
% 55%	DSCASSISTA,
% 56%	0,
% 57%	0,
% 58%	0,
% 59%	0,
% 60%	DSCENDDSTA,
% 61%	DSCLOGISTA,
% 62%	DSCENDFSTA,
% 63%	0,
% 64%	0,
% 65%	DSCENDISTA,
% 66%	0,
% 67%	0,
% 68%	0,
% 69%	0,
% 70%	DSCCONTSTA,
% 71%	0,
% 72%	0,
% 73%	DSCSAVESTA,
% 74%	0,
% 75%	0,
% 76%	0,
% 77%	0,
% 78%	DSCIMPLSTA,
% 79%	DSCPARASTA,
% 80%	0,
% 81%	0,
% 82%	0,
% 83%	0,
% 84%	0,
% 85%	0,
% 86%	0,
% 87%	0,
% 88%	0,
% 89%	DSCCOMMSTA,
% 90%	0,
% 91%	DSCEXTESTA,
% 92%	DSCCOMPSTA,
% 93%	DSCRETUSTA,
% 94%	0,	![1201]
% 95%	0,
% 96%	DSCFINDSTA,
% 97%	DSCENCOSTA,
% 98%	DSCSKIPSTA,
% 99%	DSCNAMESTA,
%100%	0,
%101%	0,
%102%	0,
%103%	DSCDELESTA,	![4502]
%104%	0,
%105%	DSCPROGSTA,
%106%	0,
%107%	0,
%108%	DSCREADSTA,
%109%	DSCTYPESTA,
%110%	0,
%111%	DSCEQUISTA,
%112%	DSCSUBRSTA,
%113%	DSCDATASTA,
%114%	DSCPRINSTA,
%115%	0,
%116%	DSCREALSTA,
%117%	0,
%118%	DSCOPENSTA,
%119%	0,
%120%	DSCENTRSTA,
%121%	DSCINQUSTA,
%122%	0,
%123%	DSCACCESTA,
%124%	0,
%125%	0,
%126%	0,
%127%	0,
%128%	0,
%129%	DSCRERESTA,
%130%	0,
%131%	0,
%132%	0,
%133%	0,
%134%	DSCWRITSTA,
%135%	0,
%136%	0,
%137%	DSCGOTOSTA,
%138%	0,
%139%	0,
%140%	DSCCHARSTA,
%141%	0,
%142%	0,
%143%	DSCBKSPST,
%144%	0,
%145%	0,
%146%	0,
%147%	0,
%148%	0,
%149%	0,
%150%	0,
%151%	0,
%152%	0,
%153%	DSCPUNCSTA,
HSIZE INDEXES	0);	![4502]



	REGISTER R1,R2;

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

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

	IF .NAME   EQL  @KEYWRD (.R2)
	THEN VREG _ .CLASLIST [.R1 ]<RIGHT> ! MATCH 
	ELSE	RETURN 0;	! NO MATCH

	.VREG
END;

END
ELUDOM