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