/*
 * SCSTR.C - string manipulation functions
 *
 * Source Version: 2.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "score.h"

#ifndef EDOM
#define EDOM 16
#endif

#define MBASE 32

#define ishexdigit(x)                                                        \
    (isdigit(x) ? (x) - '0' :                                                \
                  islower(x) ? (x) + 10 - 'a' : (x) + 10 - 'A')

#ifndef ATOF_FUNCTION
#define ATOF_FUNCTION atof
#endif

#ifndef ATOL_FUNCTION
#define ATOL_FUNCTION atol
#endif

#ifndef STRTOD_FUNCTION
#define STRTOD_FUNCTION strtod
#endif

#ifndef STRTOL_FUNCTION
#define STRTOL_FUNCTION strtol
#endif

SC_lexical_stream
 *SC_current_lexical_stream = NULL;

PFDouble
 SC_atof_hook   = ATOF_FUNCTION,
 SC_strtod_hook = STRTOD_FUNCTION;

PFLong
 SC_otol_hook   = _SC_otol,
 SC_htol_hook   = _SC_htol,
 SC_atol_hook   = ATOL_FUNCTION,
 SC_strtol_hook = STRTOL_FUNCTION;

static int
 SC_DECLARE(_SC_lex_putc, (int c)),
 SC_DECLARE(_SC_lex_getc, (byte)),
 SC_DECLARE(_SC_lex_push, (int c)),
 SC_DECLARE(_SC_lex_wrap, (byte));

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
 
/* SC_BLANKP - return TRUE if the string s is blank or a comment
 *           - and FALSE otherwise
 */
 
int SC_blankp(s, chr)
   char *s, *chr;
   {int c;

    if (strchr(chr, (int) s[0]) != NULL)
       {if (strchr(" \t\r\n", s[1]) != NULL)
           return(TRUE);}

    else
       switch (*s)
          {case '\0' :
           case '\n' :
	        return(TRUE);

           default :
	        while (TRUE)
		   {c = *s++;
		    if (c == '\0')
		       return(TRUE);

		    if (strchr(" \t\r\n", c) == NULL)
		       return(FALSE);};};

    return(FALSE);}
  
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_STOF - string to double
 *         - returns 0.0 if string is NULL
 */

double SC_stof(s)
   char *s;
   {if (s == NULL)
       return(0.0);
    else
       return(ATOF(s));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_STOI - string to integer
 *         - returns 0 if string is NULL
 */

int SC_stoi(s)
   char *s;
   {if (s == NULL)
       return(0);
    else
       return(atoi(s));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_STOL - string to long integer
 *         - returns 0 if string is NULL
 */

long SC_stol(s)
   char *s;
   {if (s == NULL)
       return(0);
    else
       return(ATOL(s));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
        
/* _SC_ATOF - a fast, working version of ATOF */

double _SC_atof(ps)
   char *ps;
   {int sign;
    Register int val, i, pwr, exponent;
    double accum;
    char *s;
    char *p;

    sign  = 1;
    s     = ps;
    accum = 0;

/* get past white space */
    for (p = s; (*p == ' ') || (*p == '\n') || (*p == '\t'); p++);
        
    if ((*p == '+') || (*p == '-'))
       sign = (*(p++) == '+') ? 1 : -1;

    for (val = 0, i = 0; (*p >= '0') && (*p <= '9'); p++, i++)
        {if (i < 4)
            val = 10*val + *p - '0';
         else
            {accum = accum*1.0e4 + val;
             val   = *p - '0';
             i     = 0;};};

    if (*p == '.')
       p++;

    for (pwr = 0; (*p >= '0') && (*p <= '9'); p++, i++)
        {if (i < 4)
            {val = 10*val + *p - '0';
             pwr--;}
         else
            {accum = accum*1.0e4 + val;
             val   = *p - '0';
             pwr--;
             i = 0;};};

    if (i != 0)
       {for (; i < 4; i++, pwr--)
            val *= 10;
        accum = accum*1.0e4 + val;};

    accum*=sign;
        
    if ((*p == 'D') || (*p == 'E') ||
        (*p == 'd') || (*p == 'e'))
       p++;

    sign = 1;
    if ((*p == '+') || (*p == '-'))
       sign = (*(p++) == '+') ? 1 : -1;

    for (exponent = 0; (*p >= '0') && (*p <= '9'); p++)
        exponent = 10*exponent + *p - '0';

    exponent *= sign;
    ps        = p;
    pwr      += exponent;

    return(accum*pow(10.0, (double) pwr));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_STRTOD - correct version of C library function strtod */

double _SC_strtod(nptr, endptr)
   char *nptr;
   char **endptr; 
   {char next,                            /* next character in ascii string */
         *ptr;                                   /* pointer to ascii string */
    int dpseen;

    dpseen = FALSE;

/* skip the white space */
    ptr = nptr;
    next = *ptr;
    while (isspace(next))
       next = *++ptr;

/* collect the fraction digits, record decimal point position if present */
    if ((next == '+') || (next == '-') || (next == '.'))
       {next = *++ptr;
        if (next == '.')
           {next = *++ptr;
            dpseen = TRUE;};};

/* illegal digit string in fraction */
    if (((next < '0') || (next > '9')) && (next != '.'))
       {errno = EDOM;
        if (endptr != NULL)
           *endptr = ptr;
        return(0);};

    while (((next >= '0') && (next <= '9')) || (next == '.'))
       {switch(next)
           {case '.' : if (dpseen)   /* illegal string - two decimal points */
                          {errno = EDOM;
                           if (endptr != NULL)
                              *endptr = ptr;
                           return(0);};
            default  : break;};
        next = *++ptr;};

/* collect exponent digits, if present */
    if ((next == 'e') || (next == 'E') ||
        (next == 'd') || (next == 'D') ||
	(next == '+') || (next == '-'))
       {next = *++ptr;

        if ((next == '+') || (next == '-'))
           next = *++ptr;

/* illegal digit string in exponent */
        if (!isdigit(next))
           {errno = EDOM;
            if (endptr != NULL)
               *endptr = ptr;
            return(0.0);};

        while (isdigit(next))
           next = *++ptr;};

/* return, setting endptr appropriately */
    if (endptr != NULL)
       *endptr = ptr;

    return(_SC_atof(nptr));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_STRTOL - strtol done right (since some libraries are bad) */

long int _SC_strtol(str, ptr, base)
   char *str;
   char **ptr;
   int base;
   {long val;
    Register int c;
    int xx, neg = 0;

/* in case no number is formed */
    if (ptr != (char **) 0)
       *ptr = str;

/* base is invalid -- should be a fatal error */
    if (base < 0 || base > MBASE)
       return (0);

    if (!isalnum(c = *str))
       {while (isspace(c))
           c = *++str;
        switch (c)
           {case '-' : neg++;
            case '+' : c = *++str;};};                      /* fall-through */

    if (base == 0)
       if (c != '0')
          base = 10;
       else if (str[1] == 'x' || str[1] == 'X')
          base = 16;
       else
          base = 8;

/* for any base > 10, the digits incrementally following
 * 9 are assumed to be "abc...z" or "ABC...Z"
 */
    if (!isalnum(c) || (xx = ishexdigit(c)) >= base)
       return(0);                                       /* no number formed */

/* skip over leading "0x" or "0X" */
    if ((base == 16) && (c == '0') && isxdigit(str[2]) &&
        ((str[1] == 'x') || (str[1] == 'X')))
       c = *(str += 2);

/* accumulate neg avoids surprises near MAXLONG */
    for (val = -ishexdigit(c);
         isalnum(c = *++str) && (xx = ishexdigit(c)) < base; )
        val = base * val - xx;

    if (ptr != (char **) 0)
       *ptr = str;

    return(neg ? val : -val);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_OTOL - string representation of octal number to long int converter */

long int _SC_otol(str)
   char *str;
   {return(STRTOL(str, NULL, 8));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_HTOL - string representation of hex number to long int converter */

long int _SC_htol(str)
   char *str;
   {return(STRTOL(str, NULL, 16));}

/*--------------------------------------------------------------------------*/

/*                           STRING SORT ROUTINES                           */

/*--------------------------------------------------------------------------*/

/* SC_STRING_SORT - sort an array of character pointers
 *                - by what they point to
 */

void SC_string_sort(v, n)
   char **v;
   int n;
   {int gap, i, j;
    char *temp;

    for (gap = n/2; gap > 0; gap /= 2)
        for (i = gap; i < n; i++)
            for (j = i-gap; j >= 0; j -= gap)
                {if (strcmp(v[j], v[j+gap]) <= 0)
                    break;
                 temp     = v[j];
                 v[j]     = v[j+gap];
                 v[j+gap] = temp;};
    return;}

/*--------------------------------------------------------------------------*/

/*                    LEXICAL SCANNER SUPPORT ROUTINES                      */

/*--------------------------------------------------------------------------*/

/* SC_OPEN_LEXICAL_STREAM - open up a stream for lexical scanning
 *                        - Arguments:
 *                        -
 *                        -  NAME    - name of file or NULL for stdin
 *                        -  INBFSZ  - byte size of input buffer or
 *                        -            MAXLINE if 0
 *                        -  STRBFSZ - byte size of string buffer or
 *                        -            MAX_LEN_BUFFER if 0
 *                        -  SCAN    - scanning function such as yylex (int)
 *                        -  INPUT   - input function (int)
 *                        -            SC_lex_getc used if NULL
 *                        -  OUTPUT  - output function (int)
 *                        -            SC_lex_putc used if NULL
 *                        -  UNPUT   - unput function (int)
 *                        -            SC_lex_push used if NULL
 *                        -  WRAP    - wrap function (int)
 *                        -            _SC_wrap used if NULL
 *                        -  MORE    - more function (int)
 *                        -  LESS    - less function (int)
 */

SC_lexical_stream *SC_open_lexical_stream(name, inbfsz, strbfsz,
                                          scan, input, output,
					  unput, wrap, more, less)
   char *name;
   int inbfsz, strbfsz;
   PFInt scan, input, output, unput, wrap, more, less;
   {SC_lexical_stream *str;

    str = FMAKE(SC_lexical_stream, "SC_OPEN_LEXICAL_STREAM:str");

/* set up the file */
    if (name != NULL)
       {str->name = SC_strsavef(name,
                    "char*:SC_OPEN_LEXICAL_STREAM:name");
        str->file = io_open(name, "r");}
    else
       {str->name = NULL;
        str->file = stdin;};

/* allocate the token space */
    str->n_tokens_max = 50;
    str->n_tokens     = 0;
    str->tokens       = FMAKE_N(SC_lexical_token, 50,
				"SC_OPEN_LEXICAL_STREAM:tokens");

/* allocate the buffers */
    if (inbfsz != 0)
       {str->in_bf  = FMAKE_N(char, inbfsz,
	                      "SC_OPEN_LEXICAL_STREAM:in_bf");
        str->out_bf = FMAKE_N(char, inbfsz,
			      "SC_OPEN_LEXICAL_STREAM:out_bf");}
    else
       {str->in_bf  = FMAKE_N(char, MAXLINE,
			      "SC_OPEN_LEXICAL_STREAM:in_bf");
        str->out_bf = FMAKE_N(char, MAXLINE,
			      "SC_OPEN_LEXICAL_STREAM:out_bf");}

    if (strbfsz != 0)
       str->str_bf = FMAKE_N(char, strbfsz,
			     "SC_OPEN_LEXICAL_STREAM:str_bf");
    else
       str->str_bf = FMAKE_N(char, MAX_LEX_BUFFER,
			     "SC_OPEN_LEXICAL_STREAM:str_bf");

    str->str_ptr = str->str_bf;
    str->in_ptr  = str->in_bf;
    str->out_ptr = str->out_bf;

/* set up the assocaited functions */
    str->scan = scan;
    str->more = more;
    str->less = less;

    if (input != NULL)
       str->inp = input;
    else
       str->inp = _SC_lex_getc;

    if (output != NULL)
       str->out = output;
    else
       str->out = _SC_lex_putc;

    if (input != NULL)
       str->unp = unput;
    else
       str->unp = _SC_lex_push;

    if (wrap != NULL)
       str->wrap = wrap;
    else
       str->wrap = _SC_lex_wrap;

    return(str);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_CLOSE_LEXICAL_STREAM - close an SC_lexical_stream and clean up the
 *                         - memory
 */

void SC_close_lexical_stream(str)
   SC_lexical_stream *str;
   {if (str->name != NULL)
       {io_close(str->file);
        SFREE(str->name);};

    SFREE(str->tokens);
    SFREE(str->in_bf);
    SFREE(str->out_bf);
    SFREE(str->str_bf);

    SFREE(str);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_SCAN - using an automatically generated lexical scanner
 *         - scan the given input string and break it down into
 *         - its lexical tokens
 *         - STR is the SC_lexical_stream
 *         - if RD is TRUE, read a line from STR before scanning
 *         - return the number of tokens read and available
 *         - return -1 if RD is TRUE and EOF has been found
 */

int SC_scan(str, rd)
   SC_lexical_stream *str;
   int rd;
   {int sz;
    char *in, *out;

    if (str->tokens == NULL)
       return(-1);

    memset(str->tokens, 0, str->n_tokens_max*sizeof(SC_lexical_token));

    in  = str->in_bf;
    out = str->out_bf;

    str->i_token  = 0;
    str->n_tokens = 0;
    str->str_ptr = str->str_bf;
    str->in_ptr  = in;
    str->out_ptr = out;

    if (rd)
       {sz = SC_arrlen(out);
        memset(out, 0, sz);

        sz = SC_arrlen(in);
        if (GETLN(in, sz, str->file) == NULL)
           return(-1);};

    SC_current_lexical_stream = str;

    SC_LEX_SCAN(str);

    SC_current_lexical_stream = NULL;

    return(str->n_tokens);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_GET_NEXT_LEXICAL_TOKEN - get the next lexical token from the
 *                           - given lexical stream
 *                           - return NULL if no tokens available
 *                           - NOTE: do we want to distinguish between
 *                           -       EOL, EOF, and an error or
 *                           -       should we leave that to the
 *                           -       lexical scanning rules?
 */

SC_lexical_token *SC_get_next_lexical_token(str)
   SC_lexical_stream *str;
   {SC_lexical_token *tok;

/* if no more tokens in the buffer, scan some more from the stream */
    if (str->i_token >= str->n_tokens)
       {SC_scan(str, TRUE);
        if (str->n_tokens == 0)
           return(NULL);};

    tok = &str->tokens[str->i_token++];

    return(tok);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_LEX_PUSH_TOKEN - called by automatically generated lexical scanners
 *                   - such as FLEX to push a token onto an array
 */

#ifdef PCC

void SC_lex_push_token(type, va_alist)
   int type;
   va_dcl

#endif

#ifdef ANSI

void SC_lex_push_token(int type, ...)

#endif

   {int indx;
    char *s;
    SC_lexical_stream *str;

    SC_VA_START(type);

    str  = SC_current_lexical_stream;
    indx = str->n_tokens++;

    str->tokens[indx].type = type;

    switch (type)
       {case SC_CMMNT_TOK  :
        case SC_STRING_TOK :
        case SC_IDENT_TOK  :
        case SC_KEY_TOK    :
        case SC_OPER_TOK   :
        case SC_PRED_TOK   :
        case SC_DELIM_TOK  :
        case SC_WSPC_TOK   :
        case SC_HOLLER_TOK :
             s = SC_VA_ARG(char *);
	     strcpy(str->str_ptr, s);
             str->tokens[indx].val.s = str->str_ptr;
	     str->str_ptr += strlen(s) + 1;
             break;

        case SC_DINT_TOK   :
        case SC_HINT_TOK   :
        case SC_OINT_TOK   :
             str->tokens[indx].val.l = SC_VA_ARG(long);
             break;

        case SC_REAL_TOK   :
             str->tokens[indx].val.d = SC_VA_ARG(double);
             break;

        default            :
             break;};

    SC_VA_END;

    if (str->n_tokens >= str->n_tokens_max)
       {str->n_tokens_max += 50;
        REMAKE_N(str->tokens, SC_lexical_token, str->n_tokens_max);};

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_LEX_PUTC - a function to attach to the lexical scanner output macro */

static int _SC_lex_putc(c)
   int c;
   {*SC_current_lexical_stream->out_ptr++ = c;

    return(c);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_LEX_GETC - a function to attach to the lexical scanner input macro */

static int _SC_lex_getc()
   {return(*SC_current_lexical_stream->in_ptr++);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_LEX_PUSH - a function to attach to the lexical scanner unput macro */

static int _SC_lex_push(c)
   int c;
   {int nb;
    SC_lexical_stream *str;

    str = SC_current_lexical_stream;

    nb = str->in_ptr - str->in_bf;
    if (nb > 0)
       {*(--str->in_ptr) = c;};

    return(c);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_LEX_WRAP - a default EOF handler for lexical scanners */

static int _SC_lex_wrap()
   {return(1);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/