Initial revision
authorAdam Dickmeiss <adam@indexdata.dk>
Mon, 6 Feb 1995 13:48:09 +0000 (13:48 +0000)
committerAdam Dickmeiss <adam@indexdata.dk>
Mon, 6 Feb 1995 13:48:09 +0000 (13:48 +0000)
fml/.depend [new file with mode: 0644]
fml/Makefile [new file with mode: 0644]
fml/fml.c [new file with mode: 0644]
fml/fml.h [new file with mode: 0644]
fml/fmlmem.c [new file with mode: 0644]
fml/fmlp.h [new file with mode: 0644]
fml/fmlsym.c [new file with mode: 0644]
fml/fmltest.c [new file with mode: 0644]
fml/fmltoken.c [new file with mode: 0644]
fml/power.fml [new file with mode: 0644]
fml/tempo.fml [new file with mode: 0644]

diff --git a/fml/.depend b/fml/.depend
new file mode 100644 (file)
index 0000000..947f7ae
--- /dev/null
@@ -0,0 +1,18 @@
+fml.o : fml.c /usr/include/assert.h /usr/include/stdlib.h /usr/include/features.h \
+  /usr/include/sys/cdefs.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
+  /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
+  /usr/include/alloca.h /usr/include/stdio.h /usr/include/libio.h /usr/include/_G_config.h \
+  fmlp.h fml.h 
+fmlmem.o : fmlmem.c /usr/include/stdio.h /usr/include/features.h /usr/include/sys/cdefs.h \
+  /usr/include/libio.h /usr/include/_G_config.h /usr/include/stdlib.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
+  /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
+  /usr/include/alloca.h /usr/include/string.h /usr/include/assert.h fmlp.h fml.h 
+fmlsym.o : fmlsym.c /usr/include/stdio.h /usr/include/features.h /usr/include/sys/cdefs.h \
+  /usr/include/libio.h /usr/include/_G_config.h /usr/include/stdlib.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
+  /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
+  /usr/include/alloca.h /usr/include/assert.h fmlp.h fml.h 
+fmltest.o : fmltest.c /usr/include/stdio.h /usr/include/features.h /usr/include/sys/cdefs.h \
+  /usr/include/libio.h /usr/include/_G_config.h fml.h 
+fmltoken.o : fmltoken.c /usr/include/string.h /usr/include/features.h /usr/include/sys/cdefs.h \
+  /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h /usr/include/assert.h /usr/include/stdio.h \
+  /usr/include/libio.h /usr/include/_G_config.h fmlp.h fml.h 
diff --git a/fml/Makefile b/fml/Makefile
new file mode 100644 (file)
index 0000000..519ef31
--- /dev/null
@@ -0,0 +1,46 @@
+# FML interpreter. Europagate, 1995
+#
+# $Id: Makefile,v 1.1 1995/02/06 13:48:09 adam Exp $
+
+SHELL=/bin/sh
+INCLUDE=-I../include
+TPROG1=fmltest
+CFLAGS=-g -Wall -pedantic 
+DEFS=$(INCLUDE)
+LIB=fml.a 
+PO = fmltoken.o fmlmem.o fml.o fmlsym.o
+CPP=cc -E
+CC=gcc
+
+all: $(LIB) $(TPROG1) $(TPROG2)
+
+$(TPROG1): $(TPROG1).o $(LIB) 
+       $(CC) $(CFLAGS) -o $(TPROG1) $(TPROG1).o $(LIB)
+
+$(LIB): $(PO)
+       rm -f $(LIB)
+       ar qc $(LIB) $(PO)
+       ranlib $(LIB)
+
+.c.o:
+       $(CC) -c $(DEFS) $(CFLAGS) $<
+
+clean:
+       rm -f *.[oa] $(TPROG1) $(TPROG2) core mon.out gmon.out errlist
+
+depend: depend2
+
+depend1:
+       mv Makefile Makefile.tmp
+       sed '/^#Depend/q' <Makefile.tmp >Makefile
+       $(CPP) $(INCLUDE) -M *.c >>Makefile
+       -rm Makefile.tmp
+
+depend2:
+       $(CPP) $(INCLUDE) -M *.c >.depend       
+
+ifeq (.depend,$(wildcard .depend))
+include .depend
+endif
+
+#Depend --- DOT NOT DELETE THIS LINE
diff --git a/fml/fml.c b/fml/fml.c
new file mode 100644 (file)
index 0000000..445e8ce
--- /dev/null
+++ b/fml/fml.c
@@ -0,0 +1,1037 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fml.c,v $
+ * Revision 1.1  1995/02/06 13:48:09  adam
+ * Initial revision
+ *
+ */
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "fmlp.h"
+
+static int default_read_func (void)
+{
+    return getchar ();
+}
+
+static void default_err_handle (int no)
+{
+    fprintf (stderr, "Error: %d\n", no);
+}
+
+static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp, 
+                                        struct token *tp);
+static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp, 
+                                     struct token *tp);
+#if 0
+static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list);
+#endif
+static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
+
+static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
+                                       struct fml_node *r);
+static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
+                                        struct fml_node *r);
+static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
+                                     struct fml_node *r);
+static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
+                                     struct fml_node *r);
+static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
+                                     struct fml_node *r);
+static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
+                                      struct fml_node *r);
+static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
+                                     struct fml_node *r);
+static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
+                                     struct fml_node *r);
+                                  
+static int indent = 0;
+
+static void pr_indent (int n)
+{
+    assert (indent >= 0);
+    if (n >= 0)
+    {
+        int i = indent;
+        while (--i >= 0)
+            putchar (' ');
+    }
+    if (n > 0)
+    {
+        printf ("[");
+        ++indent;
+    } 
+    else if (n < 0)
+    {
+        printf ("]\n");
+        --indent;
+    }
+}
+
+Fml fml_open (void)
+{
+    struct fml_sym_info *sym_info;
+
+    Fml fml = malloc (sizeof(*fml));
+
+    if (!fml)
+        return NULL;
+
+    fml->escape_char = '\\';
+    fml->comment_char = '#';
+    fml->eof_mark = EOF;
+    fml->white_chars = " \t\f\r\n";
+    fml->read_func = default_read_func;
+    fml->err_handle = default_err_handle;
+
+    fml->list = NULL;
+    fml->sym_tab = fml_sym_open ();
+    fml->atom_free_list = NULL;
+    fml->node_free_list = NULL;
+    fml->debug = 0;
+
+    sym_info = fml_sym_add (fml->sym_tab, "func");
+    sym_info->kind = FML_FUNC;
+    sym_info = fml_sym_add (fml->sym_tab, "bin");
+    sym_info->kind = FML_BIN;
+    sym_info = fml_sym_add (fml->sym_tab, "if");
+    sym_info->kind = FML_IF;
+    sym_info = fml_sym_add (fml->sym_tab, "else");
+    sym_info->kind = FML_ELSE;
+    sym_info = fml_sym_add (fml->sym_tab, "foreach");
+    sym_info->kind = FML_FOREACH;
+    sym_info = fml_sym_add (fml->sym_tab, "set");
+    sym_info->kind = FML_SET;
+    sym_info = fml_sym_add (fml->sym_tab, "while");
+    sym_info->kind = FML_WHILE;
+    sym_info = fml_sym_add (fml->sym_tab, "return");
+    sym_info->kind = FML_RETURN;
+
+
+    sym_info = fml_sym_add (fml->sym_tab, "and");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_and;
+    sym_info = fml_sym_add (fml->sym_tab, "or");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_or;
+    sym_info = fml_sym_add (fml->sym_tab, "index");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_indx;
+
+    sym_info = fml_sym_add (fml->sym_tab, "plus");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_plus;
+    sym_info = fml_sym_add (fml->sym_tab, "minus");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_minus;
+
+    sym_info = fml_sym_add (fml->sym_tab, "gt");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_gt;
+    sym_info = fml_sym_add (fml->sym_tab, "lt");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_lt;
+    sym_info = fml_sym_add (fml->sym_tab, "eq");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_eq;
+
+    sym_info = fml_sym_add (fml->sym_tab, "s");
+    sym_info->kind = FML_CPREFIX;
+    sym_info->prefix = fml_exec_space;
+    sym_info = fml_sym_add (fml->sym_tab, " ");
+    sym_info->kind = FML_CPREFIX;
+    sym_info->prefix = fml_exec_space;
+    sym_info = fml_sym_add (fml->sym_tab, "n");
+    sym_info->kind = FML_CPREFIX;
+    sym_info->prefix = fml_exec_nl;
+
+    return fml;
+}
+
+static Fml fml_pop_handler = NULL;
+static void pop_handler (struct fml_sym_info *info)
+{
+    assert (fml_pop_handler);
+    switch (info->kind)
+    {
+    case FML_VAR:
+/* fml_node_delete (fml_pop_handler, info->body); */
+        break;
+    }
+}
+static void fml_do_pop (Fml fml)
+{
+    fml_pop_handler = fml;
+    fml_sym_pop (fml->sym_tab, pop_handler);
+}
+
+int fml_preprocess (Fml fml)
+{
+    fml->list = fml_tokenize (fml);
+    return 0;
+}
+
+
+static void fml_init_token (struct token *tp, Fml fml)
+{
+    tp->maxbuf = FML_ATOM_BUF*2;
+    tp->offset = 0;
+    tp->atombuf = tp->sbuf;
+    tp->tokenbuf = tp->sbuf + tp->maxbuf;
+    tp->escape_char = fml->escape_char;
+}
+
+static void fml_del_token (struct token *tp, Fml fml)
+{
+    if (tp->maxbuf != FML_ATOM_BUF*2)
+        free (tp->atombuf);
+}
+
+static void fml_cmd_lex (struct fml_node **np, struct token *tp)
+{
+    char *cp;
+    char *dst;
+    if (!*np)
+    {
+        tp->kind = '\0';
+        return;
+    }
+    if (tp->offset == 0)
+    {
+        if ((*np)->is_atom)
+        {
+            tp->atom = (*np)->p[0];
+            if (!tp->atom->next)
+                fml_atom_str (tp->atom, tp->atombuf);
+            else
+            {
+                int l = fml_atom_str (tp->atom, NULL);
+                if (l >= tp->maxbuf-1)
+                {
+                    if (tp->maxbuf != FML_ATOM_BUF*2)
+                        free (tp->atombuf);
+                    tp->maxbuf = l + 40;
+                    tp->atombuf = malloc (tp->maxbuf*2);
+                    tp->tokenbuf = tp->atombuf + tp->maxbuf;
+                }
+                fml_atom_str (tp->atom, tp->atombuf);
+            }
+        }
+        else
+        {
+            tp->sub = (*np)->p[0];
+            tp->kind = 'g';
+            *np = (*np)->p[1];
+            return ;
+        }
+    }
+    cp = tp->atombuf + tp->offset;
+    dst = tp->tokenbuf;
+    if (*cp == tp->escape_char)
+    {
+        tp->kind = 'e';
+        tp->after_char = '\0';
+        cp++;
+        if (*cp == '\0')
+        {
+            strcpy (dst, " ");
+            tp->offset = 0;
+            *np = (*np)->p[1];
+            return ;
+        }
+    }
+    else
+    {
+        tp->kind = 't';
+        tp->after_char = ' ';
+    }
+    while (*cp)
+    {
+        if (*cp == tp->escape_char)
+        {
+            *dst = '\0';
+#if 0
+            if (cp[1] == '\0')
+            {
+                tp->after_char = ' ';
+                break;
+            }
+#endif
+            if (tp->kind == 'e')
+            {
+                cp++;
+                if (! *cp)
+                    break;
+            }
+            tp->offset = cp - tp->atombuf;
+            tp->after_char = '\0';
+            return ;
+        }
+        *dst++ = *cp++;
+    }
+    *dst = '\0';
+    tp->offset = 0;
+    *np = (*np)->p[1];
+}
+
+static struct fml_node *fml_lex_list (Fml fml, struct token *tp)
+{
+    struct fml_node *fn;
+
+    if (tp->kind == 'g')
+        return tp->sub;
+    fn = fml_node_alloc (fml);
+    fn->is_atom = 1;
+    fn->p[0] = tp->atom;
+    return fn;
+}
+
+static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
+
+static void fml_lr_values (struct fml_node *l, int *left_val,
+                           struct fml_node *r, int *right_val)
+{
+    static char arg[128];
+    if (l->is_atom)
+    {
+        fml_atom_strx (l->p[0], arg, 127);
+        *left_val = atoi (arg);
+    }
+    else
+        *left_val = 0;
+    if (r->is_atom)
+    {
+        fml_atom_strx (r->p[0], arg, 127);
+        *right_val = atoi (arg);
+    }
+    else
+        *right_val = 0;
+}
+
+static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
+                                      struct fml_node *r)
+{
+    if (l && r)
+        return r;
+    else
+        return NULL;
+}
+
+static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
+                                      struct fml_node *r)
+{
+    if (l)
+        return l;
+    return r;
+}
+
+static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
+                                       struct fml_node *r)
+{
+    struct fml_node *list = l;
+    int indx;
+
+    if (!l || !r || !r->is_atom)
+        return NULL;
+    indx = fml_atom_val (r->p[0]);
+    while (--indx >= 0 && list)
+        list = list->p[1];
+    if (!list)
+        return NULL;
+    if (list->is_atom)
+    {
+        struct fml_node *fn = fml_node_alloc (fml);
+        fn->is_atom = 1;
+        fn->p[0] = list->p[0];
+        return fn;
+    }
+    else
+        return list->p[0];
+}
+
+static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
+                                       struct fml_node *r)
+{
+    int left_val, right_val;
+    char arg[20];
+    struct fml_node *fn;
+
+    fml_lr_values (l, &left_val, r, &right_val);
+    sprintf (arg, "%d", left_val + right_val);
+    fn = fml_node_alloc (fml);
+    fn->is_atom = 1;
+    fn->p[0] = fml_atom_alloc (fml, arg);
+    return fn;
+}
+
+static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
+                                       struct fml_node *r)
+{
+    int left_val, right_val;
+    char arg[20];
+    struct fml_node *fn;
+
+    fml_lr_values (l, &left_val, r, &right_val);
+    sprintf (arg, "%d", left_val - right_val);
+    fn = fml_node_alloc (fml);
+    fn->is_atom = 1;
+    fn->p[0] = fml_atom_alloc (fml, arg);
+    return fn;
+}
+
+
+static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
+                                     struct fml_node *r)
+{
+    int left_val, right_val;
+    struct fml_node *fn;
+    fml_lr_values (l, &left_val, r, &right_val);
+    if (left_val > right_val)
+    {
+        fn = fml_node_alloc (fml);
+        fn->is_atom = 1;
+        fn->p[0] = fml_atom_alloc (fml, "1");
+    }
+    else
+        fn = NULL;
+    return fn;
+}
+
+
+static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
+                                     struct fml_node *r)
+{
+    int left_val, right_val;
+    struct fml_node *fn;
+    fml_lr_values (l, &left_val, r, &right_val);
+    if (left_val < right_val)
+    {
+        fn = fml_node_alloc (fml);
+        fn->is_atom = 1;
+        fn->p[0] = fml_atom_alloc (fml, "1");
+    }
+    else
+        fn = NULL;
+    return fn;
+}
+
+static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
+                                     struct fml_node *r)
+{
+    int left_val, right_val;
+    struct fml_node *fn;
+    fml_lr_values (l, &left_val, r, &right_val);
+    if (left_val == right_val)
+    {
+        fn = fml_node_alloc (fml);
+        fn->is_atom = 1;
+        fn->p[0] = fml_atom_alloc (fml, "1");
+    }
+    else
+        fn = NULL;
+    return fn;
+}
+
+
+static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp, 
+                                        struct token *tp)
+{
+    return NULL;
+}
+
+static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp, 
+                                     struct token *tp)
+{
+    putchar ('\n');
+    return NULL;
+}
+
+static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
+                                         struct fml_node **lp,
+                                         struct token *tp)
+{
+    struct fml_node *fn;
+    struct fml_sym_info *arg_info;
+    struct fml_node *return_value;
+    static char arg[128];
+
+    if (fml->debug)
+    {
+        pr_indent (1);
+        printf ("exec_prefix ");
+    }
+    fml_sym_push (fml->sym_tab);
+    for (fn = info->args; fn; fn = fn->p[1])
+    {
+        fml_cmd_lex (lp, tp);
+
+        assert (fn->is_atom);
+        fml_atom_strx (fn->p[0], arg, 127);
+        if (fml->debug)
+        {
+            
+            pr_indent (1);
+            printf ("%s=", arg);
+        }
+        arg_info = fml_sym_add_local (fml->sym_tab, arg);
+        arg_info->kind = FML_VAR;
+        arg_info->body = fml_lex_list (fml, tp);
+        if (arg_info->body)
+            arg_info->body = fml_sub0 (fml, arg_info->body);
+        if (fml->debug)
+        {
+            fml_pr_list (arg_info->body);
+            pr_indent (-1);
+        }
+    }
+    return_value = fml_exec_group (info->body, fml);
+    if (fml->debug)
+    {
+        pr_indent(0);
+        pr_indent (-1);
+    }
+    fml_do_pop (fml);
+    return return_value;
+}
+
+
+static void fml_emit (struct fml_node *list)
+{
+    int s = 0;
+    while (list)
+    {
+        if (list->is_atom)
+        {
+            struct fml_atom *a;
+            if (s)
+                printf (" ");
+            s++;
+            for (a = list->p[0]; a; a=a->next)
+                printf ("%s", a->buf);
+        }
+        else
+            fml_emit (list->p[0]);
+        list = list->p[1];
+    }
+}
+
+static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
+                                  struct token *tp);
+
+
+static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
+                                  struct token *tp)
+{
+    struct fml_node *fn;
+    struct fml_sym_info *info;
+    if (tp->kind == 'e')
+    {
+        info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
+        assert (info);
+        switch (info->kind)
+        {
+        case FML_VAR:
+            fn = info->body;
+            fml_cmd_lex (lp, tp);
+            break;
+        case FML_PREFIX:
+            fn = fml_exec_prefix (info, fml, lp, tp);
+            fml_cmd_lex (lp, tp);
+            break;
+        case FML_CPREFIX:
+            fn = (*info->prefix) (fml, lp, tp);
+            fml_cmd_lex (lp, tp);
+            break;
+        default:
+            fml_cmd_lex (lp, tp);
+            fn = NULL;
+        }
+    }
+    else if (tp->kind == 'g')
+    {
+        if (tp->sub)
+            fn = fml_sub0 (fml, tp->sub);
+        else
+            fn = NULL;
+        fml_cmd_lex (lp, tp);
+    }
+    else if (tp->kind == 't')
+    {
+        fn = fml_node_alloc (fml);
+        fn->is_atom = 1;
+        fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
+        fml_cmd_lex (lp, tp);
+    }
+    else
+        fn = NULL;
+    return fn;
+}
+
+static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
+                                  struct token *tp)
+{
+    struct fml_node *f1, *f2;
+    struct fml_sym_info *info;
+
+    f1 = fml_sub2 (fml, lp, tp);
+    while (tp->kind == 'e')
+    {
+        info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
+        if (!info)
+        {
+            fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
+            exit (1);
+        }
+        if (info->kind == FML_CBINARY)
+        {
+            fml_cmd_lex (lp, tp);
+            f2 = fml_sub2 (fml, lp, tp);
+            f1 = (*info->binary) (fml, f1, f2);
+            continue;
+        }
+        else if (info->kind == FML_BINARY)
+        {
+            struct fml_sym_info *arg_info;
+            char arg[127];
+
+            if (fml->debug)
+            {
+                pr_indent (1);
+                printf ("exec binary %s", tp->tokenbuf);
+            }
+            fml_cmd_lex (lp, tp);
+            f2 = fml_sub2 (fml, lp, tp);
+            fml_sym_push (fml->sym_tab);
+
+            fml_atom_strx (info->args->p[0], arg, 127);
+            arg_info = fml_sym_add_local (fml->sym_tab, arg);
+            arg_info->kind = FML_VAR;
+            arg_info->body = f1;
+            if (fml->debug)
+            {
+                printf (" left=");
+                fml_pr_list (f1);
+            }
+            fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
+                           arg, 127);
+            arg_info = fml_sym_add_local (fml->sym_tab, arg);
+            arg_info->kind = FML_VAR;
+            arg_info->body = f2;
+            if (fml->debug)
+            {
+                printf (" right=");
+                fml_pr_list (f2);
+                putchar ('\n');
+            }
+            f1 = fml_exec_group (info->body, fml);
+            fml_do_pop (fml);
+            if (fml->debug)
+            {
+                pr_indent (0);
+                pr_indent (-1);
+            }
+        }
+        else
+            break;
+    }
+    return f1;
+}
+
+#if 0
+static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list)
+{
+    struct token token;
+    struct fml_node *fn, *fn1;
+
+    fml_init_token (&token, fml);
+    assert (list);
+    fml_cmd_lex (&list, &token);
+    fn = fml_sub1 (fml, &list, &token);
+    if (token.kind == '\0')
+    {
+        fml_del_token (&token, fml);
+        return fn;
+    }
+    fn1 = fml_node_alloc (fml);
+    fn1->p[0] = fn;
+    fn = fn1;
+    while (token.kind != '\0')
+    {
+        fn1 = fn1->p[1] = fml_node_alloc (fml);
+        fn1->p[0] = fml_sub1 (fml, &list, &token);
+    }
+    fml_del_token (&token, fml);
+    return fn;
+}
+#endif
+
+static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
+{
+    struct token token;
+    struct fml_node *fn, *fn1;
+
+    fml_init_token (&token, fml);
+    assert (list);
+    fml_cmd_lex (&list, &token);
+    fn1 = fn = fml_sub1 (fml, &list, &token);
+
+    while (token.kind != '\0')
+        fn1 = fn1->p[1] = fml_sub1 (fml, &list, &token);
+    fml_del_token (&token, fml);
+    return fn;
+}
+
+static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
+                                          struct fml_node **lp,
+                                          struct token *tp)
+{
+    struct fml_sym_info *info_var;
+    struct fml_node *fn, *body;
+    struct fml_node *return_value = NULL, *rv;
+
+    fml_cmd_lex (lp, tp);
+    assert (tp->kind == 't');
+    
+    info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
+    if (!info_var)
+    {
+        info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
+        info_var->body = NULL;
+        info_var->kind = FML_VAR;
+    }
+    if (fml->debug)
+    {
+        pr_indent (1);
+        printf ("[foreach %s ", tp->tokenbuf);
+    }
+    fml_cmd_lex (lp, tp);
+
+    fn = fml_lex_list (fml, tp);
+    if (fn)
+        fn = fml_sub0 (fml, fn);
+    fml_cmd_lex (lp, tp);
+
+    body = fml_lex_list (fml, tp);
+    while (fn)
+    {
+        if (fn->is_atom)
+        {
+            struct fml_node *fn1;
+            fn1 = fml_node_alloc (fml);
+            fn1->is_atom=1;
+            fn1->p[0] = fn->p[0];
+            info_var->body = fn1;
+        }
+        else
+            info_var->body = fn->p[0];
+
+        if (fml->debug)
+        {
+            pr_indent (1);
+            printf ("[foreach loop var=");
+            fml_pr_list (info_var->body);
+            pr_indent (-1);
+        }
+        rv = fml_exec_group (body, fml);
+        if (rv)
+            return_value = rv;
+        fn = fn->p[1];
+    }
+    if (fml->debug)
+        pr_indent (-1);
+    return return_value;
+}
+
+static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
+                                     struct fml_node **lp, struct token *tp)
+{
+    struct fml_node *fn, *body;
+    struct fml_node *rv, *return_value = NULL;
+
+    fml_cmd_lex (lp, tp);
+    fn = fml_lex_list (fml, tp);
+    if (fn)
+        fn = fml_sub0 (fml, fn);
+    fml_cmd_lex (lp, tp);
+    if (fn)
+    {
+        body = fml_lex_list (fml, tp);
+        rv = fml_exec_group (body, fml);
+        if (rv)
+            return_value = rv;
+    }
+    fml_cmd_lex (lp, tp);
+    if (tp->kind == 'e')
+    {
+        info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
+        if (info->kind == FML_ELSE)
+        {
+            fml_cmd_lex (lp, tp);
+            body = fml_lex_list (fml, tp);
+            fml_cmd_lex (lp, tp);
+            if (!fn)
+            {
+                rv = fml_exec_group (body, fml);
+                if (rv)
+                    return_value = rv;
+            }
+        }
+    }
+    return return_value;
+}
+
+static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
+                                        struct fml_node **lp, struct token *tp)
+{
+    struct fml_node *fn, *body;
+    struct fml_node *return_value = NULL;
+
+    fml_cmd_lex (lp, tp);
+    fn = fml_lex_list (fml, tp);
+
+    fml_cmd_lex (lp, tp);
+    body = fml_lex_list (fml, tp);
+    while (1)
+    {
+        struct fml_node *fn_expr;
+        struct fml_node *rv;
+        if (!fn)
+            break;
+        fn_expr = fml_sub0 (fml, fn);
+        if (!fn_expr)
+            break;
+        rv = fml_exec_group (body, fml);
+        if (rv)
+            return_value = rv;
+    }
+    return return_value;
+}
+
+static void fml_exec_set (struct fml_sym_info *info, Fml fml,
+                    struct fml_node **lp, struct token *tp)
+{
+    struct fml_node *fn;
+    struct fml_sym_info *info_var;
+
+    fml_cmd_lex (lp, tp);
+    info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
+    if (!info_var)
+    {
+        info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
+        info_var->body = NULL;
+    }
+    if (fml->debug)
+    {
+        pr_indent (1);
+        printf ("set %s ", tp->tokenbuf);
+    }
+    info_var->kind = FML_VAR;
+    fml_cmd_lex (lp, tp);
+    fn = fml_lex_list (fml, tp);
+    assert (fn);
+    if (fn)
+        fn = fml_sub0 (fml, fn);
+    info_var->body = fn;
+    if (fml->debug)
+    {
+        fml_pr_list (info_var->body);
+        pr_indent (-1);
+    }
+}
+
+static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
+{
+    struct fml_node *fn;
+
+    fn = fml_sub1 (fml, lp, tp);
+    fml_emit (fn);
+#if 0
+    if (fn && fn->is_atom)
+    {
+        char arg[128];
+        fml_atom_strx (fn->p[0], arg, 127);
+        printf ("%s", arg);
+    }
+#endif
+}
+
+static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
+{
+    struct token token;
+    struct fml_sym_info *info;
+    int separate = 0;
+    struct fml_node *return_value = NULL, *rv;
+
+    if (!list)
+        return NULL;
+    fml_init_token (&token, fml);
+    fml_cmd_lex (&list, &token);
+    while (token.kind)
+    {
+        switch (token.kind)
+        {
+        case 'g':
+            rv = fml_exec_group (token.sub, fml);
+            if (rv)
+                return_value = rv;
+            break;
+        case 'e':
+            info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
+            if (info)
+            {
+                struct fml_node *fn;
+
+                switch (info->kind)
+                {
+                case FML_FUNC:
+                    fml_cmd_lex (&list, &token);
+                    assert (token.kind == 't');
+                    info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
+                    if (!info)
+                        info = fml_sym_add (fml->sym_tab, token.tokenbuf);
+                    info->kind = FML_PREFIX;
+                    info->args = NULL;
+                    while (1)
+                    {
+                        fml_cmd_lex (&list, &token);
+                        if (token.kind != 't')
+                            break;
+                        if (!info->args)
+                        {
+                            info->args = fn = fml_node_alloc (fml);
+                        }
+                        else
+                        {
+                            for (fn = info->args; fn->p[1]; fn=fn->p[1])
+                                ;
+                            fn = fn->p[1] = fml_node_alloc (fml);
+                        }
+                        fn->p[0] = token.atom;
+                        fn->is_atom = 1;
+                    }
+                    assert (token.kind == 'g');
+                    info->body = token.sub;
+                    break;
+                case FML_BIN:
+                    fml_cmd_lex (&list, &token);
+                    assert (token.kind == 't');
+                    info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
+                    if (!info)
+                        info = fml_sym_add (fml->sym_tab, token.tokenbuf);
+                    info->kind = FML_BINARY;
+
+                    fml_cmd_lex (&list, &token);
+                    assert (token.kind == 't');
+                    info->args = fn = fml_node_alloc (fml);
+                    fn->p[0] = token.atom;
+                    fn->is_atom = 1;
+
+                    fml_cmd_lex (&list, &token);
+                    assert (token.kind == 't');
+                    fn = fn->p[1] = fml_node_alloc (fml);
+                    fn->p[0] = token.atom;
+                    fn->is_atom = 1;
+
+                    fml_cmd_lex (&list, &token);
+                    assert (token.kind == 'g');
+                    info->body = token.sub;
+                    break;
+#if 0
+                case FML_PREFIX:
+                    after_char = token.after_char;
+                    fml_exec_prefix (info, fml, &list, &token);
+                    if (after_char)
+                        putchar (after_char);
+                    break;
+                case FML_VAR:
+                    fml_emit (info->body);
+                    if (token.after_char)
+                        putchar (token.after_char);
+                    break;
+#endif
+                case FML_VAR:
+                case FML_PREFIX:
+                case FML_CPREFIX:
+                    if (separate)
+                        putchar (' ');
+                    if (token.offset == 0)
+                        separate = ' ';
+                    else
+                        separate = 0;
+                    fml_emit_expr (fml, &list, &token);
+                    continue;
+                case FML_FOREACH:
+                    rv = fml_exec_foreach (info, fml, &list, &token);
+                    if (rv)
+                        return_value = rv;
+                    break;
+                case FML_IF:
+                    rv = fml_exec_if (info, fml, &list, &token);
+                    if (rv)
+                        return_value = rv;
+                    break;
+                case FML_SET:
+                    fml_exec_set (info, fml, &list, &token);
+                    break;
+                case FML_WHILE:
+                    rv = fml_exec_while (info, fml, &list, &token);
+                    if (rv)
+                        return_value = rv;
+                    break;
+                case FML_RETURN:
+                    fml_cmd_lex (&list, &token);
+                    return_value = fml_lex_list (fml, &token);
+                    if (return_value)
+                        return_value = fml_sub0 (fml, return_value);
+                    if (fml->debug)
+                    {
+                        pr_indent (1);
+                        printf ("return of:");
+                        fml_pr_list (return_value);
+                        pr_indent (-1);
+                    }
+                    break;
+                default:
+                    printf ("unknown token: `%s'", token.tokenbuf);
+                    fml_cmd_lex (&list, &token);
+                }
+            }
+            else
+            {
+                printf ("<unknown>");
+            }
+            break;
+        case 't':
+            if (separate)
+                putchar (' ');
+            if (token.offset == 0)
+                separate = ' ';
+            else
+                separate = 0;
+            fml_emit_expr (fml, &list, &token);
+            continue;
+#if 0               
+            printf ("%s", token.tokenbuf);
+            if (token.after_char)
+                putchar (token.after_char);
+#endif
+        }
+        fml_cmd_lex (&list, &token);
+    }
+    fml_del_token (&token, fml);
+    return return_value;
+}
+
+void fml_exec (Fml fml)
+{
+    fml_exec_group (fml->list, fml);
+    if (fml->debug)
+        printf ("\n");
+}
+
+
diff --git a/fml/fml.h b/fml/fml.h
new file mode 100644 (file)
index 0000000..c65e428
--- /dev/null
+++ b/fml/fml.h
@@ -0,0 +1,32 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fml.h,v $
+ * Revision 1.1  1995/02/06 13:48:09  adam
+ * Initial revision
+ *
+ */
+
+typedef struct Fml_record {
+    struct fml_node *list;
+    struct fml_sym_tab *sym_tab;
+
+    struct fml_atom *atom_free_list;
+    struct fml_node *node_free_list;
+
+    int escape_char;
+    int eof_mark;
+    char *white_chars;
+    char comment_char;
+    int (*read_func)(void);
+    void (*err_handle)(int no);
+
+    int debug;
+} *Fml;
+
+Fml fml_open (void);
+int fml_preprocess (Fml fml);
+void fml_exec (Fml fml);
+
+#define FML_ERR_NOMEM 1
+
diff --git a/fml/fmlmem.c b/fml/fmlmem.c
new file mode 100644 (file)
index 0000000..4bc4c56
--- /dev/null
@@ -0,0 +1,205 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmlmem.c,v $
+ * Revision 1.1  1995/02/06 13:48:09  adam
+ * Initial revision
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+#include "fmlp.h"
+
+#define FML_ATOM_CHUNK 1024
+#define FML_NODE_CHUNK 1024
+
+struct fml_node *fml_node_alloc (Fml fml)
+{
+    struct fml_node *n;
+
+    if (! fml->node_free_list)
+    {
+        int i;
+
+        n = fml->node_free_list = malloc (sizeof(*n) * FML_NODE_CHUNK);
+        if (!n)
+        {
+            (*fml->err_handle)(FML_ERR_NOMEM);
+            exit (1);
+        }
+        for (i = FML_ATOM_CHUNK-1; --i >= 0; n++)
+            n->p[1] = n+1;
+        n->p[1] = NULL;
+    }
+    n = fml->node_free_list;
+    fml->node_free_list = n->p[1];
+    n->p[0] = n->p[1] = NULL;
+    n->is_atom = 0;
+    return n;
+}
+
+static struct fml_atom *atom_malloc (Fml fml)
+{
+    struct fml_atom *fa;
+
+    if (! fml->atom_free_list)
+    {
+        int i;
+
+        fa = fml->atom_free_list = malloc (sizeof(*fa) * FML_ATOM_CHUNK);
+        if (!fa)
+        {
+            (*fml->err_handle)(FML_ERR_NOMEM);
+            exit (1);
+        }
+        for (i = FML_ATOM_CHUNK-1; --i >= 0; fa++)
+            fa->next = fa+1;
+        fa->next = NULL;
+    }
+    fa = fml->atom_free_list;
+    fml->atom_free_list = fa->next;
+    return fa;
+}
+
+static void atom_delete (Fml fml, struct fml_atom *a)
+{
+    a->next = fml->atom_free_list;
+    fml->atom_free_list = a;
+}
+
+static struct fml_atom *atom_copy (Fml fml, struct fml_atom *a)
+{
+    struct fml_atom *a0, *a1;
+
+    a0 = a1 = atom_malloc (fml);
+    while (a)
+    {
+        memcpy (&a1->buf, &a->buf, FML_ATOM_CHUNK);
+        if (!a->next)
+            break;
+        a = a->next;
+        a1 = a1->next = atom_malloc (fml);
+    }
+    a1->next = NULL;
+    return a0;
+}
+
+struct fml_atom *fml_atom_alloc (Fml fml, char *str)
+{
+    int soff = 0;
+    struct fml_atom *a, *a0;
+
+    a0 = a = atom_malloc (fml);
+    strncpy (a->buf, str, FML_ATOM_BUF);
+    while (strlen (str+soff) >= FML_ATOM_BUF)
+    {
+        struct fml_atom *an;
+
+        an = atom_malloc (fml);
+        a->next = an;
+        soff += FML_ATOM_BUF;
+        strncpy (an->buf, str+soff, FML_ATOM_BUF);
+        a = an;
+    }
+    a->next = NULL;
+    return a0;
+}
+
+struct fml_node *fml_mk_list (Fml fml, struct fml_node *fn)
+{
+    if (fn->is_atom)
+    {
+        struct fml_node *fn2;
+
+        fn2 = fml_node_alloc (fml);
+        fn2->is_atom = 1;
+        fn2->p[0] = fn->p[0];
+        return fn2;
+    }
+    else
+        return fn->p[0];
+}
+
+int fml_atom_str (struct fml_atom *a, char *str)
+{
+    int len = 0;
+
+    assert (a);
+    while (a->next)
+    {
+        if (str)
+            memcpy (str+len, a->buf, FML_ATOM_BUF);
+        len += FML_ATOM_BUF;
+        a = a->next;
+    }
+    if (str)
+        strcpy (str+len, a->buf);
+    len += strlen(str+len);
+    return len;
+}
+
+void fml_atom_strx (struct fml_atom *a, char *str, int max)
+{
+    int len = 0;
+
+    assert (a);
+    while (a->next && len < max - 2*FML_ATOM_BUF)
+    {
+        memcpy (str+len, a->buf, FML_ATOM_BUF);
+        len += FML_ATOM_BUF;
+        a = a->next;
+    }
+    strncpy (str+len, a->buf, FML_ATOM_BUF-1);
+    str[len+FML_ATOM_BUF-1] = '\0';
+}
+
+int fml_atom_val (struct fml_atom *a)
+{
+    assert (a);
+    return atoi (a->buf);
+}
+
+void fml_node_delete (Fml fml, struct fml_node *fn)
+{
+    struct fml_node *f1;
+    while (fn)
+    {
+        if (fn->is_atom)
+            atom_delete (fml, fn->p[0]);
+        else
+            fml_node_delete (fml, fn->p[0]);
+        f1 = fn->p[1];
+        
+        fn->p[1] = fml->node_free_list;
+        fml->node_free_list = fn;
+
+        fn = f1;
+    }
+}
+
+struct fml_node *fml_node_copy (Fml fml, struct fml_node *fn)
+{
+    struct fml_node *fn0, *fn1;
+
+    if (!fn)
+        return NULL;
+    fn1 = fn0 = fml_node_alloc (fml);
+    while (1)
+    {
+        if (fn->is_atom)
+        {
+            fn1->is_atom = 1;
+            fn1->p[0] = atom_copy (fml, fn->p[0]);
+        }
+        else 
+            fn1->p[0] = fml_node_copy (fml, fn->p[0]);
+        if (!fn->p[1])
+            break;
+        fn = fn->p[1];
+        fn1 = fn1->p[1] = fml_node_alloc (fml);
+    }
+    return fn0;
+}
diff --git a/fml/fmlp.h b/fml/fmlp.h
new file mode 100644 (file)
index 0000000..5b0aa34
--- /dev/null
@@ -0,0 +1,88 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmlp.h,v $
+ * Revision 1.1  1995/02/06 13:48:09  adam
+ * Initial revision
+ *
+ */
+
+#include "fml.h"
+
+#define FML_MAX_TOKEN 2048
+
+#define FML_ATOM_BUF 12
+
+struct fml_node {
+    void *p[2];
+    unsigned is_atom : 1;
+};
+
+struct fml_atom {
+    struct fml_atom *next;
+    char buf[FML_ATOM_BUF];
+};
+
+struct fml_node *fml_tokenize (Fml fml);
+struct fml_node *fml_node_alloc (Fml fml);
+struct fml_atom *fml_atom_alloc (Fml fml, char *str);
+int fml_atom_str (struct fml_atom *a, char *str);
+void fml_atom_strx (struct fml_atom *a, char *str, int max);
+int fml_atom_val (struct fml_atom *a);
+struct fml_node *fml_mk_list (Fml fml, struct fml_node *fn);
+void fml_node_delete (Fml fml, struct fml_node *fn);
+struct fml_node *fml_node_copy (Fml fml, struct fml_node *fn);
+
+struct token {
+    int             kind;
+    int             after_char;
+    int             maxbuf;
+    int             offset;
+    char            *atombuf;
+    char            *tokenbuf;
+
+    int             escape_char;
+
+    struct          fml_node *sub;
+    struct          fml_atom *atom;
+    char            sbuf[FML_ATOM_BUF*4];
+};
+
+struct fml_sym_info {
+    int kind;
+    struct fml_node *args;
+    struct fml_node *body;
+    struct fml_node *(*binary)(Fml fml, struct fml_node *l,
+                               struct fml_node *r);
+    struct fml_node *(*prefix)(Fml fml, struct fml_node **lp,
+                               struct token *tp);
+};
+
+struct fml_sym_tab *fml_sym_open (void);
+void fml_sym_close (struct fml_sym_tab **tabp);
+struct fml_sym_info *fml_sym_add (struct fml_sym_tab *tab, const char *s);
+struct fml_sym_info *fml_sym_add_local (struct fml_sym_tab *tab,const char *s);
+
+struct fml_sym_info *fml_sym_lookup (struct fml_sym_tab *tab, const char *s);
+struct fml_sym_info *fml_sym_lookup_local (struct fml_sym_tab *tab,
+                                           const char *s);
+void fml_sym_push (struct fml_sym_tab *tab);
+void fml_sym_pop (struct fml_sym_tab *tab, void(*ph)(struct fml_sym_info *i));
+
+void fml_pr_list (struct fml_node *p);
+
+#define FML_FUNC     1
+#define FML_IF       2
+#define FML_ELSE     3
+#define FML_PREFIX   4
+#define FML_VAR      5
+#define FML_FOREACH  6
+#define FML_RETURN   7
+#define FML_SET      8
+#define FML_WHILE    9
+#define FML_CBINARY 10
+#define FML_CPREFIX 11
+#define FML_BINARY  12
+#define FML_BIN     13
+
+
diff --git a/fml/fmlsym.c b/fml/fmlsym.c
new file mode 100644 (file)
index 0000000..b9a8390
--- /dev/null
@@ -0,0 +1,176 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmlsym.c,v $
+ * Revision 1.1  1995/02/06 13:48:09  adam
+ * Initial revision
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#include "fmlp.h"
+
+struct fml_sym {
+    struct fml_sym_info info;
+    struct fml_sym *next;
+    int level;
+    char *name;
+};
+
+struct fml_sym_tab {
+    int level;
+    int hash;
+    struct fml_sym **array;
+};
+
+struct fml_sym_tab *fml_sym_open (void)
+{
+    struct fml_sym_tab *tab;
+    int i;
+
+    tab = malloc (sizeof (*tab));
+    if (!tab)
+        return NULL;
+    tab->level = 1;
+    tab->hash = 101;
+    tab->array = malloc (sizeof(*tab->array) * tab->hash);
+    if (!tab->array)
+    {
+        free (tab);
+        return NULL;
+    }
+    for (i = 0; i<tab->hash; i++)
+        tab->array[i] = NULL;
+    return tab;
+}
+
+void fml_sym_close (struct fml_sym_tab **tabp)
+{
+    struct fml_sym *sym, *sym1;
+    int i;
+    for (i = (*tabp)->hash; --i >= 0; )
+        for (sym = (*tabp)->array[i]; sym; sym = sym1)
+        {
+            sym1 = sym->next;
+            free (sym->name);
+            free (sym);
+        }
+    free (*tabp);
+    *tabp = NULL;
+}
+
+void fml_sym_push (struct fml_sym_tab *tab)
+{
+    tab->level ++;
+}
+
+void fml_sym_pop (struct fml_sym_tab *tab, void (*ph)(struct fml_sym_info *i))
+{
+    struct fml_sym **fsp;
+    int i;
+
+    assert (tab->level > 0);
+    for (i = tab->hash; --i >= 0; )
+    {
+        fsp = tab->array + i;
+        while (*fsp)
+        {
+            if ((*fsp)->level == tab->level)
+            {
+                struct fml_sym *fs;
+
+                fs = *fsp;
+                if (ph)
+                    (*ph)(&fs->info);
+                *fsp = (*fsp)->next;
+                free (fs->name);
+                free (fs);
+            }
+            else
+                fsp = &(*fsp)->next;
+        }
+    }
+    tab->level--;
+}
+
+static unsigned fml_sym_hash (const char *s, unsigned hash)
+{
+    unsigned long v = 0;
+    while (*s)
+        v = v*65599 + *s++;
+    return v % hash;
+}
+
+
+static struct fml_sym_info *sym_add (struct fml_sym_tab *tab,
+                                     const char *s, int level)
+{
+    char *cp;
+    struct fml_sym *sym;
+    struct fml_sym **sym_entry;
+
+    cp = malloc (strlen(s)+1);
+    if (!cp)
+        return NULL;
+    strcpy (cp, s);
+
+    sym = malloc (sizeof (*sym));
+    if (!sym)
+    {
+        free (cp);
+        return NULL;
+    }
+    sym_entry = tab->array + fml_sym_hash (s, tab->hash);
+    sym->name = cp;
+    sym->next = *sym_entry;
+    *sym_entry = sym;
+    sym->level = level;
+    return &sym->info;
+}
+
+struct fml_sym_info *fml_sym_add (struct fml_sym_tab *tab, const char *s)
+{
+    return sym_add (tab, s, 0);
+}
+
+struct fml_sym_info *fml_sym_add_local (struct fml_sym_tab *tab, const char *s)
+{
+    return sym_add (tab, s, tab->level);
+}
+
+static struct fml_sym_info *sym_lookup (struct fml_sym_tab *tab,
+                                        const char *s, int level)
+{
+    struct fml_sym *sym;
+    struct fml_sym *sym0 = NULL;
+    struct fml_sym **sym_entry;
+
+    sym_entry = tab->array + fml_sym_hash (s, tab->hash);
+    for (sym = *sym_entry; sym; sym = sym->next)
+        if (!strcmp (sym->name, s))
+            if (!sym0 || sym->level > sym0->level)
+                sym0 = sym;
+    if (sym0)
+    {
+        assert (sym0->level <= tab->level);
+        if (level && sym0->level != level)
+            return NULL;
+        return &sym0->info;
+    }
+    else
+        return NULL;
+}
+
+struct fml_sym_info *fml_sym_lookup (struct fml_sym_tab *tab, const char *s)
+{
+    return sym_lookup (tab, s, 0);
+}
+
+struct fml_sym_info *fml_sym_lookup_local (struct fml_sym_tab *tab,
+                                           const char *s)
+{
+    return sym_lookup (tab, s, tab->level);
+}
+
diff --git a/fml/fmltest.c b/fml/fmltest.c
new file mode 100644 (file)
index 0000000..24158d3
--- /dev/null
@@ -0,0 +1,26 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmltest.c,v $
+ * Revision 1.1  1995/02/06 13:48:09  adam
+ * Initial revision
+ *
+ */
+
+#include <stdio.h>
+#include "fml.h"
+
+int main (int argc, char **argv)
+{
+    Fml fml;
+
+    fml = fml_open ();
+    if (argc >= 2 && (!strcmp (argv[1], "d") ||
+                      !strcmp (argv[1], "debug")))
+    {
+        fml->debug = 1;
+    }
+    fml_preprocess (fml);
+    fml_exec (fml);
+    return 0;
+}
diff --git a/fml/fmltoken.c b/fml/fmltoken.c
new file mode 100644 (file)
index 0000000..3e7793a
--- /dev/null
@@ -0,0 +1,173 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmltoken.c,v $
+ * Revision 1.1  1995/02/06 13:48:09  adam
+ * Initial revision
+ *
+ */
+#include <string.h>
+#include <assert.h>
+#include <stdio.h>
+
+#include "fmlp.h"
+
+static int look_char;
+static int look_type;
+static char lex_buf[FML_MAX_TOKEN];
+
+static void lexer (Fml fml);
+
+struct fml_node *fml_group (Fml fml);
+
+struct fml_node *fml_tokenize (Fml fml)
+{
+    struct fml_node *p;
+
+    look_char = (*fml->read_func)();
+    p = fml_group (fml);
+    if (fml->debug)
+    {
+        fml_pr_list (p);
+        printf ("\n");
+    }
+    return p;
+}
+
+void fml_pr_list (struct fml_node *p)
+{
+    printf ("{");
+
+    while (p)
+    {
+        if (p->is_atom)
+        {
+            char buf[100];
+            fml_atom_str (p->p[0], buf);
+            printf (" %s", buf);
+        }
+        else
+        {
+            printf (" ");
+            fml_pr_list (p->p[0]);
+        }
+        p = p->p[1];
+    }
+    printf (" }");         
+}
+
+struct fml_node *fml_group (Fml fml)
+{
+    struct fml_node *ptr0 = NULL, *ptr1, *ptr2;
+
+    lexer (fml);
+    if (look_type == 0)
+        return NULL;
+    while (1)
+    {
+        if (look_type == 'a')
+        {
+            ptr2 = fml_node_alloc (fml);
+            if (!ptr0)
+                ptr0 = ptr2;
+            else
+                ptr1->p[1] = ptr2;
+            ptr2->p[0] = fml_atom_alloc (fml, lex_buf);
+            ptr2->is_atom = 1;
+        }
+        else if (look_type == '{')
+        {
+            struct fml_node *sptr = fml_group (fml);
+            if (sptr)
+                if (sptr->p[1])
+                {
+                    ptr2 = fml_node_alloc (fml);
+                    if (!ptr0)
+                        ptr0 = ptr2;
+                    else
+                        ptr1->p[1] = ptr2;
+                    ptr2->p[0] = sptr;
+                    ptr2->is_atom = 0;
+                }
+                else
+                {
+                    ptr2 = sptr;
+                    if (!ptr0)
+                        ptr0 = ptr2;
+                    else
+                        ptr1->p[1] = ptr2;
+                }
+            else
+            {
+                ptr2 = fml_node_alloc (fml);
+                if (!ptr0)
+                    ptr0 = ptr2;
+                else
+                    ptr1->p[1] = ptr2;
+                ptr2->is_atom = 0;
+            }
+        }
+        else
+            break;
+        lexer (fml);
+        ptr1 = ptr2;
+    }
+    return ptr0;
+}
+
+static void lexer (Fml fml)
+{
+    int off;
+    while (1) 
+    {
+        if (look_char == fml->eof_mark)
+        {
+            look_type = 0;
+            return;
+        }
+        else if (look_char == fml->comment_char)
+        {
+            do
+                look_char = (*fml->read_func)();
+            while (look_char != '\n' && look_char != fml->eof_mark);
+        }
+        else
+        {
+            if (!strchr (fml->white_chars, look_char))
+                break;
+            look_char = (*fml->read_func)();
+        }
+    }
+    if (look_char == '{')
+    {
+        look_type = '{';
+        look_char = (*fml->read_func)();
+    }
+    else if (look_char == '}')
+    {
+        look_type = '}';
+        look_char = (*fml->read_func)();
+    }        
+    else
+    {
+        off = 0;
+        do
+        {
+            lex_buf[off++] = look_char;
+            look_char = (*fml->read_func)();
+        } while (look_char != fml->eof_mark
+                 && !strchr (fml->white_chars, look_char)
+                 && look_char != '{' && look_char != '}');
+        lex_buf[off] = '\0';
+        look_type = 'a';
+    }
+#if 0
+    if (fml->debug)
+    {
+        if (look_type == 'a')
+            printf ("[%s]", lex_buf);
+        else
+            printf ("[%c]", look_type);
+    }
+#endif
+}
diff --git a/fml/power.fml b/fml/power.fml
new file mode 100644 (file)
index 0000000..2ed92d1
--- /dev/null
@@ -0,0 +1,26 @@
+# FML power and multiplication.
+#
+# $Id: power.fml,v 1.1 1995/02/06 13:48:09 adam Exp $
+
+\bin Mult a b {
+       \set val 0
+       \set l 0
+       \while {\l \lt \b}
+       {
+               \set val {\val \plus \a}
+               \set l {\l \plus 1}
+       }
+       \return \val
+}
+
+\func Power a b {
+       \set l 0
+       \set val 1
+       \while {\l \lt \b}
+       {
+               \set val {\val \Mult \a}
+               \set l {\l \plus 1}
+       }
+       \return \val
+}
+\Power 3 5
diff --git a/fml/tempo.fml b/fml/tempo.fml
new file mode 100644 (file)
index 0000000..a323912
--- /dev/null
@@ -0,0 +1,6 @@
+# FML tempo test
+#
+# $Id: tempo.fml,v 1.1 1995/02/06 13:48:09 adam Exp $
+\set x 1 
+\set max 10000 
+\while {\x \lt 10000} {\set x {\x \plus 1}}