Artifact 0d3c5bfa7bb0bc30cec790b87e422826f6eb968f913d9a01232de27350c862d6:

• Executable file r37/lisp/csl/cslbase/grep.c — part of check-in [f2fda60abd] at 2011-09-02 18:13:33 on branch master — Some historical releases purely for archival purposes

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 22918) [annotate] [blame] [check-ins using] [more...]

/* regex.f -- translated by f2c (version of 17 January 1992  0:17:58).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm -lc   (in that order)
*/

/* Signature: 7628c6a0 08-Apr-2002 */

/* #include "f2c.h" */
typedef long int integer;
typedef long int logical;
typedef long ftnlen;
#define TRUE_ (1)
#define FALSE_ (0)
#define max(a,b) ((a) >= (b) ? (a) : (b))

#ifdef BSD
#include <strings.h>
#else
#include <string.h>
#endif

#include <ctype.h>
#include <stdarg.h>

#include "machine.h"
#include "tags.h"
#include "cslerror.h"
#include "externs.h"

/* Added by Mike Dewar to provide Lisp Interface */

#include <stdio.h>

void remark_(char *s,int length)
{
  fprintf(stderr,"error: %s\n",s);
}

void zlowc_(char *retval, int retlen,char *ch, int chlen)
{
  if (retlen!=1 || chlen!=1) remark_("zlowc: Calling sequence error",0);
  *retval = isupper(*ch) ? tolower(*ch) : *ch;
}

void error_(char *s,int length)
{
  fprintf(stderr,"error: %s\n",s);
  my_exit(42);
}

/* Common Block Declarations */

struct {
    integer smode, mode2;
} xcsmod_;

#define xcsmod_1 xcsmod_

struct {
    logical isanum[256];
} xcscas_;

#define xcscas_1 xcscas_

/* opyright 1991 Numerical Algorithms Group */
/* Match any single character */
/* $pp$ANYCHR='.' */
/* $pp$ANYAPO='?' */
/* Begin character class */
/* $pp$BCLCHR='[' */
/* Beginning of line (string) */
/* $pp$BOLAPO='%' */
/* $pp$BOLCHR='^' */
/* Closure */
/* $pp$CL0CHR='*' */
/* Positive Closure */
/* $pp$CL1CHR='+' */
/* Close tag field (group) */
/* $pp$CTGAPO='}' */
/* $pp$CTGTP1='>' */
/* End character class */
/* $pp$ECLCHR=']' */
/* End of line (string) */
/* $pp$EOLCHR='$' */
/* APOLLO and TPACK1: Escape a character anywhere, @n & @t are special */
/* $pp$ESCAPO='@' */
/* EMACS and EGREP: Escape a character inside a character class, plus */
/*                  various special functions outside. */
/* $pp$ESCCHR='\\' */
/* Invert character class */
/* $pp$NOTAPO='~' */
/* $pp$NOTCHR='^' */
/* EMACS and EGREP: Optional item (i.e. 0 or 1 repeats) */
/* $pp$OPTCHR='?' */
/* Open tag field (group) */
/* $pp$OTGAPO='{' */
/* $pp$OTGTP1='<' */
/* Recall tag field (group) */
/* $pp$TAGAPO='@' */
/* $pp$TAGTP1='&' */
/* $pp$TAGCHR='\\' */
/* Transition between alphanumerics and non-alphanumerics */
/* $pp$TRNTP1=':' */
/* Modes of operation */
/* $pp$EMACS=0 */
/* $pp$APOLLO=1 */
/* $pp$EGREP=2 */
/* $pp$TPACK1=3 */

/* Internal Pattern Symbols */

/* $pp$TAGSYM=-101 */
/* $pp$CL1SYM=-102 */
/* $pp$TRNSYM=-103 */
/* $pp$EOLSYM=-104 */
/* $pp$CTGSYM=-105 */
/* $pp$CCESYM=-106 */
/* $pp$CL0SYM=-107 */
/* $pp$ANYSYM=-108 */
/* $pp$BOLSYM=-109 */
/* $pp$OTGSYM=-110 */
/* $pp$CCLSYM=-111 */
/* -112 now unused */
/* $pp$EOSSYM=-113 */
/* $pp$DASSYM=-114 */
/* $pp$ERRSYM=-115 */
/* $pp$OPTSYM=-116 */

/*  PATTERN MATCHING AND REPLACEMENT ROUTINES */

/*        CHARACTER STRING BASED */

/*     RMJI - FRIDAY 13 JANUARY 1989 */

/*     Substantially revised and enhanced by Malcolm Cohen, October 1989. */

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

/*     Z S I N I T   -   Initialise String module (regular expressions) */

/* Subroutine */ void zsinit_(mode) /* used to have return type int */
integer *mode;
{
    /* Initialized data */

    static char digits[10+1] = "0123456789";
    static char lolett[26+1] = "abcdefghijklmnopqrstuvwxyz";
    static char uplett[26+1] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";

    static integer i;

    if (*mode == 3) {
	xcsmod_1.smode = 1;
	xcsmod_1.mode2 = 3;
    } else {
	xcsmod_1.smode = *mode;
	xcsmod_1.mode2 = *mode;
    }
    for (i = 0; i <= 255; ++i) {
	xcscas_1.isanum[i] = FALSE_;
/* L100: */
    }
    for (i = 1; i <= 26; ++i) {
	xcscas_1.isanum[uplett[i - 1]] = TRUE_;
	xcscas_1.isanum[lolett[i - 1]] = TRUE_;
/* L200: */
    }
    for (i = 1; i <= 10; ++i) {
	xcscas_1.isanum[digits[i - 1]] = TRUE_;
/* L300: */
    }
} /* zsinit_ */

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

/*     Z S C P A T   -   Compile pattern specification from STRING to */
/*                       PATSTR, FLAG indicates case sensitivity (.TRUE. */
/*                       means case sensitive)... */

/* Subroutine */ void zscpat_(string, flag_, patstr, maxpsz, ifail, string_len)

char *string;
logical *flag_;
integer *patstr, *maxpsz, *ifail;
ftnlen string_len;
{
    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    integer i_len();

    /* Local variables */
    static integer i, j, lastj, limit, itemp, lj, lastcl;
    extern logical xlssgc_();
    extern integer xissex_(), xisspr_(), xissnx_();

    /* Parameter adjustments */
    --patstr;

    /* Function Body */
    limit = (integer) string_len;
    if (*maxpsz <= max(limit,13)) {
	*ifail = 1;
	return;
    }
    *ifail = 2;

/* Save case flag */

    if (*flag_) {
	patstr[1] = 0;
    } else {
	patstr[1] = 1;
    }

/* Clear the tag fields and set the pointer to miss it */

    for (i = 2; i <= 11; ++i) {
	patstr[i] = 0;
/* L10: */
    }
    patstr[12] = 1;
    j = 13;
    lastj = j;
    lastcl = 0;
    i = 1;
L20:
    lj = j;
    if (j + 1 > *maxpsz) {
	goto L666;
    }
    if (string[i - 1] == '.' && xcsmod_1.smode != 1 || string[i - 1] == '?' &&
	     xcsmod_1.smode == 1) {
	patstr[j] = -108;
	++j;
    } else if (string[i - 1] == ':' && xcsmod_1.mode2 == 3) {
	patstr[j] = -103;
	++j;
    } else if (xcsmod_1.smode != 1 && string[i - 1] == '^' && i == 1 || 
	    xcsmod_1.smode == 1 && string[i - 1] == '%' && i == 1) {
	patstr[j] = -109;
	++j;
    } else if (string[i - 1] == '$' && i == limit) {
	patstr[j] = -104;
	++j;
    } else if (string[i - 1] == '[') {
	if (! xlssgc_(string, &i, &patstr[1], &j, maxpsz, string_len)) {
	    return;
	}
    } else if ((string[i - 1] == '*' || string[i - 1] == '+' || string[i - 1] 
	    == '?' && xcsmod_1.smode != 1) && i > 1) {
	lj = lastj;
	if (patstr[lj] == -109 || patstr[lj] == -107 || patstr[lj] == -102) {
	    goto L50;
	}
	if (string[i - 1] == '+') {
	    lastj = j;
L30:
	    if (lj < lastj) {
		if (j + 1 > *maxpsz) {
		    goto L666;
		}
		patstr[j] = patstr[lj];
		++j;
		++lj;
		goto L30;
	    }
	}
	if (j + 4 > *maxpsz) {
	    goto L666;
	}
	i__1 = lastj;
	for (itemp = j - 1; itemp >= i__1; --itemp) {
	    patstr[itemp + 4] = patstr[itemp];
/* L31: */
	}
	j += 4;
	if (string[i - 1] == '?') {
	    patstr[lastj] = -116;
	} else {
	    patstr[lastj] = -107;
	}
	patstr[lastj + 1] = 0;
	patstr[lastj + 2] = lastcl;
	patstr[lastj + 3] = 0;
	lastcl = lastj;
	lastj += 4;
    } else if (string[i - 1] == '{' && xcsmod_1.mode2 == 1 || string[i - 1] ==
	     '<' && xcsmod_1.mode2 == 3) {
	itemp = xissnx_(&patstr[1]);
	if (itemp <= 0) {
	    *ifail = 4;
	    goto L666;
	}
	if (j + 2 > *maxpsz) {
	    goto L666;
	}
	patstr[j] = -110;
	patstr[j + 1] = itemp;
	j += 2;
    } else if (string[i - 1] == '}' && xcsmod_1.mode2 == 1 || string[i - 1] ==
	     '>' && xcsmod_1.mode2 == 3) {
	if (j + 2 > *maxpsz) {
	    goto L666;
	}
	patstr[j] = -105;
	patstr[j + 1] = xisspr_(&patstr[1]);
	if (patstr[j + 1] <= 0) {
	    *ifail = 4;
	    return;
	}
	j += 2;
    } else if (string[i - 1] == '\\' && xcsmod_1.smode != 1 && i < limit) {
	++i;
	if (j + 2 > *maxpsz) {
	    goto L666;
	}
	if (string[i - 1] == '(') {
	    if (string[i] == '+' || string[i] == '*' ||
		string[i] == '?')
	      {
		/* Report error if open tag field followed by +*? */
		*ifail = 4;
		goto L666;
	      }
	    patstr[j] = -110;
	    patstr[j + 1] = xissnx_(&patstr[1]);
	} else if (string[i - 1] == ')') {
	    patstr[j] = -105;
	    patstr[j + 1] = xisspr_(&patstr[1]);
	} else if (string[i - 1] == 'b') {
	    patstr[j] = -103;
	    --j;
	} else {
	    integer tmp=i-1;
	    patstr[j] = xissex_(string, &tmp, string_len);
	    --j;
	}
	if (patstr[j + 1] <= 0 && patstr[j + 1] != -103) {
	    *ifail = 4;
	    goto L666;
	}
	j += 2;
    } else {
	patstr[j] = xissex_(string, &i, string_len);
	++j;
    }
    lastj = lj;
    ++i;
    if (i <= limit) {
	goto L20;
    }
L50:
    if (j <= *maxpsz) {
	patstr[j] = -113;
	for (i = 2; i <= 11; ++i) {
	    patstr[i] = 0;
/* L60: */
	}
	patstr[12] = 1;
	j = 13;
	*ifail = 0;
	return;
    }
/* Some sort of error found - mark the pattern as invalid */
L666:
    remark_("Invalid pattern",15L);
    patstr[13] = -115;
} /* zscpat_ */

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

/*     Z S F I N D   -   Match the string against the compiled pattern */

logical zsfind_(string, start, finish, patstr, string_len)
char *string;
integer *start, *finish, *patstr;
ftnlen string_len;
{
    /* System generated locals */
    integer i__1;
    logical ret_val;

    /* Builtin functions */
    integer i_len();

    /* Local variables */
    static integer i, n;
    extern integer xissam_();

    /* Parameter adjustments */
    --patstr;

    /* Function Body */
    if (patstr[13] == -115) {
	remark_("Pattern is in error", 19L);
    } else {
/* Loop along the line until a match is found */
	i__1 = (integer) string_len;
	for (i = 1; i <= i__1; ++i) {
	    n = xissam_(string, &i, &patstr[1], string_len);
	    if (n > 0) {
		ret_val = TRUE_;
		*start = i;
		*finish = n - 1;
		return ret_val;
	    }
/* L10: */
	}
    }
    ret_val = FALSE_;
    return ret_val;
} /* zsfind_ */

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

/*     X I S S A M   -   Function to look for a pattern match */

integer xissam_(lin, from, patstr, lin_len)
char *lin;
integer *from, *patstr;
ftnlen lin_len;
{
    /* System generated locals */
    integer ret_val;

    /* Builtin functions */
    integer i_len();

    /* Local variables */
    static integer i, j, stack, offset;
    extern logical xlssom_();
    extern integer xissps_();

    /* Parameter adjustments */
    --patstr;

    /* Function Body */
    stack = 0;
    offset = *from;
    j = 13;
L10:
    if (patstr[j] != -113) {
	if (patstr[j] == -107 || patstr[j] == -116) {
	    stack = j;
	    j += 4;
	    i = offset;
L20:
	    if (i <= (integer) lin_len) {
		if (xlssom_(lin, &i, &j, &patstr[1], lin_len)) {
		    if (patstr[stack] != -116) {
			goto L20;
		    }
		}
	    }
	    patstr[stack + 1] = i - offset;
	    patstr[stack + 3] = offset;
	    offset = i;
	} else if (! xlssom_(lin, &offset, &j, &patstr[1], lin_len)) {
L40:
	    if (stack > 0) {
		if (patstr[stack + 1] <= 0) {
		    stack = patstr[stack + 2];
		    goto L40;
		}
	    }
	    if (stack <= 0) {
		ret_val = 0;
		return ret_val;
	    }
	    --patstr[stack + 1];
	    j = stack + 4;
	    offset = patstr[stack + 3] + patstr[stack + 1];
	}
	j += xissps_(&j, &patstr[1]);
	goto L10;
    }
/* Match found, return pointer to end of match */
    ret_val = offset;
    return ret_val;
} /* xissam_ */

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

/*     X S S S C T   -   Function to close a tag field and save the */
/*                       current pointer value. */

/* Subroutine */ void xsssct_(point, n, string)
integer *point, *n, *string;
{
    static integer temp;

    /* Parameter adjustments */
    --string;

    /* Function Body */
    if (*n >= 1 && *n <= 9) {
	temp = string[*n + 2] / 256;
	string[*n + 2] = *point + (temp << 8);
    }
} /* xsssct_ */

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

/*     X I S S N X   -   Function to return an index to the next free tag */
/*                       field identifier. */

integer xissnx_(string)
integer *string;
{
    /* System generated locals */
    integer ret_val;

    /* Parameter adjustments */
    --string;

    /* Function Body */
    if (string[12] > 9) {
	ret_val = -1;
    } else {
	ret_val = string[12];
	++string[12];
    }
    return ret_val;
} /* xissnx_ */

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

/*     X S S S O P   -   Function to open a tag field and save the start */
/*                       position. */

/* Subroutine */ void xsssop_(point, n, string)
integer *point, *n, *string;
{
    /* Parameter adjustments */
    --string;

    /* Function Body */
    if (*n >= 1 && *n <= 9) {
/* Save current pointer in tag field array */
	string[*n + 2] = *point << 8;
    }
} /* xsssop_ */

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

/*     X I S S P R   -   Function to return the value of the current tag */
/*                       field to be closed.  The storage location in */
/*                       PATSTR is used to hold markers to indicate which */
/*                       tag fields have been closed already, these */
/*                       markers are cleared on exit from ZCOMPP. */

integer xisspr_(patstr)
integer *patstr;
{
    /* System generated locals */
    integer ret_val;

    /* Parameter adjustments */
    --patstr;

    /* Function Body */
    ret_val = patstr[12] - 1;
L10:
    if (ret_val > 0) {
	if (patstr[ret_val + 2] != 0) {
	    --ret_val;
	    goto L10;
	} else {
	    patstr[ret_val + 2] = 1;
	}
    }
    return ret_val;
} /* xisspr_ */

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

/*     X S S S D O   -   Expand pattern class range */

logical xsssdo_(valid, array, i, set, j, maxset, valid_len, array_len)
char *valid, *array;
integer *i, *set, *j, *maxset;
ftnlen valid_len;
ftnlen array_len;
{
    /* System generated locals */
    integer i__1;
    logical ret_val;
    char ch__1[1];

    /* Builtin functions */
    integer i_indx();

    /* Local variables */
    static integer k, limit;
    extern integer xissex_();

    /* Added by ICH */
    char *valid_null_term;

    /* Parameter adjustments */
    --set;

    /* Function Body */
    ++(*i);
    --(*j);
    ch__1[0] = xissex_(array, i, array_len);
    /* limit = i_indx(valid, ch__1, valid_len, 1L); */
    valid_null_term = (char *) malloc(valid_len+1);
    strncpy(valid_null_term,valid,(int) valid_len);
    valid_null_term[valid_len]='\0';
    limit = (integer) ((strchr(valid_null_term,ch__1[0]) - valid_null_term) + 1);
    if (limit<0)
      limit=0;
    ch__1[0] = set[*j];
    if (*j + limit - (integer) (strchr(valid_null_term,ch__1[0])
				- valid_null_term + 1) + 1 <= *maxset) {
	ch__1[0] = set[*j];
	i__1 = limit;
	for (k = (integer) (strchr(valid_null_term,ch__1[0])
			    - valid_null_term + 1); k <= i__1; ++k) {
	    set[*j] = valid[k - 1];
	    ++(*j);
/* L10: */
	}
	ret_val = TRUE_;
    } else {
	ret_val = FALSE_;
    }
    free((void *)valid_null_term);
    return ret_val;
} /* xsssdo_ */

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

/*     X I S S E X   -   Un-escape a single character */

integer xissex_(array, i, array_len)
char *array;
integer *i;
ftnlen array_len;
{
    /* System generated locals */
    integer ret_val;

    if (array[*i - 1] == '@' && xcsmod_1.smode == 1 || array[*i - 1] == '\\' 
	    && xcsmod_1.smode != 1) {
	++(*i);
	if (array[*i - 1] == 'n') {
	    ret_val = 10;
	} else if (array[*i - 1] == 't') {
	    ret_val = 9;
	} else {
	    ret_val = array[*i - 1];
	}
    } else {
	ret_val = array[*i - 1];
    }
    return ret_val;
} /* xissex_ */

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

/*     X S S S F I   -   Fill a character class set for pattern matching */

/* Subroutine */ void xsssfi_(array, i, set, j, maxset, array_len)
char *array;
integer *i, *set, *j, *maxset;
ftnlen array_len;
{
    /* System generated locals */
    char ch__1[1];

    /* Builtin functions */
    integer i_len(), i_indx();

    /* Local variables */
    static logical ok;
    extern integer xissex_();
    extern logical xsssdo_();

    /* Parameter adjustments */
    --set;

    /* Function Body */
L10:
    ok = *j + 1 < *maxset;
    if (ok && array[*i - 1] != ']') {
	if (array[*i - 1] == '\\' && xcsmod_1.smode != 1 || array[*i - 1] == 
		'@' && xcsmod_1.smode == 1) {
/* Character has been escaped */
	    set[*j] = xissex_(array, i, array_len);
	    ++(*j);
	} else if (array[*i - 1] != '-') {
	    set[*j] = array[*i - 1];
	    ++(*j);
	} else if (*j <= 1 || *i == (integer) array_len) {
	    set[*j] = -114;
	    ++(*j);
	} else /* if(complicated condition) */ {
	    ch__1[0] = set[*j - 1];
	    if (*ch__1>='0' && *ch__1<='9') {
		ok = xsssdo_("0123456789", array, i, &set[1], j, maxset, 10L, 
			array_len);
	    } else /* if(complicated condition) */ {
		ch__1[0] = set[*j - 1];
		if (*ch__1>='a' && *ch__1<='z' ) 
			{
		    ok = xsssdo_("abcdefghijklmnopqrstuvwxyz", array, i, &set[
			    1], j, maxset, 26L, array_len);
		} else /* if(complicated condition) */ {
		    ch__1[0] = set[*j - 1];
	       if ( *ch__1>='A' && *ch__1<='Z') {
			ok = xsssdo_("ABCDEFGHIJKLMNOPQRSTUVWXYZ", array, i, &
				set[1], j, maxset, 26L, array_len);
		    } else {
			set[*j] = -114;
			++(*j);
		    }
		}
	    }
	}
	++(*i);
	if (*i <= (integer) array_len) {
	    goto L10;
	}
    }
} /* xsssfi_ */

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

/*     X L S S G C   -   Get character class */

logical xlssgc_(arg, i, pat, j, maxpsz, arg_len)
char *arg;
integer *i, *pat, *j, *maxpsz;
ftnlen arg_len;
{
    /* System generated locals */
    logical ret_val;

    /* Local variables */
    static integer jstart;
    extern /* Subroutine */ void xsssfi_();
    static integer sym;

    /* Parameter adjustments */
    --pat;

    /* Function Body */
    ++(*i);
/* Check if an inclusive or exclusive set is being requested */
    if (arg[*i - 1] == '^' && xcsmod_1.smode != 1 || arg[*i - 1] == '~' && 
	    xcsmod_1.smode == 1) {
	++(*i);
	sym = -106;
    } else {
	sym = -111;
    }
    if (*j + 2 <= *maxpsz) {
	pat[*j] = sym;
	pat[*j + 1] = 0;
	jstart = *j + 1;
	*j += 2;
	xsssfi_(arg, i, &pat[1], j, maxpsz, arg_len);
	pat[jstart] = *j - jstart - 1;
/* Check to see if pattern filled in ok */
	ret_val = arg[*i - 1] == ']';
    } else {
	ret_val = FALSE_;
    }
    return ret_val;
} /* xlssgc_ */

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

/*     X L S S L O   -   Match a single character against a char set */

logical xlsslo_(c, pat, offset, c_len)
char *c;
integer *pat, *offset;
ftnlen c_len;
{
    /* System generated locals */
    logical ret_val;

    /* Local variables */
    static integer i;

    /* Parameter adjustments */
    --pat;

    /* Function Body */
    i = *offset + pat[*offset];
L10:
    if (i > *offset) {
	if (*c == pat[i]) {
	    ret_val = TRUE_;
	    return ret_val;
	}
	--i;
	goto L10;
    }
    ret_val = FALSE_;
    return ret_val;
} /* xlsslo_ */

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

/*     X L S S O M   -   Match a single pattern */

logical xlssom_(lin, i, j, patstr, lin_len)
char *lin;
integer *i, *j, *patstr;
ftnlen lin_len;
{
    /* System generated locals */
    integer i__1;
    logical ret_val;
    char ch__1[1], ch__2[1], ch__3[1];

    /* Builtin functions */
    integer i_len();

    /* Local variables */
    static integer bump;
    extern logical xlsslo_();
    extern /* Subroutine */ void xsssct_(), xsssop_();

/* Set initial (invalid) value for pointer update */
    /* Parameter adjustments */
    --patstr;

    /* Function Body */
    bump = -1;
/* Open tag field */
    if (patstr[*j] == -110) {
	bump = 0;
	xsssop_(i, &patstr[*j + 1], &patstr[1]);
/* Close tag field */
    } else if (patstr[*j] == -105) {
	bump = 0;
	xsssct_(i, &patstr[*j + 1], &patstr[1]);
/* Transition (or end or line or beginning of line) */
    } else if (patstr[*j] == -103) {
	if (*i > (integer) lin_len || *i == 1) {
	    bump = 0;
	} else {
	    i__1 = *i - 2;
	    if (xcscas_1.isanum[lin[*i - 1]] != xcscas_1.isanum[lin[i__1]]) {
		bump = 0;
/*              ELSE IF (I.GT.1) THEN */
/*              IF (ICHAR(LIN(I:I)).EQ.10) BUMP = 0 */
	    }
	}
/* End of the line */
    } else if (*i > (integer) lin_len) {
	if (patstr[*j] == -104) {
	    bump = 0;
	}
    } else if (patstr[*j] == -104) {
	if (lin[*i - 1] == 10) {
	    bump = 0;
	}
/* Ordinary character */
    } else if (patstr[*j] > 0) {
	if (patstr[1] == 1) {
	    zlowc_(ch__1, 1L, lin + (*i - 1), 1L);
	    ch__3[0] = patstr[*j];
	    zlowc_(ch__2, 1L, ch__3, 1L);
	    if (ch__1[0] == ch__2[0]) {
		bump = 1;
	    }
	} else {
	    if (lin[*i - 1] == patstr[*j]) {
		bump = 1;
	    }
	}
/* Beginning of the line */
    } else if (patstr[*j] == -109) {
	if (*i == 1) {
	    bump = 0;
	}
/* Free match (any character) */
    } else if (patstr[*j] == -108) {
	if (lin[*i - 1] != 10 && *i <= (integer) lin_len) {
	    bump = 1;
	}
/* Character class */
    } else if (patstr[*j] == -111) {
	i__1 = *j + 1;
	if (xlsslo_(lin + (*i - 1), &patstr[1], &i__1, 1L)) {
	    bump = 1;
	}
/* Negated character class */
    } else if (patstr[*j] == -106) {
	i__1 = *j + 1;
	if (lin[*i - 1] != 10 && *i <= (integer) lin_len && ! xlsslo_(lin + 
		(*i - 1), &patstr[1], &i__1, 1L)) {
	    bump = 1;
	}
/* Otherwise */
    } else {
	error_("Invalid compiled pattern", 24L);
    }
/* If bump is no longer -1 then a match has been found */
    if (bump >= 0) {
	*i += bump;
    }
    ret_val = bump >= 0;
    return ret_val;
} /* xlssom_ */

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

/*     X I S S P S   -   Return size of pattern entry */

integer xissps_(n, patstr)
integer *n, *patstr;
{
    /* System generated locals */
    integer ret_val;

    /* Parameter adjustments */
    --patstr;

    /* Function Body */
    if (patstr[*n] > 0) {
	ret_val = 1;
    } else if (patstr[*n] == -109 || patstr[*n] == -104 || patstr[*n] == -108 
	    || patstr[*n] == -103) {
	ret_val = 1;
    } else if (patstr[*n] == -111 || patstr[*n] == -106) {
	ret_val = patstr[*n + 1] + 2;
    } else if (patstr[*n] == -107) {
	ret_val = 4;
    } else if (patstr[*n] == -110 || patstr[*n] == -105) {
	ret_val = 2;
    } else {
	error_("XISSPS: Invalid pattern entry found", 35L);
    }
    return ret_val;
} /* xissps_ */