/*
 * SCCTL.C - some core routines used by many packages
 *
 * Source Version: 2.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "score.h"

#ifndef HAVE_NO_RUSAGE
#include <sys/time.h>
#include <sys/resource.h>
#endif

#ifdef SUNMOS
#include <nx.h>
#endif

#ifdef BBN
#define clock getusecclock
#endif

#ifdef MSC
#define unlink remove
#define stat _stat
#define getch _getch
#define kbhit _kbhit
#endif

int
 SC_unary_plus = TRUE,
 Radix = 10,
 *LAST = NULL;

PFfprintf
 putln = (PFfprintf) SC_fprintf;

PFfgets
 getln = (PFfgets) fgets;

char
 CV_Banner[MAXLINE],                  /* Code and Version string for banner */
 SC_line[MAXLINE],                    /* global copy of latest command line */
 pbuffer[MAXLINE],                                          /* print buffer */
 **SC_path = NULL;

int
 Zero_I  = 0,
 One_I   = 1,
 Two_I   = 2,
 Three_I = 3,
 Four_I  = 4;

double
 Zero_D  = 0.0,
 One_D   = 1.0,
 Two_D   = 2.0,
 Three_D = 3.0,
 Four_D  = 4.0;

char
 *SC_CHAR_8_S    = "char_8",
 *SC_CHAR_S      = "char",
 *SC_SHORT_S     = "short",
 *SC_INTEGER_S   = "integer",
 *SC_LONG_S      = "long",
 *SC_FLOAT_S     = "float",
 *SC_DOUBLE_S    = "double",
 *SC_STRING_S    = "char *",
 *SC_POINTER_S   = "void *",
 *SC_PCONS_P_S   = "pcons *",
 *SC_VOID_S      = "void",
 *SC_SHORT_P_S   = "short *",
 *SC_INTEGER_P_S = "integer *",
 *SC_LONG_P_S    = "long *",
 *SC_FLOAT_P_S   = "float *",
 *SC_DOUBLE_P_S  = "double *",
 *SC_PCONS_S     = "pcons",
 *SC_STRUCT_S    = "struct",
 *SC_UNKNOWN_S   = "unknown";

char
 *SC_REAL_S    = "double",
 *SC_REAL_P_S  = "double *";

/* declare the IO hooks */

PFfopen io_open_hook      = (PFfopen) fopen;
PFftell io_tell_hook      = (PFftell) F_TELL;
PFfread io_read_hook      = (PFfread) fread;
PFfwrite io_write_hook    = (PFfwrite) fwrite;
PFsetvbuf io_setvbuf_hook = (PFsetvbuf) setvbuf;
PFfclose io_close_hook    = (PFfclose) fclose;
PFfseek io_seek_hook      = (PFfseek) F_SEEK;
PFfprintf io_printf_hook  = (PFfprintf) SC_fprintf;
PFfputs io_puts_hook      = (PFfputs) fputs;
PFfgetc io_getc_hook      = (PFfgetc) fgetc;
PFungetc io_ungetc_hook   = (PFungetc) ungetc;
PFfflush io_flush_hook    = (PFfflush) fflush;
PFfgets io_gets_hook      = (PFfgets) fgets;

SC_address
 _SC_addr_;

jmp_buf
 SC_top_lev;

static int
 SC_DECLARE(_SC_assoc_aux, (pcons *alst, int flag, va_list SC_VA_VAR));

static char
 *SC_DECLARE(_SC_form_file_aux, (char *directory, char *s));

#ifdef MAC
static char
 *SC_DECLARE(_SC_form_file_mac, (char *directory, char *s));
#endif

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

/*                      DOCUMENTATION FUNCTIONS                             */

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

/* SC_BANNER - display a banner/header using the input string */

void SC_banner(s)
   char *s;
   {

    PRINT(STDOUT, "\n     %s     %s", s, CV_Banner);

    return;}

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

/*                          PREDICATES                                      */

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

/* SC_NUMSTRP - tests to see if a string is a number */

int SC_numstrp(s)
   char *s;
   {return(SC_intstrp(s, Radix) || SC_fltstrp(s));}

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

/* SC_INTSTRP - tests to see if a string is an integer in radix BASE */

int SC_intstrp(s, base)
   char *s;
   int base;
   {char *pt;

    if (s == NULL)
       return(FALSE);

    if (!SC_unary_plus && (*s == '+'))
       return(FALSE);

    if ((strcmp(s, "+") == 0) || (strcmp(s, "-") == 0))
       return(FALSE);

    pt = s;
    if (strlen(pt) == 1)
       if (strchr("0123456789", (int) *pt) == NULL)
          return(FALSE);

    STRTOL(s, &pt, base);

    return(pt == (s+strlen(s)));}

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

/* SC_FLTSTRP - tests to see if a string is a float */

int SC_fltstrp(s)
   char *s;
   {char *pt;
    int n;

    if (s == NULL)
       return(FALSE);

    if (!SC_unary_plus && (*s == '+'))
       return(FALSE);

    if ((strcmp(s, "+") == 0) ||
        (strcmp(s, "-") == 0) ||
        (strcmp(s, ".") == 0) ||
        (strcmp(s, "..") == 0))
       return(FALSE);

    n  = strlen(s);
    pt = s;
    if ((strchr("+-.0123456789", (int) s[0]) == NULL) ||
        (strchr(".0123456789", (int) s[n-1]) == NULL))
       return(FALSE);
       
    STRTOD(s, &pt);

    return(pt == (s+n));}

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

/* SC_CHRSTRP - test whether a string is made up of printable characters */

int SC_chrstrp(s)
   char *s;
   {int r = 1;
    char *sp = s;

    if (s == NULL)
       return(FALSE);

    while ((r) && (*sp != '\0'))
       {r = isprint(*sp);
        sp++;};

    return(r);}

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

/*                         AUXILLIARY FUNCTIONS                             */

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

/* SC_INIT_PATH - set up the search path */

#ifdef PCC

void SC_init_path(nd, va_alist)
   int nd;
   va_dcl

#endif

#ifdef ANSI

void SC_init_path(int nd, ...)

#endif

   {char bf[1024], *ptr, *s, *token;
    int j;
    static int i = 0, n = 0;

    if (SC_path == NULL)
       {n = 0;
        i = 0;
        SC_REMEMBER(char *, SC_strsavef(".", "char*:SC_INIT_PATH:period"),
                            SC_path, i, n, 5);};

    SC_VA_START(nd);

    for (j = 0; j < nd; j++)
        {ptr = getenv(SC_VA_ARG(char *));
         if (ptr != NULL)
            {strcpy(bf, ptr);
             ptr = bf;

             while ((token = SC_strtok(ptr, ":", s)) != NULL)
                {SC_REMEMBER(char *, SC_strsavef(token,
                               "char*:SC_INIT_PATH:token"), SC_path, i, n, 5);
                 ptr = NULL;};};};

    SC_VA_END;

    SC_path[i] = NULL;

    return;}

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

/* SC_SIGNAL - handle signals for systems with nonstandard or no signals */

PFSignal_handler SC_signal(sig, fnc)
   int sig;
   PFSignal_handler fnc;
   {

    return(NULL);}

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

/* SC_ALARM - handle alarms for systems with nonstandard or no signals */

unsigned int SC_alarm(sec)
   unsigned int sec;
   {

    return(0);}

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

/* SC_INTERRUPT_HANDLER - handle interrupts in a default sort of way */

void SC_interrupt_handler(sig)
   int sig;
   {char bf[10];

    PRINT(stdout, "\nInterrupt - Quit (q) or Resume (r): ");
    GETLN(bf, 10, stdin);
    switch (bf[0])
       {case 'r' : PRINT(stdout, "Resuming\n\n");
                   break;
        case 'q' : PRINT(stdout, "Exiting program\n\n");
                   exit(1);};

    SIGNAL(SIGINT, SC_interrupt_handler);

    return;}

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

/* SC_REGX_MATCH - returns TRUE iff the first string arg matched the
 *               - regular expression defined by the second string arg
 *               -
 *               - regular expression specifiers (so far)
 *               -
 *               -   '*' matches any number of characters
 *               -   '?' matches any single character
 */

int SC_regx_match(s, patt)
   char *s, *patt;
   {int c;
    char *ps, *pp;

    if (patt == NULL)
       return(TRUE);
    if (s == NULL)
       return(FALSE);

    ps = s;
    pp = patt;
    while ((c = *pp++) != '\0')
       {switch (c)
           {case '*' :
                 while (*pp == '*')
                    pp++;
                 c = *pp;
                 while ((ps = strchr(ps, c)) != NULL)
                    {if (SC_regx_match(ps, pp))
                        return(TRUE);
                     ps++;};
                 return(FALSE);

            case '?' :
                 return(SC_regx_match(++ps, pp));

            case '\\' :
                 c = *pp++;

            default :
                 if (*ps++ != c)
                    return(FALSE);};

        if (((*ps == '\0') && (*pp != '\0') && (*pp != '*')) ||
            ((*ps != '\0') && (*pp == '\0')))
           return(FALSE);};

    if (*ps == '\0')
       return(TRUE);
    else
       return(FALSE);}

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

/* SC_BIT_REVERSE - return an unsigned int whose bit pattern is reversed
 *                - relative to N bits of the input value, I
 */

unsigned int SC_bit_reverse(i, n)
   unsigned int i;
   int n;
   {Register unsigned j;
    int k;

    j = 0;
    for (k = 0; k < n; k++)
        {j <<= 1;
         j |= (i & 1);
         i >>= 1;};

    return(j);}

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

/* SC_BIT_COUNT - count the number of set bits in a n byte quantity
 *              - the number of bytes must be less than or equal
 *              - to sizeof(long)
 */

long SC_bit_count(c, n)
   long c;
   int n;
   {long count;

/* best for sparse bit patterns */
    if (c < 65536L)
       {count = 0L;
        while (c)
           {c ^= (c & -c);
            count++;};}

/* best for dense bit patterns */
    else
       {count = SC_BITS_BYTE*n;
        while (c != -1L)
           {c |= (c + 1);
            count--;};};

    return(count);}

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

/* SC_CHAR_COUNT - count the number of occurence of the specified character
 *               - in the given string
 */

int SC_char_count(s, c)
   char *s;
   int c;
   {int l, count;

    count = 0;
    while ((l = *s++) != '\0')
       count += (l == c);

    return(count);}

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

/* SC_CPU_TIME - return the cpu time used in seconds and microseconds
 *               SINCE THE FIRST CALL!
 */

#ifdef HAVE_NO_RUSAGE

double SC_cpu_time()
   {double dtwc, dt;
    time_t syst;
    static double dtref;
    static time_t systref;
    static clock_t NA = (clock_t) -1;
    static int first = TRUE;

#ifdef SUNMOS
    double s;
#else
    clock_t s;
#endif

    syst = time(NULL);

#ifdef SUNMOS
    while ((s = dclock()) == NA);
#else
    while ((s = clock()) == NA);
#endif

    dt = ((double) s)/((double) TICKS_SECOND);

    if (first)
       {first    = FALSE;
        dtref    = dt;
        systref  = syst;};

    dtwc = syst - systref;

    if (dtwc >= ((double) LONG_MAX / (double) TICKS_SECOND - 1.0))
       dt = dtwc;

    else if (dt >= dtref)
       dt = dt - dtref;

    else
       dt = LONG_MAX + dt - dtref;

    return(dt);}

#else

double SC_cpu_time()
   {struct rusage r;
    static struct rusage r0;
    double ut, st;
    static int first = TRUE;

    getrusage(RUSAGE_SELF, &r);

    if (first)
       {first = FALSE;
        r0 = r;};

    ut = (double) (r.ru_utime.tv_sec  - r0.ru_utime.tv_sec) +
         (double) (r.ru_utime.tv_usec - r0.ru_utime.tv_usec) /
         (double) 1000000;

    st = (double) (r.ru_stime.tv_sec  - r0.ru_stime.tv_sec) +
         (double) (r.ru_stime.tv_usec - r0.ru_stime.tv_usec) /
         (double) 1000000;

    return(ut + st);}

#endif

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

/* SC_WALL_CLOCK_TIME - return the wall clock time in seconds and microseconds
 *                      SINCE THE FIRST CALL!
 */

#ifdef HAVE_NO_RUSAGE

double SC_wall_clock_time()
   {time_t t;
    static time_t t0;
    static int first = TRUE;

    t = time(NULL);

    if (first)
       {first = FALSE;
        t0    = t;};

    return ((double) (t - t0));}

#else

double SC_wall_clock_time()
   {struct timeval t;
    struct timezone tz;
    static struct timeval t0;
    static int first = TRUE;

    gettimeofday(&t, &tz);

    if (first)
       {first = FALSE;
        t0 = t;};

    return((double) (t.tv_sec  - t0.tv_sec) +
           (double) (t.tv_usec - t0.tv_usec) / (double) 1000000);}

#endif

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

/* SC_DATE - return a string with the time and date as defined by the
 *         - ANSI function ctime
 */

#ifdef ANSI

char *SC_date()
   {time_t tm;
    char t[MAXLINE], *s, *pt;

    tm = time(NULL);
    pt = SC_ctime(tm, t, MAXLINE);

    return(SC_strsavef(SC_strtok(t, "\n", s), "char*:SC_DATE:time"));}

#endif

#ifdef PCC

char *SC_date()
   {long tm;
    char t[MAXLINE], *s;

    time(&tm);
    SC_ctime(tm, t, MAXLINE);
    return(SC_strsavef(SC_strtok(t, "\n", s), "char*:SC_DATE:time"));}

#endif

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

/* _SC_FORM_FILE_AUX - help with SC_FORM_FILE
 *                   - return a path specification consisting of the
 *                   - directory and string s
 *                   - any UNIX style directory separators or relations
 *                   - are removed in favor of the host system's designations
 */

static char *_SC_form_file_aux(directory, s)
   char *directory;
   char *s;
   {static char buffer[MAXLINE];
    char *bp;

    if (directory == NULL)
       sprintf(buffer, "%s", s);

    else if (directory[0] == '\0')
       sprintf(buffer, "%s", s);

    else
       sprintf(buffer, "%s%c%s", directory, directory_delim_c, s);

/* replace directory delimiters by the system directory delimiter */
    for (bp = buffer; *bp != '\0'; bp++)
        {if ((*bp == directory_delim_c) || (*bp == '/'))
            *bp = directory_delim_c;};

    return(buffer);}

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

#ifdef MAC

/* _SC_FORM_FILE_MAC - help with SC_FORM_FILE
 *                   - return a path specification consisting of the
 *                   - directory and string s
 *                   - any UNIX style directory separators or relations
 *                   - are removed in favor of the host system's designations
 */

static char *_SC_form_file_mac(directory, s)
   char *directory;
   char *s;
   {static char buffer[MAXLINE];
    char *bp, buf[MAXLINE];
    int i;

    if (directory == NULL)
       sprintf(buf, "%s", s);

    else if (directory[0] == '\0')
       sprintf(buf, "%s", s);

    else
       sprintf(buf, "%s%c%s", directory, directory_delim_c, s);

/* conversion from UNIX to MAC style directories is as follows:
      UNIX        MAC
     /a/b/c      a:b:c
   ../a/b/c    ::a:b:c
      a/b/c     :a:b:c
*/

    buffer[0] = '\0';

    if (buf[0] == '/')
       {
/*       bp = &buf[1];*/
        strcat(buffer, &buf[1]);}
    else
       {strcat(buffer, ":");
        i = 0;
        while (buf[i] == '.' && buf[i+1] == '.' && buf[i+2] == '/')
           {strcat(buffer, ":");
            i += 3;};
/*        bp = &buf[i];*/
        strcat(buffer, &buf[i]);};

/* replace directory delimiters by the system directory delimiter */
    for (bp = buffer; *bp != '\0'; bp++)
        {if ((*bp == directory_delim_c) || (*bp == '/'))
            *bp = directory_delim_c;};

    return(buffer);}

#endif

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

/* SC_SEARCH_FILE - search for a file in the directories in path.
 *                - if found, return the pathname; otherwise, return NULL.
 */

char *SC_search_file(path, name)
   char **path;
   char *name;
   {return(_SC_search_file(path, name, NULL, NULL));}

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

/* _SC_SEARCH_FILE - search for a file in the directories in path of the
 *                 - specified type that can be accessed in the given mode.
 *                 - if found, return the pathname; otherwise, return NULL.
 *                 - if path is NULL, search in the current directory only.
 */

char *_SC_search_file(path, name, mode, type)
   char **path;
   char *name;
   char *mode;
   char *type;
   {int i;
    char *bp, *t, *lst[2];

/* NOTE: remote file access from the MAC has been temporarily disabled, due
         to a conflict in directory designation syntax. This should be fixed
         someday...
*/

#ifndef MAC
/* if this is a remote file just go find it */
    if (strchr(name, ':') != NULL)
       return(name);

    if (name[0] == '/')
       {bp = _SC_form_file_aux("", name);
        if (_SC_query_file(bp, mode, type))
           return(bp);
        else
           return(NULL);}
#endif

    if (path == NULL)
       {lst[0] = ".";
	lst[1] = NULL;
	path   = lst;};

    for (i = 0; TRUE; i++)
        {t = path[i];
         if (t == NULL)
            break;

#ifdef MAC
         if (strcmp(t, ".") == 0)
            bp = _SC_form_file_mac("", name);
         else
            bp = _SC_form_file_mac(t, name);
#else
         bp = _SC_form_file_aux(t, name);
#endif

         if (_SC_query_file(bp, mode, type))
             return(bp);};

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

/* SC_ADVANCE_NAME - increment a sequential name by one
 *                 - assumes name is of the form:
 *                 -    <base>.[a-zA-Z]dd
 *                 -    d = [0-9a-zA-Z]
 */

void SC_advance_name(s)
   char *s;
   {int d1, d2, n;
    char *p;

    p = strchr(s, '.') + 2;
    n = STRTOL(p, NULL, 36) + 1;        

    d1 = n / 36;
    d2 = n % 36;

    if (d1 > 9)
       d1 += 'a' - 10;
    else
       d1 += '0';

    if (d2 > 9)
       d2 += 'a' - 10;
    else
       d2 += '0';

    p[0] = d1;
    p[1] = d2;

    return;}

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

/* SC_ITOA - return an ASCII representation of the given integer in
 *         - the given radix and pad with zeros to the given field width
 */

char *SC_itoa(n, radix, nc)
   int n, radix, nc;
   {int i, r;
    static char bf[MAXLINE];

    for (i = 0; n != 0; i++, n /= radix)
        {r = n % radix;

         if (r > 9)
            r += 'a' - 10;
         else
            r += '0';

         bf[i] = r;};

/* pad with zeros out to field width of nc */
    for (; i < nc; i++)
        bf[i] = '0';

    bf[i] = '\0';
    SC_strrev(bf);

    return(bf);}

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

/* SC_FILELEN - return the length of the given file */

off_t SC_filelen(fp)
   FILE *fp;
   {off_t caddr, flen;

    caddr = F_TELL(fp);
    F_SEEK(fp,(off_t)0, SEEK_END);

    flen = F_TELL(fp);
    F_SEEK(fp, caddr, SEEK_SET);

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

/* _SC_QUERY_FILE - return TRUE if the file is of the given type and can be
 *                - opened in the specified mode; otherwise, return FALSE.
 */

int _SC_query_file(name, mode, type)
   char *name, *mode, *type;
   {FILE *fp;
    int i, n, nt, ret;

#ifndef MAC

    {struct stat sb;

     if (stat(name, &sb))
        return(FALSE);

/* if not a regular file forget it (what about other types: S_IFLNK,
 * S_IFSOCK, S_IFIFO, S_IFBLK, or S_IFCHR?)
 */
     if (!(sb.st_mode & S_IFREG))
        return(FALSE);

     ret = TRUE;
     if (mode == NULL)
        ret = sb.st_mode & S_IREAD;
     else if ((strcmp(mode, "r") == 0) || (strcmp(mode, "rb") == 0))
        ret = sb.st_mode & S_IREAD;
     else
        ret = sb.st_mode & S_IWRITE;};

#else

    if (mode == NULL)
       fp = io_open(name, "r");
    else
       fp = io_open(name, mode);

    ret = (fp != NULL);
    if (fp != NULL)
       io_close(fp);

#endif

    if (ret)
       {if (type != NULL)
           {char bf[MAXLINE];
            int null_lines = 0;
/* type may be const char * and will die when SC_str_lower
 * attempts to change values
 */
            strcpy(bf, type);
            if (strcmp(SC_str_lower(bf), "ascii") == 0)
               {fp = io_open(name, "r");
                for (nt = 0; nt < 2048; nt += n)
                    {if (io_gets(bf, MAXLINE, fp) == NULL)
                        break;
                     n = strlen(bf);
                     if (n == 0)
                        {null_lines++;
/* assume an ascii file won't have more than 20 null lines */      
                         if (null_lines > 20)
                            {ret = FALSE;
                             break;};}
                     for (i = 0; i < n; i++)
                         if (!isprint(bf[i]) && !isspace(bf[i]))
                            ret = FALSE;};
                io_close(fp);}
            else
               ret = FALSE;};};

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

/* SC_ISFILE - return TRUE if the file exists, otherwise return FALSE */

int SC_isfile(name)
   char *name;
   {return(_SC_query_file(name, NULL, NULL));}

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

/* SC_ISFILE_ASCII - return TRUE if the file exists and is ascii,
 *                   otherwise return FALSE
 */

int SC_isfile_ascii(name)
   char *name;
   {return(_SC_query_file(name, NULL, "ascii"));}

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

/* SC_SYSTEM - handle calls to system for systems without standard system */

int SC_system(s)
   char *s;
   {

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

/* SC_REMOVE - ANSI standard remove function */

int SC_remove(s)
   char *s;
   {

    return(unlink(s));}
 
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_PAUSE - give the user a chance to think about things */

void SC_pause()
   {

#ifdef MAC
    EventRecord event;

    while (TRUE)
    
/* Handle the next event */
       {if (!GetNextEvent(everyEvent, &event)) 
            continue;
        switch (event.what)
           {case keyDown : return;
            default      : break;};};
#else

#ifdef DOS        
    while (kbhit() == 0);
    getch();
#else
    char s[10];

    GETLN(s, 9, stdin);
#endif

#endif

    return;}

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

/* SC_SQUEZE_BLANKS - replace consecutive blanks with a single blank
 *                  - and remove leading and trailing blanks
 */

char *SC_squeeze_blanks(s)
   char *s;
   {char *sn, *so;
    if ((s != NULL) && (*s != '\0'))
       {for (so = s; *so == ' '; so++);
        for (sn = s; (*sn = *so) != '\0'; sn++, so++)
           while ((*so == ' ') && (*(so + 1) == ' ')) so++;
        if ((sn > s) && (*(sn - 1) == ' '))
           *(sn - 1) = '\0';};
    return(s);}
 
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_STR_UPPER - upper casify the given string (in place) */

char *SC_str_upper(s)
   char *s;
   {int c;
    char *ps;

    ps = s;
    while ((c = *ps) != '\0')
       *ps++ = toupper(c);

    return(s);}

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

/* SC_STR_LOWER - lower casify the given string (in place) */

char *SC_str_lower(s)
   char *s;
   {int c;
    char *ps;

    ps = s;
    while ((c = *ps) != '\0')
       *ps++ = tolower(c);

    return(s);}

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

/* SC_STR_ICMP - case insensitive string comparison */

int SC_str_icmp(s, t)
   char *s, *t;
   {char p[MAXLINE], q[MAXLINE];

    strcpy(p, s);
    strcpy(q, t);
    SC_str_upper(p);
    SC_str_upper(q);

    return(strcmp(p, q));}

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

/*                     ASSOCIATION LIST PRIMITIVES                          */

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

/* SC_ASSOC_ENTRY - return the pcons pointer from the item in the association
 *                - list associated with the given string
 */

pcons *SC_assoc_entry(alist, s)
   pcons *alist;
   char *s;
   {char *t;
    pcons *pa, *c;

    for (pa = alist; pa != NULL; pa = (pcons *) pa->cdr)
        {c = (pcons *) pa->car;
         t = (char *) c->car;
         if (strcmp(t, s) == 0)
            return(c);};

    return(NULL);}

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

/* SC_ASSOC - return the value pointer from the item in the association
 *          - list associated with the given string
 */

byte *SC_assoc(alist, s)
   pcons *alist;
   char *s;
   {pcons *c;

    c = SC_assoc_entry(alist, s);

    return((c != NULL) ? c->cdr : NULL);}

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

/* SC_ADD_ALIST - add an item to the given association list */

pcons *SC_add_alist(alist, name, type, val)
   pcons *alist;
   char *name, *type;
   byte *val;
   {

    return(SC_mk_pcons(SC_PCONS_P_S,
                       SC_mk_pcons(SC_STRING_S,
				   SC_strsavef(name, "char*:SC_ADD_ALIST:name"),
                                   type, val),
                       SC_PCONS_P_S, alist));}

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

/* SC_REM_ALIST - remove an item from the given association list */

pcons *SC_rem_alist(alist, name)
   pcons *alist;
   char *name;
   {pcons *ths, *nxt;
    char *s;

    s = (char *) ((pcons *) alist->car)->car;
    if (strcmp(s, name) == 0)
       {SC_rl_pcons(alist->car, 3);
	nxt = (pcons *) alist->cdr;

	SC_rl_pcons(alist, 0);
	alist = nxt;}

    else
       {for (ths = alist; ths->cdr != NULL; ths = nxt)
            {nxt = (pcons *) ths->cdr;
             s   = (char *) ((pcons *) nxt->car)->car;            
             if (strcmp(s, name) == 0)
                {SC_rl_pcons(nxt->car, 3);
                 ths->cdr = nxt->cdr;

		 SC_rl_pcons(nxt, 0);
		 nxt = (pcons *) ths->cdr;

                 if (nxt == NULL)
                    break;};};};

    return(alist);}

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

/* SC_CHANGE_ALIST - change an item from the given association list
 *                 - add the item if necessary
 */

pcons *SC_change_alist(alist, name, type, val)
   pcons *alist;
   char *name, *type;
   byte *val;
   {pcons *pc;

    pc = SC_assoc_entry(alist, name);
    if (pc == NULL)
       return(SC_add_alist(alist, name, type, val));

    else
       {SFREE(pc->cdr_type);
        pc->cdr_type = SC_strsavef(type, "char*:SC_CHANGE_ALIST:type");

        SFREE(pc->cdr);
        pc->cdr = val;
        SC_mark(val, 1);

        return(alist);};}

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

/* SC_MAKE_PCONS - make a simple pcons and bind the car to the arg */

pcons *SC_make_pcons(cat, ma, ca, cdt, md, cd)
   char *cat;
   int ma;
   byte *ca;
   char *cdt;
   int md;
   byte *cd;
   {pcons *cp;

    cp = FMAKE(pcons, "SC_MK_PCONS:cp");
    cp->car = ca;
    cp->cdr = cd;

    if (ma && (ca != NULL))
       SC_mark(ca, 1);

    if (md && (cd != NULL))
       SC_mark(cd, 1);

    if (cat != NULL)
       cp->car_type = SC_strsavef(cat, "char*:SC_MK_PCONS:car_type");

    if (cdt != NULL)
       cp->cdr_type = SC_strsavef(cdt, "char*:SC_MK_PCONS:cdr_type");

    return(cp);}

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

/* SC_MK_PCONS - make a simple pcons and bind the car to the arg */

pcons *SC_mk_pcons(cat, ca, cdt, cd)
   char *cat;
   byte *ca;
   char *cdt;
   byte *cd;
   {pcons *cp;

    cp = SC_make_pcons(cat, TRUE, ca, cdt, TRUE, cd);

    return(cp);}

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

/* SC_RL_PCONS - release a pcons
 *             - LEVEL specifies:
 *             -   bit 1 on - release car
 *             -   bit 2 on - release cdr
 */

void SC_rl_pcons(cp, level)
   pcons *cp;
   int level;
   {if (cp != NULL)
       {if (level & 1)
	   {SFREE(cp->car);};
	cp->car = NULL;

	if (level & 2)
	   {SFREE(cp->cdr);};
	cp->cdr = NULL;

	SFREE(cp->car_type);
	SFREE(cp->cdr_type);

	SFREE(cp);};

    return;}

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

/* SC_ASSOC_INFO - extract values for the keys in the supplied
 *               - key, value pairs from an association list
 */

#ifdef PCC

int SC_assoc_info(alst, va_alist)
   pcons *alst;
   va_dcl

#endif

#ifdef ANSI

int SC_assoc_info(pcons *alst, ...)

#endif

   {int count;

    SC_VA_START(alst);
    count = _SC_assoc_aux(alst, TRUE, SC_VA_VAR);
    SC_VA_END;

    return(count);}

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

/* SC_ASSOC_INFO_ALT - extract values for the keys in the supplied
 *                   - key, value pairs from an association list
 *                   - don't change the value pointer if there is no key
 *                   - match
 */

#ifdef PCC

int SC_assoc_info_alt(alst, va_alist)
   pcons *alst;
   va_dcl

#endif

#ifdef ANSI

int SC_assoc_info_alt(pcons *alst, ...)

#endif

   {int count;

    SC_VA_START(alst);
    count = _SC_assoc_aux(alst, FALSE, SC_VA_VAR);
    SC_VA_END;

    return(count);}

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

/* _SC_ASSOC_AUX - extract values for the keys in the supplied
 *               - key, value pairs from an association list
 *               - depending on the flag NULL out missing items
 */

static int _SC_assoc_aux(alst, flag, SC_VA_VAR)
   pcons *alst;
   int flag;
   va_list SC_VA_VAR;
   {int count;
    char *name;
    pcons *asc, *nxt, *ths;
    byte **pv;

    count = 0;
    ths   = NULL;

    while (TRUE)
       {name = SC_VA_ARG(char *);
        if (name == NULL)
           break;

        for (asc = alst; asc != NULL; asc = nxt)
            {nxt = (pcons *) asc->cdr;
             ths = (pcons *) asc->car;
             if (strcmp((char *) ths->car, name) == 0)
                break;};

        pv  = SC_VA_ARG(byte **);
        if (asc != NULL)
           *pv = ths->cdr;
           
        else if (flag)
           *pv = NULL;};

    return(count);}

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

/* SC_FREE_ALIST - release an entire association list */

void SC_free_alist(alst, level)
   pcons *alst;
   int level;
   {pcons *pc, *nxt;

    for (pc = alst; pc != NULL; pc = nxt)
        {SC_rl_pcons(pc->car, level);
	 nxt = (pcons *) pc->cdr;
	 SC_rl_pcons(pc, 0);};

    return;}

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

/* SC_COPY_ALIST - make a copy of an association list */

pcons *SC_copy_alist(alst)
   pcons *alst;
   {pcons *pc, *pa, *pb;

    pc = NULL;
    for (pa = alst; pa != NULL; pa = (pcons *) pa->cdr)
        {pb = (pcons *) pa->car;
	 pc = SC_add_alist(pc, (char *) pb->car,
			   (char *) pb->cdr_type, pb->cdr);};

    return(pc);}

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

/* SC_APPEND_ALIST - take each item on alist2 and add to alist1
 *                 - NOTE: this puts the elements in alist2 on the front of
 *                 - alist1 in reverse order and destroys alist2!
 */

pcons *SC_append_alist(alist1, alist2)
   pcons *alist1;
   pcons *alist2;
   {pcons *pa, *c, *nxt;

    for (pa = alist2; pa != NULL; pa = nxt)
        {c   = (pcons *) pa->car;
         nxt = (pcons *) pa->cdr;

         alist1 = SC_mk_pcons(SC_PCONS_P_S, c, SC_PCONS_P_S, alist1);

         SC_rl_pcons(pa, 1);
	 SC_mark(alist1->cdr, -1);};

    return(alist1);}

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

/*                           DYNAMIC ARRAY ROUTINES                         */

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

/* SC_DA_RESET - reset each member in an array of SC_dynamic_arrays,
 *             - i.e. remove elements of each SC_dynamic_array, and zero each
 *             - SC_dynamic_array length
 *             - if elem == TRUE, restrict reset to addressed SC_dynamic_array
 *
 *   DA  - Dynamic Array
 *   DAA - Dynamic Array Array
 */           

void SC_da_reset(SC_dynamic_array *daa, int elem)
   {int nda, ida;
    SC_dynamic_array *da;

    if (elem)
       nda = 1;
    else
       nda = SC_arrlen(daa)/(long)sizeof(SC_dynamic_array);

    for (ida = 0; ida < nda; ida++)
        {da = daa + ida;

	 SFREE(da->array);
	 da->n = 0;};

    return;}

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

/* SC_DA_CLEAN - clean each member in an array of SC_dynamic_arrays,
 *             - i.e. remove elements of each SC_dynamic_array, zero each
 *             - SC_dynamic_array length, and free each SC_dynamic_array type
 *             - if elem == TRUE, restrict clean to addressed SC_dynamic_array
 *
 *   DA  - Dynamic Array
 *   DAA - Dynamic Array Array
 */

void SC_da_clean(SC_dynamic_array *daa, int elem)
   {int nda, ida;
    SC_dynamic_array *da;

    if (elem)
       nda = 1;
    else
       nda = SC_arrlen(daa)/(long)sizeof(SC_dynamic_array);

    for (ida = 0; ida < nda; ida++)
        {da = daa + ida;

	 SFREE(da->array);
	 SFREE(da->type);
	 da->n  = 0;
	 da->nx = 0;};

    return;}

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

/* SC_DA_RELEASE - clean each member in an array of SC_dynamic_arrays, then
 *               - free the array pointer
 *
 *   DA  - Dynamic Array
 *   DAA - Dynamic Array Array
 */

void SC_da_release(SC_dynamic_array *daa)
   {

    SC_da_clean(daa, FALSE);
    SC_free(daa);

    return;}

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

/* SC_DA_RELEASE_POINTEES - free pointees of each member in an array of
 *                        - SC_dynamic_arrays
 *                        - if elem == TRUE, restrict release of pointees to
 *                        - addressed SC_dynamic_array
 *
 *   DA  - Dynamic Array
 *   DAA - Dynamic Array Array
 */

void SC_da_release_pointees(SC_dynamic_array *daa, int elem)
   {int nda, ida, np, ip;
    void **ppa;
    SC_dynamic_array *da;

    if (elem)
        nda = 1;
    else
        nda = SC_arrlen(daa)/(long)sizeof(SC_dynamic_array);

    for (ida = 0; ida < nda; ida++)
        {da  = daa + ida;
	 np  = SC_N_DYNAMIC((*(daa+ida)));
	 ppa = da->array;
	 for (ip = 0; ip < np; ip++)
             SFREE(ppa[ip]);};

    return;}

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

/* SC_DA_RELEASE_ALL - free pointees of each member in an array of
 *                   - SC_dynamic_arrays, then release the array of
 *                   - SC_dynamic_arrays
 *
 *   DA  - Dynamic Array
 *   DAA - Dynamic Array Array
 */

void SC_da_release_all(SC_dynamic_array *daa)
   {

    SC_da_release_pointees(daa, FALSE);
    SC_da_release(daa);

    return;}

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

/* SC_DADA_CLEAN - release each bottom level SC_dynamic_array in an
 *               - array of SC_dynamic_arrays of SC_dynamic_arrays,
 *               - then clean all top level SC_dynamic_arrays
 *               - if elem == TRUE, restrict clean to addressed
 *               - SC_dynamic_array of SC_dynamic_arrays
 *
 *    DA     -  Dynamic Array
 *    DADA   -  Dynamic Array Dynamic Array
 *    DADAA  -  Dynamic Array Dynamic Array Array
 */

void SC_dada_clean(SC_dynamic_array *dadaa, int elem)
   {int ndada, idada, nda, ida;
    SC_dynamic_array **dapa, *pd;

    if (elem)
       ndada = 1;
    else
       ndada = SC_arrlen(dadaa)/(long)sizeof(SC_dynamic_array);

    for (idada = 0; idada < ndada; idada++) 
        {pd   = dadaa + idada;
	 nda  = SC_N_DYNAMIC((*pd));
	 dapa = (SC_dynamic_array **) (pd->array);
	 for (ida = 0; ida < nda; ida++)
	     SC_da_release(dapa[ida]);};

    SC_da_clean(dadaa, elem);

    return;}

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

/* SC_DADA_RESET - release each bottom level SC_dynamic_array in an
 *               - array of SC_dynamic_arrays of SC_dynamic_arrays,
 *               - then reset all top level SC_dynamic_arrays
 *               - if elem == TRUE, restrict reset to addressed
 *               - SC_dynamic_array of SC_dynamic_arrays
 *
 *    DA     -  Dynamic Array
 *    DADA   -  Dynamic Array Dynamic Array
 *    DADAA  -  Dynamic Array Dynamic Array Array
 */

void SC_dada_reset(SC_dynamic_array *dadaa, int elem)
   {int ndada, idada, nda, ida;
    SC_dynamic_array **dapa, *pd;

    if (elem)
       ndada = 1;
    else
       ndada = SC_arrlen(dadaa)/(long)sizeof(SC_dynamic_array);

    for (idada = 0; idada < ndada; idada++) 
        {pd   = dadaa + idada;
	 nda  = SC_N_DYNAMIC((*pd));
	 dapa = (SC_dynamic_array **) (pd->array);
	 for (ida = 0; ida < nda; ida++)
	     SC_da_release(dapa[ida]);};

    SC_da_reset(dadaa, elem);

    return;}

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

/* SC_DADA_RELEASE - release each bottom level SC_dynamic_array in an
 *                 - array of SC_dynamic_arrays of SC_dynamic_arrays,
 *                 - then release all top level SC_dynamic_arrays
 *
 *    DA    -  Dynamic Array
 *    DADA  -  Dynamic Array Dynamic Array
 *    DADAA -  Dynamic Array Dynamic Array Array
 */

void SC_dada_release(SC_dynamic_array *dadaa)
   {int ndada, idada, nda, ida;
    SC_dynamic_array  **dapa, *pd;

    ndada = SC_arrlen(dadaa)/(long)sizeof(SC_dynamic_array);
    for (idada = 0; idada < ndada; idada++)
        {pd   = dadaa + idada;
	 nda  = SC_N_DYNAMIC((*pd));
	 dapa = (SC_dynamic_array **) (pd->array);
	 for (ida = 0; ida < nda; ida++)
	     SC_da_release(dapa[ida]);};

    SC_da_release(dadaa);

    return;}

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

/* DAPRINT - print an alist for debug purposes */

DEBUG_FUNC void daprint(alst)
   pcons *alst;
   {char s[MAXLINE];
    pcons *pc, *ths;

    PRINT(stdout, "Name\t\t\t    Type\t  Address\t\tValue\n");

    for (pc = alst; pc != NULL; pc = (pcons *) pc->cdr)
        {ths = (pcons *) pc->car;

	 sprintf(s, "%s", (char *) ths->car);
	 memset(s+strlen(s), ' ', 20);
	 s[20] = '\0';

         PRINT(stdout, "%s (%d)   %s\t0x%lx (%d)",
	       s, SC_ref_count(ths->car),
	       ths->cdr_type, ths->cdr, SC_ref_count(ths->cdr));

         if (strcmp(ths->cdr_type, SC_STRING_S) == 0)
            PRINT(stdout, "\t%s", ths->cdr);

         PRINT(stdout, "\n");}

    return;}

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