Trailing-Edge
-
PDP-10 Archives
-
bb-4157j-bm_fortran20_v11_16mt9
-
fortran-compiler/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, 1987
!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