fml/fmlmem.c

   1 /*
   2  * FML interpreter. Europagate, 1995
   3  *
   4  * $Log: fmlmem.c,v $
   5  * Revision 1.4  1995/02/09 14:33:37  adam
   6  * Split source fml.c and define relevant build-in functions in separate
   7  * files. New operators mult, div, not, llen implemented.
   8  *
   9  * Revision 1.3  1995/02/09  13:07:15  adam
  10  * Nodes are freed now. Many bugs fixed.
  11  *
  12  * Revision 1.2  1995/02/06  15:23:26  adam
  13  * Added some more relational operators (le,ne,ge). Added increment
  14  * and decrement operators. Function index changed, so that first
  15  * element is 1 - not 0. Function fml_atom_val edited.
  16  *
  17  * Revision 1.1.1.1  1995/02/06  13:48:10  adam
  18  * First version of the FML interpreter. It's slow and memory isn't
  19  * freed properly. In particular, the FML nodes aren't released yet.
  20  *
  21  */
  22 #include <stdio.h>
  23 #include <stdlib.h>
  24 #include <string.h>
  25 #include <assert.h>
  26
  27 #include "fmlp.h"
  28
  29 #define FML_ATOM_CHUNK 1024
  30 #define FML_NODE_CHUNK 1024
  31
  32 static int no_nodes = 0;
  33 static int no_atoms = 0;
  34
  35 struct fml_node *fml_node_alloc (Fml fml)
  36 {
  37     struct fml_node *n;
  38
  39     if (! fml->node_free_list)
  40     {
  41         int i;
  42
  43         n = fml->node_free_list = malloc (sizeof(*n) * FML_NODE_CHUNK);
  44         if (!n)
  45         {
  46             (*fml->err_handle)(FML_ERR_NOMEM);
  47             exit (1);
  48         }
  49         for (i = FML_ATOM_CHUNK-1; --i >= 0; n++)
  50             n->p[1] = n+1;
  51         n->p[1] = NULL;
  52     }
  53     n = fml->node_free_list;
  54     fml->node_free_list = n->p[1];
  55     n->p[0] = n->p[1] = NULL;
  56     n->is_atom = 0;
  57     no_nodes++;
  58     return n;
  59 }
  60
  61 static struct fml_atom *atom_malloc (Fml fml)
  62 {
  63     struct fml_atom *fa;
  64
  65     if (! fml->atom_free_list)
  66     {
  67         int i;
  68
  69         fa = fml->atom_free_list = malloc (sizeof(*fa) * FML_ATOM_CHUNK);
  70         if (!fa)
  71         {
  72             (*fml->err_handle)(FML_ERR_NOMEM);
  73             exit (1);
  74         }
  75         for (i = FML_ATOM_CHUNK-1; --i >= 0; fa++)
  76             fa->next = fa+1;
  77         fa->next = NULL;
  78     }
  79     fa = fml->atom_free_list;
  80     fml->atom_free_list = fa->next;
  81     no_atoms++;
  82     return fa;
  83 }
  84
  85 static void atom_delete (Fml fml, struct fml_atom *a)
  86 {
  87     a->next = fml->atom_free_list;
  88     fml->atom_free_list = a;
  89     no_atoms--;
  90 }
  91
  92 static struct fml_atom *atom_copy (Fml fml, struct fml_atom *a)
  93 {
  94     struct fml_atom *a0, *a1;
  95
  96     a0 = a1 = atom_malloc (fml);
  97     while (a)
  98     {
  99         memcpy (&a1->buf, &a->buf, FML_ATOM_BUF);
 100         if (!a->next)
 101             break;
 102         a = a->next;
 103         a1 = a1->next = atom_malloc (fml);
 104     }
 105     a1->next = NULL;
 106     return a0;
 107 }
 108
 109 struct fml_atom *fml_atom_alloc (Fml fml, char *str)
 110 {
 111     int soff = 0;
 112     struct fml_atom *a, *a0;
 113
 114     a0 = a = atom_malloc (fml);
 115     strncpy (a->buf, str, FML_ATOM_BUF);
 116     while (strlen (str+soff) >= FML_ATOM_BUF)
 117     {
 118         struct fml_atom *an;
 119
 120         an = atom_malloc (fml);
 121         a->next = an;
 122         soff += FML_ATOM_BUF;
 123         strncpy (an->buf, str+soff, FML_ATOM_BUF);
 124         a = an;
 125     }
 126     a->next = NULL;
 127     return a0;
 128 }
 129
 130 struct fml_node *fml_mk_list (Fml fml, struct fml_node *fn)
 131 {
 132     if (fn->is_atom)
 133     {
 134         struct fml_node *fn2;
 135
 136         fn2 = fml_node_alloc (fml);
 137         fn2->is_atom = 1;
 138         fn2->p[0] = fn->p[0];
 139         return fn2;
 140     }
 141     else
 142         return fn->p[0];
 143 }
 144
 145 int fml_atom_str (struct fml_atom *a, char *str)
 146 {
 147     int len = 0;
 148
 149     assert (a);
 150     while (a->next)
 151     {
 152         if (str)
 153             memcpy (str+len, a->buf, FML_ATOM_BUF);
 154         len += FML_ATOM_BUF;
 155         a = a->next;
 156     }
 157     if (str)
 158         strcpy (str+len, a->buf);
 159     len += strlen(str+len);
 160     return len;
 161 }
 162
 163 void fml_atom_strx (struct fml_atom *a, char *str, int max)
 164 {
 165     int len = 0;
 166
 167     assert (a);
 168     while (a->next && len < max - 2*FML_ATOM_BUF)
 169     {
 170         memcpy (str+len, a->buf, FML_ATOM_BUF);
 171         len += FML_ATOM_BUF;
 172         a = a->next;
 173     }
 174     strncpy (str+len, a->buf, FML_ATOM_BUF-1);
 175     str[len+FML_ATOM_BUF-1] = '\0';
 176 }
 177
 178 int fml_atom_val (struct fml_atom *a)
 179 {
 180     static char arg[256];
 181     assert (a);
 182     if (!a->next)
 183         return atoi (a->buf);
 184     fml_atom_strx (a, arg, 200);
 185     return atoi (arg);
 186 }
 187
 188 struct fml_node *fml_mk_node_val (Fml fml, int val)
 189 {
 190     static char arg[64];
 191     struct fml_node *fn;
 192
 193     sprintf (arg, "%d", val);
 194     fn = fml_node_alloc (fml);
 195     fn->is_atom = 1;
 196     fn->p[0] = fml_atom_alloc (fml, arg);
 197     return fn;
 198 }
 199
 200 void fml_node_delete (Fml fml, struct fml_node *fn)
 201 {
 202     struct fml_node *f1;
 203     while (fn)
 204     {
 205         if (fn->is_atom)
 206             atom_delete (fml, fn->p[0]);
 207         else
 208             fml_node_delete (fml, fn->p[0]);
 209         f1 = fn->p[1];
 210
 211         fn->p[1] = fml->node_free_list;
 212         fml->node_free_list = fn;
 213         no_nodes--;
 214
 215         fn = f1;
 216     }
 217 }
 218
 219 struct fml_node *fml_node_copy (Fml fml, struct fml_node *fn)
 220 {
 221     struct fml_node *fn0, *fn1;
 222
 223     if (!fn)
 224         return NULL;
 225     fn1 = fn0 = fml_node_alloc (fml);
 226     while (1)
 227     {
 228         if (fn->is_atom)
 229         {
 230             fn1->is_atom = 1;
 231             fn1->p[0] = atom_copy (fml, fn->p[0]);
 232         }
 233         else
 234             fn1->p[0] = fml_node_copy (fml, fn->p[0]);
 235         if (!fn->p[1])
 236             break;
 237         fn = fn->p[1];
 238         fn1 = fn1->p[1] = fml_node_alloc (fml);
 239     }
 240     return fn0;
 241 }
 242
 243 void fml_node_stat (Fml fml)
 244 {
 245     if (fml->debug & 2)
 246         printf ("<<node=%d, atom=%d>>", no_nodes, no_atoms);
 247 }