sources/f2c/gram.c

   1 # define SEOS 1
   2 # define SCOMMENT 2
   3 # define SLABEL 3
   4 # define SUNKNOWN 4
   5 # define SHOLLERITH 5
   6 # define SICON 6
   7 # define SRCON 7
   8 # define SDCON 8
   9 # define SBITCON 9
  10 # define SOCTCON 10
  11 # define SHEXCON 11
  12 # define STRUE 12
  13 # define SFALSE 13
  14 # define SNAME 14
  15 # define SNAMEEQ 15
  16 # define SFIELD 16
  17 # define SSCALE 17
  18 # define SINCLUDE 18
  19 # define SLET 19
  20 # define SASSIGN 20
  21 # define SAUTOMATIC 21
  22 # define SBACKSPACE 22
  23 # define SBLOCK 23
  24 # define SCALL 24
  25 # define SCHARACTER 25
  26 # define SCLOSE 26
  27 # define SCOMMON 27
  28 # define SCOMPLEX 28
  29 # define SCONTINUE 29
  30 # define SDATA 30
  31 # define SDCOMPLEX 31
  32 # define SDIMENSION 32
  33 # define SDO 33
  34 # define SDOUBLE 34
  35 # define SELSE 35
  36 # define SELSEIF 36
  37 # define SEND 37
  38 # define SENDFILE 38
  39 # define SENDIF 39
  40 # define SENTRY 40
  41 # define SEQUIV 41
  42 # define SEXTERNAL 42
  43 # define SFORMAT 43
  44 # define SFUNCTION 44
  45 # define SGOTO 45
  46 # define SASGOTO 46
  47 # define SCOMPGOTO 47
  48 # define SARITHIF 48
  49 # define SLOGIF 49
  50 # define SIMPLICIT 50
  51 # define SINQUIRE 51
  52 # define SINTEGER 52
  53 # define SINTRINSIC 53
  54 # define SLOGICAL 54
  55 # define SNAMELIST 55
  56 # define SOPEN 56
  57 # define SPARAM 57
  58 # define SPAUSE 58
  59 # define SPRINT 59
  60 # define SPROGRAM 60
  61 # define SPUNCH 61
  62 # define SREAD 62
  63 # define SREAL 63
  64 # define SRETURN 64
  65 # define SREWIND 65
  66 # define SSAVE 66
  67 # define SSTATIC 67
  68 # define SSTOP 68
  69 # define SSUBROUTINE 69
  70 # define STHEN 70
  71 # define STO 71
  72 # define SUNDEFINED 72
  73 # define SWRITE 73
  74 # define SLPAR 74
  75 # define SRPAR 75
  76 # define SEQUALS 76
  77 # define SCOLON 77
  78 # define SCOMMA 78
  79 # define SCURRENCY 79
  80 # define SPLUS 80
  81 # define SMINUS 81
  82 # define SSTAR 82
  83 # define SSLASH 83
  84 # define SPOWER 84
  85 # define SCONCAT 85
  86 # define SAND 86
  87 # define SOR 87
  88 # define SNEQV 88
  89 # define SEQV 89
  90 # define SNOT 90
  91 # define SEQ 91
  92 # define SLT 92
  93 # define SGT 93
  94 # define SLE 94
  95 # define SGE 95
  96 # define SNE 96
  97 # define SENDDO 97
  98 # define SWHILE 98
  99 # define SSLASHD 99
 100
 101 /* # line 124 "gram.in" */
 102 #       include "defs.h"
 103 #       include "p1defs.h"
 104
 105 static int nstars;                      /* Number of labels in an
 106                                            alternate return CALL */
 107 static int ndim;
 108 static int vartype;
 109 int new_dcl;
 110 static ftnint varleng;
 111 static struct { expptr lb, ub; } dims[MAXDIM+1];
 112 static struct Labelblock *labarray[MAXLABLIST]; /* Labels in an alternate
 113                                                    return CALL */
 114
 115 /* The next two variables are used to verify that each statement might be reached
 116    during runtime.   lastwasbranch   is tested only in the defintion of the
 117    stat:   nonterminal. */
 118
 119 int lastwasbranch = NO;
 120 static int thiswasbranch = NO;
 121 extern ftnint yystno;
 122 extern flag intonly;
 123 static chainp datastack;
 124 extern long laststfcn, thisstno;
 125 extern int can_include; /* for netlib */
 126
 127 ftnint convci();
 128 Addrp nextdata();
 129 expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon();
 130 expptr mkcxcon();
 131 struct Listblock *mklist();
 132 struct Listblock *mklist();
 133 struct Impldoblock *mkiodo();
 134 Extsym *comblock();
 135 #define ESNULL (Extsym *)0
 136 #define NPNULL (Namep)0
 137 #define LBNULL (struct Listblock *)0
 138 extern void freetemps(), make_param();
 139
 140  static void
 141 pop_datastack() {
 142         chainp d0 = datastack;
 143         if (d0->datap)
 144                 curdtp = (chainp)d0->datap;
 145         datastack = d0->nextp;
 146         d0->nextp = 0;
 147         frchain(&d0);
 148         }
 149
 150
 151 /* # line 176 "gram.in" */
 152 typedef union   {
 153         int ival;
 154         ftnint lval;
 155         char *charpval;
 156         chainp chval;
 157         tagptr tagval;
 158         expptr expval;
 159         struct Labelblock *labval;
 160         struct Nameblock *namval;
 161         struct Eqvchain *eqvval;
 162         Extsym *extval;
 163         } YYSTYPE;
 164 #define yyclearin yychar = -1
 165 #define yyerrok yyerrflag = 0
 166 extern int yychar;
 167 extern int yyerrflag;
 168 #ifndef YYMAXDEPTH
 169 #define YYMAXDEPTH 150
 170 #endif
 171 YYSTYPE yylval, yyval;
 172 typedef int yytabelem;
 173 # define YYERRCODE 256
 174 yytabelem yyexca[] ={
 175 -1, 1,
 176         0, -1,
 177         -2, 0,
 178 -1, 20,
 179         1, 38,
 180         -2, 228,
 181 -1, 24,
 182         1, 42,
 183         -2, 228,
 184 -1, 122,
 185         6, 240,
 186         -2, 228,
 187 -1, 150,
 188         1, 244,
 189         -2, 188,
 190 -1, 174,
 191         1, 265,
 192         78, 265,
 193         -2, 188,
 194 -1, 223,
 195         77, 173,
 196         -2, 139,
 197 -1, 245,
 198         74, 228,
 199         -2, 225,
 200 -1, 271,
 201         1, 286,
 202         -2, 143,
 203 -1, 275,
 204         1, 295,
 205         78, 295,
 206         -2, 145,
 207 -1, 328,
 208         77, 174,
 209         -2, 141,
 210 -1, 358,
 211         1, 267,
 212         14, 267,
 213         74, 267,
 214         78, 267,
 215         -2, 189,
 216 -1, 436,
 217         91, 0,
 218         92, 0,
 219         93, 0,
 220         94, 0,
 221         95, 0,
 222         96, 0,
 223         -2, 153,
 224 -1, 453,
 225         1, 289,
 226         78, 289,
 227         -2, 143,
 228 -1, 455,
 229         1, 291,
 230         78, 291,
 231         -2, 143,
 232 -1, 457,
 233         1, 293,
 234         78, 293,
 235         -2, 143,
 236 -1, 459,
 237         1, 296,
 238         78, 296,
 239         -2, 144,
 240 -1, 504,
 241         78, 289,
 242         -2, 143,
 243         };
 244 # define YYNPROD 301
 245 # define YYLAST 1346
 246 yytabelem yyact[]={
 247
 248    237,   274,   471,   317,   316,   412,   420,   297,   470,   399,
 249    413,   397,   386,   357,   398,   266,   128,   356,   273,   252,
 250    292,     5,   116,   295,   326,   303,   222,    99,   184,   121,
 251    195,   229,    17,   203,   270,   304,   313,   199,   201,   118,
 252     94,   202,   396,   104,   210,   183,   236,   101,   106,   234,
 253    264,   103,   111,   336,   260,    95,    96,    97,   165,   166,
 254    334,   335,   336,   395,   105,   311,   309,   190,   130,   131,
 255    132,   133,   120,   135,   119,   114,   157,   129,   157,   475,
 256    103,   272,   334,   335,   336,   396,   521,   103,   278,   483,
 257    535,   165,   166,   334,   335,   336,   342,   341,   340,   339,
 258    338,   137,   343,   345,   344,   347,   346,   348,   450,   258,
 259    259,   260,   539,   165,   166,   258,   259,   260,   261,   525,
 260    102,   522,   155,   409,   155,   186,   187,   103,   408,   117,
 261    165,   166,   258,   259,   260,   318,   100,   527,   484,   188,
 262    446,   185,   480,   230,   240,   240,   194,   193,   290,   120,
 263    211,   119,   462,   481,   157,   294,   482,   257,   157,   243,
 264    468,   214,   463,   469,   461,   464,   460,   239,   241,   220,
 265    215,   218,   157,   219,   213,   165,   166,   334,   335,   336,
 266    342,   341,   340,   157,   371,   452,   343,   345,   344,   347,
 267    346,   348,   443,   428,   377,   294,   102,   102,   102,   102,
 268    155,   189,   447,   149,   155,   446,   192,   103,    98,   196,
 269    197,   198,   277,   376,   320,   321,   206,   288,   155,   289,
 270    300,   375,   299,   324,   315,   328,   275,   275,   330,   155,
 271    310,   333,   196,   216,   217,   350,   269,   207,   308,   352,
 272    353,   333,   100,   177,   354,   349,   323,   112,   245,   257,
 273    247,   110,   157,   417,   286,   287,   418,   362,   157,   157,
 274    157,   157,   157,   257,   257,   109,   108,   268,   279,   280,
 275    281,   265,   107,   355,     4,   333,   427,   465,   378,   370,
 276    170,   172,   176,   257,   165,   166,   258,   259,   260,   261,
 277    102,   406,   232,   293,   407,   381,   422,   390,   155,   400,
 278    391,   223,   419,   422,   155,   155,   155,   155,   155,   117,
 279    221,   314,   392,   319,   387,   359,   372,   196,   360,   373,
 280    374,   333,   333,   536,   350,   333,   275,   250,   424,   333,
 281    405,   333,   410,   532,   230,   432,   433,   434,   435,   436,
 282    437,   438,   439,   440,   441,   403,   331,   156,   401,   332,
 283    531,   333,   530,   333,   333,   333,   388,   526,   380,   529,
 284    524,   157,   257,   333,   431,   492,   257,   257,   257,   257,
 285    257,   382,   383,   235,   426,   384,   358,   494,   296,   333,
 286    448,   165,   166,   258,   259,   260,   261,   451,   165,   166,
 287    258,   259,   260,   261,   103,   445,   472,   400,   421,   191,
 288    402,   196,   103,   150,   307,   174,   285,   155,   474,   246,
 289    476,   416,   467,   466,   242,   226,   223,   200,   212,   136,
 290    209,   486,   171,   488,   490,   275,   275,   275,   141,   240,
 291    496,   429,   329,   333,   333,   333,   333,   333,   333,   333,
 292    333,   333,   333,   403,   497,   479,   401,   403,   487,   154,
 293    257,   154,   495,   493,   306,   485,   502,   454,   456,   458,
 294    500,   491,   268,   499,   505,   506,   507,   103,   451,   271,
 295    271,   472,    30,   333,   414,   501,   400,   508,   511,   509,
 296    387,   244,   208,   510,   516,   514,   515,   333,   517,   333,
 297    513,   333,   520,   293,   518,   225,   240,   333,   402,   523,
 298     92,   248,   402,   528,     6,   262,   123,   249,    81,    80,
 299    275,   275,   275,    79,   534,   533,   479,    78,   173,   263,
 300    314,    77,   403,    76,   537,   401,   351,   154,    75,   333,
 301    282,   154,    60,    49,    48,   333,    45,    33,   333,   538,
 302    113,   205,   454,   456,   458,   154,   267,   165,   166,   334,
 303    335,   336,   342,   540,   503,   411,   154,   204,   394,   393,
 304    298,   478,   503,   503,   503,   134,   389,   312,   115,   379,
 305     26,    25,    24,    23,   302,    22,   305,   402,    21,   385,
 306    284,     9,   503,     8,     7,     2,   519,   301,    20,   319,
 307    164,    51,   489,   291,   228,   327,   325,   415,    91,   361,
 308    255,    53,   337,    19,    55,   365,   366,   367,   368,   369,
 309     37,   224,     3,     1,     0,   351,     0,     0,     0,     0,
 310      0,     0,     0,     0,     0,   154,     0,     0,     0,     0,
 311      0,   154,   154,   154,   154,   154,     0,     0,     0,   267,
 312      0,   512,   267,   267,   165,   166,   334,   335,   336,   342,
 313    341,   340,   339,   338,     0,   343,   345,   344,   347,   346,
 314    348,   165,   166,   334,   335,   336,   342,   341,   453,   455,
 315    457,     0,   343,   345,   344,   347,   346,   348,     0,     0,
 316    305,     0,   459,     0,     0,     0,     0,   165,   166,   334,
 317    335,   336,   342,   341,   340,   339,   338,   351,   343,   345,
 318    344,   347,   346,   348,   444,     0,     0,     0,   449,   165,
 319    166,   334,   335,   336,   342,   341,   340,   339,   338,     0,
 320    343,   345,   344,   347,   346,   348,   165,   166,   334,   335,
 321    336,   342,     0,     0,   154,     0,   498,   343,   345,   344,
 322    347,   346,   348,     0,     0,   267,     0,     0,     0,     0,
 323      0,   442,     0,   504,   455,   457,   165,   166,   334,   335,
 324    336,   342,   341,   340,   339,   338,     0,   343,   345,   344,
 325    347,   346,   348,     0,     0,     0,     0,     0,     0,   430,
 326      0,   477,     0,   305,   165,   166,   334,   335,   336,   342,
 327    341,   340,   339,   338,     0,   343,   345,   344,   347,   346,
 328    348,   423,     0,     0,     0,     0,   165,   166,   334,   335,
 329    336,   342,   341,   340,   339,   338,     0,   343,   345,   344,
 330    347,   346,   348,     0,     0,     0,   267,     0,     0,     0,
 331      0,   165,   166,   334,   335,   336,   342,   341,   340,   339,
 332    338,    12,   343,   345,   344,   347,   346,   348,     0,     0,
 333      0,     0,     0,     0,   305,    10,    56,    46,    73,    85,
 334     14,    61,    70,    90,    38,    66,    47,    42,    68,    72,
 335     31,    67,    35,    34,    11,    87,    36,    18,    41,    39,
 336     28,    16,    57,    58,    59,    50,    54,    43,    88,    64,
 337     40,    69,    44,    89,    29,    62,    84,    13,     0,    82,
 338     65,    52,    86,    27,    74,    63,    15,     0,     0,    71,
 339     83,   160,   161,   162,   163,   169,   168,   167,   158,   159,
 340    103,     0,   160,   161,   162,   163,   169,   168,   167,   158,
 341    159,   103,     0,     0,    32,   160,   161,   162,   163,   169,
 342    168,   167,   158,   159,   103,     0,   160,   161,   162,   163,
 343    169,   168,   167,   158,   159,   103,     0,   160,   161,   162,
 344    163,   169,   168,   167,   158,   159,   103,     0,   160,   161,
 345    162,   163,   169,   168,   167,   158,   159,   103,     0,     0,
 346    233,     0,     0,     0,     0,     0,   165,   166,   363,     0,
 347    364,   233,   227,     0,     0,     0,   238,   165,   166,   231,
 348      0,     0,     0,     0,   233,     0,     0,   238,     0,     0,
 349    165,   166,   473,     0,     0,   233,     0,     0,     0,     0,
 350    238,   165,   166,   231,     0,     0,   233,     0,     0,     0,
 351      0,   238,   165,   166,   425,     0,     0,   233,     0,     0,
 352      0,     0,   238,   165,   166,     0,     0,     0,     0,     0,
 353      0,     0,     0,   238,   160,   161,   162,   163,   169,   168,
 354    167,   158,   159,   103,     0,   160,   161,   162,   163,   169,
 355    168,   167,   158,   159,   103,   160,   161,   162,   163,   169,
 356    168,   167,   158,   159,   103,     0,     0,     0,   160,   161,
 357    162,   163,   169,   168,   167,   158,   159,   103,   256,     0,
 358     93,   160,   161,   162,   163,   169,   168,   167,   158,   159,
 359    103,     0,     0,     0,     0,     0,     0,     0,     0,     0,
 360      0,     0,     0,   276,     0,     0,     0,     0,     0,   165,
 361    166,     0,   122,     0,   322,   125,   126,   127,     0,   238,
 362    165,   166,     0,     0,     0,     0,     0,   138,   139,     0,
 363    238,   140,     0,   142,   143,   144,     0,   251,   145,   146,
 364    147,     0,   148,   165,   166,   253,     0,   254,     0,     0,
 365    153,     0,     0,     0,     0,     0,   165,   166,   151,     0,
 366    152,   178,   179,   180,   181,   182,   160,   161,   162,   163,
 367    169,   168,   167,   158,   159,   103,   160,   161,   162,   163,
 368    169,   168,   167,   158,   159,   103,   160,   161,   162,   163,
 369    169,   168,   167,   158,   159,   103,   160,   161,   162,   163,
 370    169,   168,   167,   158,   159,   103,     0,     0,     0,     0,
 371      0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
 372      0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
 373      0,     0,     0,     0,     0,   251,     0,     0,     0,     0,
 374      0,   165,   166,   283,     0,   153,     0,     0,     0,     0,
 375      0,   165,   166,   175,     0,   404,     0,     0,     0,     0,
 376      0,   165,   166,    56,    46,   251,    85,     0,    61,     0,
 377     90,   165,   166,    47,    73,     0,     0,     0,    70,     0,
 378      0,    66,    87,     0,    68,    72,     0,    67,     0,    57,
 379     58,    59,    50,     0,     0,    88,     0,     0,     0,     0,
 380     89,     0,    62,    84,     0,    64,    82,    69,    52,    86,
 381      0,     0,    63,     0,   124,     0,    65,    83,     0,     0,
 382     74,     0,     0,     0,     0,    71 };
 383 yytabelem yypact[]={
 384
 385  -1000,    18,   503,   837, -1000, -1000, -1000, -1000, -1000, -1000,
 386    495, -1000, -1000, -1000, -1000, -1000, -1000,   164,   453,   -35,
 387    194,   188,   187,   173,    58,   169,    -8,    66, -1000, -1000,
 388  -1000, -1000, -1000,  1264, -1000, -1000, -1000,    -5, -1000, -1000,
 389  -1000, -1000, -1000, -1000, -1000,   453, -1000, -1000, -1000, -1000,
 390  -1000,   354, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
 391  -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
 392  -1000, -1000, -1000, -1000, -1000,  1096,   348,  1191,   348,   165,
 393  -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
 394  -1000, -1000, -1000, -1000,   453,   453,   453,   453, -1000,   453,
 395  -1000,   325, -1000, -1000,   453, -1000,   -11,   453,   453,   453,
 396    343, -1000, -1000, -1000,   453,   159, -1000, -1000, -1000, -1000,
 397    468,   346,    58, -1000, -1000,   344, -1000, -1000, -1000, -1000,
 398     66,   453,   453,   343, -1000, -1000,   234,   342,   489, -1000,
 399    341,   917,   963,   963,   340,   475,   453,   335,   453, -1000,
 400  -1000, -1000, -1000,  1083, -1000, -1000,   308,  1211, -1000, -1000,
 401  -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
 402  -1000,  1083,   193,   158, -1000, -1000,  1049,  1049, -1000, -1000,
 403  -1000, -1000,  1181,   332, -1000, -1000,   325,   325,   453, -1000,
 404  -1000,    73,   304, -1000,    58, -1000,   304, -1000, -1000, -1000,
 405    453, -1000,   380, -1000,   330,  1273,   -17,    66,   -18,   453,
 406    475,    37,   963,  1060, -1000,   453, -1000, -1000, -1000, -1000,
 407  -1000,   963, -1000,   963,   361, -1000,   963, -1000,   271, -1000,
 408    751,   475, -1000,   963, -1000, -1000, -1000,   963,   963, -1000,
 409    751, -1000,   963, -1000, -1000,    58,   475, -1000,   301,   240,
 410  -1000,  1211, -1000, -1000, -1000,   906, -1000,  1211,  1211,  1211,
 411   1211,  1211,   -30,   204,   106,   388, -1000, -1000,   388,   388,
 412  -1000,   143,   135,   116,   751, -1000,  1049, -1000, -1000, -1000,
 413  -1000, -1000,   308, -1000, -1000,   300, -1000, -1000,   325, -1000,
 414  -1000,   222, -1000, -1000, -1000,    -5, -1000,   -36,  1201,   453,
 415  -1000,   216, -1000,    45, -1000, -1000,   380,   460, -1000,   453,
 416  -1000, -1000,   178, -1000,   226, -1000, -1000, -1000,   324,   220,
 417    726,   751,   952, -1000,   751,   299,   199,   115,   751,   453,
 418    704, -1000,   941,   963,   963,   963,   963,   963,   963,   963,
 419    963,   963,   963, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
 420    676,   114,   -31,   646,   629,   321,   127, -1000, -1000, -1000,
 421   1083,    33,   751, -1000, -1000,    27,   -30,   -30,   -30,    50,
 422  -1000,   388,   106,   107,   106,  1049,  1049,  1049,   607,    88,
 423     86,    74, -1000, -1000, -1000,    87, -1000,   201, -1000,   304,
 424  -1000,   113, -1000,    85,   930, -1000,  1201, -1000, -1000,    -3,
 425   1070, -1000, -1000, -1000,   963, -1000, -1000,   453, -1000,   380,
 426     64,    78, -1000,     8, -1000,    60, -1000, -1000,   453,   963,
 427     58,   963,   963,   391, -1000,   290,   303,   963,   963, -1000,
 428    475, -1000,     0,   -31,   -31,   -31,   467,    95,    95,   581,
 429    646,   -22, -1000,   963, -1000,   475,   475,    58, -1000,   308,
 430  -1000, -1000,   388, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
 431   1049,  1049,  1049, -1000,   466,   465,    -5, -1000, -1000,   930,
 432  -1000, -1000,   564, -1000, -1000,  1201, -1000, -1000, -1000, -1000,
 433    380, -1000,   460,   460,   453, -1000,   751,    37,    11,    43,
 434    751, -1000, -1000, -1000,   963,   285,   751,    41,   282,    62,
 435  -1000,   963,   284,   227,   282,   277,   275,   258, -1000, -1000,
 436  -1000, -1000,   930, -1000, -1000,     7,   248, -1000, -1000, -1000,
 437  -1000, -1000,   963, -1000, -1000,   475, -1000, -1000,   751, -1000,
 438  -1000, -1000, -1000, -1000,   751, -1000, -1000,   751,    34,   475,
 439  -1000 };
 440 yytabelem yypgo[]={
 441
 442      0,   613,   612,    13,   611,    81,    15,    32,   610,   604,
 443    603,    10,     0,   602,   601,   600,    16,   598,    35,    25,
 444    597,   596,   595,     3,     4,   594,    67,   593,   592,    50,
 445     34,    18,    26,   101,    20,   591,    30,   373,     1,   292,
 446     24,   347,   327,     2,     9,    14,    31,    49,    46,   590,
 447    588,    39,    28,    45,   587,   585,   584,   583,   581,  1100,
 448     40,   580,   579,    12,   578,   575,   573,   572,   571,   570,
 449    568,    29,   567,    27,   566,    23,    41,     7,    44,     6,
 450     37,   565,    38,   561,   560,    11,    22,    36,   559,   558,
 451      8,    17,    33,   557,   555,   541,     5,   540,   472,   537,
 452    536,   534,   533,   532,   528,   203,   523,   521,   518,   517,
 453    513,   509,    88,   508,   507,    19 };
 454 yytabelem yyr1[]={
 455
 456      0,     1,     1,    55,    55,    55,    55,    55,    55,    55,
 457      2,    56,    56,    56,    56,    56,    56,    56,    60,    52,
 458     33,    53,    53,    61,    61,    62,    62,    63,    63,    26,
 459     26,    26,    27,    27,    34,    34,    17,    57,    57,    57,
 460     57,    57,    57,    57,    57,    57,    57,    57,    57,    10,
 461     10,    10,    74,     7,     8,     9,     9,     9,     9,     9,
 462      9,     9,     9,     9,     9,     9,    16,    16,    16,    50,
 463     50,    50,    50,    51,    51,    64,    64,    65,    65,    66,
 464     66,    80,    54,    54,    67,    67,    81,    82,    76,    83,
 465     84,    77,    77,    85,    85,    45,    45,    45,    70,    70,
 466     86,    86,    72,    72,    87,    36,    18,    18,    19,    19,
 467     75,    75,    89,    88,    88,    90,    90,    43,    43,    91,
 468     91,     3,    68,    68,    92,    92,    95,    93,    94,    94,
 469     96,    96,    11,    69,    69,    97,    20,    20,    71,    21,
 470     21,    22,    22,    38,    38,    38,    39,    39,    39,    39,
 471     39,    39,    39,    39,    39,    39,    39,    39,    39,    39,
 472     12,    12,    13,    13,    13,    13,    13,    13,    37,    37,
 473     37,    37,    32,    40,    40,    44,    44,    48,    48,    48,
 474     48,    48,    48,    48,    47,    49,    49,    49,    41,    41,
 475     42,    42,    42,    42,    42,    42,    42,    42,    58,    58,
 476     58,    58,    58,    58,    58,    58,    58,    99,    23,    24,
 477     24,    98,    98,    98,    98,    98,    98,    98,    98,    98,
 478     98,    98,     4,   100,   101,   101,   101,   101,    73,    73,
 479     35,    25,    25,    46,    46,    14,    14,    28,    28,    59,
 480     78,    79,   102,   103,   103,   103,   103,   103,   103,   103,
 481    103,   103,   103,   103,   103,   103,   103,   104,   111,   111,
 482    111,   106,   113,   113,   113,   108,   108,   105,   105,   114,
 483    114,   115,   115,   115,   115,   115,   115,    15,   107,   109,
 484    110,   110,    29,    29,     6,     6,    30,    30,    30,    31,
 485     31,    31,    31,    31,    31,     5,     5,     5,     5,     5,
 486    112 };
 487 yytabelem yyr2[]={
 488
 489      0,     0,     6,     5,     4,     5,     7,     7,     5,     3,
 490      3,     7,     9,     7,     9,     9,    11,     7,     1,     3,
 491      3,     1,     2,     4,     6,     2,     6,     2,     6,     1,
 492      5,     7,     3,     7,     3,     3,     3,     2,     2,     2,
 493      2,     2,     2,     2,     2,     3,     5,     3,    11,    15,
 494     11,    11,     1,     5,     3,     3,     3,     3,     3,     3,
 495      3,     3,     3,     3,     3,     3,     1,     9,    13,     7,
 496      9,    11,     7,     3,     7,     7,     7,     7,     7,     6,
 497      6,     7,     3,     7,     6,     6,     1,    13,     1,     1,
 498      1,     4,     6,     3,     7,     2,     5,     2,     2,     6,
 499      3,     2,     2,     6,     7,     5,     3,    11,     3,     7,
 500      1,     6,     1,     4,     6,     3,     7,     3,     2,     3,
 501      7,     3,     7,     6,     8,     3,     1,     4,     2,     6,
 502      3,     7,     3,     2,     4,     9,     3,     7,     1,     1,
 503      2,     3,     7,     2,     7,     2,     2,     2,     7,     7,
 504      7,     7,     5,     7,     7,     7,     7,     7,     5,     7,
 505      3,     3,     3,     3,     3,     3,     3,     3,     3,     5,
 506      9,    11,    11,     1,     2,     3,     2,     3,     3,     3,
 507      3,     3,     3,     2,    11,     3,     3,     3,     2,     7,
 508      2,     2,     7,     7,     7,     7,     5,     7,     2,    15,
 509      9,     3,     5,     4,    13,     5,     5,    11,     7,     2,
 510      9,     9,    11,     4,     2,     3,    21,     3,     7,     9,
 511      7,     7,     3,     3,     7,     7,    15,    15,     0,     2,
 512      7,     3,     7,     2,     5,     3,     3,     3,     7,     1,
 513      1,     1,     3,     4,     5,     5,     5,     4,     5,     5,
 514      7,     9,     9,     5,     7,     3,     7,     6,     3,     3,
 515      3,     6,     3,     3,     3,     3,     3,     7,     7,     2,
 516      6,     3,     3,     3,     5,     5,     5,     3,     7,     7,
 517      9,     9,     3,     7,     3,    11,     3,     3,     2,     7,
 518      7,     7,     7,     7,     7,     3,     7,    11,    11,    11,
 519      1 };
 520 yytabelem yychk[]={
 521
 522  -1000,    -1,   -55,    -2,   256,     3,     1,   -56,   -57,   -58,
 523     18,    37,     4,    60,    23,    69,    44,    -7,    40,   -10,
 524    -50,   -64,   -65,   -66,   -67,   -68,   -69,    66,    43,    57,
 525    -98,    33,    97,   -99,    36,    35,    39,    -8,    27,    42,
 526     53,    41,    30,    50,    55,  -100,    20,    29,  -101,  -102,
 527     48,   -35,    64,   -14,    49,    -9,    19,    45,    46,    47,
 528   -103,    24,    58,    68,    52,    63,    28,    34,    31,    54,
 529     25,    72,    32,    21,    67,  -104,  -106,  -107,  -109,  -110,
 530   -111,  -113,    62,    73,    59,    22,    65,    38,    51,    56,
 531     26,   -17,     5,   -59,   -60,   -60,   -60,   -60,    44,   -73,
 532     78,   -52,   -33,    14,    78,    99,   -73,    78,    78,    78,
 533     78,   -73,    78,   -97,    83,   -70,   -86,   -33,   -51,    85,
 534     83,   -71,   -59,   -98,    70,   -59,   -59,   -59,   -16,    82,
 535    -71,   -71,   -71,   -71,   -81,   -71,   -37,   -33,   -59,   -59,
 536    -59,    74,   -59,   -59,   -59,   -59,   -59,   -59,   -59,  -105,
 537    -42,    82,    84,    74,   -37,   -48,   -41,   -12,    12,    13,
 538      5,     6,     7,     8,   -49,    80,    81,    11,    10,     9,
 539   -105,    74,  -105,  -108,   -42,    82,  -105,    78,   -59,   -59,
 540    -59,   -59,   -59,   -53,   -52,   -53,   -52,   -52,   -60,   -33,
 541    -26,    74,   -33,   -76,   -51,   -36,   -33,   -33,   -33,   -80,
 542     74,   -82,   -76,   -92,   -93,   -95,   -33,    78,    14,    74,
 543    -78,   -73,    74,   -78,   -36,   -51,   -33,   -33,   -80,   -82,
 544    -92,    76,   -32,    74,    -4,     6,    74,    75,   -25,   -46,
 545    -38,    82,   -39,    74,   -47,   -37,   -48,   -12,    90,   -40,
 546    -38,   -40,    74,    -3,     6,   -33,    74,   -33,   -41,  -114,
 547    -42,    74,  -115,    82,    84,   -15,    15,   -12,    82,    83,
 548     84,    85,   -41,   -41,   -29,    78,    -6,   -37,    74,    78,
 549    -30,   -39,    -5,   -31,   -38,   -47,    74,   -30,  -112,  -112,
 550   -112,  -112,   -41,    82,   -61,    74,   -26,   -26,   -52,   -71,
 551     75,   -27,   -34,   -33,    82,   -75,    74,   -77,   -84,   -73,
 552    -75,   -54,   -37,   -19,   -18,   -37,    74,    74,    -7,    83,
 553    -86,    83,   -72,   -87,   -33,    -3,   -24,   -23,    98,   -33,
 554    -38,   -38,    74,   -36,   -38,   -21,   -40,   -22,   -38,    71,
 555    -38,    75,    78,   -12,    82,    83,    84,   -13,    89,    88,
 556     87,    86,    85,    91,    93,    92,    95,    94,    96,    -3,
 557    -38,   -39,   -38,   -38,   -38,   -73,   -91,    -3,    75,    75,
 558     78,   -41,   -38,    82,    84,   -41,   -41,   -41,   -41,   -41,
 559     75,    78,   -29,   -29,   -29,    78,    78,    78,   -38,   -39,
 560     -5,   -31,  -112,  -112,    75,   -62,   -63,    14,   -26,   -74,
 561     75,    78,   -16,   -88,   -89,    99,    78,   -85,   -45,   -44,
 562    -12,   -47,   -33,   -48,    74,   -36,    75,    78,    83,    78,
 563    -19,   -94,   -96,   -11,    14,   -20,   -33,    75,    78,    76,
 564    -79,    74,    76,    75,   -79,    82,    75,    77,    78,   -33,
 565     75,   -46,   -38,   -38,   -38,   -38,   -38,   -38,   -38,   -38,
 566    -38,   -38,    75,    78,    75,    74,    78,    75,  -115,   -41,
 567     75,    -6,    78,   -39,    -5,   -39,    -5,   -39,    -5,    75,
 568     78,    78,    78,    75,    78,    76,   -75,   -34,    75,    78,
 569    -90,   -43,   -38,    82,   -85,    82,   -44,   -37,   -83,   -18,
 570     78,    75,    78,    81,    78,   -87,   -38,   -73,   -38,   -28,
 571    -38,    70,    75,   -32,    74,   -40,   -38,    -3,   -39,   -91,
 572     -3,   -73,   -23,   -33,   -39,   -23,   -23,   -23,   -63,    14,
 573    -16,   -90,    77,   -45,   -44,   -77,   -23,   -96,   -11,   -33,
 574    -24,    75,    78,   -79,    75,    78,    75,    75,   -38,    75,
 575     75,    75,    75,   -43,   -38,    83,    75,   -38,    -3,    78,
 576     -3 };
 577 yytabelem yydef[]={
 578
 579      1,    -2,     0,     0,     9,    10,     2,     3,     4,     5,
 580      0,   239,     8,    18,    18,    18,    18,   228,     0,    37,
 581     -2,    39,    40,    41,    -2,    43,    44,    45,    47,   138,
 582    198,   239,   201,     0,   239,   239,   239,    66,   138,   138,
 583    138,   138,    86,   138,   133,     0,   239,   239,   214,   215,
 584    239,   217,   239,   239,   239,    54,   223,   239,   239,   239,
 585    242,   239,   235,   236,    55,    56,    57,    58,    59,    60,
 586     61,    62,    63,    64,    65,     0,     0,     0,     0,   255,
 587    239,   239,   239,   239,   239,   258,   259,   260,   262,   263,
 588    264,     6,    36,     7,    21,    21,     0,     0,    18,     0,
 589    229,    29,    19,    20,     0,    88,     0,   229,     0,     0,
 590      0,    88,   126,   134,     0,    46,    98,   100,   101,    73,
 591      0,     0,    -2,   202,   203,     0,   205,   206,    53,   240,
 592      0,     0,     0,     0,    88,   126,     0,   168,     0,   213,
 593      0,     0,   173,   173,     0,     0,     0,     0,     0,   243,
 594     -2,   245,   246,     0,   190,   191,     0,     0,   177,   178,
 595    179,   180,   181,   182,   183,   160,   161,   185,   186,   187,
 596    247,     0,   248,   249,    -2,   266,   253,     0,   300,   300,
 597    300,   300,     0,    11,    22,    13,    29,    29,     0,   138,
 598     17,     0,   110,    90,   228,    72,   110,    76,    78,    80,
 599      0,    85,     0,   123,   125,     0,     0,     0,     0,     0,
 600      0,     0,     0,     0,    69,     0,    75,    77,    79,    84,
 601    122,     0,   169,    -2,     0,   222,     0,   218,     0,   231,
 602    233,     0,   143,     0,   145,   146,   147,     0,     0,   220,
 603    174,   221,     0,   224,   121,    -2,     0,   230,   271,     0,
 604    188,     0,   269,   272,   273,     0,   277,     0,     0,     0,
 605      0,     0,   196,   271,   250,     0,   282,   284,     0,     0,
 606    254,    -2,   287,   288,     0,    -2,     0,   256,   257,   261,
 607    278,   279,   300,   300,    12,     0,    14,    15,    29,    52,
 608     30,     0,    32,    34,    35,    66,   112,     0,     0,     0,
 609    105,     0,    82,     0,   108,   106,     0,     0,   127,     0,
 610     99,    74,     0,   102,     0,   241,   200,   209,     0,     0,
 611      0,   241,     0,    70,   211,     0,     0,   140,    -2,     0,
 612      0,   219,     0,     0,     0,     0,     0,     0,     0,     0,
 613      0,     0,     0,   162,   163,   164,   165,   166,   167,   234,
 614      0,   143,   152,   158,     0,     0,     0,   119,    -2,   268,
 615      0,     0,   274,   275,   276,   192,   193,   194,   195,   197,
 616    267,     0,   252,     0,   251,     0,     0,     0,     0,   143,
 617      0,     0,   280,   281,    23,     0,    25,    27,    16,   110,
 618     31,     0,    50,     0,     0,    51,     0,    91,    93,    95,
 619      0,    97,   175,   176,     0,    71,    81,     0,    89,     0,
 620      0,     0,   128,   130,   132,   135,   136,    48,     0,     0,
 621    228,     0,     0,     0,    67,     0,   170,   173,     0,   212,
 622      0,   232,   148,   149,   150,   151,    -2,   154,   155,   156,
 623    157,   159,   144,     0,   207,     0,     0,   228,   270,   271,
 624    189,   283,     0,    -2,   290,    -2,   292,    -2,   294,    -2,
 625      0,     0,     0,    24,     0,     0,    66,    33,   111,     0,
 626    113,   115,   118,   117,    92,     0,    96,    83,    90,   109,
 627      0,   124,     0,     0,     0,   103,   104,     0,     0,   208,
 628    237,   204,   241,   171,   173,     0,   142,     0,   143,     0,
 629    120,     0,     0,   168,    -2,     0,     0,     0,    26,    28,
 630     49,   114,     0,    94,    95,     0,     0,   129,   131,   137,
 631    199,   210,     0,    68,   172,     0,   184,   226,   227,   285,
 632    297,   298,   299,   116,   118,    87,   107,   238,     0,     0,
 633    216 };
 634 typedef struct { char *t_name; int t_val; } yytoktype;
 635 #ifndef YYDEBUG
 636 #       define YYDEBUG  0       /* don't allow debugging */
 637 #endif
 638
 639 #if YYDEBUG
 640
 641 yytoktype yytoks[] =
 642 {
 643         "SEOS", 1,
 644         "SCOMMENT",     2,
 645         "SLABEL",       3,
 646         "SUNKNOWN",     4,
 647         "SHOLLERITH",   5,
 648         "SICON",        6,
 649         "SRCON",        7,
 650         "SDCON",        8,
 651         "SBITCON",      9,
 652         "SOCTCON",      10,
 653         "SHEXCON",      11,
 654         "STRUE",        12,
 655         "SFALSE",       13,
 656         "SNAME",        14,
 657         "SNAMEEQ",      15,
 658         "SFIELD",       16,
 659         "SSCALE",       17,
 660         "SINCLUDE",     18,
 661         "SLET", 19,
 662         "SASSIGN",      20,
 663         "SAUTOMATIC",   21,
 664         "SBACKSPACE",   22,
 665         "SBLOCK",       23,
 666         "SCALL",        24,
 667         "SCHARACTER",   25,
 668         "SCLOSE",       26,
 669         "SCOMMON",      27,
 670         "SCOMPLEX",     28,
 671         "SCONTINUE",    29,
 672         "SDATA",        30,
 673         "SDCOMPLEX",    31,
 674         "SDIMENSION",   32,
 675         "SDO",  33,
 676         "SDOUBLE",      34,
 677         "SELSE",        35,
 678         "SELSEIF",      36,
 679         "SEND", 37,
 680         "SENDFILE",     38,
 681         "SENDIF",       39,
 682         "SENTRY",       40,
 683         "SEQUIV",       41,
 684         "SEXTERNAL",    42,
 685         "SFORMAT",      43,
 686         "SFUNCTION",    44,
 687         "SGOTO",        45,
 688         "SASGOTO",      46,
 689         "SCOMPGOTO",    47,
 690         "SARITHIF",     48,
 691         "SLOGIF",       49,
 692         "SIMPLICIT",    50,
 693         "SINQUIRE",     51,
 694         "SINTEGER",     52,
 695         "SINTRINSIC",   53,
 696         "SLOGICAL",     54,
 697         "SNAMELIST",    55,
 698         "SOPEN",        56,
 699         "SPARAM",       57,
 700         "SPAUSE",       58,
 701         "SPRINT",       59,
 702         "SPROGRAM",     60,
 703         "SPUNCH",       61,
 704         "SREAD",        62,
 705         "SREAL",        63,
 706         "SRETURN",      64,
 707         "SREWIND",      65,
 708         "SSAVE",        66,
 709         "SSTATIC",      67,
 710         "SSTOP",        68,
 711         "SSUBROUTINE",  69,
 712         "STHEN",        70,
 713         "STO",  71,
 714         "SUNDEFINED",   72,
 715         "SWRITE",       73,
 716         "SLPAR",        74,
 717         "SRPAR",        75,
 718         "SEQUALS",      76,
 719         "SCOLON",       77,
 720         "SCOMMA",       78,
 721         "SCURRENCY",    79,
 722         "SPLUS",        80,
 723         "SMINUS",       81,
 724         "SSTAR",        82,
 725         "SSLASH",       83,
 726         "SPOWER",       84,
 727         "SCONCAT",      85,
 728         "SAND", 86,
 729         "SOR",  87,
 730         "SNEQV",        88,
 731         "SEQV", 89,
 732         "SNOT", 90,
 733         "SEQ",  91,
 734         "SLT",  92,
 735         "SGT",  93,
 736         "SLE",  94,
 737         "SGE",  95,
 738         "SNE",  96,
 739         "SENDDO",       97,
 740         "SWHILE",       98,
 741         "SSLASHD",      99,
 742         "-unknown-",    -1      /* ends search */
 743 };
 744
 745 char * yyreds[] =
 746 {
 747         "-no such reduction-",
 748         "program : /* empty */",
 749         "program : program stat SEOS",
 750         "stat : thislabel entry",
 751         "stat : thislabel spec",
 752         "stat : thislabel exec",
 753         "stat : thislabel SINCLUDE filename",
 754         "stat : thislabel SEND end_spec",
 755         "stat : thislabel SUNKNOWN",
 756         "stat : error",
 757         "thislabel : SLABEL",
 758         "entry : SPROGRAM new_proc progname",
 759         "entry : SPROGRAM new_proc progname progarglist",
 760         "entry : SBLOCK new_proc progname",
 761         "entry : SSUBROUTINE new_proc entryname arglist",
 762         "entry : SFUNCTION new_proc entryname arglist",
 763         "entry : type SFUNCTION new_proc entryname arglist",
 764         "entry : SENTRY entryname arglist",
 765         "new_proc : /* empty */",
 766         "entryname : name",
 767         "name : SNAME",
 768         "progname : /* empty */",
 769         "progname : entryname",
 770         "progarglist : SLPAR SRPAR",
 771         "progarglist : SLPAR progargs SRPAR",
 772         "progargs : progarg",
 773         "progargs : progargs SCOMMA progarg",
 774         "progarg : SNAME",
 775         "progarg : SNAME SEQUALS SNAME",
 776         "arglist : /* empty */",
 777         "arglist : SLPAR SRPAR",
 778         "arglist : SLPAR args SRPAR",
 779         "args : arg",
 780         "args : args SCOMMA arg",
 781         "arg : name",
 782         "arg : SSTAR",
 783         "filename : SHOLLERITH",
 784         "spec : dcl",
 785         "spec : common",
 786         "spec : external",
 787         "spec : intrinsic",
 788         "spec : equivalence",
 789         "spec : data",
 790         "spec : implicit",
 791         "spec : namelist",
 792         "spec : SSAVE",
 793         "spec : SSAVE savelist",
 794         "spec : SFORMAT",
 795         "spec : SPARAM in_dcl SLPAR paramlist SRPAR",
 796         "dcl : type opt_comma name in_dcl new_dcl dims lengspec",
 797         "dcl : dcl SCOMMA name dims lengspec",
 798         "dcl : dcl SSLASHD datainit vallist SSLASHD",
 799         "new_dcl : /* empty */",
 800         "type : typespec lengspec",
 801         "typespec : typename",
 802         "typename : SINTEGER",
 803         "typename : SREAL",
 804         "typename : SCOMPLEX",
 805         "typename : SDOUBLE",
 806         "typename : SDCOMPLEX",
 807         "typename : SLOGICAL",
 808         "typename : SCHARACTER",
 809         "typename : SUNDEFINED",
 810         "typename : SDIMENSION",
 811         "typename : SAUTOMATIC",
 812         "typename : SSTATIC",
 813         "lengspec : /* empty */",
 814         "lengspec : SSTAR intonlyon expr intonlyoff",
 815         "lengspec : SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff",
 816         "common : SCOMMON in_dcl var",
 817         "common : SCOMMON in_dcl comblock var",
 818         "common : common opt_comma comblock opt_comma var",
 819         "common : common SCOMMA var",
 820         "comblock : SCONCAT",
 821         "comblock : SSLASH SNAME SSLASH",
 822         "external : SEXTERNAL in_dcl name",
 823         "external : external SCOMMA name",
 824         "intrinsic : SINTRINSIC in_dcl name",
 825         "intrinsic : intrinsic SCOMMA name",
 826         "equivalence : SEQUIV in_dcl equivset",
 827         "equivalence : equivalence SCOMMA equivset",
 828         "equivset : SLPAR equivlist SRPAR",
 829         "equivlist : lhs",
 830         "equivlist : equivlist SCOMMA lhs",
 831         "data : SDATA in_data datalist",
 832         "data : data opt_comma datalist",
 833         "in_data : /* empty */",
 834         "datalist : datainit datavarlist SSLASH datapop vallist SSLASH",
 835         "datainit : /* empty */",
 836         "datapop : /* empty */",
 837         "vallist : /* empty */",
 838         "vallist : val",
 839         "vallist : vallist SCOMMA val",
 840         "val : value",
 841         "val : simple SSTAR value",
 842         "value : simple",
 843         "value : addop simple",
 844         "value : complex_const",
 845         "savelist : saveitem",
 846         "savelist : savelist SCOMMA saveitem",
 847         "saveitem : name",
 848         "saveitem : comblock",
 849         "paramlist : paramitem",
 850         "paramlist : paramlist SCOMMA paramitem",
 851         "paramitem : name SEQUALS expr",
 852         "var : name dims",
 853         "datavar : lhs",
 854         "datavar : SLPAR datavarlist SCOMMA dospec SRPAR",
 855         "datavarlist : datavar",
 856         "datavarlist : datavarlist SCOMMA datavar",
 857         "dims : /* empty */",
 858         "dims : SLPAR dimlist SRPAR",
 859         "dimlist : /* empty */",
 860         "dimlist : dim",
 861         "dimlist : dimlist SCOMMA dim",
 862         "dim : ubound",
 863         "dim : expr SCOLON ubound",
 864         "ubound : SSTAR",
 865         "ubound : expr",
 866         "labellist : label",
 867         "labellist : labellist SCOMMA label",
 868         "label : SICON",
 869         "implicit : SIMPLICIT in_dcl implist",
 870         "implicit : implicit SCOMMA implist",
 871         "implist : imptype SLPAR letgroups SRPAR",
 872         "implist : imptype",
 873         "imptype : /* empty */",
 874         "imptype : type",
 875         "letgroups : letgroup",
 876         "letgroups : letgroups SCOMMA letgroup",
 877         "letgroup : letter",
 878         "letgroup : letter SMINUS letter",
 879         "letter : SNAME",
 880         "namelist : SNAMELIST",
 881         "namelist : namelist namelistentry",
 882         "namelistentry : SSLASH name SSLASH namelistlist",
 883         "namelistlist : name",
 884         "namelistlist : namelistlist SCOMMA name",
 885         "in_dcl : /* empty */",
 886         "funarglist : /* empty */",
 887         "funarglist : funargs",
 888         "funargs : expr",
 889         "funargs : funargs SCOMMA expr",
 890         "expr : uexpr",
 891         "expr : SLPAR expr SRPAR",
 892         "expr : complex_const",
 893         "uexpr : lhs",
 894         "uexpr : simple_const",
 895         "uexpr : expr addop expr",
 896         "uexpr : expr SSTAR expr",
 897         "uexpr : expr SSLASH expr",
 898         "uexpr : expr SPOWER expr",
 899         "uexpr : addop expr",
 900         "uexpr : expr relop expr",
 901         "uexpr : expr SEQV expr",
 902         "uexpr : expr SNEQV expr",
 903         "uexpr : expr SOR expr",
 904         "uexpr : expr SAND expr",
 905         "uexpr : SNOT expr",
 906         "uexpr : expr SCONCAT expr",
 907         "addop : SPLUS",
 908         "addop : SMINUS",
 909         "relop : SEQ",
 910         "relop : SGT",
 911         "relop : SLT",
 912         "relop : SGE",
 913         "relop : SLE",
 914         "relop : SNE",
 915         "lhs : name",
 916         "lhs : name substring",
 917         "lhs : name SLPAR funarglist SRPAR",
 918         "lhs : name SLPAR funarglist SRPAR substring",
 919         "substring : SLPAR opt_expr SCOLON opt_expr SRPAR",
 920         "opt_expr : /* empty */",
 921         "opt_expr : expr",
 922         "simple : name",
 923         "simple : simple_const",
 924         "simple_const : STRUE",
 925         "simple_const : SFALSE",
 926         "simple_const : SHOLLERITH",
 927         "simple_const : SICON",
 928         "simple_const : SRCON",
 929         "simple_const : SDCON",
 930         "simple_const : bit_const",
 931         "complex_const : SLPAR uexpr SCOMMA uexpr SRPAR",
 932         "bit_const : SHEXCON",
 933         "bit_const : SOCTCON",
 934         "bit_const : SBITCON",
 935         "fexpr : unpar_fexpr",
 936         "fexpr : SLPAR fexpr SRPAR",
 937         "unpar_fexpr : lhs",
 938         "unpar_fexpr : simple_const",
 939         "unpar_fexpr : fexpr addop fexpr",
 940         "unpar_fexpr : fexpr SSTAR fexpr",
 941         "unpar_fexpr : fexpr SSLASH fexpr",
 942         "unpar_fexpr : fexpr SPOWER fexpr",
 943         "unpar_fexpr : addop fexpr",
 944         "unpar_fexpr : fexpr SCONCAT fexpr",
 945         "exec : iffable",
 946         "exec : SDO end_spec intonlyon label intonlyoff opt_comma dospecw",
 947         "exec : SDO end_spec opt_comma dospecw",
 948         "exec : SENDDO",
 949         "exec : logif iffable",
 950         "exec : logif STHEN",
 951         "exec : SELSEIF end_spec SLPAR expr SRPAR STHEN",
 952         "exec : SELSE end_spec",
 953         "exec : SENDIF end_spec",
 954         "logif : SLOGIF end_spec SLPAR expr SRPAR",
 955         "dospec : name SEQUALS exprlist",
 956         "dospecw : dospec",
 957         "dospecw : SWHILE SLPAR expr SRPAR",
 958         "iffable : let lhs SEQUALS expr",
 959         "iffable : SASSIGN end_spec assignlabel STO name",
 960         "iffable : SCONTINUE end_spec",
 961         "iffable : goto",
 962         "iffable : io",
 963         "iffable : SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label",
 964         "iffable : call",
 965         "iffable : call SLPAR SRPAR",
 966         "iffable : call SLPAR callarglist SRPAR",
 967         "iffable : SRETURN end_spec opt_expr",
 968         "iffable : stop end_spec opt_expr",
 969         "assignlabel : SICON",
 970         "let : SLET",
 971         "goto : SGOTO end_spec label",
 972         "goto : SASGOTO end_spec name",
 973         "goto : SASGOTO end_spec name opt_comma SLPAR labellist SRPAR",
 974         "goto : SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr",
 975         "opt_comma : /* empty */",
 976         "opt_comma : SCOMMA",
 977         "call : SCALL end_spec name",
 978         "callarglist : callarg",
 979         "callarglist : callarglist SCOMMA callarg",
 980         "callarg : expr",
 981         "callarg : SSTAR label",
 982         "stop : SPAUSE",
 983         "stop : SSTOP",
 984         "exprlist : expr",
 985         "exprlist : exprlist SCOMMA expr",
 986         "end_spec : /* empty */",
 987         "intonlyon : /* empty */",
 988         "intonlyoff : /* empty */",
 989         "io : io1",
 990         "io1 : iofmove ioctl",
 991         "io1 : iofmove unpar_fexpr",
 992         "io1 : iofmove SSTAR",
 993         "io1 : iofmove SPOWER",
 994         "io1 : iofctl ioctl",
 995         "io1 : read ioctl",
 996         "io1 : read infmt",
 997         "io1 : read ioctl inlist",
 998         "io1 : read infmt SCOMMA inlist",
 999         "io1 : read ioctl SCOMMA inlist",
1000         "io1 : write ioctl",
1001         "io1 : write ioctl outlist",
1002         "io1 : print",
1003         "io1 : print SCOMMA outlist",
1004         "iofmove : fmkwd end_spec in_ioctl",
1005         "fmkwd : SBACKSPACE",
1006         "fmkwd : SREWIND",
1007         "fmkwd : SENDFILE",
1008         "iofctl : ctlkwd end_spec in_ioctl",
1009         "ctlkwd : SINQUIRE",
1010         "ctlkwd : SOPEN",
1011         "ctlkwd : SCLOSE",
1012         "infmt : unpar_fexpr",
1013         "infmt : SSTAR",
1014         "ioctl : SLPAR fexpr SRPAR",
1015         "ioctl : SLPAR ctllist SRPAR",
1016         "ctllist : ioclause",
1017         "ctllist : ctllist SCOMMA ioclause",
1018         "ioclause : fexpr",
1019         "ioclause : SSTAR",
1020         "ioclause : SPOWER",
1021         "ioclause : nameeq expr",
1022         "ioclause : nameeq SSTAR",
1023         "ioclause : nameeq SPOWER",
1024         "nameeq : SNAMEEQ",
1025         "read : SREAD end_spec in_ioctl",
1026         "write : SWRITE end_spec in_ioctl",
1027         "print : SPRINT end_spec fexpr in_ioctl",
1028         "print : SPRINT end_spec SSTAR in_ioctl",
1029         "inlist : inelt",
1030         "inlist : inlist SCOMMA inelt",
1031         "inelt : lhs",
1032         "inelt : SLPAR inlist SCOMMA dospec SRPAR",
1033         "outlist : uexpr",
1034         "outlist : other",
1035         "outlist : out2",
1036         "out2 : uexpr SCOMMA uexpr",
1037         "out2 : uexpr SCOMMA other",
1038         "out2 : other SCOMMA uexpr",
1039         "out2 : other SCOMMA other",
1040         "out2 : out2 SCOMMA uexpr",
1041         "out2 : out2 SCOMMA other",
1042         "other : complex_const",
1043         "other : SLPAR expr SRPAR",
1044         "other : SLPAR uexpr SCOMMA dospec SRPAR",
1045         "other : SLPAR other SCOMMA dospec SRPAR",
1046         "other : SLPAR out2 SCOMMA dospec SRPAR",
1047         "in_ioctl : /* empty */",
1048 };
1049 #endif /* YYDEBUG */
1050 /*
1051  *      @(#) yaccpar 1.4 88/11/11
1052  *
1053  *            UNIX is a registered trademark of AT&T
1054  *              Portions Copyright 1976-1989 AT&T
1055  *      Portions Copyright 1980-1989 Microsoft Corporation
1056  *   Portions Copyright 1983-1989 The Santa Cruz Operation, Inc
1057  *                    All Rights Reserved
1058  */
1059 #ident  "@(#)yacc:yaccpar       1.10"
1060
1061 /*
1062 ** Skeleton parser driver for yacc output
1063 */
1064
1065 /*
1066 ** yacc user known macros and defines
1067 */
1068 #define YYERROR         goto yyerrlab
1069 #define YYACCEPT        return(0)
1070 #define YYABORT         return(1)
1071 #define YYBACKUP( newtoken, newvalue )\
1072 {\
1073         if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\
1074         {\
1075                 yyerror( "syntax error - cannot backup" );\
1076                 goto yyerrlab;\
1077         }\
1078         yychar = newtoken;\
1079         yystate = *yyps;\
1080         yylval = newvalue;\
1081         goto yynewstate;\
1082 }
1083 #define YYRECOVERING()  (!!yyerrflag)
1084 #ifndef YYDEBUG
1085 #       define YYDEBUG  1       /* make debugging available */
1086 #endif
1087
1088 /*
1089 ** user known globals
1090 */
1091 int yydebug;                    /* set to 1 to get debugging */
1092
1093 /*
1094 ** driver internal defines
1095 */
1096 #define YYFLAG          (-1000)
1097
1098 /*
1099 ** global variables used by the parser
1100 */
1101 YYSTYPE yyv[ YYMAXDEPTH ];      /* value stack */
1102 int yys[ YYMAXDEPTH ];          /* state stack */
1103
1104 YYSTYPE *yypv;                  /* top of value stack */
1105 int *yyps;                      /* top of state stack */
1106
1107 int yystate;                    /* current state */
1108 int yytmp;                      /* extra var (lasts between blocks) */
1109
1110 int yynerrs;                    /* number of errors */
1111 int yyerrflag;                  /* error recovery flag */
1112 int yychar;                     /* current input token number */
1113
1114
1115
1116 /*
1117 ** yyparse - return 0 if worked, 1 if syntax error not recovered from
1118 */
1119 int
1120 yyparse()
1121 {
1122         register YYSTYPE *yypvt;        /* top of value stack for $vars */
1123
1124         /*
1125         ** Initialize externals - yyparse may be called more than once
1126         */
1127         yypv = &yyv[-1];
1128         yyps = &yys[-1];
1129         yystate = 0;
1130         yytmp = 0;
1131         yynerrs = 0;
1132         yyerrflag = 0;
1133         yychar = -1;
1134
1135         goto yystack;
1136         {
1137                 register YYSTYPE *yy_pv;        /* top of value stack */
1138                 register int *yy_ps;            /* top of state stack */
1139                 register int yy_state;          /* current state */
1140                 register int  yy_n;             /* internal state number info */
1141
1142                 /*
1143                 ** get globals into registers.
1144                 ** branch to here only if YYBACKUP was called.
1145                 */
1146         yynewstate:
1147                 yy_pv = yypv;
1148                 yy_ps = yyps;
1149                 yy_state = yystate;
1150                 goto yy_newstate;
1151
1152                 /*
1153                 ** get globals into registers.
1154                 ** either we just started, or we just finished a reduction
1155                 */
1156         yystack:
1157                 yy_pv = yypv;
1158                 yy_ps = yyps;
1159                 yy_state = yystate;
1160
1161                 /*
1162                 ** top of for (;;) loop while no reductions done
1163                 */
1164         yy_stack:
1165                 /*
1166                 ** put a state and value onto the stacks
1167                 */
1168 #if YYDEBUG
1169                 /*
1170                 ** if debugging, look up token value in list of value vs.
1171                 ** name pairs.  0 and negative (-1) are special values.
1172                 ** Note: linear search is used since time is not a real
1173                 ** consideration while debugging.
1174                 */
1175                 if ( yydebug )
1176                 {
1177                         register int yy_i;
1178
1179                         printf( "State %d, token ", yy_state );
1180                         if ( yychar == 0 )
1181                                 printf( "end-of-file\n" );
1182                         else if ( yychar < 0 )
1183                                 printf( "-none-\n" );
1184                         else
1185                         {
1186                                 for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
1187                                         yy_i++ )
1188                                 {
1189                                         if ( yytoks[yy_i].t_val == yychar )
1190                                                 break;
1191                                 }
1192                                 printf( "%s\n", yytoks[yy_i].t_name );
1193                         }
1194                 }
1195 #endif /* YYDEBUG */
1196                 if ( ++yy_ps >= &yys[ YYMAXDEPTH ] )    /* room on stack? */
1197                 {
1198                         yyerror( "yacc stack overflow" );
1199                         YYABORT;
1200                 }
1201                 *yy_ps = yy_state;
1202                 *++yy_pv = yyval;
1203
1204                 /*
1205                 ** we have a new state - find out what to do
1206                 */
1207         yy_newstate:
1208                 if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG )
1209                         goto yydefault;         /* simple state */
1210 #if YYDEBUG
1211                 /*
1212                 ** if debugging, need to mark whether new token grabbed
1213                 */
1214                 yytmp = yychar < 0;
1215 #endif
1216                 if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
1217                         yychar = 0;             /* reached EOF */
1218 #if YYDEBUG
1219                 if ( yydebug && yytmp )
1220                 {
1221                         register int yy_i;
1222
1223                         printf( "Received token " );
1224                         if ( yychar == 0 )
1225                                 printf( "end-of-file\n" );
1226                         else if ( yychar < 0 )
1227                                 printf( "-none-\n" );
1228                         else
1229                         {
1230                                 for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
1231                                         yy_i++ )
1232                                 {
1233                                         if ( yytoks[yy_i].t_val == yychar )
1234                                                 break;
1235                                 }
1236                                 printf( "%s\n", yytoks[yy_i].t_name );
1237                         }
1238                 }
1239 #endif /* YYDEBUG */
1240                 if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) )
1241                         goto yydefault;
1242                 if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar )  /*valid shift*/
1243                 {
1244                         yychar = -1;
1245                         yyval = yylval;
1246                         yy_state = yy_n;
1247                         if ( yyerrflag > 0 )
1248                                 yyerrflag--;
1249                         goto yy_stack;
1250                 }
1251
1252         yydefault:
1253                 if ( ( yy_n = yydef[ yy_state ] ) == -2 )
1254                 {
1255 #if YYDEBUG
1256                         yytmp = yychar < 0;
1257 #endif
1258                         if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
1259                                 yychar = 0;             /* reached EOF */
1260 #if YYDEBUG
1261                         if ( yydebug && yytmp )
1262                         {
1263                                 register int yy_i;
1264
1265                                 printf( "Received token " );
1266                                 if ( yychar == 0 )
1267                                         printf( "end-of-file\n" );
1268                                 else if ( yychar < 0 )
1269                                         printf( "-none-\n" );
1270                                 else
1271                                 {
1272                                         for ( yy_i = 0;
1273                                                 yytoks[yy_i].t_val >= 0;
1274                                                 yy_i++ )
1275                                         {
1276                                                 if ( yytoks[yy_i].t_val
1277                                                         == yychar )
1278                                                 {
1279                                                         break;
1280                                                 }
1281                                         }
1282                                         printf( "%s\n", yytoks[yy_i].t_name );
1283                                 }
1284                         }
1285 #endif /* YYDEBUG */
1286                         /*
1287                         ** look through exception table
1288                         */
1289                         {
1290                                 register int *yyxi = yyexca;
1291
1292                                 while ( ( *yyxi != -1 ) ||
1293                                         ( yyxi[1] != yy_state ) )
1294                                 {
1295                                         yyxi += 2;
1296                                 }
1297                                 while ( ( *(yyxi += 2) >= 0 ) &&
1298                                         ( *yyxi != yychar ) )
1299                                         ;
1300                                 if ( ( yy_n = yyxi[1] ) < 0 )
1301                                         YYACCEPT;
1302                         }
1303                 }
1304
1305                 /*
1306                 ** check for syntax error
1307                 */
1308                 if ( yy_n == 0 )        /* have an error */
1309                 {
1310                         /* no worry about speed here! */
1311                         switch ( yyerrflag )
1312                         {
1313                         case 0:         /* new error */
1314                                 yyerror( "syntax error" );
1315                                 goto skip_init;
1316                         yyerrlab:
1317                                 /*
1318                                 ** get globals into registers.
1319                                 ** we have a user generated syntax type error
1320                                 */
1321                                 yy_pv = yypv;
1322                                 yy_ps = yyps;
1323                                 yy_state = yystate;
1324                                 yynerrs++;
1325                         skip_init:
1326                         case 1:
1327                         case 2:         /* incompletely recovered error */
1328                                         /* try again... */
1329                                 yyerrflag = 3;
1330                                 /*
1331                                 ** find state where "error" is a legal
1332                                 ** shift action
1333                                 */
1334                                 while ( yy_ps >= yys )
1335                                 {
1336                                         yy_n = yypact[ *yy_ps ] + YYERRCODE;
1337                                         if ( yy_n >= 0 && yy_n < YYLAST &&
1338                                                 yychk[yyact[yy_n]] == YYERRCODE)                                        {
1339                                                 /*
1340                                                 ** simulate shift of "error"
1341                                                 */
1342                                                 yy_state = yyact[ yy_n ];
1343                                                 goto yy_stack;
1344                                         }
1345                                         /*
1346                                         ** current state has no shift on
1347                                         ** "error", pop stack
1348                                         */
1349 #if YYDEBUG
1350 #       define _POP_ "Error recovery pops state %d, uncovers state %d\n"
1351                                         if ( yydebug )
1352                                                 printf( _POP_, *yy_ps,
1353                                                         yy_ps[-1] );
1354 #       undef _POP_
1355 #endif
1356                                         yy_ps--;
1357                                         yy_pv--;
1358                                 }
1359                                 /*
1360                                 ** there is no state on stack with "error" as
1361                                 ** a valid shift.  give up.
1362                                 */
1363                                 YYABORT;
1364                         case 3:         /* no shift yet; eat a token */
1365 #if YYDEBUG
1366                                 /*
1367                                 ** if debugging, look up token in list of
1368                                 ** pairs.  0 and negative shouldn't occur,
1369                                 ** but since timing doesn't matter when
1370                                 ** debugging, it doesn't hurt to leave the
1371                                 ** tests here.
1372                                 */
1373                                 if ( yydebug )
1374                                 {
1375                                         register int yy_i;
1376
1377                                         printf( "Error recovery discards " );
1378                                         if ( yychar == 0 )
1379                                                 printf( "token end-of-file\n" );
1380                                         else if ( yychar < 0 )
1381                                                 printf( "token -none-\n" );
1382                                         else
1383                                         {
1384                                                 for ( yy_i = 0;
1385                                                         yytoks[yy_i].t_val >= 0;
1386                                                         yy_i++ )
1387                                                 {
1388                                                         if ( yytoks[yy_i].t_val
1389                                                                 == yychar )
1390                                                         {
1391                                                                 break;
1392                                                         }
1393                                                 }
1394                                                 printf( "token %s\n",
1395                                                         yytoks[yy_i].t_name );
1396                                         }
1397                                 }
1398 #endif /* YYDEBUG */
1399                                 if ( yychar == 0 )      /* reached EOF. quit */
1400                                         YYABORT;
1401                                 yychar = -1;
1402                                 goto yy_newstate;
1403                         }
1404                 }/* end if ( yy_n == 0 ) */
1405                 /*
1406                 ** reduction by production yy_n
1407                 ** put stack tops, etc. so things right after switch
1408                 */
1409 #if YYDEBUG
1410                 /*
1411                 ** if debugging, print the string that is the user's
1412                 ** specification of the reduction which is just about
1413                 ** to be done.
1414                 */
1415                 if ( yydebug )
1416                         printf( "Reduce by (%d) \"%s\"\n",
1417                                 yy_n, yyreds[ yy_n ] );
1418 #endif
1419                 yytmp = yy_n;                   /* value to switch over */
1420                 yypvt = yy_pv;                  /* $vars top of value stack */
1421                 /*
1422                 ** Look in goto table for next state
1423                 ** Sorry about using yy_state here as temporary
1424                 ** register variable, but why not, if it works...
1425                 ** If yyr2[ yy_n ] doesn't have the low order bit
1426                 ** set, then there is no action to be done for
1427                 ** this reduction.  So, no saving & unsaving of
1428                 ** registers done.  The only difference between the
1429                 ** code just after the if and the body of the if is
1430                 ** the goto yy_stack in the body.  This way the test
1431                 ** can be made before the choice of what to do is needed.
1432                 */
1433                 {
1434                         /* length of production doubled with extra bit */
1435                         register int yy_len = yyr2[ yy_n ];
1436
1437                         if ( !( yy_len & 01 ) )
1438                         {
1439                                 yy_len >>= 1;
1440                                 yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */
1441                                 yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
1442                                         *( yy_ps -= yy_len ) + 1;
1443                                 if ( yy_state >= YYLAST ||
1444                                         yychk[ yy_state =
1445                                         yyact[ yy_state ] ] != -yy_n )
1446                                 {
1447                                         yy_state = yyact[ yypgo[ yy_n ] ];
1448                                 }
1449                                 goto yy_stack;
1450                         }
1451                         yy_len >>= 1;
1452                         yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */
1453                         yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
1454                                 *( yy_ps -= yy_len ) + 1;
1455                         if ( yy_state >= YYLAST ||
1456                                 yychk[ yy_state = yyact[ yy_state ] ] != -yy_n )
1457                         {
1458                                 yy_state = yyact[ yypgo[ yy_n ] ];
1459                         }
1460                 }
1461                                         /* save until reenter driver code */
1462                 yystate = yy_state;
1463                 yyps = yy_ps;
1464                 yypv = yy_pv;
1465         }
1466         /*
1467         ** code supplied by user is placed in this switch
1468         */
1469         switch( yytmp )
1470         {
1471
1472 case 3:
1473 /* # line 224 "gram.in" */
1474 {
1475 /* stat:   is the nonterminal for Fortran statements */
1476
1477                   lastwasbranch = NO; } break;
1478 case 5:
1479 /* # line 230 "gram.in" */
1480 { /* forbid further statement function definitions... */
1481                   if (parstate == INDATA && laststfcn != thisstno)
1482                         parstate = INEXEC;
1483                   thisstno++;
1484                   if(yypvt[-1].labval && (yypvt[-1].labval->labelno==dorange))
1485                         enddo(yypvt[-1].labval->labelno);
1486                   if(lastwasbranch && thislabel==NULL)
1487                         warn("statement cannot be reached");
1488                   lastwasbranch = thiswasbranch;
1489                   thiswasbranch = NO;
1490                   if(yypvt[-1].labval)
1491                         {
1492                         if(yypvt[-1].labval->labtype == LABFORMAT)
1493                                 err("label already that of a format");
1494                         else
1495                                 yypvt[-1].labval->labtype = LABEXEC;
1496                         }
1497                   freetemps();
1498                 } break;
1499 case 6:
1500 /* # line 250 "gram.in" */
1501 { if (can_include)
1502                         doinclude( yypvt[-0].charpval );
1503                   else {
1504                         fprintf(diagfile, "Cannot open file %s\n", yypvt[-0].charpval);
1505                         done(1);
1506                         }
1507                 } break;
1508 case 7:
1509 /* # line 258 "gram.in" */
1510 { if (yypvt[-2].labval)
1511                         lastwasbranch = NO;
1512                   endproc(); /* lastwasbranch = NO; -- set in endproc() */
1513                 } break;
1514 case 8:
1515 /* # line 263 "gram.in" */
1516 { extern void unclassifiable();
1517                   unclassifiable();
1518
1519 /* flline flushes the current line, ignoring the rest of the text there */
1520
1521                   flline(); } break;
1522 case 9:
1523 /* # line 270 "gram.in" */
1524 { flline();  needkwd = NO;  inioctl = NO;
1525                   yyerrok; yyclearin; } break;
1526 case 10:
1527 /* # line 275 "gram.in" */
1528 {
1529                 if(yystno != 0)
1530                         {
1531                         yyval.labval = thislabel =  mklabel(yystno);
1532                         if( ! headerdone ) {
1533                                 if (procclass == CLUNKNOWN)
1534                                         procclass = CLMAIN;
1535                                 puthead(CNULL, procclass);
1536                                 }
1537                         if(thislabel->labdefined)
1538                                 execerr("label %s already defined",
1539                                         convic(thislabel->stateno) );
1540                         else    {
1541                                 if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
1542                                     && thislabel->labtype!=LABFORMAT)
1543                                         warn1("there is a branch to label %s from outside block",
1544                                               convic( (ftnint) (thislabel->stateno) ) );
1545                                 thislabel->blklevel = blklevel;
1546                                 thislabel->labdefined = YES;
1547                                 if(thislabel->labtype != LABFORMAT)
1548                                         p1_label((long)(thislabel - labeltab));
1549                                 }
1550                         }
1551                 else    yyval.labval = thislabel = NULL;
1552                 } break;
1553 case 11:
1554 /* # line 303 "gram.in" */
1555 {startproc(yypvt[-0].extval, CLMAIN); } break;
1556 case 12:
1557 /* # line 305 "gram.in" */
1558 {       warn("ignoring arguments to main program");
1559                         /* hashclear(); */
1560                         startproc(yypvt[-1].extval, CLMAIN); } break;
1561 case 13:
1562 /* # line 309 "gram.in" */
1563 { if(yypvt[-0].extval) NO66("named BLOCKDATA");
1564                   startproc(yypvt[-0].extval, CLBLOCK); } break;
1565 case 14:
1566 /* # line 312 "gram.in" */
1567 { entrypt(CLPROC, TYSUBR, (ftnint) 0,  yypvt[-1].extval, yypvt[-0].chval); } break;
1568 case 15:
1569 /* # line 314 "gram.in" */
1570 { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, yypvt[-1].extval, yypvt[-0].chval); } break;
1571 case 16:
1572 /* # line 316 "gram.in" */
1573 { entrypt(CLPROC, yypvt[-4].ival, varleng, yypvt[-1].extval, yypvt[-0].chval); } break;
1574 case 17:
1575 /* # line 318 "gram.in" */
1576 { if(parstate==OUTSIDE || procclass==CLMAIN
1577                         || procclass==CLBLOCK)
1578                                 execerr("misplaced entry statement", CNULL);
1579                   entrypt(CLENTRY, 0, (ftnint) 0, yypvt[-1].extval, yypvt[-0].chval);
1580                 } break;
1581 case 18:
1582 /* # line 326 "gram.in" */
1583 { newproc(); } break;
1584 case 19:
1585 /* # line 330 "gram.in" */
1586 { yyval.extval = newentry(yypvt[-0].namval, 1); } break;
1587 case 20:
1588 /* # line 334 "gram.in" */
1589 { yyval.namval = mkname(token); } break;
1590 case 21:
1591 /* # line 337 "gram.in" */
1592 { yyval.extval = NULL; } break;
1593 case 29:
1594 /* # line 355 "gram.in" */
1595 { yyval.chval = 0; } break;
1596 case 30:
1597 /* # line 357 "gram.in" */
1598 { NO66(" () argument list");
1599                   yyval.chval = 0; } break;
1600 case 31:
1601 /* # line 360 "gram.in" */
1602 {yyval.chval = yypvt[-1].chval; } break;
1603 case 32:
1604 /* # line 364 "gram.in" */
1605 { yyval.chval = (yypvt[-0].namval ? mkchain((char *)yypvt[-0].namval,CHNULL) : CHNULL ); } break;
1606 case 33:
1607 /* # line 366 "gram.in" */
1608 { if(yypvt[-0].namval) yypvt[-2].chval = yyval.chval = mkchain((char *)yypvt[-0].namval, yypvt[-2].chval); } break;
1609 case 34:
1610 /* # line 370 "gram.in" */
1611 { if(yypvt[-0].namval->vstg!=STGUNKNOWN && yypvt[-0].namval->vstg!=STGARG)
1612                         dclerr("name declared as argument after use", yypvt[-0].namval);
1613                   yypvt[-0].namval->vstg = STGARG;
1614                 } break;
1615 case 35:
1616 /* # line 375 "gram.in" */
1617 { NO66("altenate return argument");
1618
1619 /* substars   means that '*'ed formal parameters should be replaced.
1620    This is used to specify alternate return labels; in theory, only
1621    parameter slots which have '*' should accept the statement labels.
1622    This compiler chooses to ignore the '*'s in the formal declaration, and
1623    always return the proper value anyway.
1624
1625    This variable is only referred to in   proc.c   */
1626
1627                   yyval.namval = 0;  substars = YES; } break;
1628 case 36:
1629 /* # line 391 "gram.in" */
1630 {
1631                 char *s;
1632                 s = copyn(toklen+1, token);
1633                 s[toklen] = '\0';
1634                 yyval.charpval = s;
1635                 } break;
1636 case 45:
1637 /* # line 407 "gram.in" */
1638 { NO66("SAVE statement");
1639                   saveall = YES; } break;
1640 case 46:
1641 /* # line 410 "gram.in" */
1642 { NO66("SAVE statement"); } break;
1643 case 47:
1644 /* # line 412 "gram.in" */
1645 { fmtstmt(thislabel); setfmt(thislabel); } break;
1646 case 48:
1647 /* # line 414 "gram.in" */
1648 { NO66("PARAMETER statement"); } break;
1649 case 49:
1650 /* # line 418 "gram.in" */
1651 { settype(yypvt[-4].namval, yypvt[-6].ival, yypvt[-0].lval);
1652                   if(ndim>0) setbound(yypvt[-4].namval,ndim,dims);
1653                 } break;
1654 case 50:
1655 /* # line 422 "gram.in" */
1656 { settype(yypvt[-2].namval, yypvt[-4].ival, yypvt[-0].lval);
1657                   if(ndim>0) setbound(yypvt[-2].namval,ndim,dims);
1658                 } break;
1659 case 51:
1660 /* # line 426 "gram.in" */
1661 { if (new_dcl == 2) {
1662                         err("attempt to give DATA in type-declaration");
1663                         new_dcl = 1;
1664                         }
1665                 } break;
1666 case 52:
1667 /* # line 433 "gram.in" */
1668 { new_dcl = 2; } break;
1669 case 53:
1670 /* # line 436 "gram.in" */
1671 { varleng = yypvt[-0].lval;
1672                   if (vartype == TYLOGICAL && varleng == 1) {
1673                         varleng = 0;
1674                         err("treating LOGICAL*1 as LOGICAL");
1675                         --nerr; /* allow generation of .c file */
1676                         }
1677                 } break;
1678 case 54:
1679 /* # line 446 "gram.in" */
1680 { varleng = (yypvt[-0].ival<0 || yypvt[-0].ival==TYLONG ? 0 : typesize[yypvt[-0].ival]);
1681                   vartype = yypvt[-0].ival; } break;
1682 case 55:
1683 /* # line 450 "gram.in" */
1684 { yyval.ival = TYLONG; } break;
1685 case 56:
1686 /* # line 451 "gram.in" */
1687 { yyval.ival = tyreal; } break;
1688 case 57:
1689 /* # line 452 "gram.in" */
1690 { ++complex_seen; yyval.ival = TYCOMPLEX; } break;
1691 case 58:
1692 /* # line 453 "gram.in" */
1693 { yyval.ival = TYDREAL; } break;
1694 case 59:
1695 /* # line 454 "gram.in" */
1696 { ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); yyval.ival = TYDCOMPLEX; } break;
1697 case 60:
1698 /* # line 455 "gram.in" */
1699 { yyval.ival = TYLOGICAL; } break;
1700 case 61:
1701 /* # line 456 "gram.in" */
1702 { NO66("CHARACTER statement"); yyval.ival = TYCHAR; } break;
1703 case 62:
1704 /* # line 457 "gram.in" */
1705 { yyval.ival = TYUNKNOWN; } break;
1706 case 63:
1707 /* # line 458 "gram.in" */
1708 { yyval.ival = TYUNKNOWN; } break;
1709 case 64:
1710 /* # line 459 "gram.in" */
1711 { NOEXT("AUTOMATIC statement"); yyval.ival = - STGAUTO; } break;
1712 case 65:
1713 /* # line 460 "gram.in" */
1714 { NOEXT("STATIC statement"); yyval.ival = - STGBSS; } break;
1715 case 66:
1716 /* # line 464 "gram.in" */
1717 { yyval.lval = varleng; } break;
1718 case 67:
1719 /* # line 466 "gram.in" */
1720 {
1721                 expptr p;
1722                 p = yypvt[-1].expval;
1723                 NO66("length specification *n");
1724                 if( ! ISICON(p) || p->constblock.Const.ci<0 )
1725                         {
1726                         yyval.lval = 0;
1727                         dclerr("length must be a positive integer constant",
1728                                 NPNULL);
1729                         }
1730                 else {
1731                         if (vartype == TYCHAR)
1732                                 yyval.lval = p->constblock.Const.ci;
1733                         else switch((int)p->constblock.Const.ci) {
1734                                 case 1: yyval.lval = 1; break;
1735                                 case 2: yyval.lval = typesize[TYSHORT]; break;
1736                                 case 4: yyval.lval = typesize[TYLONG];  break;
1737                                 case 8: yyval.lval = typesize[TYDREAL]; break;
1738                                 case 16: yyval.lval = typesize[TYDCOMPLEX]; break;
1739                                 default:
1740                                         dclerr("invalid length",NPNULL);
1741                                         yyval.lval = varleng;
1742                                 }
1743                         }
1744                 } break;
1745 case 68:
1746 /* # line 492 "gram.in" */
1747 { NO66("length specification *(*)"); yyval.lval = -1; } break;
1748 case 69:
1749 /* # line 496 "gram.in" */
1750 { incomm( yyval.extval = comblock("") , yypvt[-0].namval ); } break;
1751 case 70:
1752 /* # line 498 "gram.in" */
1753 { yyval.extval = yypvt[-1].extval;  incomm(yypvt[-1].extval, yypvt[-0].namval); } break;
1754 case 71:
1755 /* # line 500 "gram.in" */
1756 { yyval.extval = yypvt[-2].extval;  incomm(yypvt[-2].extval, yypvt[-0].namval); } break;
1757 case 72:
1758 /* # line 502 "gram.in" */
1759 { incomm(yypvt[-2].extval, yypvt[-0].namval); } break;
1760 case 73:
1761 /* # line 506 "gram.in" */
1762 { yyval.extval = comblock(""); } break;
1763 case 74:
1764 /* # line 508 "gram.in" */
1765 { yyval.extval = comblock(token); } break;
1766 case 75:
1767 /* # line 512 "gram.in" */
1768 { setext(yypvt[-0].namval); } break;
1769 case 76:
1770 /* # line 514 "gram.in" */
1771 { setext(yypvt[-0].namval); } break;
1772 case 77:
1773 /* # line 518 "gram.in" */
1774 { NO66("INTRINSIC statement"); setintr(yypvt[-0].namval); } break;
1775 case 78:
1776 /* # line 520 "gram.in" */
1777 { setintr(yypvt[-0].namval); } break;
1778 case 81:
1779 /* # line 528 "gram.in" */
1780 {
1781                 struct Equivblock *p;
1782                 if(nequiv >= maxequiv)
1783                         many("equivalences", 'q', maxequiv);
1784                 p  =  & eqvclass[nequiv++];
1785                 p->eqvinit = NO;
1786                 p->eqvbottom = 0;
1787                 p->eqvtop = 0;
1788                 p->equivs = yypvt[-1].eqvval;
1789                 } break;
1790 case 82:
1791 /* # line 541 "gram.in" */
1792 { yyval.eqvval=ALLOC(Eqvchain);
1793                   yyval.eqvval->eqvitem.eqvlhs = (struct Primblock *)yypvt[-0].expval;
1794                 } break;
1795 case 83:
1796 /* # line 545 "gram.in" */
1797 { yyval.eqvval=ALLOC(Eqvchain);
1798                   yyval.eqvval->eqvitem.eqvlhs = (struct Primblock *) yypvt[-0].expval;
1799                   yyval.eqvval->eqvnextp = yypvt[-2].eqvval;
1800                 } break;
1801 case 86:
1802 /* # line 556 "gram.in" */
1803 { if(parstate == OUTSIDE)
1804                         {
1805                         newproc();
1806                         startproc(ESNULL, CLMAIN);
1807                         }
1808                   if(parstate < INDATA)
1809                         {
1810                         enddcl();
1811                         parstate = INDATA;
1812                         }
1813                 } break;
1814 case 87:
1815 /* # line 570 "gram.in" */
1816 { ftnint junk;
1817                   if(nextdata(&junk) != NULL)
1818                         err("too few initializers");
1819                   frdata(yypvt[-4].chval);
1820                   frrpl();
1821                 } break;
1822 case 88:
1823 /* # line 578 "gram.in" */
1824 { frchain(&datastack); curdtp = 0; } break;
1825 case 89:
1826 /* # line 580 "gram.in" */
1827 { pop_datastack(); } break;
1828 case 90:
1829 /* # line 582 "gram.in" */
1830 { toomanyinit = NO; } break;
1831 case 93:
1832 /* # line 587 "gram.in" */
1833 { dataval(ENULL, yypvt[-0].expval); } break;
1834 case 94:
1835 /* # line 589 "gram.in" */
1836 { dataval(yypvt[-2].expval, yypvt[-0].expval); } break;
1837 case 96:
1838 /* # line 594 "gram.in" */
1839 { if( yypvt[-1].ival==OPMINUS && ISCONST(yypvt[-0].expval) )
1840                         consnegop((Constp)yypvt[-0].expval);
1841                   yyval.expval = yypvt[-0].expval;
1842                 } break;
1843 case 100:
1844 /* # line 606 "gram.in" */
1845 { int k;
1846                   yypvt[-0].namval->vsave = YES;
1847                   k = yypvt[-0].namval->vstg;
1848                 if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
1849                         dclerr("can only save static variables", yypvt[-0].namval);
1850                 } break;
1851 case 104:
1852 /* # line 620 "gram.in" */
1853 { if(yypvt[-2].namval->vclass == CLUNKNOWN)
1854                         make_param((struct Paramblock *)yypvt[-2].namval, yypvt[-0].expval);
1855                   else dclerr("cannot make into parameter", yypvt[-2].namval);
1856                 } break;
1857 case 105:
1858 /* # line 627 "gram.in" */
1859 { if(ndim>0) setbound(yypvt[-1].namval, ndim, dims); } break;
1860 case 106:
1861 /* # line 631 "gram.in" */
1862 { Namep np;
1863                   np = ( (struct Primblock *) yypvt[-0].expval) -> namep;
1864                   vardcl(np);
1865                   if(np->vstg == STGCOMMON)
1866                         extsymtab[np->vardesc.varno].extinit = YES;
1867                   else if(np->vstg==STGEQUIV)
1868                         eqvclass[np->vardesc.varno].eqvinit = YES;
1869                   else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
1870                         dclerr("inconsistent storage classes", np);
1871                   yyval.chval = mkchain((char *)yypvt[-0].expval, CHNULL);
1872                 } break;
1873 case 107:
1874 /* # line 643 "gram.in" */
1875 { chainp p; struct Impldoblock *q;
1876                 pop_datastack();
1877                 q = ALLOC(Impldoblock);
1878                 q->tag = TIMPLDO;
1879                 (q->varnp = (Namep) (yypvt[-1].chval->datap))->vimpldovar = 1;
1880                 p = yypvt[-1].chval->nextp;
1881                 if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
1882                 if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
1883                 if(p)  { q->impstep = (expptr)(p->datap); }
1884                 frchain( & (yypvt[-1].chval) );
1885                 yyval.chval = mkchain((char *)q, CHNULL);
1886                 q->datalist = hookup(yypvt[-3].chval, yyval.chval);
1887                 } break;
1888 case 108:
1889 /* # line 659 "gram.in" */
1890 { if (!datastack)
1891                         curdtp = 0;
1892                   datastack = mkchain((char *)curdtp, datastack);
1893                   curdtp = yypvt[-0].chval; curdtelt = 0;
1894                   } break;
1895 case 109:
1896 /* # line 665 "gram.in" */
1897 { yyval.chval = hookup(yypvt[-2].chval, yypvt[-0].chval); } break;
1898 case 110:
1899 /* # line 669 "gram.in" */
1900 { ndim = 0; } break;
1901 case 112:
1902 /* # line 673 "gram.in" */
1903 { ndim = 0; } break;
1904 case 115:
1905 /* # line 678 "gram.in" */
1906 {
1907                   if(ndim == maxdim)
1908                         err("too many dimensions");
1909                   else if(ndim < maxdim)
1910                         { dims[ndim].lb = 0;
1911                           dims[ndim].ub = yypvt[-0].expval;
1912                         }
1913                   ++ndim;
1914                 } break;
1915 case 116:
1916 /* # line 688 "gram.in" */
1917 {
1918                   if(ndim == maxdim)
1919                         err("too many dimensions");
1920                   else if(ndim < maxdim)
1921                         { dims[ndim].lb = yypvt[-2].expval;
1922                           dims[ndim].ub = yypvt[-0].expval;
1923                         }
1924                   ++ndim;
1925                 } break;
1926 case 117:
1927 /* # line 700 "gram.in" */
1928 { yyval.expval = 0; } break;
1929 case 119:
1930 /* # line 705 "gram.in" */
1931 { nstars = 1; labarray[0] = yypvt[-0].labval; } break;
1932 case 120:
1933 /* # line 707 "gram.in" */
1934 { if(nstars < MAXLABLIST)  labarray[nstars++] = yypvt[-0].labval; } break;
1935 case 121:
1936 /* # line 711 "gram.in" */
1937 { yyval.labval = execlab( convci(toklen, token) ); } break;
1938 case 122:
1939 /* # line 715 "gram.in" */
1940 { NO66("IMPLICIT statement"); } break;
1941 case 125:
1942 /* # line 721 "gram.in" */
1943 { if (vartype != TYUNKNOWN)
1944                         dclerr("-- expected letter range",NPNULL);
1945                   setimpl(vartype, varleng, 'a', 'z'); } break;
1946 case 126:
1947 /* # line 726 "gram.in" */
1948 { needkwd = 1; } break;
1949 case 130:
1950 /* # line 735 "gram.in" */
1951 { setimpl(vartype, varleng, yypvt[-0].ival, yypvt[-0].ival); } break;
1952 case 131:
1953 /* # line 737 "gram.in" */
1954 { setimpl(vartype, varleng, yypvt[-2].ival, yypvt[-0].ival); } break;
1955 case 132:
1956 /* # line 741 "gram.in" */
1957 { if(toklen!=1 || token[0]<'a' || token[0]>'z')
1958                         {
1959                         dclerr("implicit item must be single letter", NPNULL);
1960                         yyval.ival = 0;
1961                         }
1962                   else yyval.ival = token[0];
1963                 } break;
1964 case 135:
1965 /* # line 755 "gram.in" */
1966 {
1967                 if(yypvt[-2].namval->vclass == CLUNKNOWN)
1968                         {
1969                         yypvt[-2].namval->vclass = CLNAMELIST;
1970                         yypvt[-2].namval->vtype = TYINT;
1971                         yypvt[-2].namval->vstg = STGBSS;
1972                         yypvt[-2].namval->varxptr.namelist = yypvt[-0].chval;
1973                         yypvt[-2].namval->vardesc.varno = ++lastvarno;
1974                         }
1975                 else dclerr("cannot be a namelist name", yypvt[-2].namval);
1976                 } break;
1977 case 136:
1978 /* # line 769 "gram.in" */
1979 { yyval.chval = mkchain((char *)yypvt[-0].namval, CHNULL); } break;
1980 case 137:
1981 /* # line 771 "gram.in" */
1982 { yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].namval, CHNULL)); } break;
1983 case 138:
1984 /* # line 775 "gram.in" */
1985 { switch(parstate)
1986                         {
1987                         case OUTSIDE:   newproc();
1988                                         startproc(ESNULL, CLMAIN);
1989                         case INSIDE:    parstate = INDCL;
1990                         case INDCL:     break;
1991
1992                         case INDATA:
1993                                 errstr(
1994                                 "Statement order error: declaration after DATA",
1995                                         CNULL);
1996                                 break;
1997
1998                         default:
1999                                 dclerr("declaration among executables", NPNULL);
2000                         }
2001                 } break;
2002 case 139:
2003 /* # line 794 "gram.in" */
2004 { yyval.chval = 0; } break;
2005 case 141:
2006 /* # line 799 "gram.in" */
2007 { yyval.chval = mkchain((char *)yypvt[-0].expval, CHNULL); } break;
2008 case 142:
2009 /* # line 801 "gram.in" */
2010 { yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].expval,CHNULL) ); } break;
2011 case 144:
2012 /* # line 806 "gram.in" */
2013 { yyval.expval = yypvt[-1].expval; } break;
2014 case 148:
2015 /* # line 813 "gram.in" */
2016 { yyval.expval = mkexpr(yypvt[-1].ival, yypvt[-2].expval, yypvt[-0].expval); } break;
2017 case 149:
2018 /* # line 815 "gram.in" */
2019 { yyval.expval = mkexpr(OPSTAR, yypvt[-2].expval, yypvt[-0].expval); } break;
2020 case 150:
2021 /* # line 817 "gram.in" */
2022 { yyval.expval = mkexpr(OPSLASH, yypvt[-2].expval, yypvt[-0].expval); } break;
2023 case 151:
2024 /* # line 819 "gram.in" */
2025 { yyval.expval = mkexpr(OPPOWER, yypvt[-2].expval, yypvt[-0].expval); } break;
2026 case 152:
2027 /* # line 821 "gram.in" */
2028 { if(yypvt[-1].ival == OPMINUS)
2029                         yyval.expval = mkexpr(OPNEG, yypvt[-0].expval, ENULL);
2030                   else  yyval.expval = yypvt[-0].expval;
2031                 } break;
2032 case 153:
2033 /* # line 826 "gram.in" */
2034 { yyval.expval = mkexpr(yypvt[-1].ival, yypvt[-2].expval, yypvt[-0].expval); } break;
2035 case 154:
2036 /* # line 828 "gram.in" */
2037 { NO66(".EQV. operator");
2038                   yyval.expval = mkexpr(OPEQV, yypvt[-2].expval,yypvt[-0].expval); } break;
2039 case 155:
2040 /* # line 831 "gram.in" */
2041 { NO66(".NEQV. operator");
2042                   yyval.expval = mkexpr(OPNEQV, yypvt[-2].expval, yypvt[-0].expval); } break;
2043 case 156:
2044 /* # line 834 "gram.in" */
2045 { yyval.expval = mkexpr(OPOR, yypvt[-2].expval, yypvt[-0].expval); } break;
2046 case 157:
2047 /* # line 836 "gram.in" */
2048 { yyval.expval = mkexpr(OPAND, yypvt[-2].expval, yypvt[-0].expval); } break;
2049 case 158:
2050 /* # line 838 "gram.in" */
2051 { yyval.expval = mkexpr(OPNOT, yypvt[-0].expval, ENULL); } break;
2052 case 159:
2053 /* # line 840 "gram.in" */
2054 { NO66("concatenation operator //");
2055                   yyval.expval = mkexpr(OPCONCAT, yypvt[-2].expval, yypvt[-0].expval); } break;
2056 case 160:
2057 /* # line 844 "gram.in" */
2058 { yyval.ival = OPPLUS; } break;
2059 case 161:
2060 /* # line 845 "gram.in" */
2061 { yyval.ival = OPMINUS; } break;
2062 case 162:
2063 /* # line 848 "gram.in" */
2064 { yyval.ival = OPEQ; } break;
2065 case 163:
2066 /* # line 849 "gram.in" */
2067 { yyval.ival = OPGT; } break;
2068 case 164:
2069 /* # line 850 "gram.in" */
2070 { yyval.ival = OPLT; } break;
2071 case 165:
2072 /* # line 851 "gram.in" */
2073 { yyval.ival = OPGE; } break;
2074 case 166:
2075 /* # line 852 "gram.in" */
2076 { yyval.ival = OPLE; } break;
2077 case 167:
2078 /* # line 853 "gram.in" */
2079 { yyval.ival = OPNE; } break;
2080 case 168:
2081 /* # line 857 "gram.in" */
2082 { yyval.expval = mkprim(yypvt[-0].namval, LBNULL, CHNULL); } break;
2083 case 169:
2084 /* # line 859 "gram.in" */
2085 { NO66("substring operator :");
2086                   yyval.expval = mkprim(yypvt[-1].namval, LBNULL, yypvt[-0].chval); } break;
2087 case 170:
2088 /* # line 862 "gram.in" */
2089 { yyval.expval = mkprim(yypvt[-3].namval, mklist(yypvt[-1].chval), CHNULL); } break;
2090 case 171:
2091 /* # line 864 "gram.in" */
2092 { NO66("substring operator :");
2093                   yyval.expval = mkprim(yypvt[-4].namval, mklist(yypvt[-2].chval), yypvt[-0].chval); } break;
2094 case 172:
2095 /* # line 869 "gram.in" */
2096 { yyval.chval = mkchain((char *)yypvt[-3].expval, mkchain((char *)yypvt[-1].expval,CHNULL)); } break;
2097 case 173:
2098 /* # line 873 "gram.in" */
2099 { yyval.expval = 0; } break;
2100 case 175:
2101 /* # line 878 "gram.in" */
2102 { if(yypvt[-0].namval->vclass == CLPARAM)
2103                         yyval.expval = (expptr) cpexpr(
2104                                 ( (struct Paramblock *) (yypvt[-0].namval) ) -> paramval);
2105                 } break;
2106 case 177:
2107 /* # line 885 "gram.in" */
2108 { yyval.expval = mklogcon(1); } break;
2109 case 178:
2110 /* # line 886 "gram.in" */
2111 { yyval.expval = mklogcon(0); } break;
2112 case 179:
2113 /* # line 887 "gram.in" */
2114 { yyval.expval = mkstrcon(toklen, token); } break;
2115 case 180:
2116 /* # line 888 "gram.in" */
2117  { yyval.expval = mkintcon( convci(toklen, token) ); } break;
2118 case 181:
2119 /* # line 889 "gram.in" */
2120  { yyval.expval = mkrealcon(tyreal, token); } break;
2121 case 182:
2122 /* # line 890 "gram.in" */
2123  { yyval.expval = mkrealcon(TYDREAL, token); } break;
2124 case 184:
2125 /* # line 895 "gram.in" */
2126 { yyval.expval = mkcxcon(yypvt[-3].expval,yypvt[-1].expval); } break;
2127 case 185:
2128 /* # line 899 "gram.in" */
2129 { NOEXT("hex constant");
2130                   yyval.expval = mkbitcon(4, toklen, token); } break;
2131 case 186:
2132 /* # line 902 "gram.in" */
2133 { NOEXT("octal constant");
2134                   yyval.expval = mkbitcon(3, toklen, token); } break;
2135 case 187:
2136 /* # line 905 "gram.in" */
2137 { NOEXT("binary constant");
2138                   yyval.expval = mkbitcon(1, toklen, token); } break;
2139 case 189:
2140 /* # line 911 "gram.in" */
2141 { yyval.expval = yypvt[-1].expval; } break;
2142 case 192:
2143 /* # line 917 "gram.in" */
2144 { yyval.expval = mkexpr(yypvt[-1].ival, yypvt[-2].expval, yypvt[-0].expval); } break;
2145 case 193:
2146 /* # line 919 "gram.in" */
2147 { yyval.expval = mkexpr(OPSTAR, yypvt[-2].expval, yypvt[-0].expval); } break;
2148 case 194:
2149 /* # line 921 "gram.in" */
2150 { yyval.expval = mkexpr(OPSLASH, yypvt[-2].expval, yypvt[-0].expval); } break;
2151 case 195:
2152 /* # line 923 "gram.in" */
2153 { yyval.expval = mkexpr(OPPOWER, yypvt[-2].expval, yypvt[-0].expval); } break;
2154 case 196:
2155 /* # line 925 "gram.in" */
2156 { if(yypvt[-1].ival == OPMINUS)
2157                         yyval.expval = mkexpr(OPNEG, yypvt[-0].expval, ENULL);
2158                   else  yyval.expval = yypvt[-0].expval;
2159                 } break;
2160 case 197:
2161 /* # line 930 "gram.in" */
2162 { NO66("concatenation operator //");
2163                   yyval.expval = mkexpr(OPCONCAT, yypvt[-2].expval, yypvt[-0].expval); } break;
2164 case 199:
2165 /* # line 935 "gram.in" */
2166 {
2167                 if(yypvt[-3].labval->labdefined)
2168                         execerr("no backward DO loops", CNULL);
2169                 yypvt[-3].labval->blklevel = blklevel+1;
2170                 exdo(yypvt[-3].labval->labelno, NPNULL, yypvt[-0].chval);
2171                 } break;
2172 case 200:
2173 /* # line 942 "gram.in" */
2174 {
2175                 exdo(ctls - ctlstack - 2, NPNULL, yypvt[-0].chval);
2176                 NOEXT("DO without label");
2177                 } break;
2178 case 201:
2179 /* # line 947 "gram.in" */
2180 { exenddo(NPNULL); } break;
2181 case 202:
2182 /* # line 949 "gram.in" */
2183 { exendif();  thiswasbranch = NO; } break;
2184 case 204:
2185 /* # line 952 "gram.in" */
2186 { exelif(yypvt[-2].expval); lastwasbranch = NO; } break;
2187 case 205:
2188 /* # line 954 "gram.in" */
2189 { exelse(); lastwasbranch = NO; } break;
2190 case 206:
2191 /* # line 956 "gram.in" */
2192 { exendif(); lastwasbranch = NO; } break;
2193 case 207:
2194 /* # line 960 "gram.in" */
2195 { exif(yypvt[-1].expval); } break;
2196 case 208:
2197 /* # line 964 "gram.in" */
2198 { yyval.chval = mkchain((char *)yypvt[-2].namval, yypvt[-0].chval); } break;
2199 case 210:
2200 /* # line 969 "gram.in" */
2201 { yyval.chval = mkchain(CNULL, (chainp)yypvt[-1].expval); } break;
2202 case 211:
2203 /* # line 973 "gram.in" */
2204 { exequals((struct Primblock *)yypvt[-2].expval, yypvt[-0].expval); } break;
2205 case 212:
2206 /* # line 975 "gram.in" */
2207 { exassign(yypvt[-0].namval, yypvt[-2].labval); } break;
2208 case 215:
2209 /* # line 979 "gram.in" */
2210 { inioctl = NO; } break;
2211 case 216:
2212 /* # line 981 "gram.in" */
2213 { exarif(yypvt[-6].expval, yypvt[-4].labval, yypvt[-2].labval, yypvt[-0].labval);  thiswasbranch = YES; } break;
2214 case 217:
2215 /* # line 983 "gram.in" */
2216 { excall(yypvt[-0].namval, LBNULL, 0, labarray); } break;
2217 case 218:
2218 /* # line 985 "gram.in" */
2219 { excall(yypvt[-2].namval, LBNULL, 0, labarray); } break;
2220 case 219:
2221 /* # line 987 "gram.in" */
2222 { if(nstars < MAXLABLIST)
2223                         excall(yypvt[-3].namval, mklist(yypvt[-1].chval), nstars, labarray);
2224                   else
2225                         err("too many alternate returns");
2226                 } break;
2227 case 220:
2228 /* # line 993 "gram.in" */
2229 { exreturn(yypvt[-0].expval);  thiswasbranch = YES; } break;
2230 case 221:
2231 /* # line 995 "gram.in" */
2232 { exstop(yypvt[-2].ival, yypvt[-0].expval);  thiswasbranch = yypvt[-2].ival; } break;
2233 case 222:
2234 /* # line 999 "gram.in" */
2235 { yyval.labval = mklabel( convci(toklen, token) ); } break;
2236 case 223:
2237 /* # line 1003 "gram.in" */
2238 { if(parstate == OUTSIDE)
2239                         {
2240                         newproc();
2241                         startproc(ESNULL, CLMAIN);
2242                         }
2243                 } break;
2244 case 224:
2245 /* # line 1012 "gram.in" */
2246 { exgoto(yypvt[-0].labval);  thiswasbranch = YES; } break;
2247 case 225:
2248 /* # line 1014 "gram.in" */
2249 { exasgoto(yypvt[-0].namval);  thiswasbranch = YES; } break;
2250 case 226:
2251 /* # line 1016 "gram.in" */
2252 { exasgoto(yypvt[-4].namval);  thiswasbranch = YES; } break;
2253 case 227:
2254 /* # line 1018 "gram.in" */
2255 { if(nstars < MAXLABLIST)
2256                         putcmgo(putx(fixtype(yypvt[-0].expval)), nstars, labarray);
2257                   else
2258                         err("computed GOTO list too long");
2259                 } break;
2260 case 230:
2261 /* # line 1030 "gram.in" */
2262 { nstars = 0; yyval.namval = yypvt[-0].namval; } break;
2263 case 231:
2264 /* # line 1034 "gram.in" */
2265 { yyval.chval = (yypvt[-0].expval ? mkchain((char *)yypvt[-0].expval,CHNULL) : CHNULL); } break;
2266 case 232:
2267 /* # line 1036 "gram.in" */
2268 { if(yypvt[-0].expval)
2269                         if(yypvt[-2].chval) yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].expval,CHNULL));
2270                         else yyval.chval = mkchain((char *)yypvt[-0].expval,CHNULL);
2271                   else
2272                         yyval.chval = yypvt[-2].chval;
2273                 } break;
2274 case 234:
2275 /* # line 1046 "gram.in" */
2276 { if(nstars<MAXLABLIST) labarray[nstars++] = yypvt[-0].labval; yyval.expval = 0; } break;
2277 case 235:
2278 /* # line 1050 "gram.in" */
2279 { yyval.ival = 0; } break;
2280 case 236:
2281 /* # line 1052 "gram.in" */
2282 { yyval.ival = 1; } break;
2283 case 237:
2284 /* # line 1056 "gram.in" */
2285 { yyval.chval = mkchain((char *)yypvt[-0].expval, CHNULL); } break;
2286 case 238:
2287 /* # line 1058 "gram.in" */
2288 { yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].expval,CHNULL) ); } break;
2289 case 239:
2290 /* # line 1062 "gram.in" */
2291 { if(parstate == OUTSIDE)
2292                         {
2293                         newproc();
2294                         startproc(ESNULL, CLMAIN);
2295                         }
2296
2297 /* This next statement depends on the ordering of the state table encoding */
2298
2299                   if(parstate < INDATA) enddcl();
2300                 } break;
2301 case 240:
2302 /* # line 1075 "gram.in" */
2303 { intonly = YES; } break;
2304 case 241:
2305 /* # line 1079 "gram.in" */
2306 { intonly = NO; } break;
2307 case 242:
2308 /* # line 1084 "gram.in" */
2309 { endio(); } break;
2310 case 244:
2311 /* # line 1089 "gram.in" */
2312 { ioclause(IOSUNIT, yypvt[-0].expval); endioctl(); } break;
2313 case 245:
2314 /* # line 1091 "gram.in" */
2315 { ioclause(IOSUNIT, ENULL); endioctl(); } break;
2316 case 246:
2317 /* # line 1093 "gram.in" */
2318 { ioclause(IOSUNIT, IOSTDERR); endioctl(); } break;
2319 case 248:
2320 /* # line 1096 "gram.in" */
2321 { doio(CHNULL); } break;
2322 case 249:
2323 /* # line 1098 "gram.in" */
2324 { doio(CHNULL); } break;
2325 case 250:
2326 /* # line 1100 "gram.in" */
2327 { doio(yypvt[-0].chval); } break;
2328 case 251:
2329 /* # line 1102 "gram.in" */
2330 { doio(yypvt[-0].chval); } break;
2331 case 252:
2332 /* # line 1104 "gram.in" */
2333 { doio(yypvt[-0].chval); } break;
2334 case 253:
2335 /* # line 1106 "gram.in" */
2336 { doio(CHNULL); } break;
2337 case 254:
2338 /* # line 1108 "gram.in" */
2339 { doio(yypvt[-0].chval); } break;
2340 case 255:
2341 /* # line 1110 "gram.in" */
2342 { doio(CHNULL); } break;
2343 case 256:
2344 /* # line 1112 "gram.in" */
2345 { doio(yypvt[-0].chval); } break;
2346 case 258:
2347 /* # line 1119 "gram.in" */
2348 { iostmt = IOBACKSPACE; } break;
2349 case 259:
2350 /* # line 1121 "gram.in" */
2351 { iostmt = IOREWIND; } break;
2352 case 260:
2353 /* # line 1123 "gram.in" */
2354 { iostmt = IOENDFILE; } break;
2355 case 262:
2356 /* # line 1130 "gram.in" */
2357 { iostmt = IOINQUIRE; } break;
2358 case 263:
2359 /* # line 1132 "gram.in" */
2360 { iostmt = IOOPEN; } break;
2361 case 264:
2362 /* # line 1134 "gram.in" */
2363 { iostmt = IOCLOSE; } break;
2364 case 265:
2365 /* # line 1138 "gram.in" */
2366 {
2367                 ioclause(IOSUNIT, ENULL);
2368                 ioclause(IOSFMT, yypvt[-0].expval);
2369                 endioctl();
2370                 } break;
2371 case 266:
2372 /* # line 1144 "gram.in" */
2373 {
2374                 ioclause(IOSUNIT, ENULL);
2375                 ioclause(IOSFMT, ENULL);
2376                 endioctl();
2377                 } break;
2378 case 267:
2379 /* # line 1152 "gram.in" */
2380 {
2381                   ioclause(IOSUNIT, yypvt[-1].expval);
2382                   endioctl();
2383                 } break;
2384 case 268:
2385 /* # line 1157 "gram.in" */
2386 { endioctl(); } break;
2387 case 271:
2388 /* # line 1165 "gram.in" */
2389 { ioclause(IOSPOSITIONAL, yypvt[-0].expval); } break;
2390 case 272:
2391 /* # line 1167 "gram.in" */
2392 { ioclause(IOSPOSITIONAL, ENULL); } break;
2393 case 273:
2394 /* # line 1169 "gram.in" */
2395 { ioclause(IOSPOSITIONAL, IOSTDERR); } break;
2396 case 274:
2397 /* # line 1171 "gram.in" */
2398 { ioclause(yypvt[-1].ival, yypvt[-0].expval); } break;
2399 case 275:
2400 /* # line 1173 "gram.in" */
2401 { ioclause(yypvt[-1].ival, ENULL); } break;
2402 case 276:
2403 /* # line 1175 "gram.in" */
2404 { ioclause(yypvt[-1].ival, IOSTDERR); } break;
2405 case 277:
2406 /* # line 1179 "gram.in" */
2407 { yyval.ival = iocname(); } break;
2408 case 278:
2409 /* # line 1183 "gram.in" */
2410 { iostmt = IOREAD; } break;
2411 case 279:
2412 /* # line 1187 "gram.in" */
2413 { iostmt = IOWRITE; } break;
2414 case 280:
2415 /* # line 1191 "gram.in" */
2416 {
2417                 iostmt = IOWRITE;
2418                 ioclause(IOSUNIT, ENULL);
2419                 ioclause(IOSFMT, yypvt[-1].expval);
2420                 endioctl();
2421                 } break;
2422 case 281:
2423 /* # line 1198 "gram.in" */
2424 {
2425                 iostmt = IOWRITE;
2426                 ioclause(IOSUNIT, ENULL);
2427                 ioclause(IOSFMT, ENULL);
2428                 endioctl();
2429                 } break;
2430 case 282:
2431 /* # line 1207 "gram.in" */
2432 { yyval.chval = mkchain((char *)yypvt[-0].tagval, CHNULL); } break;
2433 case 283:
2434 /* # line 1209 "gram.in" */
2435 { yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].tagval, CHNULL)); } break;
2436 case 284:
2437 /* # line 1213 "gram.in" */
2438 { yyval.tagval = (tagptr) yypvt[-0].expval; } break;
2439 case 285:
2440 /* # line 1215 "gram.in" */
2441 { yyval.tagval = (tagptr) mkiodo(yypvt[-1].chval,yypvt[-3].chval); } break;
2442 case 286:
2443 /* # line 1219 "gram.in" */
2444 { yyval.chval = mkchain((char *)yypvt[-0].expval, CHNULL); } break;
2445 case 287:
2446 /* # line 1221 "gram.in" */
2447 { yyval.chval = mkchain((char *)yypvt[-0].tagval, CHNULL); } break;
2448 case 289:
2449 /* # line 1226 "gram.in" */
2450 { yyval.chval = mkchain((char *)yypvt[-2].expval, mkchain((char *)yypvt[-0].expval, CHNULL) ); } break;
2451 case 290:
2452 /* # line 1228 "gram.in" */
2453 { yyval.chval = mkchain((char *)yypvt[-2].expval, mkchain((char *)yypvt[-0].tagval, CHNULL) ); } break;
2454 case 291:
2455 /* # line 1230 "gram.in" */
2456 { yyval.chval = mkchain((char *)yypvt[-2].tagval, mkchain((char *)yypvt[-0].expval, CHNULL) ); } break;
2457 case 292:
2458 /* # line 1232 "gram.in" */
2459 { yyval.chval = mkchain((char *)yypvt[-2].tagval, mkchain((char *)yypvt[-0].tagval, CHNULL) ); } break;
2460 case 293:
2461 /* # line 1234 "gram.in" */
2462 { yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].expval, CHNULL) ); } break;
2463 case 294:
2464 /* # line 1236 "gram.in" */
2465 { yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].tagval, CHNULL) ); } break;
2466 case 295:
2467 /* # line 1240 "gram.in" */
2468 { yyval.tagval = (tagptr) yypvt[-0].expval; } break;
2469 case 296:
2470 /* # line 1242 "gram.in" */
2471 { yyval.tagval = (tagptr) yypvt[-1].expval; } break;
2472 case 297:
2473 /* # line 1244 "gram.in" */
2474 { yyval.tagval = (tagptr) mkiodo(yypvt[-1].chval, mkchain((char *)yypvt[-3].expval, CHNULL) ); } break;
2475 case 298:
2476 /* # line 1246 "gram.in" */
2477 { yyval.tagval = (tagptr) mkiodo(yypvt[-1].chval, mkchain((char *)yypvt[-3].tagval, CHNULL) ); } break;
2478 case 299:
2479 /* # line 1248 "gram.in" */
2480 { yyval.tagval = (tagptr) mkiodo(yypvt[-1].chval, yypvt[-3].chval); } break;
2481 case 300:
2482 /* # line 1252 "gram.in" */
2483 { startioctl(); } break;
2484         }
2485         goto yystack;           /* reset registers in driver code */
2486 }