Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
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