Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/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,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: D. B. TOLMAN/MD/EGM
MODULE CODETA(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN
GLOBAL BIND CODETV = 6^24 + 0^18 + 3; ! Version Date: 24-Jul-81
%(
***** 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.
***** 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, !
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
%[1044]% IE=14, !INTERNAL COMPILER ERROR
%[1044]% FO=15; !Fatal statement out of order
% 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, FO, 8, 8, 8, OW, IE, ![1044]
%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',
%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