%{

#ifndef lint
static char *RCSid = "$Id: lexsrc.l,v 1.13 1993/05/10 05:51:00 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
    This code modified for Win32 port by Ataman Software, Inc. June 29, 1995.
*/

#include "rexx.h"
#include "symbols.h"
#include <ctype.h>
#include <assert.h>
#include <string.h>


#ifdef YYLMAX
# undef YYLMAX
#endif
#define YYLMAX 512

#ifdef FLEX_SCANNER
# undef YY_CHAR
# ifdef yywrap
#  undef yywrap
# endif
# define YY_CHAR YY_CHAR_TYPE
# undef YY_INPUT
# define YY_INPUT(buf,result,max_size)\
     { int c=mygetchar(); result=((c==EOF)?ret_yy_null():(buf[0]=c,1)) ; }
#else
# undef input
# define input() (yylastch<yytext+YYLMAX-1?(((yytchar=yysptr>yysbuf?U(*--yysptr):mygetchar())==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar):(exiterror(ERR_TOO_LONG_LINE),yytchar))
#endif

YY_CHAR_TYPE *yylastch = NULL ;

int do_level = 0 ;
int in_numform=0, next_numform=0 ;
int obs_with=0, in_do=0, in_then=0, dontlast=0 ;
int sum=0, flag=1, nnextstart=0, nnextline ;
extern int nextline ;
int i, j, k, code=0, next=0, in_parse=0, support=0, in_trace=0, itflag=0 ;
int in_signal=0, in_call=0, in_address=0 ;
int seek_with=0 ;
static int firsttime=0, prev=0, last=0 ;
char retvalue[512], char1, ch, ech ;
int retlength=0 ;
extern int thischar, nextstart, tstart, tline ;
YY_CHAR_TYPE *rmspc( YY_CHAR_TYPE *instr ) ;
void striptext( char *text ) ;
int mygetchar( void ) ;
int mmygetchar( void ) ;
int ret_yy_null(), kill_this_space=0, kill_next_space=1 ;

%}


%start comm signal sgtype procd parse then with
%start numeric do1 other value1 ifcont signame nmform

%e 2500
%p 17000
%k 1500
%a 7000
%n 1000
%o 8000

%{
int yy_startcond=comm ;
%}

not [\\^~]

csym [0-9.][a-zA-Z0-9.@#$!?_]*
ssym [a-zA-Z@#$!?_][a-zA-Z0-9.@#$!?_]*
sym [a-zA-Z0-9.@#$!?_]+
hsym [\t a-fA-F0-9]
bsym [\t 01]
hex {bl}*{hsym}*({bl}+({hsym}{hsym})+)*{bl}*
bin {bl}*{bsym}*({bl}+({bsym}{bsym}{bsym}{bsym})+)*{bl}*

vtail [a-zA-Z@#$!?_][a-zA-Z0-9@#$!?_]*
ctail [0-9][a-zA-Z0-9@#$!?_]*


a [aA]
b [bB]
c [cC]
d [dD]
e [eE]
f [fF]
g [gG]
h [hH]
i [iI]
j [jJ]
k [kK]
l [lL]
m [mM]
n [nN]
o [oO]
p [pP]
q [qQ]
r [rR]
s [sS]
t [tT]
u [uU]
v [vV]
w [wW]
x [xX]
y [yY]
z [zZ]


bl (\ |\`|\t)*
bbl (\ |\t)+

%%

   { if (next==1) {
        next = 0 ;
        last = (dontlast==0) ;
        dontlast = 0 ;
        return code ; }

     if (next_numform)
     {
        in_numform = 1 ;
        next_numform = 0 ;
     }
     else
        in_numform = 0 ;

     if (in_address)
        in_address-- ;

     kill_this_space = kill_next_space ;
     kill_next_space = 0 ;
     

     if (itflag)
        in_trace = in_trace = seek_with = 0 ;
     itflag = (in_trace) ;
     
     tstart = nextstart ;   /* used to be thischar */
     tline = nextline ;
     prev = last ;
     last = 0 ; }

\` ;

<ifcont>{bl}[;\r?\n]{bl} {
   nextstart = thischar ;   
   return STATSEP ; }

{bl}(;|\r?\n){bl} {
   BEGIN comm ;
   if (obs_with==1)
      exiterror( 38 ) ;
   obs_with = in_do = 0 ;
   in_signal = in_address = in_call = 0 ;
   in_parse = 0 ;
   nextstart = thischar ;
   return STATSEP ; }

<comm>{a}{d}{d}{r}{e}{s}{s}{bl} {
   BEGIN value1 ;
   in_signal = 1 ;
   in_address = 2 ;
   return ADDRESS ; }

<comm>{a}{r}{g}{bl} {
   BEGIN other ;
   in_parse = 1 ;
   return ARG ; }

<comm>{c}{a}{l}{l}{bl} {
   BEGIN signal ;
   in_call = 1 ;
   return CALL ; }

<comm>{d}{o}{bl} {
   BEGIN do1 ;
   assert( do_level >=0 ) ;
   do_level++ ;
   in_do = 1 ;
   return DO ; }

<comm>{d}{r}{o}{p}{bl} {
   BEGIN other ;
   in_parse = 1 ;
   return DROP ; }

<comm>{e}{l}{s}{e}{bl} {
   BEGIN comm ;
   return ELSE ; }

<comm>{e}{x}{i}{t}{bl} {
   BEGIN other ;
   return EXIT ; }

<comm>{i}{f}{bl} {
   BEGIN ifcont ;
   in_then = 1 ;
   return IF ; }

<comm>{i}{n}{t}{e}{r}{p}{r}{e}{t}{bl} {
   BEGIN other ;
   return INTERPRET ; }

<comm>{i}{t}{e}{r}{a}{t}{e}{bl} {
   BEGIN other ;
   return ITERATE ; }

<comm>{l}{e}{a}{v}{e}{bl} {
   BEGIN other ;
   return LEAVE ; }

<comm>{o}{p}{t}{i}{o}{n}{s}{bl} {
   BEGIN other ;
   return OPTIONS ; }

<comm>{n}{o}{p}{bl} {
   BEGIN other ;
   return NOP ; }

<comm>{n}{u}{m}{e}{r}{i}{c}{bl} {
   BEGIN numeric ;
   return NUMERIC ; }

<comm>{p}{a}{r}{s}{e}{bl} {
   BEGIN parse ;
   in_parse = 1 ;
   return PARSE ; }

<comm>{p}{r}{o}{c}{e}{d}{u}{r}{e}{bl} {
   BEGIN procd ;
   return PROCEDURE ; }

<comm>{p}{u}{l}{l}{bl} {
   BEGIN other ;
   in_parse = 1 ;
   return PULL ; }

<comm>{p}{u}{s}{h}{bl} {
   BEGIN other ;
   return PUSH ; }

<comm>{q}{u}{e}{u}{e}{bl} {
   BEGIN other ;
   return QUEUE ; }

<comm>{r}{e}{t}{u}{r}{n}{bl} {
   BEGIN other ;
   return RETURN ; }

<comm>{s}{a}{y}{bl} {
   BEGIN other ;
   return SAY ; }

<comm>{s}{e}{l}{e}{c}{t}{bl} {
   BEGIN other ;
   assert( do_level >= 0 ) ;
   do_level++ ;
   return SELECT ; }

<comm>{s}{i}{g}{n}{a}{l}{bl} {
   BEGIN signal ;
   in_signal = 1 ;
   return SIGNAL ; }

<comm>{t}{r}{a}{c}{e}{bl} {
   BEGIN value1 ;
   in_trace = 1 ;
   return TRACE ; }

<comm>{w}{h}{e}{n}{bl} {
   BEGIN ifcont ;
   in_then = 1 ;
   return WHEN ; }

<comm>{o}{t}{h}{e}{r}{w}{i}{s}{e}{bl} {
   BEGIN comm ;
   return OTHERWISE ; }

<comm>{e}{n}{d}{bl} {
   BEGIN other ;
   assert( do_level >= 0 ) ;
   if (do_level==0)
      exiterror( ERR_UNMATCHED_END ) ;
   do_level-- ;
   return END ; }

{bl} { 
   if (in_parse) 
      return yylex() ;
   else
      REJECT ; }

\. {
   if (in_parse)
      return PLACEHOLDER ; 
   else
   {
      REJECT ;
      retvalue[0] = '.' ;
      retvalue[1] = 0x00 ;
      return CONSYMBOL ;
   }
 }

<comm>{csym}{bl}={bl} {
   exiterror( ERR_INVALID_START ) ; }

<comm>{ssym}{bl}={bl} {
   BEGIN other ;
   
   j = 0 ;
   for (i=0;yytext[i];i++)
      if ('a' <= yytext[i] && yytext[i] <= 'z')
         retvalue[j++] = yytext[i] & 0xDF ;
      else if (yytext[i]!='=' && yytext[i]!='\t' && yytext[i]!='\n' && yytext[i]!=' ' && yytext[i]!='`')
         retvalue[j++] = yytext[i] ;
   retvalue[j] = 0x00 ;

   return ASSIGNMENTVARIABLE ; }

<nmform,signal,value1>{bl}{v}{a}{l}{u}{e}{bl} {
   if (in_call) REJECT ;
   BEGIN other ;
   if ((!in_trace)&&(!in_address)&&(!in_signal)&&(!in_call))
      obs_with = 1 ;
   in_trace = in_signal = in_call = in_address = 0 ;
   return VALUE ; }

<signal>{o}{n}{bl} {
   BEGIN sgtype ;
   return ON ; }

<signal>{o}{f}{f}{bl} {
   BEGIN sgtype ;
   return OFF ; }

<signame>{n}{a}{m}{e}{bl} {
   BEGIN other ;
   return NAME ; }

<sgtype>{e}{r}{r}{o}{r}{bl} {
   BEGIN signame ;
   return ERROR ; }

<sgtype>{h}{a}{l}{t}{bl} {
   BEGIN signame ;
   return HALT ; }

<sgtype>{n}{o}{v}{a}{l}{u}{e}{bl} {
   BEGIN signame ;
   return NOVALUE ; }

<sgtype>{n}{o}{t}{r}{e}{a}{d}{y}{bl} {
   BEGIN signame ;
   return NOTREADY ; }

<sgtype>{f}{a}{i}{l}{u}{r}{e}{bl} {
   BEGIN signame ;
   return FAILURE ; }

<sgtype>{s}{y}{n}{t}{a}{x}{bl} {
   BEGIN signame ;
   return SYNTAX ; }

<value1>{bl}[a-zA-Z?]+{bl} {
   if (!in_trace) REJECT ;
   strcpy(retvalue,rmspc( yytext )) ;
   return WHATEVER ; }

<procd>{e}{x}{p}{o}{s}{e}{bl} {
   BEGIN other ;
   in_parse = 1 ;
   return EXPOSE ; }

<parse>{u}{p}{p}{e}{r}{bl} {
   return UPPER ; }

<parse>{a}{r}{g}{bl} {
   BEGIN other ;
   return ARG ; }

<parse>{n}{u}{m}{e}{r}{i}{c}{bl} {
   BEGIN other ;
   return NUMERIC ; }

<parse>{p}{u}{l}{l}{bl} {
   BEGIN other ;
   return PULL ; }

<parse>{s}{o}{u}{r}{c}{e}{bl} {
   BEGIN other ;
   return SOURCE ; }

<parse>{e}{x}{t}{e}{r}{n}{a}{l}{bl} {
   BEGIN other ;
   return EXTERNAL ; }

<parse>{l}{i}{n}{e}{i}{n}{bl} {
   BEGIN other ;
   return LINEIN ; }

<parse>{v}{e}{r}{s}{i}{o}{n}{bl} {
   BEGIN other ;
    return VERSION ; }

<parse>{v}{a}{r}{bl} {
   BEGIN other ;
   return VAR ; }

<parse>{v}{a}{l}{u}{e}{bl} {
   seek_with = 1 ;
   in_trace = 0 ;
   in_parse = 0 ;
   BEGIN with ;
   return VALUE ; }

<comm>{bl}{t}{h}{e}{n}{bl} {
   in_then = 0 ;
   return THEN ; }

<other,ifcont>{bl}{t}{h}{e}{n}{bl} {
   if (in_then!=1) REJECT ;
   BEGIN comm ;
   in_then = 0 ;
   return THEN ; }

{bl}{w}{i}{t}{h}{bl} {
   BEGIN other ;
   if ((in_do)||(!seek_with)) 
      REJECT ;
   seek_with = 0 ;
   in_parse = 1 ;
   return WITH ; }


<numeric>{d}{i}{g}{i}{t}{s}{bl} {
   BEGIN other ;
   return DIGITS ; }

<numeric>{f}{o}{r}{m}{bl} {
   BEGIN nmform ;
   next_numform = 1 ;
   return FORM ; }

<nmform>{s}{c}{i}{e}{n}{t}{i}{f}{i}{c}{bl} {
   return SCIENTIFIC ; }

<nmform>{e}{n}{g}{i}{n}{e}{e}{r}{i}{n}{g}{bl} {
   return ENGINEERING ; }

<numeric>{f}{u}{z}{z}{bl} {
   BEGIN other ;
   return FUZZ ; }

<do1>{f}{o}{r}{e}{v}{e}{r}{bl} {
   BEGIN other ;
   assert(in_do) ;
   in_do = 2 ;
   return FOREVER ; }

{bl}{t}{o}{bl} {
   if (in_do==2) {
      BEGIN other ;
      return TO ; }
   else if (in_do==1)
      exiterror( ERR_INVALID_DO_SYNTAX ) ;
   REJECT ; }

{bl}{b}{y}{bl} {
   if (in_do==2) {
      BEGIN other ; 
      return BY ; }
   else if (in_do==1)
      exiterror( ERR_INVALID_DO_SYNTAX ) ;
   REJECT ; }

{bl}{f}{o}{r}{bl} {
   if (in_do==2) {
      BEGIN other ;
      return FOR ; }
   else if (in_do==1)
      exiterror( ERR_INVALID_DO_SYNTAX ) ;
   REJECT ; }

{bl}{w}{h}{i}{l}{e}{bl} {
   if (in_do) {
      if (in_do==3)
         exiterror( ERR_INVALID_DO_SYNTAX ) ;

      in_do=3 ;
      BEGIN other ;
      return WHILE ; }
   REJECT ; }

{bl}{u}{n}{t}{i}{l}{bl} {
   if (in_do) {
      if (in_do==3)
         exiterror( ERR_INVALID_DO_SYNTAX ) ;

      in_do=3 ;
      BEGIN other ;
      return UNTIL ; }
   REJECT ; }


<do1>{ssym}{bl}/= {
   BEGIN other ;
   in_do = 2 ;
   strcpy(retvalue,rmspc( yytext )) ;
   return DOVARIABLE ; }   

<comm>{sym}{bl}:{bl} { 
   BEGIN comm ;
   
   for (i=j=0;ch=yytext[i];i++) {
      if ('a' <= ch && ch <= 'z')
         retvalue[j++] = ch & 0xDF ;
      else if ((ch!=' ')&&(ch!=',')&&(ch!='\t')&&(ch!='\n')&&(ch!=':')&&(ch!='`'))
         retvalue[j++] = ch ; }
   retvalue[j] = 0x00 ;
  /* nnextline = nextline ;
   nnextstart = thischar ;   
   nextstart = tstart ; 
   support = nextline - tline ;
   nextline = tline ; */
   return LABEL ; }


('([^']|'')+'|\"([^"]|\"\")+\")`*\( {
   BEGIN other ;
   char1 = yytext[0] ;

   strcpy(retvalue,&yytext[1]) ;
   for (i=3; i<=yyleng && retvalue[yyleng-i]=='`'; i++) ;
   retvalue[yyleng-i] = 0x00 ;   

   kill_next_space = 1 ;
   if (prev==1) {
      next = dontlast = 1 ;
      code = EXFUNCNAME ;
      return CONCATENATE ; }

   last = 0 ;
   return EXFUNCNAME ; }



('{hex}'|\"{hex}\")[xX]/[^a-zA-Z0-9.@#$!?_(] {
   BEGIN other ;
   ech = yytext[0] ;

   /* first group can be large and odd-numbered; find # of zeros to pad */
   for (i=1; (yytext[i]!=ech) && isxdigit(yytext[i]); i++) ;      

   /* j is the number of digits processed */
   j = (i-1)%2 ;
   sum = k = 0 ;

   for (i=1;(ech!=(ch=yytext[i]));i++) 
   {
      if (isspace(ch))
      {
         if ((i==1)||(j))   /* leading space or space within a byte */
            exiterror( ERR_INVALID_HEX_CONST ) ;         
      }
      else if (isxdigit(ch))
      {
         sum = sum *16 + (HEXVAL(ch)) ;
         if ((++j)==2)
         {
            retvalue[k++] = sum ;
            sum = j = 0 ;
         }
      }
   }

   if ((i>1) && isspace(yytext[i-1]))
      exiterror( ERR_INVALID_HEX_CONST ) ;

   retvalue[k] = 0x00 ;
   retlength = k ;

   if ((prev==1)&&(!in_parse)) 
   {
      next = 1 ;
      code = STRING ;
      return CONCATENATE ; 
   }

   last = 1 ;
   return HEXSTRING ; 
}



('{bin}'|\"{bin}\")[bB]/[^a-zA-Z0-9.@#$!?_(] {
   BEGIN other ;
   ech = yytext[0] ;

   /* first group can be large and odd-numbered; find # of zeros to pad */
   for (i=1; (yytext[i]!=ech) && isdigit(yytext[i]); i++) ;      

   /* j is the number of digits processed */
   j = (4 - (i-1))%4 ;
   sum = k = 0 ;

   for (i=1;(ech!=(ch=yytext[i]));i++) 
   {
      if (isspace(ch))
      {
         if ((i==1)||(j))   /* leading space or space within a byte */
              exiterror( ERR_INVALID_HEX_CONST ) ;         
      }
      else if ((ch=='0')||(ch=='1'))
      {
         sum = sum *2 + (ch-'0') ;
         if ((++j)==4)
         {
            retvalue[k++] = sum ;
            sum = j = 0 ;
         }
      }
   }

   if ((i>1) && isspace(yytext[i-1]))
      exiterror( ERR_INVALID_HEX_CONST ) ;

   j = (k%2) ;
   /* then pack the nibbles */
   for (i=j=(k%2); i<=k; i++)
   { 
      if (i%2)
         retvalue[i/2] = (retvalue[i/2]&0xf0) + retvalue[i-j] ;
      else
         retvalue[i/2] = ((retvalue[i-j]&0x0f)<<4) ;
   }

   retvalue[retlength=i/2] = 0x00 ;

   if ((prev==1)&&(!in_parse)) 
   {
      next = 1 ;
      code = STRING ;
      return CONCATENATE ; 
   }

   last = 1 ;
   return BINSTRING ; 
}


('([^']|'')*'|\"([^"]|"")*\")[xXbB]/[^a-zA-Z0-9.@#$!?_(] {
   exiterror( ERR_INVALID_HEX_CONST ) ;
   }


('([^']|'')*'|\"([^"]|\"\")*\") { 
   BEGIN other ;
   char1 = yytext[0] ;
   for (i=1; yytext[i+1]; i++)
   {
      if (yytext[i]==0x0a)
         exiterror( ERR_UNMATCHED_QUOTE ) ;

      if (yytext[i]==char1 && yytext[i+1]==char1)
         for (j=i+1; yytext[j]; j++)
            yytext[j] = yytext[j+1] ;
   }

   yytext[strlen(yytext)-1] = 0x00 ;
   strcpy(retvalue,&yytext[1]) ;

   if (in_numform) 
      exiterror( ERR_INV_SUBKEYWORD ) ;

   if ((prev==1)&&(!in_parse)) {
      next = 1 ;
      code = STRING ;
      return CONCATENATE ; }

   last = 1 ;
   return STRING ; }


[0-9]+ {
   if (!in_parse)
      REJECT ;
   strcpy(retvalue,yytext) ;
   return OFFSET ; }

((([0-9]+\.|\.?[0-9])[0-9]*{e}(\-|\+)[0-9]+))|([.0-9][a-zA-Z0-9.$!?@#_]*) {
   BEGIN other ;
   for (i=0;yytext[i];i++)
      if ('a' <= yytext[i] && yytext[i] <= 'z')
         retvalue[i] = yytext[i] & 0xDF ;
      else
         retvalue[i] = yytext[i] ;
   retvalue[i] = 0x00 ;

   if (in_numform) 
      exiterror( ERR_INV_SUBKEYWORD ) ;

   if (in_call)
   {
      in_call = 0 ;
      BEGIN other ;
      kill_next_space = 1 ;
      last = 1 ;
      return CONSYMBOL ;
   }

   if ((prev==1)&&(!in_parse)) {
      next = 1 ;
      code = CONSYMBOL ;
      return CONCATENATE ; }

   last = 1 ;
   return CONSYMBOL ; }


{ssym} {
   /* 
    * this might be a symbol in front of a function, but only if next 
    * char in input stream is "(".
    */

   if (in_trace) REJECT ;

   for (i=0; i<=yyleng && yytext[yyleng-i]!='`'; i++)
      retvalue[i] = toupper(yytext[i]) ;

   if (in_numform) 
      exiterror( ERR_INV_SUBKEYWORD ) ;

   if (in_address)
   {
      kill_next_space = 1 ;
      in_address=0 ;
      return ENVIRONMENT ;
   }

   for (;(i=input())=='`';) ;
   if (i=='(')
   {
      BEGIN other ; 
      kill_next_space = 1 ;
      if (prev==1) 
      {
         next = dontlast = 1 ;
         code = INFUNCNAME ;
         return CONCATENATE ; 
      }
      last = 0 ;
      return INFUNCNAME ; 
   }
   else
   {
      unput((YY_CHAR)i) ;
   }

   if (in_call)
   {
      kill_next_space = 1 ;
      BEGIN other ;
      in_call = 0 ;
      last = 1 ;
      return SIMSYMBOL ;
   }

   BEGIN other ;
   if ((prev==1)&&(!in_parse)) {
      next = 1 ;
      code = SIMSYMBOL ;
      return CONCATENATE ; }

   last = 1 ;
   return SIMSYMBOL ; }


{bl}\) {
   last = 1 ;
   return ')' ; }

\({bl} {
   BEGIN other ;
   if (prev==1) 
   {
      next = dontlast = 1 ;
      code = '(' ;
      return CONCATENATE ; 
   }
   return '(' ; }

{bl}\,{bl} {
   return ',' ; }

{bl}\-{bl} {
   BEGIN other ;
   return '-' ; }

{bl}\+{bl} {
   BEGIN other ;
   return '+' ; }

{bl}\/{bl} {
   return '/' ; }

{bl}%{bl} {
   return '%' ; }

{bl}\*{bl} {
   return '*' ; }

{bl}\|{bl} {
   return '|' ; }

{bl}&{bl} {
   return '&' ; }

{bl}={bl} {
   return '=' ; }

{not}{bl} {
   /* why don't I have a {bl} in the beginning of this re? bug? */
   BEGIN other ;
   return NOT ; }

{bl}(\>|{not}{bl}(\<{bl}=|={bl}\<)){bl} {
   return GT ; }

{bl}({not}{bl}\<|={bl}\>|\>{bl}=){bl} {
   return GTE ; }

{bl}(\<|{not}{bl}(\>{bl}=|={bl}\>)){bl} {
   return LT ; }

{bl}({not}{bl}\>|={bl}\<|\<{bl}=){bl} {
   return LTE ; }

{bl}({not}{bl}=|\<{bl}\>|\>{bl}\<){bl} {
   return DIFFERENT ; }

{bl}={bl}={bl} {
   return EQUALEQUAL ; }

{bl}{not}{bl}={bl}={bl} {
   return NOTEQUALEQUAL ; }

{bl}\/{bl}\/{bl} { 
   return MODULUS ; } 

{bl}&{bl}&{bl} { 
   return XOR ; }

{bl}\|{bl}\|{bl} { 
   return CONCATENATE ; }

{bl}\*{bl}\*{bl} { 
   return EXP ; } 

{bl}[ \t]{bl} { 
   if (kill_this_space)
   {
      return yylex() ;
   }
   if (in_address)
   {
      in_address = 0 ;
      return yylex() ;
   }
   return (((in_parse)&&(!seek_with)) ? yylex() : SPACE) ; }

['"]  { exiterror( ERR_UNMATCHED_QUOTE ) ; } 


[^A-Za-z0-9 \t\n@#$&|.?!_*()+=%\\^'";:<,>/-] {
                             exiterror( ERR_INVALID_CHAR ) ; }

:            { exiterror( ERR_SYMBOL_EXPECTED );}

.            { exiterror( ERR_INTERPRETER_FAILURE ) ; }


%%

#define NORMALSTAT  0
#define COMMENTSTAT 1
#define SINGLEQUOTE 2
#define DOUBLEQUOTE 3

void myungetc( int ch, FILE *str ) ;
int linenr=1 ;
nodeptr currentnode=NULL ;
static int singlequote=0, doblequote=0 ; 

static int firstln=0 ;


YY_CHAR_TYPE *rmspc( YY_CHAR_TYPE *instr ) 
{
   YY_CHAR_TYPE ch ;
   int i, j=0 ;

   for (i=0;instr[i];i++) {
      ch = instr[i] ;
      if ('a' <= ch && ch <= 'z')
         instr[j++] = ch & 0xDF ;
      else if ((ch!=' ') && (ch!=',') && (ch!='\t') && (ch!='\n'))
         instr[j++] = ch ; }
   instr[j] = 0x00 ;
 
   return( instr ) ;
}


int bufptr=0 ;
/* Previous bug. 8-bits clean combined with EOF ==> need at least short */
short chbuffer[LOOKAHEAD] ;
int ipretflag=0, cch=0 ;
char *interptr=NULL ;
int cchmax = 0 ;
lineboxptr first_source_line=NULL, last_source_line=NULL ;


void init_it_all()
{
   in_numform = 0 ;
   next_numform = 0 ;
   next = last = prev = 0 ;
   obs_with = 0 ;
   in_do = 0 ;
   in_then = 0 ;
   dontlast = 0 ;
   sum = 0 ;
   thischar = 0 ;
   firstln = 0 ;
   nnextstart = 0 ;
   in_parse = 0 ;
   in_trace = 0 ;
   itflag = 0 ;
   in_signal = 0 ;
   in_call = 0 ;
   in_address = 0 ;
   seek_with = 0 ;
   kill_this_space = 0 ;
   kill_next_space = 1 ;
   ipretflag = 0 ;
   do_level = 0 ;
   singlequote = doblequote = 0 ;
   cch = bufptr = 0 ;
}

void initexternal( FILE *fptr ) 
{
   extern char *interptr ; 
   extern int linenr ;
#ifdef FLEX_SCANNER
   extern int yy_init ;
#else
#ifdef HPUX
   extern YY_CHAR_TYPE *yysptr, yysbuf[] ;
#else
   extern YY_CHAR_TYPE *yysptr, yysbuf[] ;
#endif
#endif
   extern int ipretflag, cch, bufptr ;

   first_source_line = last_source_line = NULL ;
   linenr = nextstart = nextline = 1 ;
   init_it_all() ;
   yyin = fptr ;

   /* BUG. Fix this, or be hanged. Will not handle recursive 
      interpretations. */
   bufptr=0;
#ifdef FLEX_SCANNER
   yy_init = 1 ;
#else
   yysptr = yysbuf ;
#endif
   BEGIN comm ;
}

char *interptrmax ;


void initinterpret( streng *str )
{
   extern char *interptr ; 
#ifdef FLEX_SCANNER
   extern int yy_init ;
#else
#ifdef HPUX
   extern YY_CHAR_TYPE *yysptr, yysbuf[] ;
#else
   extern YY_CHAR_TYPE *yysptr, yysbuf[] ;
#endif
#endif
   extern int ipretflag, cch, bufptr ;

   first_source_line = last_source_line = NULL ;
   cch = bufptr = 0 ;
   init_it_all() ;
   ipretflag = 1 ;
   /* BUG. Fix this, or be hanged. Will not handle recursive 
      interpretations. */
   bufptr=0;
   singlequote = doblequote = 0 ;

#ifdef FLEX_SCANNER
   yy_init = 1 ;
#else
   yysptr = yysbuf ;
#endif
   BEGIN comm ;
   cchmax = str->len ;
   interptr = str->value ;
   interptrmax = interptr + cchmax ;
}


void initmacro( streng *str )
{
   extern char *interptr ; 
#ifdef FLEX_SCANNER
   extern int yy_init ;
#else
#ifdef HPUX
   extern YY_CHAR_TYPE *yysptr, yysbuf[] ;
#else
   extern YY_CHAR_TYPE *yysptr, yysbuf[] ;
#endif
#endif
   extern int ipretflag, cch, bufptr ;

   first_source_line = last_source_line = NULL ;
   linenr = nextstart = nextline = 1 ;
   thischar = 0 ;

   singlequote = doblequote = 0 ;
   firstln = 0 ;
   init_it_all() ;
   do_level = 0 ;
   in_parse = 0 ;
   cch = bufptr = 0 ;
   ipretflag = 1 ;
   
   /* BUG. Fix this, or be hanged. Will not handle recursive 
      interpretations. */
   bufptr=0;
#ifdef FLEX_SCANNER
   yy_init = 1 ;
#else
   yysptr = yysbuf ;
#endif
   BEGIN comm ;
   interptrmax = str->value + str->len ;
   cchmax = str->len ;
   interptr = str->value ;
}


void initvalue( streng *str )
{
   extern int isvalue, yy_start ;
#ifdef FLEX_SCANNER
   extern int yy_init ;
#endif
   
   init_it_all() ;
   in_parse = 0 ;
   do_level = 0 ;
   singlequote = doblequote = 0 ;
   initinterpret( str ) ;
   BEGIN other ;
#ifdef FLEX_SCANNER
   yy_init = 1 ;
#endif
}


int mygetc( FILE *str )
{
   extern int nextline ;
   lineboxptr newline ;
   extern int linenr, bufptr ;
   extern sysinfo systeminfo ;
   extern short chbuffer[] ;
   extern int cch ;
   extern char *interptrmax ;
   extern int thischar ;
   static char thisline[BUFFERSIZE] ;
   int nextchar ;
   static int  previous=0x0a ;
   extern int ipretflag ;
   extern char *interptr ;

   if (bufptr>0) 
   {
      thischar++ ;
      return chbuffer[--bufptr] ;
   }
   else if (ipretflag) 
   {
      if (interptr>=interptrmax)
      {
         myungetc(EOF,yyin) ;
         nextchar = 0x0a ; 
         cch++ ;
      } 
      else
         thisline[cch++] = nextchar = *interptr++ ; 
   }
   else
   {
      thisline[cch++] = nextchar = getc(str) ;
      if ((previous!=0x0a) && (nextchar==EOF))
      {
         myungetc(EOF,yyin) ;
         nextchar = 0x0a ;
      }
      previous = nextchar ;
   }

   thisline[cch] = nextchar = (nextchar) ? nextchar : EOF ;
   thischar++ ;
   if (nextchar=='\n')
      nextline++ ;

   if (cch>=BUFFERSIZE) 
      exiterror(12) ;

   if ((nextchar=='\n')) {
      thischar = 0 ;
      thisline[--cch] = 0x00 ;
      newline = (lineboxptr)Malloc(sizeof(linebox)) ;
      newline->line = Str_cre( thisline ) ;
      newline->prev = last_source_line ;
      newline->next = NULL ;
      newline->lineno = linenr++ ; 
      cch = 0 ;
      if (first_source_line==NULL) 
         first_source_line = newline ;
      else
         last_source_line->next = newline ; 
      last_source_line = newline ; }

   return ( nextchar ) ;
}


void myungetc( int ch, FILE *str )
{
   extern int linenr, bufptr ;
   extern short chbuffer[] ;

   thischar-- ;
   chbuffer[bufptr++] = (short)ch ;
}


int mygetchar()
{
   static char buff[BUFFERSIZE] ;
   int ptr=0, this ;
   static int prev, haveprev=0 ;
   extern FILE *yyin ;

   if (haveprev==1) {
      haveprev = 0 ;
      this=prev ; }
   else
      this = mmygetchar() ;

   if ((this==',')&&(!singlequote)&&(!doblequote)) {
      this = mmygetchar() ;
      while ((this==' ')||(this=='\t')||(this=='`')) {
         this = mmygetchar() ; }

      if (this=='\n') 
         return (int)' ' ;

      prev = this ;
      haveprev = 1 ;
      return (int)',' ; }

   return this ;
}


int mmygetchar()
{
   int this, next, lev ;
   extern FILE *yyin ;

   this = mygetc( yyin ) ;

   if (firstln==0) 
   {
      firstln = 1 ;
      if (this=='#') 
      {
         for (;(this!=0x0a) && (this!=EOF); this=mygetc(yyin) ) ;
         this = mygetc(yyin) ;
      }
   }

   if ((this==0x0a) && (doblequote || singlequote))
      exiterror( ERR_UNMATCHED_QUOTE ) ;

   if ((this=='\'')&&(doblequote==0))
      singlequote = (singlequote==0) ;

   if ((this=='"')&&(singlequote==0))
      doblequote = (doblequote==0) ;

   if ((this=='`')&&(singlequote==0)&&(doblequote==0))
      exiterror(13) ;

   if ((this=='/')&&(singlequote==0)&&(doblequote==0)) {
      if ((next = mygetc(yyin))=='*') {
         for (lev=1;lev>0;) {
            if ((next=mygetc(yyin))=='*') {
               if ((next=mygetc(yyin))=='/')
                  lev-- ;
               else
                  myungetc(next,yyin) ; }
#ifdef NESTEDCOMMENTS
            else if (next=='/') {
               if ((next=mygetc(yyin))=='*')
                  lev++ ;
               else
                  myungetc(next,yyin) ; }
#endif
            else if (next==EOF)
               exiterror( ERR_UNMATCHED_QUOTE ) ;
               }
         this = '`' ; }
      else
         myungetc(next,yyin) ; }

   return( this ) ;
}


void initscanner()
{
#ifdef FLEX_SCANNER
   yy_init = 1 ;
#endif
   singlequote = doblequote = 0 ;
   do_level = 0 ;
   BEGIN comm ;
}


void striptext( char *text )
{
   int i, j=0 ;

   for (i=0; text[i]; i++) {
      if ('a' <= text[i] && text[i] <= 'z')
         text[i] &= 0xDF ;
      if (('A'<=text[i] && text[i]<='Z'))
         text[j++] = text[i] ; }

   text[j] = 0x00 ;
}


/* just so we can trap mismatch of comments or quotes */
int ret_yy_null()
{
   return 0 ;
}

int yywrap()
{
   assert( do_level>= 0 ) ;
   if (do_level>0)
      exiterror( ERR_INCOMPLETE_STRUCT ) ;
   return 1 ;
}
