preamble.c

編譯器的辭法分析器工具

          atsignalled=1;

                             /* if it is, allow escaped linefeeds */

        if (atsignalled && (buff[n-1]=='\\')){
                             /* escaped newline, so .. 
                              * .. chop off the escape and .. */
          buff += --n;       /* .. we go round again */

          nbuff--;           /* we knock off one from our buffer count */
          continue;
        }

        if (!atsignalled) {
                              /* ordinary token return. just ... 
                               * ... crank our buffer */
            nbuff--;          /* remember that nbuff>0 so this is OK */
            yylen=0;

            return (yytchar=(int)(yylval=(VALUE)(int) *++yylloc));

         }

              /* we're here because we're in an @ sequence without an
                 escaped linefeed */

          switch (c=getchar()){
            default:          /* we peeked at the next line ... */
                              /* and it didn't start with @, so ... */
              ungetc((int)c,stdin);
                              /* we finished the readahead, and ... */
                              /* can start unloading tokens */
              nbuff--;        /* remember that nbuff>0 so this is OK */
              yylen=1;

              return (yytchar=(int)(yylval=(VALUE)(int) *++yylloc));        

            case '@':          /* or it did start @, so eat the '@' --
                                * now it won't be seen next time */
                        
              buff += n;
              continue;   /* and go round again */
          }

        } /* endwhile*/

        /*  we're here because gets() failed */

        yytchar=EOF;                          /*  EOF encountered */
        yylloc=NULL;          /* signal that readahead buffer is empty */
        yylen=0;
        return ((int)(yylval=(VALUE)0));
}

CHARS GNAME(CHARS x)
/*
        Return "f" from "f(a,b,c)". Return "f" from "f".
        The returned pointer is safe until  UNSETNAME.
*/
{
        static char *a;
        getname(&a);        /* finish off last name */
        a=strchr(x,'(');
        if (a) {
                *a = 0;
                putname(x);
                *a = '(';
                }
        else
                putname(x);
        getname(&x);
        return(x);
}


CHARS findbrkt(a, x, b, s, nargs)
/*
if *x is '(' then find the matching ')' and return its address.
If there is no match, return 0. If *x is not '(', find the
closing bracket which matches the first open bracket encountered.

Also count the 1st level true separators s encountered in nargs.
*/
register char a, b, s;
CHARS x;
int *nargs;
{
        register char c;
        static int n;               /* the level count */
        n=0;

    if(nargs) *nargs=0;

        while(0!=(c=*x++)){
                if(c=='"') {       /* get to the end of the string */
                        while(0!=(c=*x++)) {
                                if(c=='\\') {
                                    if(0!=(c=*x++))
                                        continue;
                                    else
                                        return --x; /* with prejudice */
                                }
                                if(c=='"')
                                        break;
                                /* else keep looking */
                        }
                        /* now x is one beyond the end of the string */
                        continue;  /* now look for a comma */
                }
                else if(c=='\'') {
                        while(0!=(c=*x++)) {
                                if(c=='\\') {
                                     if(0!=(c=*x++))
                                          continue;
                                     else
                                        return --x; /* with prejudice */
                                }
                                if(c=='\'')
                                        break;
                                /* else keep looking */
                        }
                        /* now x is one beyond the end of the quote */
                        continue;
                }
                else if (c==a) {
                        /* found an open bracket */
                        n++;
                        /* now x is one beyond the end of the quote */
                        continue;
                 }
                else if(c==b) {
                        if(--n<0)
                            return --x;    /* bad news */
                }
                else if(c==s) {
                        /* found a seperator */
                        if(n==0)
                             if(nargs) (*nargs)++;
                        /* now x is one beyond the seperator */
                        continue;
                }
                                 
        }

        return(NULL);
}


CHARS GARGS(CHARS x)
/*
        Return "a,b,c" from "f(a,b,c)". Return "" from "f".
        The returned pointer is safe until  UNSETNAME.
*/
{
        static CHARS a, b; static int nargs;

        getname(&a);                /* finish off the last word */
        a=strchr(x,'(');
        if (a) {
                b = findbrkt('(',++a,')',',',&nargs);
                if (b)  {
                        *b=0;
                        putname(a);
                        *b = ')';
                        }
                /* else
                        putname(a); */
                }
        getname(&x);
        return(x);
}

CHARS CATFUNCARGS(CHARS x)
/*
        Turn "f(a,b,c,d)" into "f,4,a,b,c,d". Turn "f" into "f,0".
        The returned pointer is safe until  UNSETNAME.
*/
{
        static CHARS brkt1, brkt2, arg1; static int nargs;
        static char numbuff[32];

        brkt1=(CHARS)strchr(x,'(');
        if ((int)brkt1!=(int)NULL) {
                *brkt1=0;
                putname(x);  /* write the function name */
                *brkt1='(';
                            

        /* this is where we want to find the corresponding ')'.
           We are sure that we start at a '(', so we can't
           get b=a back again. */

        arg1=brkt1;
        while(0!=*++arg1)
             if((*arg1!=' ')||(*arg1!='\t')) break; 
                brkt2 = findbrkt('(',arg1,')',',',&nargs);
                
                if ((int)brkt2!=(int)NULL)  {/* there is a 2nd bracket */
                        *brkt2=0;
                        if((int)brkt2!=(int)arg1){
                                         /* & it wasn't an empty one */
                                putname(",");
                sprintf(numbuff,"%d",nargs+1); /* (int)%d maybe? */
                putname(numbuff);
                                putname(",");
                                putname(arg1);
                        }
            else                     /* it was empty */
                putname(",0");       /* (int)0 maybe? */
                        *brkt2 = ')';
            
                }
                else                  /* no second bracket!! IMPOSSIBLE */
                            /*putname(brkt1);*/
                putname(",0");       /* (int)0 maybe? */
        }

        else    {            /* there are no args */
                putname(x);
                putname(",0");      /* (int)0 maybe? */
        }

        getname(&x);
        return(x);
}

CHARS UNSETNAME(CHARS x)
/* identity action on x with side-effect of resetting agents */
{
        /*CHARS resetagent();

        resetall();*/
        return(x);
}

VOID GETANAME(CHARS *n, CHARS x, CHARS z, int nid)
/* use list z for vars and write "x<nid>(var1,...,vark)" in n */
{
        static CHARS y;
        static char mybuff[SMALLBUFFERSIZE];

        sprintf(&mybuff[0],"%s%d",x,nid);
        y = putname((CHARS)&mybuff[0]); /* y is the beginning of the cache */

        putname((CHARS)"(");
        y+=strlen(y);                 /* now we're where the args start */
        putname(z);

        putname((CHARS)")");
        getname(n);
}

VOID GETNEWNAME(CHARS *n, CHARS x)
/* use list x for vars and write "newname(var1,...,vark)" in n */
{
 
        static int nid;                                /* new id counter */

        GETANAME(n, "hid", x, nid++);

}
                 

int is_in(CHARS x,CHARS y)
/*
  y should be a comma separated list, with y[-1]='('.
  x is a simple name.
*/
{
        register CHARS z;
        int n;

        n=strlen(x);
        while (1)
        {

        /* look for substring matching x in y */

                z = strstr((char*)y,(char*)x);

                if (z==NULL)

        /* I didn't see any */

                        return(0);

                if ((z==y || z[-1]==',') &&

         /* hmm. Possible. It starts off right.  */

                        (z[n]==0 || z[n]==',' ))

        /* and it ends ok too. Accept the match. */

                        return(1);

        /* No match. Try again. Increase y to next comma position+1 */

                y = strchr((char*)y,',');
                if (y++ == NULL)
                        break;
        }
        return(0);
}