regina/lexsrc.l

   1 %{
   2 #ifndef lint
   3 static char *RCSid = "$Id$";
   4 #endif
   5
   6 /*
   7  *  The Regina Rexx Interpreter
   8  *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
   9  *
  10  *  This library is free software; you can redistribute it and/or
  11  *  modify it under the terms of the GNU Library General Public
  12  *  License as published by the Free Software Foundation; either
  13  *  version 2 of the License, or (at your option) any later version.
  14  *
  15  *  This library is distributed in the hope that it will be useful,
  16  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18  *  Library General Public License for more details.
  19  *
  20  *  You should have received a copy of the GNU Library General Public
  21  *  License along with this library; if not, write to the Free
  22  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23  */
  24
  25 #include "rexx.h"
  26 #include "yaccsrc.h"
  27 #include <ctype.h>
  28 #include <string.h>
  29 #include <assert.h>
  30
  31 /* Define ASCII_0_TERMINATES_STRING if you want that ASCII-0 terminates
  32  * an input string. Normally this should not happen. Input strings are
  33  * terminated by a length encoding. The string {"", length=1} is invalid for
  34  * the lexer (ASCII-0 is not allowed) while {"", length=0} is allowed (this
  35  * is an empty input).
  36  * ASCII_0_TERMINATES_STRING is only(!) for backward compatibility and
  37  * shouldn't be used under normal circumstances.
  38  * FGC
  39  */
  40 #define ASCII_0_TERMINATES_STRING
  41
  42 #ifdef YYLMAX
  43 # undef YYLMAX
  44 #endif
  45 #define YYLMAX BUFFERSIZE
  46
  47 #ifdef FLEX_SCANNER
  48 #undef YY_CHAR
  49 #define YY_CHAR YY_CHAR_TYPE
  50 #undef YY_INPUT
  51 #define YY_INPUT(buf,result,max_size) result=fill_buffer(buf,max_size)
  52 #endif
  53
  54 /* NOTE: Every comment is replaced by a '`' character in the lower input
  55  * routines. These should check for such (illegal) characters.
  56  */
  57 #define MY_ISBLANK(c) (((c)==' ')||((c)=='\t')||((c)=='`'))
  58
  59 PROTECTION_VAR(regina_parser)
  60 /* externals which are protected by regina_parser */
  61 internal_parser_type parser_data = {NULL, };
  62 int retlength=0 ;
  63 char retvalue[BUFFERSIZE] ;
  64 unsigned SymbolDetect = 0;
  65 /* end of externals protected by regina_parser */
  66
  67 /* locals, they are protected by regina_parser, too */
  68 static int nextline = 1;
  69 static int nextstart = 1;
  70 static int do_level = 0 ;
  71 static int in_numform=0, next_numform=0 ;
  72 static int obs_with=0, in_do=0, in_then=0, dontlast=0 ;
  73 static int sum=0 ;
  74 static int code=0, nexta=0, in_parse=0, in_trace=0, itflag=0 ;
  75 static int in_signal=0, in_call=0 ;
  76 static enum { not_in_address = 0,
  77               in_address_keyword, /* ADDRESS just seen */
  78               in_address_main, /* after the first word */
  79               in_address_value, /* like main but VALUE was seen */
  80               in_address_with} in_address = not_in_address,
  81                                last_in_address = not_in_address ;
  82 static enum {no_seek_with = 0,
  83              seek_with_from_parse,
  84              seek_with_from_address} seek_with = no_seek_with ;
  85 static int preva=0, lasta=0 ;
  86 static char ch, ech ;
  87 static int kill_this_space=0, kill_next_space=1 ;
  88 static int extnextline = -1, extnextstart; /* for a delayed line increment */
  89 static int linenr=1 ;
  90 static int contline = 0;
  91 static int inEOF=0 ;
  92 static int singlequote=0, doblequote=0 ;
  93 static int firstln=0 ;
  94 static int bufptr=0 ;
  95 /* Previous bug. 8-bits clean combined with EOF ==> need at least short */
  96 static short chbuffer[LOOKAHEAD] ;
  97 static int ipretflag=0, cch=0 ;
  98 static const char *interptr=NULL ;
  99 static const char *interptrmax ;
 100 static int cchmax = 0 ;
 101
 102 static YY_CHAR_TYPE *rmspc( YY_CHAR_TYPE *instr ) ;
 103 static int fill_buffer( char *buf, int max_size ) ;
 104 #define SET_NEXTSTART() (nextstart += yyleng)
 105
 106 #define YY_FATAL_ERROR(s) exiterror( ERR_PROG_UNREADABLE, 1, s )
 107 %}
 108
 109
 110 %start comm signal sgtype procd parse then with
 111 %start numeric do1 other value1 ifcont signame nmform
 112
 113 %e 2500
 114 %p 17000
 115 %k 1500
 116 %a 7000
 117 %n 1000
 118 %o 8000
 119
 120 %{
 121 /* int yy_startcond=comm ; FGC: Needless? */
 122 %}
 123
 124 not [\\^~]
 125
 126 csym [0-9.][a-zA-Z0-9.@#$!?_]*
 127 ssym [a-zA-Z@#$!?_][a-zA-Z0-9.@#$!?_]*
 128 strs ('([^']|'')*'|\"([^"]|\"\")*\")
 129 labl ({sym}|{strs})+
 130 sym [a-zA-Z0-9.@#$!?_]+
 131 hsym [\t a-fA-F0-9]
 132 bsym [\t 01]
 133 hex {bl}*{hsym}*({bl}+({hsym}{hsym})+)*{bl}*
 134 bin {bl}*{bsym}*({bl}+({bsym}{bsym}{bsym}{bsym})+)*{bl}*
 135
 136 vtail [a-zA-Z@#$!?_][a-zA-Z0-9@#$!?_]*
 137 ctail [0-9][a-zA-Z0-9@#$!?_]*
 138
 139
 140 a [aA]
 141 b [bB]
 142 c [cC]
 143 d [dD]
 144 e [eE]
 145 f [fF]
 146 g [gG]
 147 h [hH]
 148 i [iI]
 149 j [jJ]
 150 k [kK]
 151 l [lL]
 152 m [mM]
 153 n [nN]
 154 o [oO]
 155 p [pP]
 156 q [qQ]
 157 r [rR]
 158 s [sS]
 159 t [tT]
 160 u [uU]
 161 v [vV]
 162 w [wW]
 163 x [xX]
 164 y [yY]
 165 z [zZ]
 166
 167
 168 bl (\ |\`|\t)*
 169 bbl (\ |\t)+
 170
 171 %%
 172
 173    { if (nexta==1) {
 174         nexta = 0 ;
 175         lasta = (dontlast==0) ;
 176         dontlast = 0 ;
 177         return code ; }
 178
 179      if (next_numform)
 180      {
 181         in_numform = 1 ;
 182         next_numform = 0 ;
 183      }
 184      else
 185         in_numform = 0 ;
 186
 187      last_in_address = in_address ; /* just for the "Environment" */
 188     /* there can't be an intermediate SPACE between ADDRESS and the next word*/
 189      if (in_address == in_address_keyword)
 190         in_address = in_address_main ;
 191
 192      kill_this_space = kill_next_space ;
 193      kill_next_space = 0 ;
 194
 195
 196      if (itflag)
 197         in_trace = seek_with = 0 ;
 198      itflag = (in_trace) ;
 199
 200      if (extnextline != -1)
 201      {
 202         parser_data.tstart = nextstart = extnextstart;
 203         parser_data.tline = nextline = extnextline;
 204         extnextline = -1;
 205      }
 206      else
 207      {
 208         parser_data.tstart = nextstart ;
 209         parser_data.tline = nextline ;
 210      }
 211      preva = lasta ;
 212      lasta = 0 ;
 213    }
 214
 215 \`* SET_NEXTSTART() ;
 216
 217 <ifcont>{bl}[;\r?\n]{bl} {
 218    char *ptr;
 219    if ((ptr = strchr(yytext, '\n')) != NULL)
 220    {
 221       nextstart = yyleng - (int) (ptr - (char *) yytext) ;
 222       nextline++ ;
 223       if (extnextline != -1)
 224          extnextline++;
 225    }
 226    else
 227       SET_NEXTSTART() ;
 228    return STATSEP ; }
 229
 230 {bl}(;|\r?\n){bl} {
 231    char *ptr;
 232    BEGIN comm ;
 233    if (obs_with==1)
 234    {
 235       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 236       exiterror( ERR_INVALID_TEMPLATE, 1, yytext )  ;
 237    }
 238    obs_with = in_do = 0 ;
 239    in_signal = in_address = in_call = 0 ;
 240    in_parse = 0 ;
 241    if (seek_with == seek_with_from_address)
 242       seek_with = no_seek_with ;
 243    if ((ptr = strchr(yytext, '\n')) != NULL)
 244    {
 245       nextstart = yyleng - (int) (ptr - (char *) yytext) ;
 246       nextline++ ;
 247       if (extnextline != -1)
 248          extnextline++;
 249    }
 250    else
 251       SET_NEXTSTART() ;
 252    return STATSEP ; }
 253
 254 <comm>{a}{d}{d}{r}{e}{s}{s}{bl} {
 255    BEGIN value1 ; /* Allow a following VALUE keyword */
 256    seek_with = seek_with_from_address ;
 257    in_address = in_address_keyword ;
 258    in_call = 1 ; /* Allow the next words to be given as in CALL. */
 259    SET_NEXTSTART() ;
 260    return ADDRESS ; }
 261
 262 <comm>{a}{r}{g}{bl} {
 263    BEGIN other ;
 264    in_parse = 1 ;
 265    SET_NEXTSTART() ;
 266    return ARG ; }
 267
 268 <comm>{c}{a}{l}{l}{bl} {
 269    BEGIN signal ;
 270    in_call = 1 ;
 271    SET_NEXTSTART() ;
 272    return CALL ; }
 273
 274 <comm>{d}{o}{bl} {
 275    BEGIN do1 ;
 276    assert( do_level >=0 ) ;
 277    do_level++ ;
 278    in_do = 1 ;
 279    SET_NEXTSTART() ;
 280    return DO ; }
 281
 282 <comm>{d}{r}{o}{p}{bl} {
 283    BEGIN other ;
 284    in_parse = 1 ;
 285    SET_NEXTSTART() ;
 286    return DROP ; }
 287
 288 <comm>{e}{l}{s}{e}{bl} {
 289    BEGIN comm ;
 290    SET_NEXTSTART() ;
 291    return ELSE ; }
 292
 293 <comm>{e}{x}{i}{t}{bl} {
 294    BEGIN other ;
 295    SET_NEXTSTART() ;
 296    return EXIT ; }
 297
 298 <comm>{i}{f}{bl} {
 299    BEGIN ifcont ;
 300    in_then = 1 ;
 301    parser_data.if_linenr = linenr - 1;
 302    SET_NEXTSTART() ;
 303    return IF ; }
 304
 305 <comm>{i}{n}{t}{e}{r}{p}{r}{e}{t}{bl} {
 306    BEGIN other ;
 307    SET_NEXTSTART() ;
 308    return INTERPRET ; }
 309
 310 <comm>{i}{t}{e}{r}{a}{t}{e}{bl} {
 311    BEGIN other ;
 312    SET_NEXTSTART() ;
 313    return ITERATE ; }
 314
 315 <comm>{l}{e}{a}{v}{e}{bl} {
 316    BEGIN other ;
 317    SET_NEXTSTART() ;
 318    return LEAVE ; }
 319
 320 <comm>{o}{p}{t}{i}{o}{n}{s}{bl} {
 321    BEGIN other ;
 322    SET_NEXTSTART() ;
 323    return OPTIONS ; }
 324
 325 <comm>{n}{o}{p}{bl} {
 326    BEGIN other ;
 327    SET_NEXTSTART() ;
 328    return NOP ; }
 329
 330 <comm>{n}{u}{m}{e}{r}{i}{c}{bl} {
 331    BEGIN numeric ;
 332    SET_NEXTSTART() ;
 333    return NUMERIC ; }
 334
 335 <comm>{p}{a}{r}{s}{e}{bl} {
 336    BEGIN parse ;
 337    in_parse = 1 ;
 338    SET_NEXTSTART() ;
 339    return PARSE ; }
 340
 341 <comm>{p}{r}{o}{c}{e}{d}{u}{r}{e}{bl} {
 342    BEGIN procd ;
 343    SET_NEXTSTART() ;
 344    return PROCEDURE ; }
 345
 346 <comm>{p}{u}{l}{l}{bl} {
 347    BEGIN other ;
 348    in_parse = 1 ;
 349    SET_NEXTSTART() ;
 350    return PULL ; }
 351
 352 <comm>{p}{u}{s}{h}{bl} {
 353    BEGIN other ;
 354    SET_NEXTSTART() ;
 355    return PUSH ; }
 356
 357 <comm>{q}{u}{e}{u}{e}{bl} {
 358    BEGIN other ;
 359    SET_NEXTSTART() ;
 360    return QUEUE ; }
 361
 362 <comm>{r}{e}{t}{u}{r}{n}{bl} {
 363    BEGIN other ;
 364    SET_NEXTSTART() ;
 365    return RETURN ; }
 366
 367 <comm>{s}{a}{y}{bl} {
 368    BEGIN other ;
 369    SET_NEXTSTART() ;
 370    return SAY ; }
 371
 372 <comm>{s}{e}{l}{e}{c}{t}{bl} {
 373    BEGIN other ;
 374    assert( do_level >= 0 ) ;
 375    do_level++ ;
 376    SET_NEXTSTART() ;
 377    return SELECT ; }
 378
 379 <comm>{s}{i}{g}{n}{a}{l}{bl} {
 380    BEGIN signal ;
 381    in_signal = 1 ;
 382    SET_NEXTSTART() ;
 383    return SIGNAL ; }
 384
 385 <comm>{t}{r}{a}{c}{e}{bl} {
 386    BEGIN value1 ;
 387    in_trace = 1 ;
 388    SET_NEXTSTART() ;
 389    return TRACE ; }
 390
 391 <comm>{u}{p}{p}{e}{r}{bl} {
 392    BEGIN other ;
 393    in_parse = 1 ;
 394    SET_NEXTSTART() ;
 395    return UPPER ; }
 396
 397 <comm>{w}{h}{e}{n}{bl} {
 398    BEGIN ifcont ;
 399    in_then = 1 ;
 400    parser_data.when_linenr = linenr - 1;
 401    SET_NEXTSTART() ;
 402    return WHEN ; }
 403
 404 <comm>{o}{t}{h}{e}{r}{w}{i}{s}{e}{bl} {
 405    BEGIN comm ;
 406    SET_NEXTSTART() ;
 407    return OTHERWISE ; }
 408
 409 <comm>{e}{n}{d}{bl} {
 410    BEGIN other ;
 411    assert( do_level >= 0 ) ;
 412    if (do_level==0)
 413    {
 414       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 415       exiterror( ERR_UNMATCHED_END, 1 ) ;
 416    }
 417    do_level-- ;
 418    SET_NEXTSTART() ;
 419    return END ; }
 420
 421 {bl} {
 422    if (in_parse)
 423    {
 424       SET_NEXTSTART() ;
 425       return yylex() ;
 426    }
 427    else
 428       REJECT ; }
 429
 430 \. {
 431    if (in_parse)
 432    {
 433       SET_NEXTSTART() ;
 434       return PLACEHOLDER ;
 435    }
 436    else
 437    {
 438       REJECT ;
 439 #if 0
 440       /* FGC: What should the following mean after a REJECT? */
 441       retvalue[0] = '.' ;
 442       retvalue[1] = '\0' ;
 443       return CONSYMBOL ;
 444 #endif
 445    }
 446  }
 447
 448 <comm>{csym}{bl}={bl} {
 449    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 450    if (yytext[0] == '.')
 451       exiterror( ERR_INVALID_START, 3, yytext )  ;
 452    else
 453       exiterror( ERR_INVALID_START, 2, yytext )  ;
 454    SET_NEXTSTART() ; }
 455
 456 <comm>{ssym}{bl}={bl} {
 457    unsigned i,j;
 458    BEGIN other ;
 459
 460    j = 0 ;
 461    for (i=0;yytext[i];i++)
 462       if ('a' <= yytext[i] && yytext[i] <= 'z')
 463          retvalue[j++] = (char) (yytext[i] & 0xDF) ; /* ASCII only */
 464       else if (yytext[i]!='='  && yytext[i]!='\n' && !MY_ISBLANK(yytext[i]))
 465          retvalue[j++] = yytext[i] ;
 466    retvalue[j] = '\0' ;
 467
 468    SET_NEXTSTART() ;
 469    return ASSIGNMENTVARIABLE ; }
 470
 471 <nmform,signal,value1>{bl}{v}{a}{l}{u}{e}{bl} {
 472    if (in_call)
 473    {
 474       if ((last_in_address == in_address_keyword) &&
 475           (in_address == in_address_main))
 476       {
 477          BEGIN other ; /* the next useful expression will set it to "other"
 478                         * in either case. The BEGIN-states aren't very
 479                         * handy in most cases; they are not flexible enough.
 480                         */
 481          in_address = in_address_value ;
 482          SET_NEXTSTART() ;
 483          return VALUE ;
 484       }
 485       REJECT ;
 486    }
 487    BEGIN other ;
 488    if ((!in_trace)&&(!in_address)&&(!in_signal)&&(!in_call)&&(!in_numform))
 489       obs_with = 1 ;
 490    in_trace = in_signal = in_call = 0 ;
 491    SET_NEXTSTART() ;
 492    return VALUE ; }
 493
 494 <signal>{o}{n}{bl} {
 495    BEGIN sgtype ;
 496    SET_NEXTSTART() ;
 497    return ON ; }
 498
 499 <signal>{o}{f}{f}{bl} {
 500    BEGIN sgtype ;
 501    SET_NEXTSTART() ;
 502    return OFF ; }
 503
 504 <signame>{n}{a}{m}{e}{bl} {
 505    BEGIN other ;
 506    SET_NEXTSTART() ;
 507    return NAME ; }
 508
 509 <sgtype>{e}{r}{r}{o}{r}{bl} {
 510    BEGIN signame ;
 511    SET_NEXTSTART() ;
 512    return ERROR ; }
 513
 514 <sgtype>{h}{a}{l}{t}{bl} {
 515    BEGIN signame ;
 516    SET_NEXTSTART() ;
 517    return HALT ; }
 518
 519 <sgtype>{n}{o}{v}{a}{l}{u}{e}{bl} {
 520    BEGIN signame ;
 521    SET_NEXTSTART() ;
 522    return NOVALUE ; }
 523
 524 <sgtype>{n}{o}{t}{r}{e}{a}{d}{y}{bl} {
 525    BEGIN signame ;
 526    SET_NEXTSTART() ;
 527    return NOTREADY ; }
 528
 529 <sgtype>{f}{a}{i}{l}{u}{r}{e}{bl} {
 530    BEGIN signame ;
 531    SET_NEXTSTART() ;
 532    return FAILURE ; }
 533
 534 <sgtype>{s}{y}{n}{t}{a}{x}{bl} {
 535    BEGIN signame ;
 536    SET_NEXTSTART() ;
 537    return SYNTAX ; }
 538
 539 <sgtype>{l}{o}{s}{t}{d}{i}{g}{i}{t}{s}{bl} {
 540    BEGIN signame ;
 541    SET_NEXTSTART() ;
 542    return LOSTDIGITS ; }
 543
 544 <value1>{bl}[a-zA-Z?]+{bl} {
 545    if (!in_trace) REJECT ;
 546    strcpy(retvalue,rmspc( yytext )) ;
 547    SET_NEXTSTART() ;
 548    return WHATEVER ; }
 549
 550 <procd>{e}{x}{p}{o}{s}{e}{bl} {
 551    BEGIN other ;
 552    in_parse = 1 ;
 553    SET_NEXTSTART() ;
 554    return EXPOSE ; }
 555
 556 <parse>{u}{p}{p}{e}{r}{bl} {
 557    SET_NEXTSTART() ;
 558    return UPPER ; }
 559
 560 <parse>{a}{r}{g}{bl} {
 561    BEGIN other ;
 562    SET_NEXTSTART() ;
 563    return ARG ; }
 564
 565 <parse>{n}{u}{m}{e}{r}{i}{c}{bl} {
 566    BEGIN other ;
 567    SET_NEXTSTART() ;
 568    return NUMERIC ; }
 569
 570 <parse>{p}{u}{l}{l}{bl} {
 571    BEGIN other ;
 572    SET_NEXTSTART() ;
 573    return PULL ; }
 574
 575 <parse>{s}{o}{u}{r}{c}{e}{bl} {
 576    BEGIN other ;
 577    SET_NEXTSTART() ;
 578    return SOURCE ; }
 579
 580 <parse>{e}{x}{t}{e}{r}{n}{a}{l}{bl} {
 581    BEGIN other ;
 582    SET_NEXTSTART() ;
 583    return EXTERNAL ; }
 584
 585 <parse>{l}{i}{n}{e}{i}{n}{bl} {
 586    BEGIN other ;
 587    SET_NEXTSTART() ;
 588    return LINEIN ; }
 589
 590 <parse>{v}{e}{r}{s}{i}{o}{n}{bl} {
 591    BEGIN other ;
 592    SET_NEXTSTART() ;
 593    return VERSION ; }
 594
 595 <parse>{v}{a}{r}{bl} {
 596    BEGIN other ;
 597    SET_NEXTSTART() ;
 598    return VAR ; }
 599
 600 <parse>{v}{a}{l}{u}{e}{bl} {
 601    seek_with = seek_with_from_parse ;
 602    in_trace = 0 ;
 603    in_parse = 0 ;
 604    BEGIN with ; /* in fact this works as a "not comm" */
 605    SET_NEXTSTART() ;
 606    return VALUE ; }
 607
 608 <comm>{bl}{t}{h}{e}{n}{bl} {
 609    in_then = 0 ;
 610    SET_NEXTSTART() ;
 611    return THEN ; }
 612
 613 <other,ifcont>{bl}{t}{h}{e}{n}{bl} {
 614    if (in_then!=1) REJECT ;
 615    BEGIN comm ;
 616    in_then = 0 ;
 617    SET_NEXTSTART() ;
 618    return THEN ; }
 619
 620 {bl}{w}{i}{t}{h}{bl} {
 621    BEGIN other ;
 622    if ((in_do)||(!seek_with))
 623       REJECT ;
 624    if (seek_with == seek_with_from_parse)
 625       in_parse = 1 ;
 626    seek_with = 0 ;
 627    if (in_address) /* any address state */
 628       in_address = in_address_with ; /* WITH seen */
 629    SET_NEXTSTART() ;
 630    return WITH ; }
 631
 632
 633 <numeric>{d}{i}{g}{i}{t}{s}{bl} {
 634    BEGIN other ;
 635    SET_NEXTSTART() ;
 636    return DIGITS ; }
 637
 638 <numeric>{f}{o}{r}{m}{bl} {
 639    BEGIN nmform ;
 640    next_numform = 1 ;
 641    SET_NEXTSTART() ;
 642    return FORM ; }
 643
 644 <nmform>{s}{c}{i}{e}{n}{t}{i}{f}{i}{c}{bl} {
 645    SET_NEXTSTART() ;
 646    return SCIENTIFIC ; }
 647
 648 <nmform>{e}{n}{g}{i}{n}{e}{e}{r}{i}{n}{g}{bl} {
 649    SET_NEXTSTART() ;
 650    return ENGINEERING ; }
 651
 652 <numeric>{f}{u}{z}{z}{bl} {
 653    BEGIN other ;
 654    SET_NEXTSTART() ;
 655    return FUZZ ; }
 656
 657 <do1>{f}{o}{r}{e}{v}{e}{r}{bl} {
 658    BEGIN other ;
 659    assert(in_do) ;
 660    in_do = 2 ;
 661    SET_NEXTSTART() ;
 662    return FOREVER ; }
 663
 664 {bl}{t}{o}{bl} {
 665    if (in_do==2)
 666    {
 667       BEGIN other ;
 668       SET_NEXTSTART() ;
 669       return TO ;
 670    }
 671    else if (in_do==1)
 672    {
 673       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 674       exiterror( ERR_INVALID_DO_SYNTAX, 1, "TO" )  ;
 675    }
 676    REJECT ; }
 677
 678 {bl}{b}{y}{bl} {
 679    if (in_do==2)
 680    {
 681       BEGIN other ;
 682       SET_NEXTSTART() ;
 683       return BY ;
 684    }
 685    else if (in_do==1)
 686    {
 687       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 688       exiterror( ERR_INVALID_DO_SYNTAX, 1, "BY" ) ;
 689    }
 690    REJECT ; }
 691
 692 {bl}{f}{o}{r}{bl} {
 693    if (in_do==2)
 694    {
 695       BEGIN other ;
 696       SET_NEXTSTART() ;
 697       return FOR ;
 698    }
 699    else if (in_do==1)
 700    {
 701       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 702       exiterror( ERR_INVALID_DO_SYNTAX, 1, "FOR" ) ;
 703    }
 704    REJECT ; }
 705
 706 {bl}{w}{h}{i}{l}{e}{bl} {
 707    if (in_do)
 708    {
 709       if (in_do==3)
 710       {
 711          parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 712          exiterror( ERR_INVALID_DO_SYNTAX, 1, "WHILE" )  ;
 713       }
 714       in_do=3 ;
 715       BEGIN other ;
 716       SET_NEXTSTART() ;
 717       return WHILE ;
 718    }
 719    REJECT ; }
 720
 721 {bl}{u}{n}{t}{i}{l}{bl} {
 722    if (in_do) {
 723       if (in_do==3)
 724       {
 725          parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 726          exiterror( ERR_INVALID_DO_SYNTAX, 1, "UNTIL" )  ;
 727       }
 728
 729       in_do=3 ;
 730       BEGIN other ;
 731       SET_NEXTSTART() ;
 732       return UNTIL ; }
 733    REJECT ; }
 734
 735
 736 <do1>{ssym}{bl}/= {
 737    BEGIN other ;
 738    in_do = 2 ;
 739    strcpy(retvalue,rmspc( yytext )) ;
 740    SET_NEXTSTART() ;
 741    return DOVARIABLE ; }
 742
 743 <comm>{sym}{bl}:{bl} {  /* set labl to sym for other kind or vice versa*/
 744    unsigned i,j;
 745    BEGIN comm ;
 746
 747    for (i=j=0;(ch=yytext[i])!=0;i++) {
 748       if ('a' <= ch && ch <= 'z')
 749          retvalue[j++] = (char) (ch & 0xDF) ; /* ASCII only */
 750       /* FIXME: the following is WRONG, must first cut off {bl}:{bl} and
 751        * then fixup strings, FGC */
 752       else if ((ch!=',')&&(ch!='\n')&&(ch!=':')&&!MY_ISBLANK(ch))
 753          retvalue[j++] = ch ; }
 754    retvalue[j] = '\0' ;
 755    SET_NEXTSTART() ;
 756    return LABEL ; }
 757
 758
 759 ('([^']|'')+'|\"([^"]|\"\")+\")`*\( {
 760    int i;
 761    BEGIN other ;
 762
 763    strcpy(retvalue,&yytext[1]) ;
 764    for (i=3; i<=yyleng && retvalue[yyleng-i]=='`'; i++) ;
 765    retvalue[yyleng-i] = '\0' ;
 766
 767    kill_next_space = 1 ;
 768    if (preva==1) {
 769       nexta = dontlast = 1 ;
 770       code = EXFUNCNAME ;
 771       SET_NEXTSTART() ;
 772       return CONCATENATE ; }
 773
 774    lasta = 0 ;
 775    SET_NEXTSTART() ;
 776    return EXFUNCNAME ; }
 777
 778
 779
 780 ('{hex}'|\"{hex}\")[xX]/[^a-zA-Z0-9.@#$!?_(] {
 781    unsigned i,j,k;
 782    BEGIN other ;
 783    ech = yytext[0] ;
 784
 785    /* first group can be large and odd-numbered; find # of zeros to pad */
 786    for (i=1; (yytext[i]!=ech) && isxdigit(yytext[i]); i++) ;
 787
 788    /* j is the number of digits processed */
 789    j = (i-1)%2 ;
 790    sum = k = 0 ;
 791
 792    for (i=1;(ech!=(ch=yytext[i]));i++)
 793    {
 794       if (isspace(ch))
 795       {
 796          if ((i==1)||(j))   /* leading space or space within a byte */
 797          {
 798             parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 799             exiterror( ERR_INVALID_HEX_CONST, 1, i ) ;
 800          }
 801       }
 802       else if (isxdigit(ch))
 803       {
 804          sum = sum *16 + (HEXVAL(ch)) ;
 805          if ((++j)==2)
 806          {
 807             retvalue[k++] = (char) sum ;
 808             sum = j = 0 ;
 809          }
 810       }
 811    }
 812
 813    if ((i>1) && isspace(yytext[i-1]))
 814    {
 815       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 816       exiterror( ERR_INVALID_HEX_CONST, 1, i ) ;
 817    }
 818
 819    retvalue[k] = '\0' ;
 820    retlength = k ;
 821
 822    if ((preva==1)&&(!in_parse)&&(!in_call))
 823    {
 824       nexta = 1 ;
 825       code = STRING ;
 826       SET_NEXTSTART() ;
 827       return CONCATENATE ;
 828    }
 829
 830    if (in_call)
 831    {
 832       in_call = 0 ;
 833       kill_next_space = 1 ;
 834    }
 835    else
 836       lasta = 1 ;
 837
 838    SET_NEXTSTART() ;
 839    return HEXSTRING ;
 840 }
 841
 842
 843
 844 ('{bin}'|\"{bin}\")[bB]/[^a-zA-Z0-9.@#$!?_(] {
 845    unsigned i,j,k;
 846    BEGIN other ;
 847    ech = yytext[0] ;
 848
 849    /* first group can be large and odd-numbered; find # of zeros to pad */
 850    for (i=1; (yytext[i]!=ech) && isdigit(yytext[i]); i++) ;
 851
 852    /* j is the number of digits processed */
 853    j = (4 - (i-1))%4 ;
 854    sum = k = 0 ;
 855
 856    for (i=1;(ech!=(ch=yytext[i]));i++)
 857    {
 858       if (isspace(ch))
 859       {
 860          if ((i==1)||(j))   /* leading space or space within a byte */
 861          {
 862             parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 863             exiterror( ERR_INVALID_HEX_CONST, 2, i ) ;
 864          }
 865       }
 866       else if ((ch=='0')||(ch=='1'))
 867       {
 868          sum = sum *2 + (ch-'0') ;
 869          if ((++j)==4)
 870          {
 871             retvalue[k++] = (char) sum ;
 872             sum = j = 0 ;
 873          }
 874       }
 875    }
 876
 877    if ((i>1) && isspace(yytext[i-1]))
 878    {
 879       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 880       exiterror( ERR_INVALID_HEX_CONST, 2, i ) ;
 881    }
 882
 883    j = (k%2) ;
 884    /* then pack the nibbles */
 885    for (i=j=(k%2); i<=k; i++)
 886    {
 887       if (i%2)
 888          retvalue[i/2] = (char)((retvalue[i/2]&0xf0) + retvalue[i-j]) ;
 889       else
 890          retvalue[i/2] = (char)((retvalue[i-j]&0x0f)<<4) ;
 891    }
 892
 893    retvalue[retlength=i/2] = '\0' ;
 894
 895    if ((preva==1)&&(!in_parse)&&(!in_call))
 896    {
 897       nexta = 1 ;
 898       code = STRING ;
 899       SET_NEXTSTART() ;
 900       return CONCATENATE ;
 901    }
 902
 903    if (in_call)
 904    {
 905       in_call = 0 ;
 906       kill_next_space = 1 ;
 907    }
 908    else
 909       lasta = 1 ;
 910
 911    SET_NEXTSTART() ;
 912    return BINSTRING ;
 913 }
 914
 915 ('([^']|'')*'|\"([^"]|"")*\")[xXbB]/[^a-zA-Z0-9.@#$!?_(] {
 916    unsigned int i;
 917    char bad=' ';
 918    BEGIN other ;
 919    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 920    for (i=0;yytext[i]; i++)
 921    {
 922       if ( !isxdigit(yytext[i]) && !(yytext[i] == '\"' && yytext[0] == '\"') && !(yytext[i] == '\'' && yytext[0] == '\'') && yytext[i] != ' ' )
 923       {
 924          bad = yytext[i];
 925          break;
 926       }
 927    }
 928    exiterror( ERR_INVALID_HEX_CONST, 3, bad )  ;
 929    SET_NEXTSTART() ;
 930    }
 931
 932 ('([^']|'')*'|\"([^"]|\"\")*\") {
 933    unsigned i,j;
 934    BEGIN other ;
 935    for (i=1; yytext[i+1]; i++)
 936    {
 937       if (yytext[i]=='\n')
 938       {
 939          parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 940          exiterror( ERR_UNMATCHED_QUOTE, 0 ) ;
 941       }
 942
 943       if (yytext[i]==yytext[0] && yytext[i+1]==yytext[0])
 944          for (j=i+1; yytext[j]; j++)
 945             yytext[j] = yytext[j+1] ;
 946    }
 947
 948    yytext[strlen(yytext)-1] = '\0' ;
 949    strcpy(retvalue,&yytext[1]) ;
 950
 951    if (in_numform)
 952    {
 953       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 954       exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", retvalue ) ;
 955    }
 956
 957    if ((preva==1)&&(!in_parse)&&(!in_call)) {
 958       nexta = 1 ;
 959       code = STRING ;
 960       SET_NEXTSTART() ;
 961       return CONCATENATE ; }
 962
 963     if (in_call)
 964     {
 965        in_call = 0 ;
 966        kill_next_space = 1 ;
 967     }
 968     else
 969        lasta = 1 ;
 970
 971    SET_NEXTSTART() ;
 972    return STRING ; }
 973
 974
 975 [0-9]+ {
 976    if (!in_parse)
 977       REJECT ;
 978    strcpy(retvalue,yytext) ;
 979    SET_NEXTSTART() ;
 980    return OFFSET ; }
 981
 982 (((([0-9]+\.|\.?[0-9])[0-9]*{e}(\-|\+)[0-9]+))|([.0-9][a-zA-Z0-9.$!?@#_]*))\`*\( {
 983    int i;
 984    BEGIN other ;
 985    for (i=0; i<yyleng-1 && yytext[i]!='`'; i++) /* Copy value only */
 986       retvalue[i] = (char) toupper(yytext[i]) ;
 987    retvalue[i] = '\0' ;
 988
 989    if (in_numform)
 990    {
 991       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 992       exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", retvalue ) ;
 993    }
 994
 995    BEGIN other ;
 996    kill_next_space = 1 ;
 997    if (preva==1)
 998    {
 999       nexta = dontlast = 1 ;
1000       code = INFUNCNAME ;
1001       SET_NEXTSTART() ;
1002       return CONCATENATE ;
1003    }
1004    lasta = 0 ;
1005    SET_NEXTSTART() ;
1006    return INFUNCNAME ; }
1007
1008 ((([0-9]+\.|\.?[0-9])[0-9]*{e}(\-|\+)[0-9]+))|([.0-9][a-zA-Z0-9.$!?@#_]*) {
1009    int i;
1010    BEGIN other ;
1011    for (i=0; i<=yyleng; i++) /* Copy '\0', too */
1012       retvalue[i] = (char) toupper(yytext[i]) ;
1013
1014    if (in_numform)
1015    {
1016       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1017       exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", retvalue ) ;
1018    }
1019
1020    if (in_call)
1021    {
1022       in_call = 0 ;
1023       BEGIN other ;
1024       kill_next_space = 1 ;
1025       lasta = 1 ;
1026       SET_NEXTSTART() ;
1027       return CONSYMBOL ;
1028    }
1029
1030    if ((preva==1)&&(!in_parse)) {
1031       nexta = 1 ;
1032       code = CONSYMBOL ;
1033       SET_NEXTSTART() ;
1034       return CONCATENATE ; }
1035
1036    lasta = 1 ;
1037    SET_NEXTSTART() ;
1038    return CONSYMBOL ; }
1039
1040 {ssym} {
1041    int i,j;
1042    /*
1043     * this might be a symbol in front of a function, but only if next
1044     * char in input stream is "(".
1045     */
1046
1047    if (in_trace) REJECT ;
1048
1049    for (i=0; i<=yyleng; i++) /* include terminating '\0' */
1050       retvalue[i] = (char) toupper(yytext[i]) ;
1051
1052    if (in_numform)
1053    {
1054       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1055       exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", retvalue ) ;
1056    }
1057
1058    if ((last_in_address == in_address_keyword) &&
1059        (in_address == in_address_main))
1060    {
1061       kill_next_space = 1 ;
1062       in_call = 0 ;
1063       SET_NEXTSTART() ;
1064       return SIMSYMBOL ;
1065    }
1066
1067    /* We must check if a '(' follows. Remember the number of eaten chars. */
1068       j = 1;
1069    for (;(i=input())=='`';)
1070      j++ ;
1071    if (i != '(')
1072    {
1073       j-- ;
1074       unput(i) ;
1075    }
1076    /* input() has destroyed the yytext-terminator re-set it */
1077    yytext[yyleng] = '\0';
1078    SET_NEXTSTART() ;
1079    nextstart += j ;
1080
1081    if (i=='(')
1082    {
1083       BEGIN other ;
1084       kill_next_space = 1 ;
1085       if (preva==1)
1086       {
1087          nexta = dontlast = 1 ;
1088          code = INFUNCNAME ;
1089          return CONCATENATE ;
1090       }
1091       lasta = 0 ;
1092       return INFUNCNAME ;
1093    }
1094
1095    if (in_call)
1096    {
1097       kill_next_space = 1 ;
1098       BEGIN other ;
1099       in_call = 0 ;
1100       lasta = 1 ;
1101       return SIMSYMBOL ;
1102    }
1103
1104    BEGIN other ;
1105    if ((preva==1)&&(!in_parse)) {
1106       nexta = 1 ;
1107       code = SIMSYMBOL ;
1108       return CONCATENATE ; }
1109
1110    lasta = 1 ;
1111
1112    if (in_address == in_address_with)
1113       kill_next_space = 1 ;
1114    if (SymbolDetect) /* allow a fast breakout */
1115    {
1116       /* We define a tricky preprocessor directive. This will give us
1117        * maximum performance without the loss of control or errors produced
1118        * by typos.
1119        */
1120 #define RET_IF(s)  if ((SymbolDetect & SD_##s) &&      \
1121                        (yyleng == sizeof(#s) - 1) &&   \
1122                        (strncmp(retvalue,              \
1123                                 #s,                    \
1124                                 sizeof(#s) - 1) == 0)) \
1125                       return(s)
1126       /* e.g. RET_IF(INPUT); is replaced by:
1127        *  if ((SymbolDetect & SD_INPUT) &&
1128        *      (yyleng == sizeof("INPUT") - 1) &&
1129        *      (strncmp(retvalue,
1130        *               "INPUT",
1131        *               sizeof("INPUT") - 1) == 0))
1132        *     return(s);
1133        */
1134       RET_IF(INPUT);
1135       RET_IF(OUTPUT);
1136       RET_IF(ERROR);
1137       RET_IF(NORMAL);
1138       RET_IF(APPEND);
1139       RET_IF(REPLACE);
1140       RET_IF(STREAM);
1141       RET_IF(STEM);
1142       RET_IF(LIFO);
1143       RET_IF(FIFO);
1144 #undef RET_IF
1145    }
1146    return SIMSYMBOL ; }
1147
1148 {bl}\) {
1149    lasta = 1 ;
1150    SET_NEXTSTART() ;
1151    return ')' ; }
1152
1153 \({bl} {
1154    BEGIN other ;
1155    if (preva==1)
1156    {
1157       nexta = dontlast = 1 ;
1158       code = '(' ;
1159       SET_NEXTSTART() ;
1160       return CONCATENATE ;
1161    }
1162    SET_NEXTSTART() ;
1163    return '(' ; }
1164
1165 {bl}\,{bl} {
1166    SET_NEXTSTART() ;
1167    return ',' ; }
1168
1169 {bl}\-{bl} {
1170    BEGIN other ;
1171    SET_NEXTSTART() ;
1172    return '-' ; }
1173
1174 {bl}\+{bl} {
1175    BEGIN other ;
1176    SET_NEXTSTART() ;
1177    return '+' ; }
1178
1179 {bl}\/{bl} {
1180    SET_NEXTSTART() ;
1181    return '/' ; }
1182
1183 {bl}%{bl} {
1184    SET_NEXTSTART() ;
1185    return '%' ; }
1186
1187 {bl}\*{bl} {
1188    SET_NEXTSTART() ;
1189    return '*' ; }
1190
1191 {bl}\|{bl} {
1192    SET_NEXTSTART() ;
1193    return '|' ; }
1194
1195 {bl}&{bl} {
1196    SET_NEXTSTART() ;
1197    return '&' ; }
1198
1199 {bl}={bl} {
1200    SET_NEXTSTART() ;
1201    return '=' ; }
1202
1203 {not}{bl} {
1204    /* why don't I have a {bl} in the beginning of this re? bug? */
1205    BEGIN other ;
1206    SET_NEXTSTART() ;
1207    return NOT ; }
1208
1209 {bl}\>{bl}\>{bl} {
1210    SET_NEXTSTART() ;
1211    return GTGT ; }
1212
1213 {bl}\<{bl}\<{bl} {
1214    SET_NEXTSTART() ;
1215    return LTLT ; }
1216
1217 {bl}{not}{bl}\>{bl}\>{bl} {
1218    SET_NEXTSTART() ;
1219    return NOTGTGT ; }
1220
1221 {bl}{not}{bl}\<{bl}\<{bl} {
1222    SET_NEXTSTART() ;
1223    return NOTLTLT ; }
1224
1225 {bl}\>{bl}\>{bl}={bl} {
1226    SET_NEXTSTART() ;
1227    return GTGTE ; }
1228
1229 {bl}\<{bl}\<{bl}={bl} {
1230    SET_NEXTSTART() ;
1231    return LTLTE ; }
1232
1233 {bl}(\>|{not}{bl}(\<{bl}=|={bl}\<)){bl} {
1234    SET_NEXTSTART() ;
1235    return GT ; }
1236
1237 {bl}({not}{bl}\<|={bl}\>|\>{bl}=){bl} {
1238    SET_NEXTSTART() ;
1239    return GTE ; }
1240
1241 {bl}(\<|{not}{bl}(\>{bl}=|={bl}\>)){bl} {
1242    SET_NEXTSTART() ;
1243    return LT ; }
1244
1245 {bl}({not}{bl}\>|={bl}\<|\<{bl}=){bl} {
1246    SET_NEXTSTART() ;
1247    return LTE ; }
1248
1249 {bl}({not}{bl}=|\<{bl}\>|\>{bl}\<){bl} {
1250    SET_NEXTSTART() ;
1251    return DIFFERENT ; }
1252
1253 {bl}={bl}={bl} {
1254    SET_NEXTSTART() ;
1255    return EQUALEQUAL ; }
1256
1257 {bl}{not}{bl}={bl}={bl} {
1258    SET_NEXTSTART() ;
1259    return NOTEQUALEQUAL ; }
1260
1261 {bl}\/{bl}\/{bl} {
1262    SET_NEXTSTART() ;
1263    return MODULUS ; }
1264
1265 {bl}&{bl}&{bl} {
1266    SET_NEXTSTART() ;
1267    return XOR ; }
1268
1269 {bl}\|{bl}\|{bl} {
1270    SET_NEXTSTART() ;
1271    return CONCATENATE ; }
1272
1273 {bl}\*{bl}\*{bl} {
1274    SET_NEXTSTART() ;
1275    return EXP ; }
1276
1277 {bl}[ \t]{bl} {
1278    if (in_address == in_address_value) /* Always allow spaces in the VALUE */
1279    {                                   /* part of the ADDRESS stmt.        */
1280       SET_NEXTSTART() ;
1281       return SPACE ;
1282    }
1283    if (kill_this_space)
1284    {
1285       SET_NEXTSTART() ;
1286       return yylex() ;
1287    }
1288    SET_NEXTSTART() ;
1289    return (((in_parse)&&(!seek_with)) ? yylex() : SPACE) ; }
1290
1291 ['"] {
1292    SET_NEXTSTART() ;
1293    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1294    exiterror( ERR_UNMATCHED_QUOTE, 0 )  ; }
1295
1296
1297 [^A-Za-z0-9 \t\n@#$&|.?!_*()+=%\\^'";:<,>/-] {
1298    SET_NEXTSTART() ;
1299    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1300    exiterror( ERR_INVALID_CHAR, 1, yytext[0], yytext[0] )  ; }
1301
1302 : {
1303    SET_NEXTSTART() ;
1304    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1305    exiterror( ERR_SYMBOL_EXPECTED, 1, yytext ) ;}
1306
1307 . {
1308    SET_NEXTSTART() ;
1309    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1310    exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;}
1311
1312
1313 %%
1314
1315 #define NORMALSTAT  0
1316 #define COMMENTSTAT 1
1317 #define SINGLEQUOTE 2
1318 #define DOUBLEQUOTE 3
1319
1320
1321 /* rmspc uppercases all characters and removes blanks from a string.
1322  * Returns the input string.
1323  */
1324 static YY_CHAR_TYPE *rmspc( YY_CHAR_TYPE *instr )
1325 {
1326    YY_CHAR_TYPE *retval=instr ,
1327                 *dest  =instr ,
1328                 c ;
1329
1330    while ((c = *instr++) != '\0')
1331    {
1332       c = (YY_CHAR_TYPE) toupper(c);
1333       /* These characters are treated as blanks: */
1334       if ((c!='`') && (c!=' ') && (c!=',') && (c!='\t') && (c!='\n'))
1335          *dest++ = c ;
1336    }
1337    *dest = '\0' ;
1338
1339    return( retval ) ;
1340 }
1341
1342
1343 /* get_next_line: Lower level input fetcher.
1344  * Reads exactly one line from the input stream (file or string).
1345  * All EOL characters are removed and the result is stored in
1346  * last_source_line. A check for line overflow occurred here.
1347  * A special check is done for CP/M ^Z (DOS and friends use this for
1348  * "backward" compatibility, too).
1349  * line is filled with valid values on success.
1350  * max must reflect size of line and should be at least BUFFERSIZE + 2;
1351  * Returns -1 (no input) or the number of valid chars in line.
1352  */
1353 static int get_next_line( char *line, int max, FILE *stream )
1354 {
1355    lineboxptr newline ;
1356    offsrcline *incore_newline;
1357    int pos = 0;
1358    int c = 0, nextEOL ;
1359
1360    if (inEOF) /* You can't use myunputc if EOF is reached! */
1361       return EOF ;
1362
1363    while (pos <= max - 2)
1364    {
1365       /* get next char */
1366       if (bufptr>0)
1367          c = chbuffer[--bufptr] ;
1368       else if (ipretflag)
1369       {
1370          if (interptr>=interptrmax)
1371             c = EOF ;
1372          else
1373 #ifdef ASCII_0_TERMINATES_STRING
1374             if ((c = *interptr++) == '\0')
1375                c = EOF ;
1376 #else
1377             c = *interptr++ ;
1378 #endif
1379       }
1380       else
1381          c = getc(stream) ;
1382
1383       if ((c=='\r') || (c=='\n') || (c==EOF))
1384          break ;
1385       line[pos++] = (char) (unsigned char) c ;
1386    }
1387
1388    /* first, check for overflow */
1389    if ((c!='\r') && (c!='\n') && (c!=EOF))
1390    {
1391       parser_data.tline = linenr ; /* set tline for exiterror */
1392       exiterror( ERR_TOO_LONG_LINE, 0 )  ;
1393    }
1394
1395    /* We have either a (first) line terminator or EOF */
1396    if (c==EOF)
1397    {
1398       if ((pos==1) && (line[0]=='\x1A')) /* CP/M ^Z EOF? */
1399          pos-- ;
1400       if (pos == 0)
1401       {
1402          inEOF = 1 ;
1403          return EOF ;
1404       }
1405       nextEOL = EOF;
1406    }
1407    else
1408    {
1409       /* get one more char */
1410       if (bufptr>0)
1411          nextEOL = chbuffer[--bufptr] ;
1412       else if (ipretflag)
1413       {
1414          if (interptr>=interptrmax)
1415             nextEOL = EOF ;
1416          else
1417 #ifdef ASCII_0_TERMINATES_STRING
1418             if ((nextEOL = *interptr++) == '\0')
1419                nextEOL = EOF ;
1420 #else
1421             nextEOL = *interptr++ ;
1422 #endif
1423       }
1424       else
1425          nextEOL = getc(stream) ;
1426    }
1427
1428    /* Decide if the next character is the last char of a EOL pair.
1429     * Valid pairs are CR/LF or LF/CR. Put nextEOL back if there is no pair.
1430     */
1431    if (((c!='\n') || (nextEOL!='\r')) &&
1432        ((c!='\r') || (nextEOL!='\n')))
1433       chbuffer[bufptr++] = (short) nextEOL ;
1434
1435    cch = 0 ; /* not needed ? */
1436    line[pos++] = '\n';
1437
1438    if (parser_data.incore_source)
1439    {  /* We can use the incore string to describe a source line. */
1440       incore_newline = FreshLine() ;
1441       incore_newline->length = pos - 1 ;
1442       /* FIXME: What happens on the second attempt to read EOF or with CRLF? */
1443       incore_newline->offset = interptr - parser_data.incore_source ;
1444       return pos ;
1445    }
1446
1447    newline = (lineboxptr)Malloc(sizeof(linebox)) ;
1448    newline->line = Str_make_TSD( parser_data.TSD, pos - 1 ) ;
1449    newline->line->len = pos - 1 ;
1450    memcpy(newline->line->value, line, pos - 1 ) ;
1451    newline->prev = parser_data.last_source_line ;
1452    newline->next = NULL ;
1453    newline->lineno = linenr++ ;
1454
1455    if (parser_data.first_source_line==NULL)
1456       parser_data.first_source_line = newline ;
1457    else
1458       parser_data.last_source_line->next = newline ;
1459    parser_data.last_source_line = newline ;
1460
1461    return pos ;
1462 }
1463
1464 /* fill_buffer: Higher level input fetcher.
1465  * (To allow the C-file to compile, all Rexx comments in this comment
1466  *  are written as "{*" "*}" instead of the normal, C-like manner.)
1467  * Reads lines from the input stream (yyin or string) with get_next_line.
1468  * Only one line is returned to allow the saving of the line number.
1469  * This routine replaces all comments by '`' signs. This allows
1470  * the detection of a "pseudo" blank: The fragment "say x{* *}y" uses two
1471  * variables, not one called "xy". The parsing of comments must be done
1472  * here to check for the actual numbers of open and closes ("{*" and "*}").
1473  * While doing this we must always check for strings since "'{*'" is not part
1474  * of a comment.
1475  * Here is a problem: Is this a nested valid comment: "{* '{*' *} *}"?
1476  * I think so although you cannot remove the outer comment signs without an
1477  * error. Everything within a comment is a comment (per def.). Counting
1478  * opens and closes of comment signs is an ugly trick to help the user.
1479  * He/she must know what he/she is doing if nesting comments!
1480  *
1481  * max_size gives the maximum size of buf. This is filled up with input.
1482  * We never return less than one character until EOF is reached. Thus, we
1483  * read more than one true input line if a comment spans over more than one
1484  * line.
1485  * A line will either be terminated by a single '\n' or by a blank. The
1486  * later one replaces a line continuation (',' [spaces] EOL).
1487  * Errors in this low
1488  *
1489  * Conclusion: We have to fight very hard to set the expected line number.
1490  *             * Comments spanning over lines set them on getting the
1491  *               "follow" lines.
1492  *             * Concatenated lines set
1493  */
1494 static int fill_buffer( char *buf, int max_size )
1495 {
1496    /* statics protected by regina_parser */
1497    static char line[BUFFERSIZE+2] ; /* special buffer to allow max_size */
1498    static int pos = 0, max = 0 ;    /* being smaller than BUFFERSIZE+1  */
1499    static int nesting = 0;          /* nesting level of comments        */
1500    int nesting_start_line = 0;      /* start line of comment for errortext() */
1501    char *dest, c;
1502    int i, squote, dquote;
1503
1504    if (firstln == 0)
1505    {
1506       firstln = 1;
1507       contline = 0;
1508       nesting = 0;
1509       pos = 0;
1510       max = get_next_line( line, sizeof(line), yyin ) ;
1511       if (max < 0) /* empty input file */
1512          return 0 ;
1513 #if 0
1514       if (line[0] == '#')
1515       {  /* Ignore first line beginning this way for unix compat */
1516          max = 0;
1517          return fill_buffer( buf, max_size ) ;
1518       }
1519 #else
1520       if (line[0] == '#')
1521       {  /* Ignore first line beginning this way for unix compat */
1522          max = 5;
1523          memcpy( line, "/**/\n", 5 );
1524       }
1525 #endif
1526    }
1527    else if (pos < max) /* Are there still characters to transmit? */
1528    {
1529       /* Buffer already checked for correctness */
1530       if (max_size > max - pos)
1531          max_size = max - pos;
1532       memcpy(buf, line + pos, max_size);
1533       pos += max_size;
1534       return(max_size);
1535    }
1536    else /* Need next line */
1537    {
1538       if (contline && !nesting)
1539       {
1540          extnextline = ++nextline ;
1541          extnextstart = 1 ;
1542          contline = 0;
1543       }
1544       pos = 0;
1545       max = get_next_line( line, sizeof(line), yyin ) ;
1546       if (max < 0) /* empty input file */
1547       {
1548          if (nesting)
1549          {
1550             parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1551             exiterror( ERR_UNMATCHED_QUOTE, 1 ) ;
1552          }
1553          return 0 ;
1554       }
1555    }
1556
1557    /* A new line is available, check first for an ending comment */
1558    dest = line; /* we change comments in line */
1559    if (nesting) /* This may lead to more line reading */
1560    {
1561       /*
1562        * The first time extnextline is non-zero, we have the comment
1563        * starting sequence line. This is saved for use if no matching
1564        * ending comment sequence is found, so that the error message
1565        * reflects the start of the comment.
1566        * Regina feature request: #508788
1567        */
1568       if ( extnextline < 0 )
1569          nesting_start_line = nextline+1;
1570       extnextline = ++nextline ;
1571       extnextstart = 1; /* See Reference (*) below */
1572 repeated_nesting:
1573       while (pos < max)
1574       {
1575          c = line[pos];
1576          if (c == '*') /* start of comment end? */
1577          {
1578             if (line[pos+1] == '/')
1579             {  /* pos+1 always exists, at least '\n' or '\0' */
1580                if (--nesting == 0)
1581                {
1582                   pos += 2;
1583                   *dest++ = '`';
1584                   *dest++ = '`';
1585                   break;
1586                }
1587                *dest++ = '`';
1588                pos++;
1589             }
1590          }
1591          else if (c == '/') /* start of new begin? */
1592          {
1593             if (line[pos+1] == '*')
1594             {
1595                nesting++;
1596                *dest++ = '`';
1597                pos++;
1598             }
1599          }
1600          *dest++ = '`';
1601          pos++;
1602       }
1603       if (pos >= max)
1604       {
1605          pos = 0;
1606          max = get_next_line( line, sizeof(line), yyin ) ;
1607          if (max < 0) /* empty input file */
1608          {
1609             if ( nesting_start_line )
1610                parser_data.tline = nesting_start_line ; /* set tline for exiterror */
1611             else
1612                parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1613             exiterror( ERR_UNMATCHED_QUOTE, 1 ) ;
1614             return 0 ;
1615          }
1616          /* This is a comment continuation. If the lexer will return
1617           * something it already has a valid tline/tstart pair.
1618           * The lexer will return the current token and on the NEXT
1619           * call it expects a valid nextline/nextstart pair.
1620           */
1621          extnextline = ++nextline; extnextstart = 1;
1622          dest = line; /* we change comments in line */
1623          goto repeated_nesting;
1624       }
1625       extnextstart = pos + 1;
1626       if (contline)
1627       { /* Exception! Have a look at: "x='y',{*\n\n*}\n'z'". This should
1628          * result in "x = 'y' 'z'".
1629          * We must parse until EOL and check for whitespaces and comments...
1630          */
1631          while (pos < max)
1632          {
1633             c = line[pos];
1634             if (!isspace(c))
1635             {
1636                if (c == '/')
1637                {
1638                   if (line[pos+1] == '*')
1639                   {
1640                      pos += 2;
1641                      nesting++;
1642                      goto repeated_nesting;
1643                   }
1644                }
1645                parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1646                exiterror( ERR_YACC_SYNTAX, 1, parser_data.tline ) ; /* standard error */
1647             }
1648             pos++;
1649          }
1650          /* All done, it was a continuation line. */
1651          /* contline will be resetted by: */
1652          return fill_buffer( buf, max_size ) ;
1653       }
1654    }
1655    /* We have something to play with. Run through the input and check for
1656     * strings including comments.
1657     */
1658    squote = dquote = 0;
1659    while (pos < max)
1660    {
1661       /* We use selective loops to reduce comparisons */
1662       if (nesting)
1663          do
1664          {
1665             c = line[pos];
1666             if (c == '*') /* start of comment end? */
1667             {
1668                if (line[pos+1] == '/')
1669                {  /* pos+1 always exists, at least '\n' or '\0' */
1670                   if (--nesting == 0)
1671                   {
1672                      pos += 2;
1673                      *dest++ = '`';
1674                      *dest++ = '`';
1675                      break;
1676                   }
1677                   pos++;
1678                }
1679             }
1680             else if (c == '/') /* start of new begin? */
1681             {
1682                if (line[pos+1] == '*')
1683                {
1684                   nesting++;
1685                   pos++;
1686                   *dest++ = '`';
1687                }
1688             }
1689             pos++;
1690             *dest++ = '`';
1691          } while (pos < max);
1692       else if (squote)
1693          {
1694             while ((c = line[pos]) != '\'')
1695             {
1696                *dest++ = c;
1697                if (++pos >= max)
1698                {
1699                   parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1700                   exiterror( ERR_UNMATCHED_QUOTE, 2 ) ;
1701                }
1702             }
1703             *dest++ = '\'';
1704             pos++;
1705             squote = 0;
1706          }
1707       else if (dquote)
1708          {
1709             while ((c = line[pos]) != '\"')
1710             {
1711                *dest++ = c;
1712                if (++pos >= max)
1713                {
1714                   parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1715                   exiterror( ERR_UNMATCHED_QUOTE, 3 ) ;
1716                }
1717             }
1718             *dest++ = '\"';
1719             pos++;
1720             dquote = 0;
1721          }
1722       else
1723          while (pos < max)
1724             switch (c = line[pos])
1725             {
1726                case '\'':
1727                   *dest++ = c ;
1728                   squote = 1 ;
1729                   pos++ ;
1730                   goto outer_loop;
1731
1732                case '\"':
1733                   *dest++ = c ;
1734                   dquote = 1 ;
1735                   pos++ ;
1736                   goto outer_loop;
1737
1738                case '/':
1739                   if (line[pos + 1] == '*')
1740                   {
1741                      *dest++ = '`' ;
1742                      *dest++ = '`' ;
1743                      pos += 2 ;
1744                      nesting++ ;
1745                      goto outer_loop;
1746                   }
1747                   else
1748                   {
1749                      *dest++ = c;
1750                      pos++ ;
1751                   }
1752                   break ;
1753
1754                case '`':
1755                   parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1756                   exiterror( ERR_INVALID_CHAR, 1, c, c ) ;
1757
1758                default:
1759                   *dest++ = c;
1760                   pos++ ;
1761             }
1762 outer_loop:
1763       ;
1764    }
1765
1766    max = (int) (dest - line);
1767
1768    /* Now we can replace a ',' [spaces|comments] '\n' with the line
1769     * continuation, but check for nesting first
1770     */
1771    if (nesting)
1772    { /* Don't leave ANY spaces at EOL. That would confuse the lexer. */
1773       i = max - 1;
1774       while ((i >= 0) && isspace(line[i]))
1775          i--;
1776       max = i + 1;
1777       /* Of course, there is one exception: line continuation */
1778       while ((i >= 0) && (line[i] == '`'))
1779          i-- ;
1780       if ((i >= 0) && (line[i] == ','))
1781       {
1782          contline = 1;
1783          line[i] = ' ';
1784          max = i + 1;
1785       }
1786       /* (Reference (*) )
1787        * At this point the lexer can't determine the nextline since we eat up
1788        * the \n. This leads to an incorrect count. But either the '`'-signs
1789        * are ignored or they are follows of a "token", a valid word.
1790        * Look at "say x;say y ``". This will cause the lexer to
1791        * return at least 4 tokens (SAY "x" ";" SAY) before "y" will be
1792        * returned. We can only set nextline/nextstart at "y".
1793        * Result: We set this pair at the start of the next call to
1794        * fill_buffer such that the next call to yylex will set the correct
1795        * values.
1796        */
1797    }
1798    else
1799    {
1800       i = max - 1; /* on last valid char */
1801       while (i >= 0)
1802       {
1803          if (!MY_ISBLANK(line[i]) && (line[i] != '\n'))
1804             break;
1805          i--;
1806       }
1807       /* i now -1 or on last nonblank */
1808       if ((i >= 0) && (line[i] == ','))
1809       {  /* FIXME: What shall be do with "," followed by EOF? */
1810          max = i + 1;
1811          line[i] = ' ';
1812          contline = 1;
1813       }
1814    }
1815
1816    if (max_size > max)
1817       max_size = max;
1818    memcpy(buf, line, max_size);
1819    pos = max_size;
1820    return(max_size);
1821 }
1822
1823
1824 /* yywrap MAY be called by the lexer is EOF encounters, see (f)lex docu */
1825 int yywrap( void )
1826 {
1827    assert( do_level>= 0 ) ;
1828    if (do_level>0)
1829    {
1830       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1831       exiterror( ERR_INCOMPLETE_STRUCT, 0 )  ;
1832    }
1833    return 1 ;
1834 }
1835
1836 /******************************************************************************
1837  ******************************************************************************
1838  * global interface ***********************************************************
1839  ******************************************************************************
1840  *****************************************************************************/
1841
1842 /* initalize all local and global values */
1843 static void init_it_all( tsd_t *TSD )
1844 {
1845 #if defined(FLEX_SCANNER) && defined(FLEX_DEBUG)
1846    if (__reginadebug)
1847       yy_flex_debug = 1;
1848      else
1849       yy_flex_debug = 0;
1850 #endif
1851    inEOF = 0 ;
1852    in_numform = 0 ;
1853    next_numform = 0 ;
1854    nexta = 0 ;
1855    lasta = 0 ;
1856    preva = 0 ;
1857    obs_with = 0 ;
1858    in_do = 0 ;
1859    in_then = 0 ;
1860    dontlast = 0 ;
1861    sum = 0 ;
1862    firstln = 0 ;
1863    in_parse = 0 ;
1864    in_trace = 0 ;
1865    itflag = 0 ;
1866    in_signal = 0 ;
1867    in_call = 0 ;
1868    in_address = 0 ;
1869    seek_with = 0 ;
1870    kill_this_space = 0 ;
1871    ipretflag = 0 ;
1872    do_level = 0 ;
1873    singlequote = 0 ;
1874    doblequote = 0 ;
1875    cch = 0 ;
1876    bufptr = 0 ;
1877    cchmax = 0 ;
1878    ch = '\0',
1879    code = 0,
1880    contline = 0;
1881    ech= '\0' ;
1882    extnextstart = 0;
1883    interptr = NULL ;
1884    interptrmax = NULL ;
1885                           /* non-zero values */
1886    linenr = 1 ;
1887    nextline = 1;
1888    nextstart = 1;
1889    kill_next_space = 1 ;
1890    extnextline = -1 ;
1891    SymbolDetect = 0;
1892
1893    memset(&parser_data, 0, sizeof(internal_parser_type));
1894    parser_data.TSD = TSD;
1895 }
1896
1897 /* fetch may only be called by fetch_protected. The parser and lexer are
1898  * already protected by regina_parser by fetch_protected.
1899  * This function prepares the lexer and parser and call them. The
1900  * result and all generated values are stored in result. The parser
1901  * tree isn't executed here.
1902  * Exactly fptr xor str must be non-null.
1903  */
1904 static void fetch(tsd_t *TSD, FILE *fptr, const streng *str,
1905                   internal_parser_type *result)
1906 {
1907    init_it_all( TSD ) ;
1908
1909 #ifdef FLEX_SCANNER
1910    yy_init = 1 ;
1911    yy_delete_buffer(YY_CURRENT_BUFFER) ;
1912    yyrestart(fptr) ;
1913 #else
1914    yysptr = yysbuf ;
1915    yyin = fptr ;
1916 #endif
1917
1918    if (str != NULL)
1919    {
1920       ipretflag = 1 ;
1921       cchmax = str->len ;
1922       interptr = str->value ;
1923       interptrmax = interptr + cchmax ;
1924       result->incore_source = str->value;
1925    }
1926
1927    BEGIN comm ;
1928    NewProg();
1929    parser_data.result = __reginaparse();
1930
1931 #ifdef FLEX_SCANNER
1932    yy_delete_buffer(YY_CURRENT_BUFFER) ;
1933 #else
1934    yysptr = yysbuf ;
1935 #endif
1936    yyin = NULL ;
1937
1938    *result = parser_data;
1939    /* Some functions assume null values if parsing isn't running: */
1940    memset(&parser_data, 0, sizeof(internal_parser_type));
1941 }
1942
1943 /* This function serializes the parser/lexer requests of the process and
1944  * call fetch which will make the work. Look there.
1945  */
1946 static void fetch_protected(tsd_t *TSD, FILE *fptr, const streng *str,
1947                             internal_parser_type *result)
1948 {
1949    volatile int panicked = 0;
1950
1951    THREAD_PROTECT(regina_parser)
1952    TSD->in_protected = 1;
1953
1954    if ( setjmp( TSD->protect_return ) )
1955       panicked = 1;
1956    else
1957       fetch(TSD, fptr, str, result);
1958
1959    TSD->in_protected = 0;
1960    THREAD_UNPROTECT(regina_parser)
1961
1962    if (!panicked)
1963       return;
1964
1965    /* We got a fatal condition while fetching the input. */
1966    if (TSD->delayed_error_type == PROTECTED_DelayedExit)
1967       TSD->MTExit(TSD->expected_exit_error);
1968    if (TSD->delayed_error_type == PROTECTED_DelayedSetjmpBuf)
1969       longjmp( *(TSD->currlevel->buf), 1 ) ;
1970    longjmp( *(TSD->systeminfo->panic), 1 ) ;
1971 }
1972
1973 /* fetch_file reads in a REXX file from disk (or a pipe). It returns without
1974  * executing the program. The parsed tree with all needed values including
1975  * the result of the parsing is copied to result.
1976  * fptr remains open after this call.
1977  * type is either PARSE_ONLY or PARSE_AND_TIN. In the later case a tinned variant of the
1978  * parsing tree is created, too.
1979  */
1980 void fetch_file(tsd_t *TSD, FILE *fptr, internal_parser_type *result)
1981 {
1982    fetch_protected(TSD, fptr, NULL, result);
1983 }
1984
1985 /* fetch_string reads in a REXX macro from a streng. It returns without
1986  * executing the program. The parsed tree with all needed values including
1987  * the result of the parsing is copied to result.
1988  * type is either PARSE_ONLY or PARSE_AND_TIN. In the later case a tinned variant of the
1989  * parsing tree is created, too.
1990  * The function is typically called by an "INTERPRET" instruction.
1991  */
1992 void fetch_string(tsd_t *TSD, const streng *str, internal_parser_type *result)
1993 {
1994    fetch_protected(TSD, NULL, str, result);
1995 }