* Sebastian Hammer, Adam Dickmeiss
*
* $Log: regxread.c,v $
- * Revision 1.26 1999-05-26 07:49:14 adam
+ * Revision 1.29 1999-07-12 07:27:54 adam
+ * Improved speed of Tcl processing. Fixed one memory leak.
+ *
+ * Revision 1.28 1999/07/06 12:26:04 adam
+ * Fixed filters so that MS-DOS CR is ignored.
+ *
+ * Revision 1.27 1999/06/28 13:25:40 quinn
+ * Improved diagnostics for Tcl
+ *
+ * Revision 1.26 1999/05/26 07:49:14 adam
* C++ compilation.
*
* Revision 1.25 1999/05/25 12:33:32 adam
struct regxCode {
char *str;
+#if HAVE_TCL_H
+ Tcl_Obj *tcl_obj;
+#endif
};
struct lexRuleAction {
struct regxCode *p = *pp;
if (p)
{
+#if HAVE_TCL_H
+ if (p->tcl_obj)
+ Tcl_DecrRefCount (p->tcl_obj);
+#endif
xfree (p->str);
xfree (p);
*pp = NULL;
p->str = (char *) xmalloc (len+1);
memcpy (p->str, buf, len);
p->str[len] = '\0';
+#if HAVE_TCL_H
+ p->tcl_obj = Tcl_NewStringObj ((char *) buf, len);
+ if (p->tcl_obj)
+ Tcl_IncrRefCount (p->tcl_obj);
+#endif
*pp = p;
}
{
struct lexRule *rp, *rp1;
+ dfa_delete (&p->dfa);
xfree (p->fastRule);
for (rp = p->rules; rp; rp = rp1)
{
}
actionListDel (&p->beginActionList);
actionListDel (&p->endActionList);
+ actionListDel (&p->initActionList);
xfree (p->name);
xfree (p);
}
char cmd[32];
int i, level;
- while (*cp == ' ' || *cp == '\t' || *cp == '\n')
+ while (*cp == ' ' || *cp == '\t' || *cp == '\n' || *cp == '\r')
cp++;
switch (*cp)
{
{
logf (LOG_WARN, "bad character %d %c", *cp, *cp);
cp++;
- while (*cp && *cp != ' ' && *cp != '\t' && *cp != '\n')
+ while (*cp && *cp != ' ' && *cp != '\t' &&
+ *cp != '\n' && *cp != '\r')
cp++;
*cpp = cp;
return 0;
int readFileSpec (struct lexSpec *spec)
{
struct lexContext *lc;
- char *lineBuf;
- int lineSize = 512;
int c, i, errors = 0;
FILE *spec_inf = 0;
+ WRBUF lineBuf;
+ char fname[256];
- lineBuf = (char *) xmalloc (1+lineSize);
#if HAVE_TCL_H
if (spec->tcl_interp)
{
- sprintf (lineBuf, "%s.tflt", spec->name);
- spec_inf = yaz_path_fopen (data1_get_tabpath(spec->dh), lineBuf, "r");
+ sprintf (fname, "%s.tflt", spec->name);
+ spec_inf = yaz_path_fopen (data1_get_tabpath(spec->dh), fname, "r");
}
#endif
if (!spec_inf)
{
- sprintf (lineBuf, "%s.flt", spec->name);
- spec_inf = yaz_path_fopen (data1_get_tabpath(spec->dh), lineBuf, "r");
+ sprintf (fname, "%s.flt", spec->name);
+ spec_inf = yaz_path_fopen (data1_get_tabpath(spec->dh), fname, "r");
}
if (!spec_inf)
{
logf (LOG_ERRNO|LOG_WARN, "cannot read spec file %s", spec->name);
- xfree (lineBuf);
return -1;
}
- logf (LOG_LOG, "reading regx filter %s", lineBuf);
+ logf (LOG_LOG, "reading regx filter %s", fname);
#if HAVE_TCL_H
if (spec->tcl_interp)
logf (LOG_LOG, "Tcl enabled");
#endif
+ lineBuf = wrbuf_alloc();
spec->lineNo = 0;
c = getc (spec_inf);
while (c != EOF)
{
- int off = 0;
- if (c == '#' || c == '\n' || c == ' ' || c == '\t')
+ wrbuf_rewind (lineBuf);
+ if (c == '#' || c == '\n' || c == ' ' || c == '\t' || c == '\r')
{
while (c != '\n' && c != EOF)
c = getc (spec_inf);
else
{
int addLine = 0;
-
- lineBuf[off++] = c;
+
while (1)
{
int c1 = c;
+ wrbuf_putc(lineBuf, c);
c = getc (spec_inf);
+ while (c == '\r')
+ c = getc (spec_inf);
if (c == EOF)
break;
if (c1 == '\n')
break;
addLine++;
}
- lineBuf[off] = c;
- if (off < lineSize)
- off++;
}
- lineBuf[off] = '\0';
- readOneSpec (spec, lineBuf);
+ wrbuf_putc(lineBuf, '\0');
+ readOneSpec (spec, wrbuf_buf(lineBuf));
spec->lineNo += addLine;
}
}
fclose (spec_inf);
- xfree (lineBuf);
+ wrbuf_free(lineBuf, 1);
#if 0
debug_dfa_trav = 1;
else if (*s == '-')
{
*tokBuf = s++;
- while (*s && *s != ' ' && *s != '\t' && *s != '\n' && *s != ';')
+ while (*s && *s != ' ' && *s != '\t' && *s != '\n' && *s != '\r' &&
+ *s != ';')
s++;
*tokLen = s - *tokBuf;
*src = s;
else
{
*tokBuf = s++;
- while (*s && *s != ' ' && *s != '\t' && *s != '\n' && *s != ';')
+ while (*s && *s != ' ' && *s != '\t' && *s != '\n' && *s != '\r' &&
+ *s != ';')
s++;
*tokLen = s - *tokBuf;
}
static void execTcl (struct lexSpec *spec, struct regxCode *code)
{
int i;
+ int ret;
for (i = 0; i < spec->arg_no; i++)
{
char var_name[10], *var_buf;
var_buf[var_len] = ch;
}
}
- Tcl_Eval (spec->tcl_interp, code->str);
+ if (code->tcl_obj)
+ ret = Tcl_GlobalEvalObj(spec->tcl_interp, code->tcl_obj);
+ else
+ ret = Tcl_GlobalEval (spec->tcl_interp, code->str);
+ if (ret != TCL_OK)
+ {
+ const char *err = Tcl_GetVar(spec->tcl_interp, "errorInfo", 0);
+ logf(LOG_FATAL, "Tcl error, line=%d, \"%s\"\n%s",
+ spec->tcl_interp->errorLine,
+ spec->tcl_interp->result,
+ err ? err : "[NO ERRORINFO]");
+ }
}
/* HAVE_TCL_H */
#endif