New test options in fmltest.
* FML interpreter. Europagate, 1995
*
* $Log: fmlmem.c,v $
- * Revision 1.9 1995/02/27 09:01:20 adam
+ * Revision 1.10 1995/03/02 08:06:03 adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.9 1995/02/27 09:01:20 adam
* Regular expression support. Argument passing by name option. New FML
* function strlen.
*
if (fml->debug & 2)
printf ("<<node=%d, atom=%d>>", no_nodes, no_atoms);
}
+
+struct fml_atom *fml_atom_strsub (Fml fml, struct fml_atom *a, int o, int l)
+{
+ static char buf[512];
+ char *cp;
+ struct fml_atom *an;
+ int ol = fml_atom_len (a);
+
+ if (ol >= 510)
+ {
+ cp = malloc (ol + 1);
+ assert (cp);
+ }
+ else
+ cp = buf;
+ fml_atom_str (a, buf);
+ if (o + l < ol)
+ buf[o+l] = '\0';
+ an = fml_atom_alloc (fml, buf+o);
+ if (ol >= 510)
+ free (cp);
+ return an;
+}
* FML interpreter. Europagate, 1995
*
* $Log: fmlp.h,v $
- * Revision 1.11 1995/02/27 09:01:21 adam
+ * Revision 1.12 1995/03/02 08:06:05 adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.11 1995/02/27 09:01:21 adam
* Regular expression support. Argument passing by name option. New FML
* function strlen.
*
struct fml_node *fml_node_copy (Fml fml, struct fml_node *fn);
struct fml_node *fml_mk_node_val (Fml fml, int val);
int fml_atom_cmp (Fml fml, struct fml_atom *a1, struct fml_atom *a2);
+struct fml_atom *fml_atom_strsub (Fml fml, struct fml_atom *a, int o, int l);
struct token {
int kind;
* FML interpreter. Europagate, 1995
*
* $Log: fmlstr.c,v $
- * Revision 1.4 1995/02/27 09:01:21 adam
+ * Revision 1.5 1995/03/02 08:06:07 adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.4 1995/02/27 09:01:21 adam
* Regular expression support. Argument passing by name option. New FML
* function strlen.
*
return fml_mk_node_val (fml, len);
}
+static struct fml_node *fml_exec_strsub (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ struct fml_node *fn_str;
+ struct fml_node *fn_offset;
+ struct fml_node *fn_length;
+ struct fml_node *fn_res;
+ int offset, length;
+
+ fml_cmd_lex (lp, tp);
+ fn_str = fml_expr_term (fml, lp, tp);
+ fn_offset = fml_expr_term (fml, lp, tp);
+ fn_length = fml_expr_term (fml, lp, tp);
+ if (!fn_offset->is_atom || !fn_length->is_atom || !fn_str->is_atom)
+ {
+ fml_node_delete (fml, fn_str);
+ fml_node_delete (fml, fn_offset);
+ fml_node_delete (fml, fn_length);
+ return NULL;
+ }
+ offset = fml_atom_val (fn_offset->p[0]);
+ fml_node_delete (fml, fn_offset);
+ length = fml_atom_val (fn_length->p[0]);
+ fml_node_delete (fml, fn_length);
+ if (offset == 0 && fml_atom_len (fn_str->p[0]) < length)
+ return fn_str;
+ fn_res = fml_node_alloc (fml);
+ fn_res->is_atom = 1;
+ fn_res->p[0]= fml_atom_strsub (fml, fn_str->p[0], offset, length);
+ fml_node_delete (fml, fn_str);
+ return fn_res;
+}
+
static struct fml_node *fml_exec_strcmp (Fml fml, struct fml_node **lp,
struct token *tp)
{
sym_info = fml_sym_add (fml->sym_tab, "strlen");
sym_info->kind = FML_CPREFIX;
sym_info->prefix = fml_exec_strlen;
+ sym_info = fml_sym_add (fml->sym_tab, "strsub");
+ sym_info->kind = FML_CPREFIX;
+ sym_info->prefix = fml_exec_strsub;
#if USE_GNU_REGEX
sym_info = fml_sym_add (fml->sym_tab, "match");
sym_info->kind = FML_CPREFIX;
* FML interpreter. Europagate, 1995
*
* $Log: fmlsym.c,v $
- * Revision 1.3 1995/02/23 08:32:06 adam
+ * Revision 1.4 1995/03/02 08:06:09 adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.3 1995/02/23 08:32:06 adam
* Changed header.
*
* Revision 1.1.1.1 1995/02/06 13:48:10 adam
#include "fmlp.h"
+#define SYM_CHUNK 128
+
struct fml_sym {
struct fml_sym_info info;
struct fml_sym *next;
int level;
char *name;
+ struct fml_sym *level_link;
};
struct fml_sym_tab {
int level;
int hash;
struct fml_sym **array;
+ struct fml_sym *level_link_0;
+ struct fml_sym *level_link_n;
+ struct fml_sym *free_list;
};
+static struct fml_sym *sym_alloc (struct fml_sym_tab *tab)
+{
+ struct fml_sym *p = tab->free_list;
+ if (!p)
+ {
+ int i;
+
+ tab->free_list = p = malloc (sizeof(*p) * SYM_CHUNK);
+ assert (p);
+ for (i = 0; i<SYM_CHUNK-1; i++)
+ p[i].next = p+i+1;
+ p[i].next = NULL;
+ }
+ tab->free_list = p->next;
+ return p;
+}
+
+static void sym_release (struct fml_sym_tab *tab, struct fml_sym *p)
+{
+ p->next = tab->free_list;
+ tab->free_list = p;
+}
+
struct fml_sym_tab *fml_sym_open (void)
{
struct fml_sym_tab *tab;
if (!tab)
return NULL;
tab->level = 1;
- tab->hash = 101;
+ tab->level_link_0 = NULL;
+ tab->level_link_n = NULL;
+ tab->free_list = NULL;
+ tab->hash = 41;
tab->array = malloc (sizeof(*tab->array) * tab->hash);
if (!tab->array)
{
(*ph)(&fs->info);
*fsp = (*fsp)->next;
free (fs->name);
- free (fs);
+ sym_release (tab, fs);
}
else
fsp = &(*fsp)->next;
return NULL;
strcpy (cp, s);
- sym = malloc (sizeof (*sym));
- if (!sym)
- {
- free (cp);
- return NULL;
- }
+ sym = sym_alloc (tab);
+
sym_entry = tab->array + fml_sym_hash (s, tab->hash);
sym->name = cp;
sym->next = *sym_entry;
*sym_entry = sym;
sym->level = level;
+ if (level)
+ {
+ sym->level_link = tab->level_link_n;
+ tab->level_link_n = sym;
+ }
+ else
+ {
+ sym->level_link = tab->level_link_0;
+ tab->level_link_0 = sym;
+ }
return &sym->info;
}
* FML interpreter. Europagate, 1995
*
* $Log: fmltest.c,v $
- * Revision 1.7 1995/02/23 08:32:06 adam
+ * Revision 1.8 1995/03/02 08:06:10 adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.7 1995/02/23 08:32:06 adam
* Changed header.
*
* Revision 1.5 1995/02/10 15:50:56 adam
#include <fmlmarc.h>
+char *prog;
static FILE *inf;
static int inf_read (void)
{
Fml fml;
int nfiles = 0;
+ int marc_show = 0;
int interactive = 0;
- Iso2709Rec rec = NULL;
+ const char *iso2709_fname = NULL;
+ const char *format_func = NULL;
+ int number_of_records = 10000;
+ prog = *argv;
fml = fml_open ();
while (-- argc > 0)
{
fml->debug |= 2;
else if (argv[0][1] == 'i')
interactive = 1;
+ else if (argv[0][1] == 's')
+ marc_show = 1;
+ else if (argv[0][1] == 'n')
+ {
+ if (argc > 1)
+ {
+ number_of_records = atoi (*++argv);
+ --argc;
+ }
+ }
else if (argv[0][1] == '2')
{
- if (argc > 1)
+ if (argc > 2)
{
- char *buf;
- FILE *inf;
- ++argv;
+ iso2709_fname = *++argv;
+ --argc;
+ format_func = *++argv;
--argc;
-
- inf = fopen (*argv, "r");
- if (!inf)
- {
- fprintf (stderr, "cannot open record `%s'\n", *argv);
- exit (1);
- }
- if ((buf = iso2709_read (inf)))
- {
- rec = iso2709_cvt (buf);
- free (buf);
- }
- else
- {
- fprintf (stderr, "no record in `%s'\n", *argv);
- exit (1);
- }
- fclose (inf);
+ }
+ else
+ {
+ fprintf (stderr, "missing marcfile and format\n");
+ exit (1);
}
}
else
fml_preprocess (fml);
fml_exec (fml);
}
+ else if (iso2709_fname)
+ {
+ FILE *inf;
+ char *buf;
+ const char *nargv[5];
+ Iso2709Rec rec;
+ int no = 0;
+
+ inf = fopen (iso2709_fname, "r");
+ if (!inf)
+ {
+ fprintf (stderr, "cannot open %s\n", iso2709_fname);
+ exit (1);
+ }
+ while (no < number_of_records && (buf = iso2709_read (inf)))
+ {
+ rec = iso2709_cvt (buf);
+ free (buf);
+ nargv[0] = "\\";
+ nargv[1] = format_func;
+ nargv[2] = " \\list";
+ nargv[4] = NULL;
+ nargv[3]= marc_to_str (fml, rec);
+ if (marc_show)
+ printf ("\n[%s]\n", nargv[3]);
+ iso2709_rm (rec);
+ fml_exec_call_argv (fml, nargv);
+ no++;
+ }
+ fclose (inf);
+ }
else
{
if (interactive)
break;
if ((cp = strchr (arg, '\n')))
*cp = '\0';
- if (*arg == '!' && rec)
- {
- nargv[0] = arg+1;
- nargv[1] = " ";
- nargv[2] = marc_to_str (fml, rec);
- printf ("passing '%s'\n", nargv[2]);
- nargv[3] = NULL;
- }
- else
- {
- nargv[0] = arg;
- nargv[1] = NULL;
- }
+ nargv[0] = arg;
+ nargv[1] = NULL;
fml_exec_call_argv (fml, nargv);
}
}
--- /dev/null
+# FML marc rutines - with passing of code and regular expressions
+#
+# $Id: marc4.fml,v 1.1 1995/03/02 08:06:11 adam Exp $
+\func case tag indicator identifier \code max {
+ \if {\match \tag {\line\index 1}} {
+ \if {\match \indicator {\line\index 2}} {
+ \foreach field {\line \index 3} {
+ \if{\match \identifier \field\index 1} {
+ \set info {\field \index 2}
+ \if {{\strlen \info}\gt \max}
+ {
+ \set info {\strsub \info 0 50 ..}
+ }
+ \code
+ }
+ }
+ } }
+}
+
+\func casx tag identifier \pre \mid \end {
+ \set no {}
+ \if {\match \tag {\line\index 1}} {
+ \foreach field {\line \index 3} {
+ \if {\match \identifier \field\index 1} {
+ \set info {\field \index 2}
+ \if {\no} {
+ \mid
+ \incr \no
+ }
+ \else {
+ \set no 1
+ \pre
+ }
+ }
+ }
+ }
+ \if {\no} {
+ \end
+ }
+}
+
+\func marc rec \code {
+ \foreach line {\rec} {\code}
+}
+
+\func f0 record {
+ \marc {\record} {
+ \case 245 .. [a] { \info } 60
+ \case 260 .. c { - \info} 9
+ }
+ \n
+}
+
+\func f1 record {
+ \marc {\record} {
+ \case 245 .. [ab] {\info\ } 400
+ \casx 260 [abc] {\n\ \ \info} {\ \info} {}
+ \casx 300 [ab] {- \info} {\ \info} {}
+ }
+ \n
+ \marc {\record} {
+ \casx 700 a {\info} {\ ,\info} {\n}
+ }
+ \marc {\record} {
+ \case 020 .. a {ISBN: \info\n} 50
+ \case 022 .. a {ISSN: \info\n} 50
+ \casx 050 [ab] {LC: \info} {\info} {\n}
+ }
+ \n
+}
--- /dev/null
+# FML marc rutines - with passing of code and regular expressions
+#
+# $Id: marc5.fml,v 1.1 1995/03/02 08:06:12 adam Exp $
+\func case tag indicator identifier \code max {
+ \if {\match \tag {\line\index 1}} {
+ \if {\match \indicator {\line\index 2}} {
+ \foreach field {\line \index 3} {
+ \if{\match \identifier \field\index 1} {
+ \set info {\field \index 2}
+ \if {{\strlen \info}\gt \max}
+ {
+ \set info {\strsub \info 0 50 ..}
+ }
+ \code
+ }
+ }
+ } }
+}
+
+\func casx tag identifier \pre \mid \end {
+ \set no {}
+ \if {\match \tag {\line\index 1}} {
+ \foreach field {\line \index 3} {
+ \if {\match \identifier \field\index 1} {
+ \set info {\field \index 2}
+ \if {\no} {
+ \mid
+ \incr \no
+ }
+ \else {
+ \set no 1
+ \pre
+ }
+ }
+ }
+ }
+ \if {\no} {
+ \end
+ }
+}
+
+\func marc rec \code {
+ \foreach line {\rec} {\code}
+}
+
+\func f0 record {
+ \marc {\record} {
+ \case 245 .. [a] { \info } 60
+ \case 260 .. c { - \info} 9
+ }
+ \n
+}
+
+\func f1 record {
+ \foreach line {\record} {
+ \case 245 .. [ab] {\info\ } 400
+ \casx 260 [abc] {\n\ \ \info} {\ \info} {}
+ \casx 300 [ab] {- \info} {\ \info} {}
+ }
+ \n
+ \foreach line {\record} {
+ \casx 700 a {\info} {\ ,\info} {\n}
+ }
+ \foreach line {\record} {
+ \case 020 .. a {ISBN: \info\n} 50
+ \case 022 .. a {ISSN: \info\n} 50
+ \casx 050 [ab] {LC: \info} {\info} {\n}
+ }
+ \n
+}
projects / egate.git / commitdiff