regina/lexsrc.l

   1 %{
   2 /*
   3  *  The Regina Rexx Interpreter
   4  *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
   5  *
   6  *  This library is free software; you can redistribute it and/or
   7  *  modify it under the terms of the GNU Library General Public
   8  *  License as published by the Free Software Foundation; either
   9  *  version 2 of the License, or (at your option) any later version.
  10  *
  11  *  This library is distributed in the hope that it will be useful,
  12  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  *  Library General Public License for more details.
  15  *
  16  *  You should have received a copy of the GNU Library General Public
  17  *  License along with this library; if not, write to the Free
  18  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19  */
  20
  21 #include "rexx.h"
  22 #include "yaccsrc.h"
  23 #include <string.h>
  24 #include <assert.h>
  25 #include <errno.h>
  26
  27 /* Define ASCII_0_TERMINATES_STRING if you want that ASCII-0 terminates
  28  * an input string. Normally this should not happen. Input strings are
  29  * terminated by a length encoding. The string {"", length=1} is invalid for
  30  * the lexer (ASCII-0 is not allowed) while {"", length=0} is allowed (this
  31  * is an empty input).
  32  * ASCII_0_TERMINATES_STRING is only(!) for backward compatibility and
  33  * shouldn't be used under normal circumstances.
  34  * FGC
  35  */
  36 #define ASCII_0_TERMINATES_STRING
  37
  38 #ifdef YYLMAX
  39 # undef YYLMAX
  40 #endif
  41 #define YYLMAX BUFFERSIZE
  42
  43 #ifdef FLEX_SCANNER
  44 #undef YY_CHAR
  45 #define YY_CHAR YY_CHAR_TYPE
  46 #undef YY_INPUT
  47 #define YY_INPUT(buf,result,max_size) result=fill_buffer(buf,max_size)
  48 #endif
  49
  50 /* NOTE: Every comment is replaced by a '`' character in the lower input
  51  * routines. These should check for such (illegal) characters.
  52  */
  53 #define MY_ISBLANK(c) (((c)==' ')||((c)=='\t')||((c)=='\v')||((c)=='\f')|| \
  54                        ((c)=='\r')||((c)=='`'))
  55
  56 PROTECTION_VAR(regina_parser)
  57 /* externals which are protected by regina_parser */
  58 internal_parser_type parser_data = {NULL, };
  59 int retlength=0 ;
  60 char retvalue[BUFFERSIZE] ;
  61 unsigned SymbolDetect = 0;
  62 /* end of externals protected by regina_parser */
  63
  64 /* locals, they are protected by regina_parser, too */
  65 static int nextline = 1;
  66 static int nextstart = 1;
  67 static int do_level = 0 ;
  68 static int in_numform=0, next_numform=0 ;
  69 static int obs_with=0, in_do=0, in_then=0;
  70 static int in_parse=0 ;
  71 static int in_trace=0, itflag=0 ;
  72 static int in_signal=0, in_call=0 ;
  73 static enum { not_in_address = 0,
  74               in_address_keyword, /* ADDRESS just seen */
  75               in_address_main, /* after the first word */
  76               in_address_value, /* like main but VALUE was seen */
  77               in_address_with} in_address = not_in_address,
  78                                last_in_address = not_in_address ;
  79 static enum {no_seek_with = 0,
  80              seek_with_from_parse,
  81              seek_with_from_address} seek_with = no_seek_with ;
  82 /*
  83  * expression_ended is set if a typical expression has ended and the next
  84  * token has to be preceeded by a CONCATENATE (abuttal) operator in most
  85  * cases.
  86  */
  87 static int expression_ended=0;
  88
  89 /*
  90  * insert_abuttal is set if the last token was a possible end of an expression.
  91  * The next token may need to be preceeded by an additional CONCATENATE
  92  * operator under some conditions like not being "in_parse".
  93  */
  94 static int insert_abuttal=0;
  95
  96 /*
  97  * A symbol may be pending after a CONTATENATE (abuttal) operator has been
  98  * returned. This symbol will be stored here. 0 indicates no pending symbol.
  99  * ASCII 0 will never been returned, there is no need for another indicator.
 100  */
 101 static int delayed_symbol=0;
 102
 103 /*
 104  * inhibit_delayed_abuttal can be set only if delayed_symbol has been set,
 105  * but not always. An opening parenthesis must have been detected, too.
 106  * It inhibits the use of a CONCATENATE (abuttal) operator after the staring
 107  * parenthesis. Examples:
 108  * CONCATENATE {var_symbol}     <-- needs a CONCATENATE, another {var_symbol}
 109  *                                  may follow.
 110  * CONCATENATE {var_symbol} "(" <-- needs a CONCATENATE, another {var_symbol}
 111  *                                  is an expression's start.
 112  */
 113 static int inhibit_delayed_abuttal=0;
 114
 115 static char ch;
 116 static int kill_this_space=0, kill_next_space=1 ;
 117 static int extnextline = -1, extnextstart; /* for a delayed line increment */
 118 static int linenr=1 ;
 119 static int contline = 0;
 120 static int inEOF=0 ;
 121 static int singlequote=0, doblequote=0 ;
 122 static int firstln=0 ;
 123 static int bufptr=0 ;
 124 /* Previous bug. 8-bits clean combined with EOF ==> need an int */
 125 static int chbuffer[LOOKAHEAD] ;
 126 static int ipretflag=0, cch=0 ;
 127 static const char *interptr=NULL ;
 128 static const char *last_interptr=NULL ;
 129 static const char *interptrmax ;
 130 static int cchmax = 0 ;
 131
 132 static YY_CHAR_TYPE *rmspc( YY_CHAR_TYPE *instr ) ;
 133 static void set_assignment( void );
 134 static int process_number_or_const( const char *text, int len );
 135 static int process_hex_or_bin_string( char *text, int len, int base );
 136 static void compress_string( char *dest, const char *src );
 137 static int fill_buffer( char *buf, int max_size ) ;
 138 #define SET_NEXTSTART() (nextstart += yyleng)
 139
 140 #define YY_FATAL_ERROR(s) exiterror( ERR_PROG_UNREADABLE, 1, s )
 141 %}
 142
 143
 144 %start comm signal sgtype procd parse then with
 145 %start numeric do1 other value1 ifcont signame nmform
 146
 147 %e 2500
 148 %p 17000
 149 %k 1500
 150 %a 7000
 151 %n 1000
 152 %o 8000
 153
 154 %{
 155 %}
 156
 157
 158 /*
 159  * ANSI 6.2.2 definitions (partially with extensions)
 160  */
 161 digit             [0-9]
 162 special           [,:;)(]
 163 not               [\\^~]
 164 extra             [#$@]
 165 general           [_!?A-Za-z]|{extra}
 166 dot               [.]
 167
 168                   /*
 169                    * sigh, we need the reversed classes. flex isn't smart
 170                    * enough to provide it.
 171                    * Added "0-9" to notGeneral... to fix bug 724390
 172                    */
 173 notGeneralDot     [^_!?A-Za-z0-9#$@.]
 174 notGeneralParen   [^_!?A-Za-z0-9#$@.(]
 175
 176 space             [ \t]
 177 blank             [\f\v\r]|{space}
 178 EOL               ;|\r?\n
 179
 180                   /*
 181                    * A comment is converted to a sequence of ` signs in the
 182                    * lower layer
 183                    */
 184 comment           [`]
 185 between           ({blank}|{comment})*
 186
 187 var_symbol_c      {dot}|{digit}|{general}
 188 var_symbol        {general}{var_symbol_c}*
 189                   /*
 190                    * A number is a little bit different to detect signs in the
 191                    * exponent
 192                    */
 193 const_symbol      ({dot}|{digit}){var_symbol_c}*
 194 reserved_symbol   {dot}[a-zA-Z]+
 195 symbol            {var_symbol}|{const_symbol}
 196
 197 mantissa          ({dot}?{digit}+)|({digit}+{dot}{digit}*)
 198 exponent          [eE][-+]?{digit}+
 199                   /*
 200                    * read ANSI 6.2.1.1 carefully. We have to check the chars
 201                    * after the exponent for notGeneralDot below.
 202                    */
 203 number            {mantissa}{exponent}?
 204
 205 hex_digit         {digit}|[a-fA-F]
 206 bin_digit         [0-1]
 207 hex_digit_tuple   {blank}*{hex_digit}{hex_digit}
 208 bin_digit_tuple   {blank}*{bin_digit}{bin_digit}{bin_digit}{bin_digit}
 209
 210 hex_string_start  {hex_digit}{hex_digit}?
 211 hex_string        ({hex_string_start}{hex_digit_tuple}*)?
 212 bin_string_start  {bin_digit}({bin_digit}({bin_digit}{bin_digit}?)?)?
 213 bin_string        ({bin_string_start}{bin_digit_tuple}*)?
 214
 215 text_string       '([^']|'')*'|\"([^"]|\"\")*\"
 216 mintext_string    '([^']|'')+'|\"([^"]|\"\")+\"
 217
 218 trace_char        [a-zA-Z?]
 219
 220                   /*
 221                    * The list of keywords.
 222                    */
 223 key_address       [aA][dD][dD][rR][eE][sS][sS]
 224 key_arg           [aA][rR][gG]
 225 key_by            [bB][yY]
 226 key_call          [cC][aA][lL][lL]
 227 key_caseless      [cC][aA][sS][eE][lL][eE][sS][sS]
 228 key_digits        [dD][iI][gG][iI][tT][sS]
 229 key_do            [dD][oO]
 230 key_dotline       {dot}[lL][iI][nN][eE]
 231 key_drop          [dD][rR][oO][pP]
 232 key_else          [eE][lL][sS][eE]
 233 key_end           [eE][nN][dD]
 234 key_engineering   [eE][nN][gG][iI][nN][eE][eE][rR][iI][nN][gG]
 235 key_error         [eE][rR][rR][oO][rR]
 236 key_exit          [eE][xX][iI][tT]
 237 key_expose        [eE][xX][pP][oO][sS][eE]
 238 key_external      [eE][xX][tT][eE][rR][nN][aA][lL]
 239 key_failure       [fF][aA][iI][lL][uU][rR][eE]
 240 key_for           [fF][oO][rR]
 241 key_forever       [fF][oO][rR][eE][vV][eE][rR]
 242 key_form          [fF][oO][rR][mM]
 243 key_fuzz          [fF][uU][zZ][zZ]
 244 key_halt          [hH][aA][lL][tT]
 245 key_if            [iI][fF]
 246 key_interpret     [iI][nN][tT][eE][rR][pP][rR][eE][tT]
 247 key_iterate       [iI][tT][eE][rR][aA][tT][eE]
 248 key_leave         [lL][eE][aA][vV][eE]
 249 key_linein        [lL][iI][nN][eE][iI][nN]
 250 key_lostdigits    [lL][oO][sS][tT][dD][iI][gG][iI][tT][sS]
 251 key_lower         [lL][oO][wW][eE][rR]
 252 key_name          [nN][aA][mM][eE]
 253 key_nop           [nN][oO][pP]
 254 key_notready      [nN][oO][tT][rR][eE][aA][dD][yY]
 255 key_novalue       [nN][oO][vV][aA][lL][uU][eE]
 256 key_numeric       [nN][uU][mM][eE][rR][iI][cC]
 257 key_off           [oO][fF][fF]
 258 key_on            [oO][nN]
 259 key_options       [oO][pP][tT][iI][oO][nN][sS]
 260 key_otherwise     [oO][tT][hH][eE][rR][wW][iI][sS][eE]
 261 key_parse         [pP][aA][rR][sS][eE]
 262 key_procedure     [pP][rR][oO][cC][eE][dD][uU][rR][eE]
 263 key_pull          [pP][uU][lL][lL]
 264 key_push          [pP][uU][sS][hH]
 265 key_queue         [qQ][uU][eE][uU][eE]
 266 key_return        [rR][eE][tT][uU][rR][nN]
 267 key_say           [sS][aA][yY]
 268 key_scientific    [sS][cC][iI][eE][nN][tT][iI][fF][iI][cC]
 269 key_select        [sS][eE][lL][eE][cC][tT]
 270 key_signal        [sS][iI][gG][nN][aA][lL]
 271 key_source        [sS][oO][uU][rR][cC][eE]
 272 key_syntax        [sS][yY][nN][tT][aA][xX]
 273 key_then          [tT][hH][eE][nN]
 274 key_to            [tT][oO]
 275 key_trace         [tT][rR][aA][cC][eE]
 276 key_until         [uU][nN][tT][iI][lL]
 277 key_upper         [uU][pP][pP][eE][rR]
 278 key_value         [vV][aA][lL][uU][eE]
 279 key_var           [vV][aA][rR]
 280 key_version       [vV][eE][rR][sS][iI][oO][nN]
 281 key_when          [wW][hH][eE][nN]
 282 key_while         [wW][hH][iI][lL][eE]
 283 key_with          [wW][iI][tT][hH]
 284
 285
 286 %%
 287
 288    {
 289      if ( delayed_symbol )
 290      {
 291         int retval;
 292         retval = delayed_symbol;
 293         delayed_symbol = 0;
 294         /*
 295          * Pass the meaning of inhibit_delayed_abuttal to the normal algorithm
 296          * for automatic abuttal detection.
 297          */
 298         expression_ended = !inhibit_delayed_abuttal;
 299         inhibit_delayed_abuttal = 0;
 300         return retval;
 301      }
 302
 303      if (next_numform)
 304      {
 305         in_numform = 1 ;
 306         next_numform = 0 ;
 307      }
 308      else
 309         in_numform = 0 ;
 310
 311      last_in_address = in_address ; /* just for the "Environment" */
 312     /* there can't be an intermediate SPACE between ADDRESS and the next word*/
 313      if ( in_address == in_address_keyword )
 314         in_address = in_address_main ;
 315
 316      kill_this_space = kill_next_space ;
 317      kill_next_space = 0 ;
 318
 319
 320      if (itflag)
 321      {
 322         in_trace = 0 ;
 323         seek_with = no_seek_with ;
 324      }
 325      itflag = (in_trace) ;
 326
 327      if (extnextline != -1)
 328      {
 329         parser_data.tstart = nextstart = extnextstart;
 330         parser_data.tline = nextline = extnextline;
 331         extnextline = -1;
 332      }
 333      else
 334      {
 335         parser_data.tstart = nextstart ;
 336         parser_data.tline = nextline ;
 337      }
 338      insert_abuttal = expression_ended ;
 339      expression_ended = 0 ;
 340    }
 341
 342 {comment}* {
 343    SET_NEXTSTART() ; }
 344
 345 <ifcont>{between}{EOL}{between} {
 346    /*
 347     * Fixes bug 579597, "[;\r?\n]" instead of "{EOL}" causes the bug.
 348     */
 349    char *ptr;
 350    if ((ptr = strchr(yytext, '\n')) != NULL)
 351    {
 352       nextstart = yyleng - (int) (ptr - (char *) yytext) ;
 353       nextline++ ;
 354       if (extnextline != -1)
 355       {
 356          extnextline++;
 357          extnextstart = nextstart; /* fixes bug 938204 */
 358       }
 359    }
 360    else
 361       SET_NEXTSTART() ;
 362    return STATSEP ; }
 363
 364 {between}{EOL}{between} {
 365    char *ptr;
 366    BEGIN comm ;
 367    if ( obs_with )
 368    {
 369       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 370       exiterror( ERR_INVALID_TEMPLATE, 1, yytext )  ;
 371    }
 372    obs_with = in_do = 0 ;
 373    in_signal = in_call = 0 ;
 374    in_address = not_in_address;
 375    in_parse = 0 ;
 376    if ( seek_with == seek_with_from_address )
 377       seek_with = no_seek_with ;
 378    if ((ptr = strchr(yytext, '\n')) != NULL)
 379    {
 380       nextstart = yyleng - (int) (ptr - (char *) yytext) ;
 381       nextline++ ;
 382       if (extnextline != -1)
 383       {
 384          extnextline++;
 385          extnextstart = nextstart; /* fixes bug 938204 */
 386       }
 387    }
 388    else
 389       SET_NEXTSTART() ;
 390    return STATSEP ; }
 391
 392 {key_dotline}/{notGeneralDot} {
 393    int  i;
 394    char work[16];
 395
 396    /* support C-like __LINE__ value */
 397    /* determine current source line, and create a numeric literal */
 398
 399    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 400
 401    sprintf (work, "%d", parser_data.tline);
 402
 403    /* copy back work, right-to-left */
 404
 405    for (i = strlen (work) - 1; i >= 0; i--)
 406    {
 407       unput (work[i]);
 408    }
 409 }
 410
 411 <comm>{key_address}{between} {
 412    BEGIN value1 ; /* Allow a following VALUE keyword */
 413    seek_with = seek_with_from_address ;
 414    in_address = in_address_keyword ;
 415    in_call = 1 ; /* Allow the next words to be given as in CALL. */
 416    SET_NEXTSTART() ;
 417    return ADDRESS ; }
 418
 419 <comm>{key_arg}{between} {
 420    BEGIN other ;
 421    in_parse = 1 ;
 422    SET_NEXTSTART() ;
 423    return ARG ; }
 424
 425 <comm>{key_call}{between} {
 426    BEGIN signal ;
 427    in_call = 1 ;
 428    SET_NEXTSTART() ;
 429    return CALL ; }
 430
 431 <comm>{key_do}{between} {
 432    BEGIN do1 ;
 433    assert( do_level >=0 ) ;
 434    do_level++ ;
 435    in_do = 1 ;
 436    SET_NEXTSTART() ;
 437    return DO ; }
 438
 439 <comm>{key_drop}{between} {
 440    BEGIN other ;
 441    in_parse = 1 ;
 442    SET_NEXTSTART() ;
 443    return DROP ; }
 444
 445 <comm>{key_else}{between} {
 446    BEGIN comm ;
 447    SET_NEXTSTART() ;
 448    return ELSE ; }
 449
 450 <comm>{key_exit}{between} {
 451    BEGIN other ;
 452    SET_NEXTSTART() ;
 453    return EXIT ; }
 454
 455 <comm>{key_if}{between} {
 456    BEGIN ifcont ;
 457    in_then = 1 ;
 458    parser_data.if_linenr = linenr - 1;
 459    SET_NEXTSTART() ;
 460    return IF ; }
 461
 462 <comm>{key_interpret}{between} {
 463    BEGIN other ;
 464    SET_NEXTSTART() ;
 465    return INTERPRET ; }
 466
 467 <comm>{key_iterate}{between} {
 468    BEGIN other ;
 469    SET_NEXTSTART() ;
 470    return ITERATE ; }
 471
 472 <comm>{key_leave}{between} {
 473    BEGIN other ;
 474    SET_NEXTSTART() ;
 475    return LEAVE ; }
 476
 477 <comm>{key_options}{between} {
 478    BEGIN other ;
 479    SET_NEXTSTART() ;
 480    return OPTIONS ; }
 481
 482 <comm>{key_nop}{between} {
 483    BEGIN other ;
 484    SET_NEXTSTART() ;
 485    return NOP ; }
 486
 487 <comm>{key_numeric}{between} {
 488    BEGIN numeric ;
 489    SET_NEXTSTART() ;
 490    return NUMERIC ; }
 491
 492 <comm>{key_parse}{between} {
 493    BEGIN parse ;
 494    in_parse = 1 ;
 495    SET_NEXTSTART() ;
 496    return PARSE ; }
 497
 498 <comm>{key_procedure}{between} {
 499    BEGIN procd ;
 500    SET_NEXTSTART() ;
 501    return PROCEDURE ; }
 502
 503 <comm>{key_pull}{between} {
 504    BEGIN other ;
 505    in_parse = 1 ;
 506    SET_NEXTSTART() ;
 507    return PULL ; }
 508
 509 <comm>{key_push}{between} {
 510    BEGIN other ;
 511    SET_NEXTSTART() ;
 512    return PUSH ; }
 513
 514 <comm>{key_queue}{between} {
 515    BEGIN other ;
 516    SET_NEXTSTART() ;
 517    return QUEUE ; }
 518
 519 <comm>{key_return}{between} {
 520    BEGIN other ;
 521    SET_NEXTSTART() ;
 522    return RETURN ; }
 523
 524 <comm>{key_say}{between} {
 525    BEGIN other ;
 526    SET_NEXTSTART() ;
 527    return SAY ; }
 528
 529 <comm>{key_select}{between} {
 530    BEGIN other ;
 531    assert( do_level >= 0 ) ;
 532    do_level++ ;
 533    SET_NEXTSTART() ;
 534    return SELECT ; }
 535
 536 <comm>{key_signal}{between} {
 537    BEGIN signal ;
 538    in_signal = 1 ;
 539    SET_NEXTSTART() ;
 540    return SIGNAL ; }
 541
 542 <comm>{key_trace}{between} {
 543    BEGIN value1 ;
 544    in_trace = 1 ;
 545    SET_NEXTSTART() ;
 546    return TRACE ; }
 547
 548 <comm>{key_upper}{between} {
 549    BEGIN other ;
 550    in_parse = 1 ;
 551    SET_NEXTSTART() ;
 552    return UPPER ; }
 553
 554 <comm>{key_when}{between} {
 555    BEGIN ifcont ;
 556    in_then = 1 ;
 557    parser_data.when_linenr = linenr - 1;
 558    SET_NEXTSTART() ;
 559    return WHEN ; }
 560
 561 <comm>{key_otherwise}{between} {
 562    BEGIN comm ;
 563    SET_NEXTSTART() ;
 564    return OTHERWISE ; }
 565
 566 <comm>{key_end}{between} {
 567    BEGIN other ;
 568    assert( do_level >= 0 ) ;
 569    if ( !do_level )
 570    {
 571       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 572       exiterror( ERR_UNMATCHED_END, 1 ) ;
 573    }
 574    do_level-- ;
 575    SET_NEXTSTART() ;
 576    return END ; }
 577
 578 {between} {
 579    if (in_parse)
 580    {
 581       SET_NEXTSTART() ;
 582       return yylex() ;
 583    }
 584    else
 585       REJECT ; }
 586
 587 \. {
 588    if (in_parse)
 589    {
 590       SET_NEXTSTART() ;
 591       return PLACEHOLDER ;
 592    }
 593    else
 594    {
 595       REJECT ;
 596    }
 597  }
 598
 599 <comm>{const_symbol}{between}={between} {
 600    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 601    if ( yytext[0] == '.' )
 602    {
 603       set_assignment();
 604       /*
 605        * FIXME, FGC: ANSI 6.2.3.1 forces an error 50.1 if yytext[0]=='.'
 606        *             ANSI 6.3.2.8 forces this error 31.3 which is wrong
 607        *             in its content.
 608        *             We use 6.2.3.1
 609        */
 610       if ( !KNOWN_RESERVED( retvalue, retlength ) )
 611       {
 612          yytext[retlength] = '\0';
 613          exiterror( ERR_RESERVED_SYMBOL, 1, yytext );
 614       }
 615       else
 616       {
 617          yytext[retlength] = '\0';
 618          exiterror( ERR_INVALID_START, 3, yytext );
 619       }
 620    }
 621    else
 622    {
 623       yytext[retlength] = '\0';
 624       exiterror( ERR_INVALID_START, 2, yytext );
 625    }
 626    /* known reserved variable */
 627    SET_NEXTSTART() ;
 628    return ASSIGNMENTVARIABLE ; }
 629
 630 <comm>{var_symbol}{between}={between} {
 631    BEGIN other ;
 632
 633    set_assignment();
 634
 635    SET_NEXTSTART() ;
 636    return ASSIGNMENTVARIABLE ; }
 637
 638 <nmform,signal,value1>{between}{key_value}{between} {
 639    if (in_call)
 640    {
 641       if ( ( last_in_address == in_address_keyword )
 642         && ( in_address == in_address_main ) )
 643       {
 644          BEGIN other ; /* the next useful expression will set it to "other"
 645                         * in either case. The BEGIN-states aren't very
 646                         * handy in most cases; they are not flexible enough.
 647                         */
 648          in_address = in_address_value ;
 649          in_call = 0;
 650          SET_NEXTSTART() ;
 651          return VALUE ;
 652       }
 653       REJECT ;
 654    }
 655    BEGIN other ;
 656    if ((!in_trace)&&(!in_address)&&(!in_signal)&&(!in_call)&&(!in_numform))
 657       obs_with = 1 ;
 658    in_trace = in_signal = in_call = 0 ;
 659    SET_NEXTSTART() ;
 660    return VALUE ; }
 661
 662 <signal>{key_on}{between} {
 663    BEGIN sgtype ;
 664    SET_NEXTSTART() ;
 665    return ON ; }
 666
 667 <signal>{key_off}{between} {
 668    BEGIN sgtype ;
 669    SET_NEXTSTART() ;
 670    return OFF ; }
 671
 672 <signame>{key_name}{between} {
 673    BEGIN other ;
 674    SET_NEXTSTART() ;
 675    return NAME ; }
 676
 677 <sgtype>{key_error}{between} {
 678    BEGIN signame ;
 679    SET_NEXTSTART() ;
 680    return ERROR ; }
 681
 682 <sgtype>{key_halt}{between} {
 683    BEGIN signame ;
 684    SET_NEXTSTART() ;
 685    return HALT ; }
 686
 687 <sgtype>{key_novalue}{between} {
 688    BEGIN signame ;
 689    SET_NEXTSTART() ;
 690    return NOVALUE ; }
 691
 692 <sgtype>{key_notready}{between} {
 693    BEGIN signame ;
 694    SET_NEXTSTART() ;
 695    return NOTREADY ; }
 696
 697 <sgtype>{key_failure}{between} {
 698    BEGIN signame ;
 699    SET_NEXTSTART() ;
 700    return FAILURE ; }
 701
 702 <sgtype>{key_syntax}{between} {
 703    BEGIN signame ;
 704    SET_NEXTSTART() ;
 705    return SYNTAX ; }
 706
 707 <sgtype>{key_lostdigits}{between} {
 708    BEGIN signame ;
 709    SET_NEXTSTART() ;
 710    return LOSTDIGITS ; }
 711
 712 <value1>{between}{trace_char}+{between} {
 713    if (!in_trace) REJECT ;
 714    strcpy(retvalue,rmspc( yytext )) ;
 715    SET_NEXTSTART() ;
 716    return WHATEVER ; }
 717
 718 <procd>{key_expose}{between} {
 719    BEGIN other ;
 720    in_parse = 1 ;
 721    SET_NEXTSTART() ;
 722    return EXPOSE ; }
 723
 724 <parse>{key_upper}{between} {
 725    SET_NEXTSTART() ;
 726    return UPPER ; }
 727
 728 <parse>{key_lower}{between} {
 729    SET_NEXTSTART() ;
 730    return LOWER ; }
 731
 732 <parse>{key_caseless}{between} {
 733    SET_NEXTSTART() ;
 734    return CASELESS ; }
 735
 736 <parse>{key_arg}{between} {
 737    BEGIN other ;
 738    SET_NEXTSTART() ;
 739    return ARG ; }
 740
 741 <parse>{key_numeric}{between} {
 742    BEGIN other ;
 743    SET_NEXTSTART() ;
 744    return NUMERIC ; }
 745
 746 <parse>{key_pull}{between} {
 747    BEGIN other ;
 748    SET_NEXTSTART() ;
 749    return PULL ; }
 750
 751 <parse>{key_source}{between} {
 752    BEGIN other ;
 753    SET_NEXTSTART() ;
 754    return SOURCE ; }
 755
 756 <parse>{key_external}{between} {
 757    BEGIN other ;
 758    SET_NEXTSTART() ;
 759    return EXTERNAL ; }
 760
 761 <parse>{key_linein}{between} {
 762    BEGIN other ;
 763    SET_NEXTSTART() ;
 764    return LINEIN ; }
 765
 766 <parse>{key_version}{between} {
 767    BEGIN other ;
 768    SET_NEXTSTART() ;
 769    return VERSION ; }
 770
 771 <parse>{key_var}{between} {
 772    BEGIN other ;
 773    in_parse = 2; /* accept a variable and treat func(a) as func (a) */
 774    SET_NEXTSTART() ;
 775    return VAR ; }
 776
 777 <parse>{key_value}{between} {
 778    seek_with = seek_with_from_parse ;
 779    in_trace = 0 ;
 780    in_parse = 0 ;
 781    BEGIN with ; /* in fact this works as a "not comm" */
 782    SET_NEXTSTART() ;
 783    return VALUE ; }
 784
 785 <comm>{between}{key_then}{between} {
 786    in_then = 0 ;
 787    SET_NEXTSTART() ;
 788    return THEN ; }
 789
 790 <other,ifcont>{between}{key_then}{between} {
 791    if (in_then!=1) REJECT ;
 792    BEGIN comm ;
 793    in_then = 0 ;
 794    SET_NEXTSTART() ;
 795    return THEN ; }
 796
 797 {between}{key_with}{between} {
 798    /*
 799     * Fixes bug 952380
 800     */
 801    if ((in_do)||(!seek_with))
 802       REJECT ;
 803    BEGIN other ;
 804    if ( seek_with == seek_with_from_parse )
 805       in_parse = 1 ;
 806    seek_with = no_seek_with ;
 807    if (in_address) /* any address state */
 808       in_address = in_address_with ; /* WITH seen */
 809    SET_NEXTSTART() ;
 810    return WITH ; }
 811
 812
 813 <numeric>{key_digits}{between} {
 814    BEGIN other ;
 815    SET_NEXTSTART() ;
 816    return DIGITS ; }
 817
 818 <numeric>{key_form}{between} {
 819    BEGIN nmform ;
 820    next_numform = 1 ;
 821    SET_NEXTSTART() ;
 822    return FORM ; }
 823
 824 <nmform>{key_scientific}{between} {
 825    SET_NEXTSTART() ;
 826    return SCIENTIFIC ; }
 827
 828 <nmform>{key_engineering}{between} {
 829    SET_NEXTSTART() ;
 830    return ENGINEERING ; }
 831
 832 <numeric>{key_fuzz}{between} {
 833    BEGIN other ;
 834    SET_NEXTSTART() ;
 835    return FUZZ ; }
 836
 837 <do1>{key_forever}{between} {
 838    BEGIN other ;
 839    assert(in_do) ;
 840    in_do = 2 ;
 841    SET_NEXTSTART() ;
 842    return FOREVER ; }
 843
 844 {key_to}{between} {
 845    if ( in_do == 2 )
 846    {
 847       BEGIN other ;
 848       SET_NEXTSTART() ;
 849       return TO ;
 850    }
 851    else if ( in_do == 1 )
 852    {
 853       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 854       exiterror( ERR_INVALID_DO_SYNTAX, 1, "TO" )  ;
 855    }
 856    REJECT ; }
 857
 858 {key_by}{between} {
 859    if ( in_do == 2 )
 860    {
 861       BEGIN other ;
 862       SET_NEXTSTART() ;
 863       return BY ;
 864    }
 865    else if ( in_do == 1 )
 866    {
 867       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 868       exiterror( ERR_INVALID_DO_SYNTAX, 1, "BY" ) ;
 869    }
 870    REJECT ; }
 871
 872 {key_for}{between} {
 873    if ( in_do == 2 )
 874    {
 875       BEGIN other ;
 876       SET_NEXTSTART() ;
 877       return FOR ;
 878    }
 879    else if ( in_do == 1 )
 880    {
 881       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 882       exiterror( ERR_INVALID_DO_SYNTAX, 1, "FOR" ) ;
 883    }
 884    REJECT ; }
 885
 886 {key_while}{between} {
 887    if (in_do)
 888    {
 889       if ( in_do == 3 )
 890       {
 891          parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 892          exiterror( ERR_INVALID_DO_SYNTAX, 1, "WHILE" )  ;
 893       }
 894       in_do=3 ;
 895       BEGIN other ;
 896       SET_NEXTSTART() ;
 897       return WHILE ;
 898    }
 899    REJECT ; }
 900
 901 {key_until}{between} {
 902    if (in_do) {
 903       if ( in_do == 3 )
 904       {
 905          parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 906          exiterror( ERR_INVALID_DO_SYNTAX, 1, "UNTIL" )  ;
 907       }
 908
 909       in_do=3 ;
 910       BEGIN other ;
 911       SET_NEXTSTART() ;
 912       return UNTIL ; }
 913    REJECT ; }
 914
 915
 916 <do1>{reserved_symbol}{between}/= {
 917    BEGIN other ;
 918    in_do = 2 ;
 919    set_assignment();
 920    if ( !KNOWN_RESERVED( retvalue, retlength ) )
 921       exiterror( ERR_RESERVED_SYMBOL, 1, yytext )  ;
 922    SET_NEXTSTART() ;
 923    return DOVARIABLE ; }
 924
 925 <do1>{var_symbol}{between}/= {
 926    BEGIN other ;
 927    in_do = 2 ;
 928    strcpy(retvalue,rmspc( yytext )) ;
 929    SET_NEXTSTART() ;
 930    return DOVARIABLE ; }
 931
 932 <comm>{symbol}{between}:{between} {
 933    unsigned i;
 934    BEGIN comm ;
 935
 936    for( i = 0; ( ch = yytext[i] ) != '\0'; i++ )
 937    {
 938       /*
 939        * A blank or ':' can't occur in the normal text. They are terminators.
 940        */
 941       if ( ( ch == ':' )
 942         || ( ch == '\n' )
 943         || ( MY_ISBLANK( ch ) ) )
 944          break;
 945       retvalue[i] = (char) rx_toupper( ch );
 946    }
 947    retvalue[i] = '\0' ;
 948    SET_NEXTSTART() ;
 949    return LABEL ; }
 950
 951
 952 <comm>{mintext_string}{between}:{between} {
 953    BEGIN comm ;
 954
 955    compress_string( retvalue, yytext );
 956
 957    SET_NEXTSTART() ;
 958    return LABEL ; }
 959
 960
 961 {mintext_string}{comment}*\( {
 962    BEGIN other ;
 963
 964    compress_string( retvalue, yytext );
 965
 966    kill_next_space = 1 ;
 967    if ( insert_abuttal ) {
 968       inhibit_delayed_abuttal = 1 ;
 969       delayed_symbol = EXFUNCNAME ;
 970       SET_NEXTSTART() ;
 971       return CONCATENATE ; }
 972
 973    expression_ended = 0 ;
 974    SET_NEXTSTART() ;
 975    return EXFUNCNAME ; }
 976
 977
 978
 979 ('{hex_string}'|\"{hex_string}\")[xX]/{notGeneralDot} {
 980    /*
 981     * fixes bug 617225.
 982     */
 983    return process_hex_or_bin_string( yytext, yyleng, 16 ); }
 984
 985
 986
 987 ('{bin_string}'|\"{bin_string}\")[bB]/{notGeneralDot} {
 988    return process_hex_or_bin_string( yytext, yyleng, 2 ); }
 989
 990 {text_string}[xXbB]/{notGeneralParen} {
 991    char c;
 992    int i,base,charcount,first,tuple;
 993
 994    base = ( rx_toupper( yytext[yyleng - 1] ) == 'X' ) ? 16 : 2;
 995    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
 996    /*
 997     * We are sure to have an invalid string since the above patterns won't
 998     * match. We can either have invalid characters or misplaced spaces.
 999     *
1000     * Blanks as the first characters are forbidden.
1001     */
1002    if ( MY_ISBLANK( yytext[1] ) )
1003       exiterror( ERR_INVALID_HEX_CONST, ( base == 16 ) ? 1 : 2, 1 );
1004
1005    tuple = ( base == 16 ) ? 2 : 4;
1006    for ( i = 1, first = 1, charcount = 0; i < yyleng - 2; i++ )
1007    {
1008       c = yytext[i];
1009       if ( MY_ISBLANK( c ) )
1010       {
1011          /*
1012           * The first tuple may have less than tuple chars
1013           */
1014          if ( ( ( charcount % tuple ) == 0 ) || first )
1015          {
1016             first = 0;
1017             charcount = 0;
1018             continue;
1019          }
1020          exiterror( ERR_INVALID_HEX_CONST, ( base == 16 ) ? 1 : 2, i );
1021       }
1022       charcount++;
1023       if ( base == 2 )
1024       {
1025          if ( ( c == '0' ) || ( c == '1' ) )
1026             continue;
1027       }
1028       if ( base == 16 )
1029       {
1030          if ( rx_isxdigit( c ) )
1031             continue;
1032       }
1033       exiterror( ERR_INVALID_HEX_CONST, ( base == 16 ) ? 3 : 4, c );
1034    }
1035    /*
1036     * We didn't match something like "1 12 34 "X Assume this as the error.
1037     * Look back to the first blank in the last sequence.
1038     */
1039    for ( i = yyleng - 2; i > 1; i-- )
1040       if ( !MY_ISBLANK( yytext[i - 1] ) )
1041          break;
1042    exiterror( ERR_INVALID_HEX_CONST, ( base == 16 ) ? 1 : 2, i ); }
1043
1044 {text_string} {
1045    BEGIN other ;
1046
1047    compress_string( retvalue, yytext );
1048
1049    strcpy( yytext, retvalue ); /* proper error display */
1050
1051    if (in_numform)
1052    {
1053       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1054       exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", retvalue ) ;
1055    }
1056
1057    /* fixes 1109372 */
1058    if ( insert_abuttal && !in_parse && !in_signal && !in_call ) {
1059       delayed_symbol = STRING ;
1060       SET_NEXTSTART() ;
1061       return CONCATENATE ; }
1062
1063     if (in_call)
1064     {
1065        in_call = 0 ;
1066        kill_next_space = 1 ;
1067     }
1068     else
1069        expression_ended = 1 ;
1070
1071    SET_NEXTSTART() ;
1072    return STRING ; }
1073
1074
1075 {digit}+ {
1076    if (!in_parse)
1077       REJECT ;
1078    strcpy(retvalue,yytext) ;
1079    SET_NEXTSTART() ;
1080    return OFFSET ; }
1081
1082 {digit}+/{notGeneralDot} {
1083    /*
1084     * This is the same as of the "{digit}+" rule above. flex is very stupid.
1085     * (Or is it a feature?)
1086     * The number below will take precedence instead of a plain "{digit}+",
1087     * even of the fact that the above rule may match the same length of
1088     * characters. flex seems to count the next "expect characters" for the
1089     * comparison which rule shall be used.
1090     */
1091    if (!in_parse)
1092       REJECT ;
1093    strcpy(retvalue,yytext) ;
1094    SET_NEXTSTART() ;
1095    return OFFSET ; }
1096
1097 {number}/{notGeneralDot} {
1098    /*
1099     * must split two rule parts because of the "/" rule-part.
1100     * This fixes bug 602283.
1101     */
1102    return process_number_or_const( yytext, yyleng );
1103 }
1104
1105 {const_symbol} {
1106    return process_number_or_const( yytext, yyleng );
1107 }
1108
1109 {var_symbol} {
1110    int i,j;
1111    /*
1112     * this might be a symbol in front of a function, but only if next
1113     * char in input stream is "(".
1114     */
1115
1116    if (in_trace) REJECT ;
1117
1118    memcpy( retvalue, yytext, yyleng + 1 ); /* include terminating '\0' */
1119    mem_upper( retvalue, yyleng );
1120
1121    if (in_numform)
1122    {
1123       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1124       exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", retvalue ) ;
1125    }
1126
1127    if ( ( last_in_address == in_address_keyword )
1128      && ( in_address == in_address_main ) )
1129    {
1130       kill_next_space = 1 ;
1131       in_call = 0 ;
1132       SET_NEXTSTART() ;
1133       return SIMSYMBOL ;
1134    }
1135
1136    BEGIN other;
1137
1138    if ( in_call )
1139    {
1140       /*
1141        * This has precedence over checking the parenthesis below.
1142        * Fixes bug 521502.
1143        */
1144       in_call = 0;
1145       kill_next_space = 1;
1146       SET_NEXTSTART();
1147       return SIMSYMBOL;
1148    }
1149
1150    if ( in_parse == 2 )
1151    {
1152       /*
1153        * This has precedence over checking the parenthesis below.
1154        * Fixes bug 1109335.
1155        */
1156       in_parse = 1;
1157       kill_next_space = 1;
1158       SET_NEXTSTART();
1159       return SIMSYMBOL;
1160    }
1161
1162    /* We must check if a '(' follows. Remember the number of eaten chars. */
1163       j = 1;
1164 #ifdef __cplusplus
1165    for (; ( i = yyinput() ) == '`';)
1166 #else
1167    for (; ( i = input() ) == '`';)
1168 #endif
1169      j++ ;
1170    if (i != '(')
1171    {
1172       j-- ;
1173       unput(i) ;
1174    }
1175    /* input() has destroyed the yytext-terminator re-set it */
1176    yytext[yyleng] = '\0';
1177    SET_NEXTSTART() ;
1178    nextstart += j ;
1179
1180    if ( i == '(' )
1181    {
1182       kill_next_space = 1 ;
1183       if ( insert_abuttal )
1184       {
1185          inhibit_delayed_abuttal = 1 ;
1186          delayed_symbol = INFUNCNAME ;
1187          return CONCATENATE ;
1188       }
1189       expression_ended = 0 ;
1190       return INFUNCNAME ;
1191    }
1192
1193    if ( insert_abuttal && !in_parse ) {
1194       delayed_symbol = SIMSYMBOL ;
1195       return CONCATENATE ; }
1196
1197    expression_ended = 1 ;
1198
1199    if ( in_address == in_address_with )
1200       kill_next_space = 1 ;
1201    if (SymbolDetect) /* allow a fast breakout */
1202    {
1203       /* We define a tricky preprocessor directive. This will give us
1204        * maximum performance without the loss of control or errors produced
1205        * by typos.
1206        */
1207 #define RET_IF(s)  if ((SymbolDetect & SD_##s) &&      \
1208                        (yyleng == sizeof(#s) - 1) &&   \
1209                        (strncmp(retvalue,              \
1210                                 #s,                    \
1211                                 sizeof(#s) - 1) == 0)) \
1212                       return(s)
1213       /* e.g. RET_IF(INPUT); is replaced by:
1214        *  if ((SymbolDetect & SD_INPUT) &&
1215        *      (yyleng == sizeof("INPUT") - 1) &&
1216        *      (strncmp(retvalue,
1217        *               "INPUT",
1218        *               sizeof("INPUT") - 1) == 0))
1219        *     return(s);
1220        */
1221       RET_IF(INPUT);
1222       RET_IF(OUTPUT);
1223       RET_IF(ERROR);
1224       RET_IF(NORMAL);
1225       RET_IF(APPEND);
1226       RET_IF(REPLACE);
1227       RET_IF(STREAM);
1228       RET_IF(STEM);
1229       RET_IF(LIFO);
1230       RET_IF(FIFO);
1231 #undef RET_IF
1232    }
1233    return SIMSYMBOL ; }
1234
1235 {reserved_symbol} {
1236    int i,j;
1237    /*
1238     * this is mainly the content of var_symbol but we do a REJECT for all but
1239     * normal variable names.
1240     */
1241
1242    if ( in_trace || in_numform || in_call )
1243       REJECT;
1244
1245    if ( ( last_in_address == in_address_keyword )
1246      && ( in_address == in_address_main ) )
1247       REJECT;
1248
1249    set_assignment();
1250    if ( !KNOWN_RESERVED( retvalue, retlength ) )
1251       REJECT;
1252
1253    /* We must check if a '(' follows. Remember the number of eaten chars. */
1254 #ifdef __cplusplus
1255    for ( j = 1; ( i = yyinput() ) == '`'; )
1256 #else
1257    for ( j = 1; ( i = input() ) == '`'; )
1258 #endif
1259      j++;
1260    if ( i != '(' )
1261    {
1262       j--;
1263       unput( i );
1264    }
1265    /* input() has destroyed the yytext-terminator re-set it */
1266    yytext[yyleng] = '\0';
1267    SET_NEXTSTART();
1268    nextstart += j;
1269
1270    if ( i == '(' )
1271       REJECT; /* function name can't start with '.' */
1272
1273    BEGIN other;
1274    if ( insert_abuttal && !in_parse )
1275    {
1276       delayed_symbol = SIMSYMBOL;
1277       return CONCATENATE;
1278    }
1279
1280    expression_ended = 1;
1281    return SIMSYMBOL;
1282    }
1283
1284 {between}\) {
1285    expression_ended = 1 ;
1286    SET_NEXTSTART() ;
1287    return ')' ; }
1288
1289 \({between} {
1290    BEGIN other ;
1291    if ( insert_abuttal )
1292    {
1293       inhibit_delayed_abuttal = 1 ;
1294       delayed_symbol = '(' ;
1295       SET_NEXTSTART() ;
1296       return CONCATENATE ;
1297    }
1298    SET_NEXTSTART() ;
1299    return '(' ; }
1300
1301 {between}\,{between} {
1302    SET_NEXTSTART() ;
1303    return ',' ; }
1304
1305 {between}\-{between} {
1306    BEGIN other ;
1307    SET_NEXTSTART() ;
1308    return '-' ; }
1309
1310 {between}\+{between} {
1311    BEGIN other ;
1312    SET_NEXTSTART() ;
1313    return '+' ; }
1314
1315 {between}\/{between} {
1316    SET_NEXTSTART() ;
1317    return '/' ; }
1318
1319 {between}%{between} {
1320    SET_NEXTSTART() ;
1321    return '%' ; }
1322
1323 {between}\*{between} {
1324    SET_NEXTSTART() ;
1325    return '*' ; }
1326
1327 {between}\|{between} {
1328    SET_NEXTSTART() ;
1329    return '|' ; }
1330
1331 {between}&{between} {
1332    SET_NEXTSTART() ;
1333    return '&' ; }
1334
1335 {between}={between} {
1336    SET_NEXTSTART() ;
1337    return '=' ; }
1338
1339 {not}{between} {
1340    /* why don't I have a {between} in the beginning of this re? bug? */
1341    BEGIN other ;
1342    SET_NEXTSTART() ;
1343    return NOT ; }
1344
1345 {between}\>{blank}*\>{between} {
1346    SET_NEXTSTART() ;
1347    return GTGT ; }
1348
1349 {between}\<{blank}*\<{between} {
1350    SET_NEXTSTART() ;
1351    return LTLT ; }
1352
1353 {between}{not}{blank}*\>{blank}*\>{between} {
1354    SET_NEXTSTART() ;
1355    return NOTGTGT ; }
1356
1357 {between}{not}{blank}*\<{blank}*\<{between} {
1358    SET_NEXTSTART() ;
1359    return NOTLTLT ; }
1360
1361 {between}\>{blank}*\>{blank}*={between} {
1362    SET_NEXTSTART() ;
1363    return GTGTE ; }
1364
1365 {between}\<{blank}*\<{blank}*={between} {
1366    SET_NEXTSTART() ;
1367    return LTLTE ; }
1368
1369 {between}(\>|{not}{blank}*(\<{blank}*=|={blank}*\<)){between} {
1370    SET_NEXTSTART() ;
1371    return GT ; }
1372
1373 {between}({not}{blank}*\<|={blank}*\>|\>{blank}*=){between} {
1374    SET_NEXTSTART() ;
1375    return GTE ; }
1376
1377 {between}(\<|{not}{blank}*(\>{blank}*=|={blank}*\>)){between} {
1378    SET_NEXTSTART() ;
1379    return LT ; }
1380
1381 {between}({not}{blank}*\>|={blank}*\<|\<{blank}*=){between} {
1382    SET_NEXTSTART() ;
1383    return LTE ; }
1384
1385 {between}({not}{blank}*=|\<{blank}*\>|\>{blank}*\<){between} {
1386    SET_NEXTSTART() ;
1387    return DIFFERENT ; }
1388
1389 {between}={blank}*={between} {
1390    SET_NEXTSTART() ;
1391    return EQUALEQUAL ; }
1392
1393 {between}{not}{blank}*={blank}*={between} {
1394    SET_NEXTSTART() ;
1395    return NOTEQUALEQUAL ; }
1396
1397 {between}\/{blank}*\/{between} {
1398    SET_NEXTSTART() ;
1399    return MODULUS ; }
1400
1401 {between}&{blank}*&{between} {
1402    SET_NEXTSTART() ;
1403    return XOR ; }
1404
1405 {between}\|{blank}*\|{between} {
1406    SET_NEXTSTART() ;
1407    return CONCATENATE ; }
1408
1409 {between}\*{blank}*\*{between} {
1410    SET_NEXTSTART() ;
1411    return EXP ; }
1412
1413 {between}{blank}{between} {
1414    if ( in_address == in_address_value ) /* Always allow spaces in the VALUE */
1415    {                                   /* part of the ADDRESS stmt.        */
1416       SET_NEXTSTART() ;
1417       return SPACE ;
1418    }
1419    if (kill_this_space)
1420    {
1421       SET_NEXTSTART() ;
1422       return yylex() ;
1423    }
1424    SET_NEXTSTART() ;
1425    return (((in_parse)&&(!seek_with)) ? yylex() : SPACE) ; }
1426
1427 ['"] {
1428    SET_NEXTSTART() ;
1429    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1430    exiterror( ERR_UNMATCHED_QUOTE, 0 )  ; }
1431
1432
1433 : {
1434    SET_NEXTSTART() ;
1435    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1436    exiterror( ERR_SYMBOL_EXPECTED, 1, yytext ) ;}
1437
1438 . {
1439    SET_NEXTSTART() ;
1440    parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1441    exiterror( ERR_INVALID_CHAR, 1, yytext[0], yytext[0] ); }
1442
1443
1444 %%
1445
1446 #define NORMALSTAT  0
1447 #define COMMENTSTAT 1
1448 #define SINGLEQUOTE 2
1449 #define DOUBLEQUOTE 3
1450
1451 /*
1452  * set_assignment sets an assignment variable in retvalue from yytext with
1453  * a trailing {between}[={between}] stripped.
1454  * retlength is set, too.
1455  */
1456 static void set_assignment( void )
1457 {
1458    char ch;
1459
1460    for( retlength = 0; ( ch = yytext[retlength] ) != 0; retlength++ )
1461    {
1462       /*
1463        * A blank or '=' can't occur in the normal text. They are terminators.
1464        */
1465       if ( ( ch == '=' )
1466         || ( ch == '\n' )
1467         || ( MY_ISBLANK( ch ) ) )
1468          break;
1469       retvalue[retlength] = (char) rx_toupper( ch );
1470    }
1471    retvalue[retlength] = '\0' ;
1472 }
1473
1474 /* rmspc uppercases all characters and removes blanks from a string.
1475  * Returns the input string.
1476  */
1477 static YY_CHAR_TYPE *rmspc( YY_CHAR_TYPE *instr )
1478 {
1479    YY_CHAR_TYPE *retval=instr ,
1480                 *dest  =instr ,
1481                 c ;
1482
1483    while ((c = *instr++) != '\0')
1484    {
1485       c = (YY_CHAR_TYPE) rx_toupper(c);
1486       /* These characters are treated as blanks: */
1487       if ((c!='`') && (c!=' ') && (c!=',') && (c!='\t') && (c!='\n'))
1488          *dest++ = c ;
1489    }
1490    *dest = '\0' ;
1491
1492    return( retval ) ;
1493 }
1494
1495 /*
1496  * process_number_or_const does the processing of a decimal number or a const.
1497  * The detection was to complicated to put it into one routine.
1498  * We have to read some more characters to decide whether or not we have
1499  * an INFUNCNAME.
1500  * Returns a lexical code.
1501  */
1502 static int process_number_or_const( const char *text, int len )
1503 {
1504    int eaten,c,symbol;
1505
1506    /*
1507     * Copy and uppercase the return value.
1508     */
1509    memcpy( retvalue, text, len + 1 ); /* include terminating '\0' */
1510    mem_upper( retvalue, len );
1511
1512    if ( in_numform )
1513    {
1514       parser_data.tline = linenr - 1; /* set tline for exiterror */
1515       exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", retvalue );
1516    }
1517    nextstart += len;
1518
1519    BEGIN other;
1520
1521    /*
1522     * Plain number or const_symbol.
1523     */
1524    if ( KNOWN_RESERVED( retvalue, len ) )
1525       symbol = SIMSYMBOL;
1526    else
1527       symbol = CONSYMBOL;
1528
1529    if ( in_call )
1530    {
1531       /*
1532        * This has precedence over checking the parenthesis below.
1533        * Fixes bug 521502.
1534        */
1535       in_call = 0;
1536       kill_next_space = 1;
1537       SET_NEXTSTART();
1538       return symbol;
1539    }
1540
1541    /*
1542     * We must check if a '(' follows. Remember the number of eaten chars.
1543     */
1544    eaten = 1;
1545 #ifdef __cplusplus
1546    while ( ( c = yyinput() ) == '`' )
1547 #else
1548    while ( ( c = input() ) == '`' )
1549 #endif
1550    {
1551      eaten++;
1552    }
1553    if ( c != '(' )
1554    {
1555       eaten--;
1556       unput( c );
1557    }
1558    /*
1559     * input() has destroyed the yytext-terminator re-set it
1560     */
1561    yytext[yyleng] = '\0';
1562    nextstart += eaten;
1563    if ( c == '(' )
1564    {
1565       kill_next_space = 1;
1566       if ( insert_abuttal )
1567       {
1568          inhibit_delayed_abuttal = 1;
1569          delayed_symbol = INFUNCNAME;
1570          return CONCATENATE;
1571       }
1572       expression_ended = 0;
1573       return INFUNCNAME;
1574    }
1575
1576    if ( insert_abuttal && !in_parse )
1577    {
1578       delayed_symbol = symbol;
1579       return CONCATENATE;
1580    }
1581
1582    expression_ended = 1;
1583    return symbol;
1584 }
1585
1586 /*
1587  * compress_string removes quotes or double quotes from the src and changes
1588  * double delimiter to one. The delimiter should be either ' or ".
1589  */
1590 static void compress_string( char *dest, const char *src )
1591 {
1592    char c, delim = *src++;
1593
1594    for (;;)
1595    {
1596       if ( ( c = *src++ ) == delim )
1597       {
1598          if (*src == delim )
1599          {
1600             *dest++ = *src++;
1601          }
1602          else
1603          {
1604             break;
1605          }
1606       }
1607       else
1608       {
1609          if ( c == '\n' )
1610          {
1611             parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1612             exiterror( ERR_UNMATCHED_QUOTE, 0 ) ;
1613          }
1614          *dest++ = c;
1615       }
1616    }
1617    *dest = '\0';
1618 }
1619
1620 /*
1621  * process_hex_or_bin_string convert the string in text which is given as
1622  * a hexstring or a binstring to a "normal" string. base must be either 2 or
1623  * 16.
1624  * We rely on having a well-formed string. This must be ensured. It is
1625  * something of the form "content"x or 'content'b or similar.
1626  * Returns a lexical code. retvalue and retlength will be filled.
1627  */
1628 static int process_hex_or_bin_string( char *text, int len, int base )
1629 {
1630    char c;
1631    int i,left;
1632    unsigned char *dest,sum;
1633
1634    BEGIN other;
1635    SET_NEXTSTART();
1636
1637    text++;
1638    len -= 3;
1639
1640    /*
1641     * First, count the number of valid chars to determine the missed leading
1642     * zeros of the first final character.
1643     */
1644    for ( i = 0, left = 0 ; i < len; i++ )
1645    {
1646       c = text[i];
1647       if ( !MY_ISBLANK( c ) )
1648          left++;
1649    }
1650
1651    /*
1652     * left shall be the count of input char left to process one dest char.
1653     * Accessing one character after the content's end is allowed.
1654     */
1655    left %= ( base == 2 ) ? 8 : 2;
1656
1657    dest = (unsigned char *) retvalue;
1658    retlength = 0;
1659
1660    sum = 0;
1661    c = *text;
1662    for (;;)
1663    {
1664       while ( len && MY_ISBLANK( c ) )
1665       {
1666          c = *++text;
1667          len--;
1668       }
1669       if ( len == 0 )
1670          break;
1671
1672       if ( base == 2 )
1673       {
1674          if ( left == 0 )
1675             left = 8;
1676          sum <<= 1;
1677          sum |= (unsigned char) ( c - '0' );
1678       }
1679       else
1680       {
1681          if ( left == 0 )
1682             left = 2;
1683          sum <<= 4;
1684          sum |= HEXVAL( c );
1685       }
1686       c = *++text;
1687       len--;
1688
1689       if ( --left == 0 )
1690       {
1691          dest[retlength++] = sum;
1692          sum = 0;
1693       }
1694    }
1695    dest[retlength] = '\0';
1696
1697    /* We must check if a '(' follows. Remember the number of eaten chars. */
1698    left = 1;
1699 #ifdef __cplusplus
1700    for (; ( i = yyinput() ) == '`';)
1701 #else
1702    for (; ( i = input() ) == '`';)
1703 #endif
1704      left++;
1705    if (i != '(')
1706    {
1707       left--;
1708       unput(i);
1709    }
1710    /* input() has destroyed the yytext-terminator re-set it */
1711    text[len] = '\0';
1712    SET_NEXTSTART();
1713    nextstart += left;
1714
1715    if (i == '(')
1716    {
1717       kill_next_space = 1;
1718       if (insert_abuttal)
1719       {
1720          inhibit_delayed_abuttal = 1;
1721          delayed_symbol = INFUNCNAME;
1722          return CONCATENATE;
1723       }
1724       expression_ended = 0;
1725       return INFUNCNAME;
1726    }
1727
1728    if ( insert_abuttal && !in_parse && !in_call )
1729    {
1730       delayed_symbol = STRING;
1731       return CONCATENATE;
1732    }
1733
1734    if ( in_call )
1735    {
1736       in_call = 0;
1737       kill_next_space = 1;
1738    }
1739    else
1740       expression_ended = 1;
1741
1742    return ( base == 2 ) ? BINSTRING : HEXSTRING;
1743 }
1744
1745 /* get_next_line: Lower level input fetcher.
1746  * Reads exactly one line from the input stream (file or string).
1747  * All EOL characters are removed and the result is stored in
1748  * last_source_line. A check for line overflow occurred here.
1749  * A special check is done for CP/M ^Z (DOS and friends use this for
1750  * "backward" compatibility, too).
1751  * line is filled with valid values on success.
1752  * max must reflect size of line and should be at least BUFFERSIZE + 2;
1753  * Returns -1 (no input) or the number of valid chars in line.
1754  */
1755 static int get_next_line( char *line, int max, FILE *stream )
1756 {
1757    lineboxptr newline ;
1758    offsrcline *incore_newline;
1759    int pos = 0;
1760    int c = 0;
1761
1762    if (inEOF) /* You can't use myunputc if EOF is reached! */
1763       return EOF ;
1764
1765    while (pos <= max - 2)
1766    {
1767       /* get next char */
1768       if (bufptr>0)
1769          c = chbuffer[--bufptr] ;
1770       else if (ipretflag)
1771       {
1772          if (interptr>=interptrmax)
1773             c = EOF ;
1774          else
1775 #ifdef ASCII_0_TERMINATES_STRING
1776             if ((c = *interptr++) == '\0')
1777                c = EOF ;
1778 #else
1779             c = *interptr++ ;
1780 #endif
1781       }
1782       else
1783       {
1784          c = getc(stream) ;
1785
1786          if ( parser_data.TSD->HaltRaised )
1787             halt_raised( parser_data.TSD );
1788       }
1789
1790       if ((c=='\r') || (c=='\n') || (c==EOF))
1791          break ;
1792       line[pos++] = (char) (unsigned char) c ;
1793    }
1794
1795    /* first, check for overflow */
1796    if ((c!='\r') && (c!='\n') && (c!=EOF))
1797    {
1798       parser_data.tline = linenr ; /* set tline for exiterror */
1799       exiterror( ERR_TOO_LONG_LINE, 0 )  ;
1800    }
1801
1802    /* We have either a (first) line terminator or EOF */
1803    if (c==EOF)
1804    {
1805       if ((pos==1) && (line[0]=='\x1A')) /* CP/M ^Z EOF? */
1806          pos-- ;
1807       if (pos == 0)
1808       {
1809          inEOF = 1 ;
1810          return EOF ;
1811       }
1812       chbuffer[bufptr++] = EOF; /* push back EOF for reuse */
1813    }
1814    else
1815    {
1816       /* Maybe we have CRLF or LFCR. Check for the pair character. */
1817       char pairChar = (c == '\r') ? '\n' : '\r';
1818
1819
1820       /* get one more char and consume it if it is the pair of the EOL */
1821       if (bufptr > 0)
1822       {
1823          if (chbuffer[bufptr - 1] == (int) pairChar)
1824             bufptr--;
1825       }
1826       else if (ipretflag)
1827       {
1828          if ((interptr < interptrmax) && (*interptr == pairChar))
1829             interptr++;
1830       }
1831       else
1832       {
1833          int next = getc(stream);
1834          if (next != pairChar)
1835          {
1836             /* ungetc may break some runtime stuff. Use the internal lookahead*/
1837             chbuffer[bufptr++] = next;
1838          }
1839          if ( parser_data.TSD->HaltRaised )
1840             halt_raised( parser_data.TSD );
1841       }
1842    }
1843
1844
1845    cch = 0 ; /* not needed ? */
1846    line[pos++] = '\n';
1847
1848    if (parser_data.incore_source)
1849    {
1850       /*
1851        * We can use the incore string to describe a source line, but we
1852        * MUST incement linenr otherwise .LINE doesn't work in instore macros.
1853        * This will probably also allow errors to be reported for the correct line number.
1854        */
1855       linenr++;
1856       incore_newline = FreshLine() ;
1857       incore_newline->length = pos - 1 ;
1858       incore_newline->offset = last_interptr - parser_data.incore_source ;
1859       last_interptr = interptr;
1860       return pos ;
1861    }
1862
1863    newline = (lineboxptr)Malloc(sizeof(linebox)) ;
1864    newline->line = Str_make_TSD( parser_data.TSD, pos - 1 ) ;
1865    newline->line->len = pos - 1 ;
1866    memcpy(newline->line->value, line, pos - 1 ) ;
1867    newline->prev = parser_data.last_source_line ;
1868    newline->next = NULL ;
1869    newline->lineno = linenr++ ;
1870
1871    if (parser_data.first_source_line==NULL)
1872       parser_data.first_source_line = newline ;
1873    else
1874       parser_data.last_source_line->next = newline ;
1875    parser_data.last_source_line = newline ;
1876
1877    return pos ;
1878 }
1879
1880 /* fill_buffer: Higher level input fetcher.
1881  * (To allow the C-file to compile, all Rexx comments in this comment
1882  *  are written as "{*" "*}" instead of the normal, C-like manner.)
1883  * Reads lines from the input stream (yyin or string) with get_next_line.
1884  * Only one line is returned to allow the saving of the line number.
1885  * This routine replaces all comments by '`' signs. This allows
1886  * the detection of a "pseudo" blank: The fragment "say x{* *}y" uses two
1887  * variables, not one called "xy". The parsing of comments must be done
1888  * here to check for the actual numbers of open and closes ("{*" and "*}").
1889  * While doing this we must always check for strings since "'{*'" is not part
1890  * of a comment.
1891  * Here is a problem: Is this a nested valid comment: "{* '{*' *} *}"?
1892  * I think so although you cannot remove the outer comment signs without an
1893  * error. Everything within a comment is a comment (per def.). Counting
1894  * opens and closes of comment signs is an ugly trick to help the user.
1895  * He/she must know what he/she is doing if nesting comments!
1896  *
1897  * max_size gives the maximum size of buf. This is filled up with input.
1898  * We never return less than one character until EOF is reached. Thus, we
1899  * read more than one true input line if a comment spans over more than one
1900  * line.
1901  * A line will either be terminated by a single '\n' or by a blank. The
1902  * later one replaces a line continuation (',' [spaces] EOL).
1903  * Errors in this low
1904  *
1905  * Conclusion: We have to fight very hard to set the expected line number.
1906  *             * Comments spanning over lines set them on getting the
1907  *               "follow" lines.
1908  *             * Concatenated lines set
1909  */
1910 static int fill_buffer( char *buf, int max_size )
1911 {
1912    /* statics protected by regina_parser */
1913    static char line[BUFFERSIZE+2] ; /* special buffer to allow max_size */
1914    static int pos = 0, max = 0 ;    /* being smaller than BUFFERSIZE+1  */
1915    static int nesting = 0;          /* nesting level of comments        */
1916    int nesting_start_line = 0;      /* start line of comment for errortext() */
1917    char *dest, c;
1918    int i, squote, dquote;
1919    int line_comment;
1920
1921    if (firstln == 0)
1922    {
1923       firstln = 1;
1924       contline = 0;
1925       nesting = 0;
1926       pos = 0;
1927       max = get_next_line( line, sizeof(line), yyin ) ;
1928       if (max < 0) /* empty input file */
1929          return 0 ;
1930       /* test for both #! - fixes bug 1230639 */
1931       if ( max > 1
1932       &&  line[0] == '#'
1933       &&  line[1] == '!' )
1934       {  /* Ignore first line beginning this way for unix compat */
1935          max = 5;
1936          memcpy( line, "/**/\n", 5 );
1937       }
1938    }
1939    else if (pos < max) /* Are there still characters to transmit? */
1940    {
1941       /* Buffer already checked for correctness */
1942       if (max_size > max - pos)
1943          max_size = max - pos;
1944       memcpy(buf, line + pos, max_size);
1945       pos += max_size;
1946       return(max_size);
1947    }
1948    else /* Need next line */
1949    {
1950       if (contline && !nesting)
1951       {
1952          extnextline = ++nextline ;
1953          extnextstart = 1 ;
1954          contline = 0;
1955       }
1956       pos = 0;
1957       max = get_next_line( line, sizeof(line), yyin ) ;
1958       if (max < 0) /* empty input file */
1959       {
1960          if (nesting)
1961          {
1962             parser_data.tline = linenr - 1 ; /* set tline for exiterror */
1963             exiterror( ERR_UNMATCHED_QUOTE, 1 ) ;
1964          }
1965          return 0 ;
1966       }
1967    }
1968
1969    /* A new line is available, check first for an ending comment */
1970    dest = line; /* we change comments in line */
1971    if (nesting) /* This may lead to more line reading */
1972    {
1973       /*
1974        * The first time extnextline is non-zero, we have the comment
1975        * starting sequence line. This is saved for use if no matching
1976        * ending comment sequence is found, so that the error message
1977        * reflects the start of the comment.
1978        * Regina feature request: #508788
1979        */
1980       if ( extnextline < 0 )
1981          nesting_start_line = nextline+1;
1982       extnextline = ++nextline ;
1983       extnextstart = 1; /* See Reference (*) below */
1984 repeated_nesting:
1985       while (pos < max)
1986       {
1987          c = line[pos];
1988          if (c == '*') /* start of comment end? */
1989          {
1990             if (line[pos+1] == '/')
1991             {  /* pos+1 always exists, at least '\n' or '\0' */
1992                if (--nesting == 0)
1993                {
1994                   pos += 2;
1995                   *dest++ = '`';
1996                   *dest++ = '`';
1997                   break;
1998                }
1999                *dest++ = '`';
2000                pos++;
2001             }
2002          }
2003          else if (c == '/') /* start of new begin? */
2004          {
2005             if (line[pos+1] == '*')
2006             {
2007                nesting++;
2008                *dest++ = '`';
2009                pos++;
2010             }
2011          }
2012          *dest++ = '`';
2013          pos++;
2014       }
2015       if (pos >= max)
2016       {
2017          pos = 0;
2018          max = get_next_line( line, sizeof(line), yyin ) ;
2019          if (max < 0) /* empty input file */
2020          {
2021             if ( nesting_start_line )
2022                parser_data.tline = nesting_start_line ; /* set tline for exiterror */
2023             else
2024                parser_data.tline = linenr - 1 ; /* set tline for exiterror */
2025             exiterror( ERR_UNMATCHED_QUOTE, 1 ) ;
2026             return 0 ;
2027          }
2028          /* This is a comment continuation. If the lexer will return
2029           * something it already has a valid tline/tstart pair.
2030           * The lexer will return the current token and on the NEXT
2031           * call it expects a valid nextline/nextstart pair.
2032           */
2033          extnextline = ++nextline; extnextstart = 1;
2034          dest = line; /* we change comments in line */
2035          goto repeated_nesting;
2036       }
2037       extnextstart = pos + 1;
2038       if (contline)
2039       { /* Exception! Have a look at: "x='y',{*\n\n*}\n'z'". This should
2040          * result in "x = 'y' 'z'".
2041          * We must parse until EOL and check for whitespaces and comments...
2042          */
2043          while (pos < max)
2044          {
2045             c = line[pos];
2046             if (!rx_isspace(c))
2047             {
2048                if (c == '/')
2049                {
2050                   if (line[pos+1] == '*')
2051                   {
2052                      pos += 2;
2053                      nesting++;
2054                      goto repeated_nesting;
2055                   }
2056                }
2057                parser_data.tline = linenr - 1 ; /* set tline for exiterror */
2058                exiterror( ERR_YACC_SYNTAX, 1, parser_data.tline ) ; /* standard error */
2059             }
2060             pos++;
2061          }
2062          /* All done, it was a continuation line. */
2063          /* contline will be resetted by: */
2064          return fill_buffer( buf, max_size ) ;
2065       }
2066    }
2067    /* We have something to play with. Run through the input and check for
2068     * strings including comments.
2069     */
2070    squote = dquote = 0;
2071    line_comment = 0;
2072    while (pos < max)
2073    {
2074       /* We use selective loops to reduce comparisons */
2075       if (nesting)
2076          do
2077          {
2078             c = line[pos];
2079             if (c == '*') /* start of comment end? */
2080             {
2081                if (line[pos+1] == '/')
2082                {  /* pos+1 always exists, at least '\n' or '\0' */
2083                   if (--nesting == 0)
2084                   {
2085                      pos += 2;
2086                      *dest++ = '`';
2087                      *dest++ = '`';
2088                      break;
2089                   }
2090                   pos++;
2091                }
2092             }
2093             else if (c == '/') /* start of new begin? */
2094             {
2095                if (line[pos+1] == '*')
2096                {
2097                   nesting++;
2098                   pos++;
2099                   *dest++ = '`';
2100                }
2101             }
2102             pos++;
2103             *dest++ = '`';
2104          } while (pos < max);
2105       else if (squote)
2106          {
2107             while ((c = line[pos]) != '\'')
2108             {
2109                *dest++ = c;
2110                if (++pos >= max)
2111                {
2112                   parser_data.tline = linenr - 1 ; /* set tline for exiterror */
2113                   exiterror( ERR_UNMATCHED_QUOTE, 2 ) ;
2114                }
2115             }
2116             *dest++ = '\'';
2117             pos++;
2118             squote = 0;
2119          }
2120       else if (dquote)
2121          {
2122             while ((c = line[pos]) != '\"')
2123             {
2124                *dest++ = c;
2125                if (++pos >= max)
2126                {
2127                   parser_data.tline = linenr - 1 ; /* set tline for exiterror */
2128                   exiterror( ERR_UNMATCHED_QUOTE, 3 ) ;
2129                }
2130             }
2131             *dest++ = '\"';
2132             pos++;
2133             dquote = 0;
2134          }
2135       else if (line_comment)
2136          {
2137             while ((c = line[pos]) >= ' ')    /* not at end of line yet */
2138             {
2139                *dest++ = '`';
2140                if (++pos >= max)
2141                {
2142                   parser_data.tline = linenr - 1 ; /* set tline for exiterror */
2143                   exiterror( ERR_UNMATCHED_QUOTE, 3 ) ;
2144                }
2145             }
2146             *dest++ = c;    /* line terminator */
2147             pos++;
2148             line_comment = 0;
2149          }
2150       else
2151          while (pos < max)
2152             switch (c = line[pos])
2153             {
2154                case '\'':
2155                   *dest++ = c ;
2156                   squote = 1 ;
2157                   pos++ ;
2158                   goto outer_loop;
2159
2160                case '\"':
2161                   *dest++ = c ;
2162                   dquote = 1 ;
2163                   pos++ ;
2164                   goto outer_loop;
2165
2166                case '/':
2167                   if (line[pos + 1] == '*')
2168                   {
2169                      *dest++ = '`' ;
2170                      *dest++ = '`' ;
2171                      pos += 2 ;
2172                      nesting++ ;
2173                      goto outer_loop;
2174                   }
2175                   else
2176                   {
2177                      *dest++ = c;
2178                      pos++ ;
2179                   }
2180                   break ;
2181
2182                case '-':    /* line "--" comments */
2183                   if (line[pos + 1] == '-')
2184                   {
2185                      *dest++ = '`' ;
2186                      *dest++ = '`' ;
2187                      pos += 2 ;
2188                      line_comment = 1 ;
2189                      goto outer_loop;
2190                   }
2191                   else
2192                   {
2193                      *dest++ = c;
2194                      pos++ ;
2195                   }
2196                   break ;
2197
2198                case '`':
2199                   parser_data.tline = linenr - 1 ; /* set tline for exiterror */
2200                   exiterror( ERR_INVALID_CHAR, 1, c, c ) ;
2201
2202                default:
2203                   *dest++ = c;
2204                   pos++ ;
2205             }
2206 outer_loop:
2207       ;
2208    }
2209
2210    max = (int) (dest - line);
2211
2212    /* Now we can replace a ',' [spaces|comments] '\n' with the line
2213     * continuation, but check for nesting first
2214     */
2215    if (nesting)
2216    { /* Don't leave ANY spaces at EOL. That would confuse the lexer. */
2217       i = max - 1;
2218       while ((i >= 0) && rx_isspace(line[i]))
2219          i--;
2220       max = i + 1;
2221       /* Of course, there is one exception: line continuation */
2222       while ((i >= 0) && (line[i] == '`'))
2223          i-- ;
2224       if ((i >= 0) && (line[i] == ','))
2225       {
2226          contline = 1;
2227          line[i] = ' ';
2228          max = i + 1;
2229       }
2230       /* (Reference (*) )
2231        * At this point the lexer can't determine the nextline since we eat up
2232        * the \n. This leads to an incorrect count. But either the '`'-signs
2233        * are ignored or they are follows of a "token", a valid word.
2234        * Look at "say x;say y ``". This will cause the lexer to
2235        * return at least 4 tokens (SAY "x" ";" SAY) before "y" will be
2236        * returned. We can only set nextline/nextstart at "y".
2237        * Result: We set this pair at the start of the next call to
2238        * fill_buffer such that the next call to yylex will set the correct
2239        * values.
2240        */
2241    }
2242    else
2243    {
2244       i = max - 1; /* on last valid char */
2245       while (i >= 0)
2246       {
2247          if (!MY_ISBLANK(line[i]) && (line[i] != '\n'))
2248             break;
2249          i--;
2250       }
2251       /* i now -1 or on last nonblank */
2252       if ((i >= 0) && (line[i] == ','))
2253       {  /* FIXME: What shall be do with "," followed by EOF? */
2254          max = i + 1;
2255          line[i] = ' ';
2256          contline = 1;
2257       }
2258    }
2259
2260    if (max_size > max)
2261       max_size = max;
2262    memcpy(buf, line, max_size);
2263    pos = max_size;
2264    return(max_size);
2265 }
2266
2267
2268 /* yywrap MAY be called by the lexer is EOF encounters, see (f)lex docu */
2269 int yywrap( void )
2270 {
2271    assert( do_level>= 0 ) ;
2272    if (do_level>0)
2273    {
2274       parser_data.tline = linenr - 1 ; /* set tline for exiterror */
2275       exiterror( ERR_INCOMPLETE_STRUCT, 0 )  ;
2276    }
2277    return 1 ;
2278 }
2279
2280 /******************************************************************************
2281  ******************************************************************************
2282  * global interface ***********************************************************
2283  ******************************************************************************
2284  *****************************************************************************/
2285
2286 /* initalize all local and global values */
2287 static void init_it_all( tsd_t *TSD )
2288 {
2289 #if defined(FLEX_SCANNER) && defined(FLEX_DEBUG)
2290    if (__reginadebug)
2291       yy_flex_debug = 1;
2292      else
2293       yy_flex_debug = 0;
2294 #endif
2295    inEOF = 0 ;
2296    in_numform = 0 ;
2297    next_numform = 0 ;
2298    expression_ended = 0 ;
2299    insert_abuttal = 0 ;
2300    obs_with = 0 ;
2301    in_do = 0 ;
2302    in_then = 0 ;
2303    inhibit_delayed_abuttal = 0 ;
2304    firstln = 0 ;
2305    in_parse = 0 ;
2306    in_trace = 0 ;
2307    itflag = 0 ;
2308    in_signal = 0 ;
2309    in_call = 0 ;
2310    in_address = not_in_address ;
2311    seek_with = no_seek_with ;
2312    kill_this_space = 0 ;
2313    ipretflag = 0 ;
2314    do_level = 0 ;
2315    singlequote = 0 ;
2316    doblequote = 0 ;
2317    cch = 0 ;
2318    bufptr = 0 ;
2319    cchmax = 0 ;
2320    ch = '\0',
2321    delayed_symbol = 0,
2322    contline = 0;
2323    extnextstart = 0;
2324    interptr = NULL ;
2325    interptrmax = NULL ;
2326                           /* non-zero values */
2327    linenr = 1 ;
2328    nextline = 1;
2329    nextstart = 1;
2330    kill_next_space = 1 ;
2331    extnextline = -1 ;
2332    SymbolDetect = 0;
2333
2334    memset(&parser_data, 0, sizeof(internal_parser_type));
2335    parser_data.TSD = TSD;
2336 }
2337
2338 /* fetch may only be called by fetch_protected. The parser and lexer are
2339  * already protected by regina_parser by fetch_protected.
2340  * This function prepares the lexer and parser and call them. The
2341  * result and all generated values are stored in result. The parser
2342  * tree isn't executed here.
2343  * Exactly fptr xor str must be non-null.
2344  */
2345 static void fetch(tsd_t *TSD, FILE *fptr, const streng *str,
2346                   internal_parser_type *result)
2347 {
2348    init_it_all( TSD ) ;
2349
2350 #ifdef FLEX_SCANNER
2351    yy_init = 1 ;
2352    yy_delete_buffer(YY_CURRENT_BUFFER) ;
2353    yyrestart(fptr) ;
2354 #else
2355    yysptr = yysbuf ;
2356    yyin = fptr ;
2357 #endif
2358
2359    if (str != NULL)
2360    {
2361       ipretflag = 1 ;
2362       cchmax = str->len ;
2363       interptr = str->value ;
2364       last_interptr = interptr ;
2365       interptrmax = interptr + cchmax ;
2366       parser_data.incore_source = str->value; /* fixes bug 972796 */
2367       result->incore_source = str->value;
2368    }
2369
2370    BEGIN comm ;
2371    NewProg();
2372    parser_data.result = __reginaparse();
2373
2374 #ifdef FLEX_SCANNER
2375    yy_delete_buffer(YY_CURRENT_BUFFER) ;
2376 #else
2377    yysptr = yysbuf ;
2378 #endif
2379    yyin = NULL ;
2380
2381    *result = parser_data;
2382    /* Some functions assume null values if parsing isn't running: */
2383    memset(&parser_data, 0, sizeof(internal_parser_type));
2384 }
2385
2386 /* This function serializes the parser/lexer requests of the process and
2387  * call fetch which will make the work. Look there.
2388  */
2389 static void fetch_protected( tsd_t * volatile TSD, FILE *fptr,
2390                              const streng *str, internal_parser_type *result )
2391 {
2392    volatile int panicked = 0;
2393    tsd_t * volatile saved_TSD;
2394
2395    THREAD_PROTECT( regina_parser )
2396    TSD->in_protected = 1;
2397    memset(&parser_data, 0, sizeof(internal_parser_type));
2398
2399    saved_TSD = TSD; /* vars used until here */
2400    if ( setjmp( TSD->protect_return ) )
2401    {
2402       TSD = saved_TSD; /* prevents bugs like  592393 */
2403       panicked = 1;
2404    }
2405    else
2406       fetch( TSD, fptr, str, result );
2407
2408    TSD->in_protected = 0;
2409    THREAD_UNPROTECT( regina_parser )
2410
2411    if ( !panicked )
2412       return;
2413
2414    /*
2415     * We got a fatal condition while fetching the input.
2416     */
2417    memset(result, 0, sizeof(internal_parser_type));
2418
2419    /*
2420     * FIXME: Currently no time to investigate it, but we have to do
2421     *        a cleanup of the node and source lines of parser_data
2422     *        here. Test this with
2423     *        interpret '"a='
2424     *        and with
2425     *        interpret 'nop;"a='
2426     */
2427    if ( TSD->delayed_error_type == PROTECTED_DelayedInterpreterExit )
2428       jump_interpreter_exit( TSD, TSD->expected_exit_error );
2429    if ( TSD->delayed_error_type == PROTECTED_DelayedRexxSignal )
2430       jump_rexx_signal( TSD );
2431    jump_script_exit( TSD, TSD->systeminfo->result );
2432 }
2433
2434 /* fetch_file reads in a REXX file from disk (or a pipe). It returns without
2435  * executing the program. The parsed tree with all needed values including
2436  * the result of the parsing is copied to result.
2437  * fptr remains open after this call.
2438  * type is either PARSE_ONLY or PARSE_AND_TIN. In the later case a tinned variant of the
2439  * parsing tree is created, too.
2440  */
2441 void fetch_file(tsd_t *TSD, FILE *fptr, internal_parser_type *result)
2442 {
2443    fetch_protected(TSD, fptr, NULL, result);
2444 }
2445
2446 /* fetch_string reads in a REXX macro from a streng. It returns without
2447  * executing the program. The parsed tree with all needed values including
2448  * the result of the parsing is copied to result.
2449  * type is either PARSE_ONLY or PARSE_AND_TIN. In the later case a tinned variant of the
2450  * parsing tree is created, too.
2451  * The function is typically called by an "INTERPRET" instruction.
2452  */
2453 void fetch_string(tsd_t *TSD, const streng *str, internal_parser_type *result)
2454 {
2455    fetch_protected(TSD, NULL, str, result);
2456 }