Google
 

Trailing-Edge - PDP-10 Archives - AP-D480B-SB_1978 - 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) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR:  D. B. TOLMAN/MD
MODULE CODETA (RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN

GLOBAL BIND CODEV  = 4^24 + 1^18 + 2;	!VERSION DATE 28-JAN-75

%(
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

)%


% 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,	!
		PARAMETER=4,	!
		SPECIF=5,	!GLOBAL, DIMENSION,EQUIV,COMMON
		TYPE = 6,	!ALL TYPE STATEMENTS INCLUDING "TYPE" FUNCTION
		NAMEXT=7,	!NAMELIST AND EXTERNAL
		STFNARAS=8,	!STATEMENT FUNCTION OR ARRAY ASSIGNMENT
		DATAA=9,		!
		EXECU=10,	!EXECUTABLE INCLUDING ENTRY
		IOSTMN=11,
		STAEND=12,		!
		STINCLUDE=13;	!

	%ERROR ACTION CODES%

	BIND
		OW=11,		!STATEMENT OUT OF ORDER
		ED=12,		!ENCOUNTERED PROGRAM
				!		SUBROUTINE
				!		FUNCTION
				!		BLOCK DATA
				!BEFORE AN END
		BD=13,	!STATEMENT NOT LEGAL IN BLOCK DATA
		IE=14;		!INTERNAL COMPILER ERROR

% GLOBAL BINDS FOR EXTERNAL REFERENCES TO PSTATE STATES  %
GLOBAL BIND  
	PST1ST = 0,	! FIRST STATE
	PSTIMPL = 1,	! IMPLICIT STATE
	PSTSPF = 3,	! SPECIFICATION STATE
	PSTEXECU = 5,	! EXECUTABLE STATE
	PSTBKIMP = 6,	! BLOCK DATA IMPLICIT
	PSTEND = 10;	! 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	PARAMT	SPECIF	STMFN	EXECU	BLKD	BLKD	BLKD	BLKD	END
		STMNT	STMNT	STMNT	STMNT		STMNT	IMPLCT	PARAMT	SPECIF	DATA	
		0	1	2	3	4	5	6	7	8	9	10
ORDER CODE
%
%0.HEAD%	1,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	IE,

%1.BLOCKD%	6,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	ED,	IE,

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

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

%4.PARAMETER%	2,	2,	2,	OW,	OW,	OW,	7,	7,	OW,	OW,	IE,

%5.SPECIF%	3,	3,	3,	3,	OW,	OW,	8,	8,	8,	OW,	IE,

%6.TYPE%	0,	3,	3,	3,	OW,	OW,	8,	8,	8,	OW,	IE,

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

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

%9.DATAA%	4,	4,	4,	4,	4,	5,	9,	9,	9,	9,	IE,

%10.EXECU%	5,	5,	5,	5,	5,	5,	BD,	BD,	BD,	BD,	IE,

%11.IOSTMN%	5,	5,	5,	5,	5,	5,	BD,	BD,	BD,	BD,	IE,

%12.END%	10,	10,	10,	10,	10,	10,	10,	10,	10,	10,	IE,

%13.INCLUDE%	0,	1,	2,	3,	4,	5,	6,	7,	8,	9,	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,
% 16%	SUBRSTA,
% 18%	OPENSTA,
% 19%	INTESTA,
% 29%	LOGISTA,
% 30%	IMPLSTA,
% 32%	GLOBSTA,
% 34%	FINDSTA,
% 38%	CALLSTA,
% 39%	REWISTA,
% 41%	PARASTA,
% 45%	RERESTA,
% 49%	GOTOSTA,
% 51%	DIMESTA,
% 53%	PAUSSTA,
% 54%	LOGICALIF,
% 56%	DOUBSTA,
% 57%	RETUSTA,
% 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,
% 88%	SKIPSTA,
% 90%	WRITSTA,
% 91%	EXTESTA,
% 93%	COMMSTA,
% 95%	ENCOSTA,
% 96%	COMPSTA,
% 98%	CONTSTA,
%109%	ASSISTA,
%113%	TYPESTA,
%114%	STOPSTA,
%121%	PROGSTA;




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

EXTERNAL
	ASSIGNMENT,
	ARITHIF,
	STATEFUNC,	! STATEMENT FUNCTION OR ARRAY REFERENCE
	DOLOOP,
	ENDSTA,
	LOGICALIF;

% MACROS WHICH DEFINE THE STATEMENT DESCRIPTION ENTRY VALUES  %
MACRO
	OBJBAD  =  1^22+  $,
	TERMBAD =  1^23+  $,
	LABAD   =  1^24+  $,
	LABDFR  = 2^24+  $,
	SYNTX	= ^26+  $;

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

	% 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',
% 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%
% 34%	DSCFINDSTA NAMES FIND SYNTX  IOSTMN^18 + FINDSTA<0,0>,' FIND?0',	!
% 38%	DSCCALLSTA NAMES CALL SYNTX  EXECU^18 + CALLSTA<0,0>,' CALL?0',
% 39%	DSCREWISTA NAMES UTILSPEC SYNTX  IOSTMN^18 + REWISTA<0,0>,' REWIND?0',
%41%	DSCPARAMT GLOBALLY NAMES PARAMSPEC SYNTX OBJBAD LABAD PARAMETER^18 + PARASTA<0,0>, ' PARAMETER?0',
% 45%	DSCRERESTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + RERESTA<0,0>,' REREAD?0',
% 49%	DSCGOTOSTA NAMES GOTO SYNTX   TERMBAD	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 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	EXECU^18 + ENTRSTA<0,0>,' ENTRY?0',
% 65%	DSCEQUISTA NAMES EQUIVALENCE SYNTX   OBJBAD	LABAD	SPECIF^18 + EQUISTA<0,0>,' EQUIVALENCE?0',
% 67%	DSCDECOSTA NAMES ENCODECODESPEC SYNTX  IOSTMN^18 + DECOSTA<0,0>,' DECODE?0',
% 71%	DSCNAMESTA NAMES  NAMELIST SYNTX  OBJBAD	LABAD	NAMEXT^18 + NAMESTA<0,0>,' NAMELIST?0',
% 73%	DSCACCESTA NAMES IOSPEC1 SYNTX  IOSTMN^18 + ACCESTA<0,0>,' ACCEPT?0',
% 75%	DSCBLOCSTA NAMES  OBJBAD	LABAD	BLOCKD^18 + BLOCSTA<0,0>,' BLOCKDATA?0',
% 78%	DSCREADSTA NAMES RWSPEC SYNTX  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',
% 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',
% 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',
% 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',	![242]
%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%	0,
% 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%	0,	%DSCGLOBSTA,	!CONFLICTS WITH FIND%
% 33%	0,
% 34%	DSCFINDSTA,	!
% 35%	0,
% 36%	0,
% 37%	0,
% 38%	DSCCALLSTA,
% 39%	DSCREWISTA,
% 40%	0,
% 41%	DSCPARAMT,
% 42%	0,
% 43%	0,
% 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%	0,
% 83%	DSCCLOSSTA,
% 84%	DSCENDFSTA,
% 85%	0,
% 86%	DSCREALSTA,
% 87%	0,
% 88%	DSCSKIPSTA,	!CONFLICTS WITH WRITE
% 89%	0,
% 90%	DSCWRITSTA,
% 91%	DSCEXTESTA,
% 92%	0,
% 93%	DSCCOMMSTA,
% 94%	0,
% 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