source: trunk/third/enscript/states/prims.c @ 17620

/*
 * Primitive procedures for states.
 * Copyright (c) 1997 Markku Rossi.
 *
 * Author: Markku Rossi <mtr@iki.fi>
 */

/*
 * This file is part of GNU enscript.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file COPYING.  If not, write to
 * the Free Software Foundation, 59 Temple Place - Suite 330,
 * Boston, MA 02111-1307, USA.
 */

#include "defs.h"

/*
 * Types and definitions.
 */

#define DEFUN(prim)                     \
static Node *                           \
prim (prim_name, args, env, linenum)    \
     char *prim_name;                   \
     List *args;                        \
     Environment *env;                  \
     unsigned int linenum;

#define NEED_ARG()                                              \
do {                                                            \
  if (arg == NULL)                                              \
    {                                                           \
      fprintf (stderr, _("%s:%d: %s: too few arguments\n"),     \
               defs_file, linenum, prim_name);                  \
      exit (1);                                                 \
    }                                                           \
} while (0)

#define LAST_ARG()                                              \
  do {                                                          \
    if (arg != NULL)                                            \
      {                                                         \
        fprintf (stderr, _("%s:%d: %s: too many arguments\n"),  \
                 defs_file, linenum, prim_name);                \
        exit (1);                                               \
      }                                                         \
  } while (0)

#define MATCH_ARG(type) match_arg (prim_name, type, &arg, env, linenum)

#define APPEND(data, len)                               \
  do {                                                  \
    if (result_len < result_pos + (len))                \
      {                                                 \
        result_len += (len) + 1024;                     \
        result = xrealloc (result, result_len);         \
      }                                                 \
    memcpy (result + result_pos, (data), (len));        \
    result_pos += (len);                                \
  } while (0)

#define FMTSPECIAL(ch) \
     (('0' <= (ch) && (ch) <= '9') || (ch) == '.' || (ch) == '-')


/*
 * Some forward protypes.
 */

static Node *prim_print ___P ((char *prim_name, List *args,
                               Environment *env, unsigned int linenum));


/*
 * Static functions.
 */

static Node *
match_arg (prim_name, type, argp, env, linenum)
     char *prim_name;
     NodeType type;
     ListItem **argp;
     Environment *env;
     unsigned int linenum;
{
  ListItem *arg = *argp;
  Node *n;

  NEED_ARG ();
  n = eval_expr ((Expr *) arg->data, env);
  if (type != nVOID && n->type != type)
    {
      fprintf (stderr, _("%s:%d: %s: illegal argument type\n"),
               defs_file, linenum, prim_name);
      exit (1);
    }
  *argp = arg->next;

  return n;
}

/* Primitives. */

DEFUN (prim_call)
{
  ListItem *arg = args->head;
  Expr *e;
  char *cp;

  e = (Expr *) arg->data;
  if (e->type != eSYMBOL)
    {
      fprintf (stderr, _("%s:%d: %s: illegal argument type\n"),
               defs_file, linenum, prim_name);
      exit (1);
    }
  cp = e->u.node->u.sym;

  arg = arg->next;
  LAST_ARG ();

  return execute_state (cp);
}


DEFUN (prim_check_namerules)
{
  ListItem *arg = args->head;
  ListItem *i;
  Cons *c;
  Node *n;

  LAST_ARG ();

  if (start_state)
    goto return_false;

  for (i = namerules->head; i; i = i->next)
    {
      c = (Cons *) i->data;
      n = (Node *) c->car;

      if (re_search (REGEXP (n), current_fname, strlen (current_fname),
                     0, strlen (current_fname), NULL) >= 0)
        {
          /* This is it. */
          n = (Node *) c->cdr;

          start_state = n->u.sym;

          n = node_alloc (nINTEGER);
          n->u.integer = 1;
          return n;
        }
    }

return_false:

  n = node_alloc (nINTEGER);
  n->u.integer = 0;

  return n;
}


DEFUN (prim_check_startrules)
{
  ListItem *arg = args->head;
  ListItem *i;
  Cons *c;
  Node *n;

  LAST_ARG ();

  if (start_state)
    goto return_false;

  for (i = startrules->head; i; i = i->next)
    {
      c = (Cons *) i->data;
      n = (Node *) c->car;

      if (re_search (REGEXP (n), inbuf, data_in_buffer,
                     0, data_in_buffer, NULL) >= 0)
        {
          /* This is it. */
          n = (Node *) c->cdr;

          start_state = n->u.sym;

          n = node_alloc (nINTEGER);
          n->u.integer = 1;
          return n;
        }
    }

return_false:

  n = node_alloc (nINTEGER);
  n->u.integer = 0;

  return n;
}


DEFUN (prim_concat)
{
  ListItem *arg = args->head;
  Node *n;
  int len = 0;
  char *data = NULL;

  NEED_ARG ();
  for (; arg; arg = arg->next)
    {
      n = eval_expr ((Expr *) arg->data, env);
      if (n->type != nSTRING)
        {
          fprintf (stderr, _("%s:%d: %s: illegal argument type\n"),
                   defs_file, linenum, prim_name);
          exit (1);
        }

      if (n->u.str.len > 0)
        {
          data = (char *) xrealloc (data, len + n->u.str.len);
          memcpy (data + len, n->u.str.data, n->u.str.len);
          len += n->u.str.len;
        }
      node_free (n);
    }

  n = node_alloc (nSTRING);
  n->u.str.data = data;
  n->u.str.len = len;

  return n;
}


DEFUN (prim_float)
{
  ListItem *arg = args->head;
  Node *n, *r;
  char buf[512];

  n = MATCH_ARG (nVOID);
  LAST_ARG ();

  r = node_alloc (nREAL);

  switch (n->type)
    {
    case nVOID:
    case nREGEXP:
    case nSYMBOL:
      r->u.real = 0.0;
      break;

    case nARRAY:
      r->u.real = (double) n->u.array.len;
      break;

    case nSTRING:
      if (n->u.str.len > sizeof (buf) - 1)
        r->u.real = 0.0;
      else
        {
          memcpy (buf, n->u.str.data, n->u.str.len);
          buf[n->u.str.len] = '\0';
          r->u.real = atof (buf);
        }
      break;

    case nINTEGER:
      r->u.real = (double) n->u.integer;
      break;

    case nREAL:
      r->u.real = n->u.real;
      break;
    }

  node_free (n);
  return r;
}


DEFUN (prim_getenv)
{
  ListItem *arg = args->head;
  Node *var, *n;
  char *key;
  char *cp;

  var = MATCH_ARG (nSTRING);
  LAST_ARG ();

  key = (char *) xcalloc (1, var->u.str.len + 1);
  memcpy (key, var->u.str.data, var->u.str.len);

  cp = getenv (key);

  node_free (var);
  xfree (key);

  n = node_alloc (nSTRING);
  if (cp == NULL)
    {
      n->u.str.data = (char *) xmalloc (1);
      n->u.str.len = 0;
    }
  else
    {
      n->u.str.data = xstrdup (cp);
      n->u.str.len = strlen (cp);
    }

  return n;
}


DEFUN (prim_int)
{
  ListItem *arg = args->head;
  Node *n, *r;
  char buf[512];

  n = MATCH_ARG (nVOID);
  LAST_ARG ();

  r = node_alloc (nINTEGER);

  switch (n->type)
    {
    case nVOID:
    case nREGEXP:
    case nSYMBOL:
      r->u.integer = 0;
      break;

    case nARRAY:
      r->u.integer = n->u.array.len;
      break;

    case nSTRING:
      if (n->u.str.len > sizeof (buf) - 1)
        r->u.integer = 0;
      else
        {
          memcpy (buf, n->u.str.data, n->u.str.len);
          buf[n->u.str.len] = '\0';
          r->u.integer = atoi (buf);
        }
      break;

    case nINTEGER:
      r->u.integer = n->u.integer;
      break;

    case nREAL:
      r->u.integer = (int) n->u.real;
      break;
    }

  node_free (n);
  return r;
}


DEFUN (prim_length)
{
  ListItem *arg = args->head;
  Node *n;
  int result = 0;

  NEED_ARG ();
  for (; arg; arg = arg->next)
    {
      n = eval_expr ((Expr *) arg->data, env);
      switch (n->type)
        {
        case nSTRING:
          result += n->u.str.len;
          break;

        case nARRAY:
          result += n->u.array.len;
          break;

        default:
          fprintf (stderr, _("%s:%d: %s: illegal argument type\n"),
                   defs_file, linenum, prim_name);
          exit (1);
          break;
        }
      node_free (n);
    }

  n = node_alloc (nINTEGER);
  n->u.integer = result;

  return n;
}


DEFUN (prim_list)
{
  ListItem *arg = args->head;
  unsigned int len;
  Node *n;

  /* Count list length. */
  for (len = 0; arg; len++, arg = arg->next)
    ;
  arg = args->head;

  /* Create list node. */
  n = node_alloc (nARRAY);
  n->u.array.array = (Node **) xcalloc (len + 1, sizeof (Node *));
  n->u.array.allocated = len + 1;
  n->u.array.len = len;

  /* Fill it up. */
  for (len = 0; arg; len++, arg = arg->next)
    n->u.array.array[len] = eval_expr ((Expr *) arg->data, env);

  return n;
}


DEFUN (prim_panic)
{
  fprintf (stderr, _("%s: panic: "), program);
  ofp = stderr;
  prim_print (prim_name, args, env, linenum);
  fprintf (stderr, "\n");
  exit (1);

  /* NOTREACHED */
  return nvoid;
}


DEFUN (prim_prereq)
{
  ListItem *arg = args->head;
  Node *s;
  int over[3];
  int rver[3];
  char *cp;
  int i;

  s = MATCH_ARG (nSTRING);
  LAST_ARG ();

  /* Our version. */
  sscanf (VERSION, "%d.%d.%d", &over[0], &over[1], &over[2]);

  /* Required version. */

  cp = (char *) xcalloc (1, s->u.str.len + 1);
  memcpy (cp, s->u.str.data, s->u.str.len);

  if (sscanf (cp, "%d.%d.%d", &rver[0], &rver[1], &rver[2]) != 3)
    {
      fprintf (stderr,
               _("%s:%d: %s: malformed version string `%s'\n"),
               defs_file, linenum, prim_name, cp);
      exit (1);
    }

  /* Check version. */
  for (i = 0; i < 3; i++)
    {
      if (over[i] > rver[i])
        /* Ok, our version is bigger. */
        break;
      if (over[i] < rver[i])
        {
          /* Fail, our version is too small. */
          fprintf (stderr,
                   _("%s: FATAL ERROR: States version %s or higher is required for this script\n"),
                   program, cp);
          exit (1);
        }
    }

  /* Our version is higher or equal to the required one. */
  xfree (cp);

  return nvoid;
}


static void
print_node (n)
     Node *n;
{
  unsigned int i;

  switch (n->type)
    {
    case nVOID:
      break;

    case nSTRING:
      fwrite (n->u.str.data, n->u.str.len, 1, ofp);
      break;

    case nREGEXP:
      fputc ('/', ofp);
      fwrite (n->u.re.data, n->u.re.len, 1, ofp);
      fputc ('/', ofp);
      break;

    case nINTEGER:
      fprintf (ofp, "%d", n->u.integer);
      break;

    case nREAL:
      fprintf (ofp, "%f", n->u.real);
      break;

    case nSYMBOL:
      fprintf (ofp, "%s", n->u.sym);
      break;

    case nARRAY:
      for (i = 0; i < n->u.array.len; i++)
        {
          print_node (n->u.array.array[i]);
          if (i + 1 < n->u.array.len)
            fprintf (ofp, " ");
        }
    }
}


DEFUN (prim_print)
{
  ListItem *arg = args->head;
  Node *n;

  NEED_ARG ();
  for (; arg; arg = arg->next)
    {
      n = eval_expr ((Expr *) arg->data, env);
      print_node (n);
      node_free (n);
    }

  return nvoid;
}


DEFUN (prim_range)
{
  ListItem *arg = args->head;
  Node *from, *start, *end, *n;
  int i;

  NEED_ARG ();
  from = eval_expr ((Expr *) arg->data, env);
  arg = arg->next;

  start = MATCH_ARG (nINTEGER);
  end = MATCH_ARG (nINTEGER);
  LAST_ARG ();

  if (start->u.integer > end->u.integer)
    {
      fprintf (stderr,
               _("%s:%d: %s: start offset is bigger than end offset\n"),
               defs_file, linenum, prim_name);
      exit (1);
    }

  if (from->type == nSTRING)
    {
      if (end->u.integer > from->u.str.len)
        {
          fprintf (stderr, _("%s:%d: %s: offset out of range\n"),
                   defs_file, linenum, prim_name);
          exit (1);
        }

      n = node_alloc (nSTRING);
      n->u.str.len = end->u.integer - start->u.integer;
      /* +1 to avoid zero allocation */
      n->u.str.data = (char *) xmalloc (n->u.str.len + 1);
      memcpy (n->u.str.data, from->u.str.data + start->u.integer,
              n->u.str.len);
    }
  else if (from->type == nARRAY)
    {
      if (end->u.integer > from->u.array.len)
        {
          fprintf (stderr, _("%s:%d: %s: offset out of range\n"),
                   defs_file, linenum, prim_name);
          exit (1);
        }

      n = node_alloc (nARRAY);
      n->u.array.len = end->u.integer - start->u.integer;
      /* +1 to avoid zero allocation */
      n->u.array.allocated = n->u.array.len + 1;
      n->u.array.array = (Node **) xcalloc (n->u.array.allocated,
                                            sizeof (Node *));

      for (i = 0; i < n->u.array.len; i++)
        n->u.array.array[i]
          = node_copy (from->u.array.array[i + start->u.integer]);
    }
  else
    {
      fprintf (stderr, _("%s:%d: %s: illegal argument\n"),
               defs_file, linenum, prim_name);
      exit (1);
    }

  node_free (from);
  node_free (start);
  node_free (end);

  return n;
}


DEFUN (prim_regexp)
{
  ListItem *arg = args->head;
  Node *str, *n;

  str = MATCH_ARG (nSTRING);
  LAST_ARG ();

  /* Create a new REGEXP node. */

  n = node_alloc (nREGEXP);
  n->u.re.data = xmalloc (str->u.str.len + 1);
  n->u.re.len = str->u.str.len;
  memcpy (n->u.re.data, str->u.str.data, str->u.str.len);
  n->u.re.data[str->u.str.len] = '\0';

  return n;
}


DEFUN (prim_regexp_syntax)
{
  ListItem *arg = args->head;
  Node *ch, *st;
  char syntax;

  ch = MATCH_ARG (nINTEGER);
  st = MATCH_ARG (nINTEGER);
  LAST_ARG ();

  syntax = (char) st->u.integer;
  if (syntax != 'w' && syntax != ' ')
    {
      fprintf (stderr,
               _("%s:%d: %s: illegal regexp character syntax: %c\n"),
               defs_file, linenum, prim_name, syntax);
      exit (1);
    }

  re_set_character_syntax ((unsigned char) ch->u.integer, syntax);

  return nvoid;
}


DEFUN (prim_regmatch)
{
  ListItem *arg = args->head;
  Node *str, *re, *n;
  static struct re_registers matches = {0, NULL, NULL};
  static Node *current_match_node = NULL;
  int i;

  str = MATCH_ARG (nSTRING);
  re = MATCH_ARG (nREGEXP);
  LAST_ARG ();

  /* Search for match. */
  i = re_search (REGEXP (re), str->u.str.data, str->u.str.len,
                 0, str->u.str.len, &matches);

  if (i < 0)
    {
      current_match = NULL;
      node_free (str);
    }
  else
    {
      node_free (current_match_node);
      current_match_node = str;

      current_match = &matches;
      current_match_buf = str->u.str.data;
    }
  node_free (re);

  n = node_alloc (nINTEGER);
  n->u.integer = (i >= 0);

  return n;
}


/*
 * Common regular expression substituter for regsub and regsuball.
 */

Node *
do_regsubsts (str, re, subst, allp)
     Node *str;
     Node *re;
     Node *subst;
     int allp;
{
  int i, pos, j;
  static struct re_registers matches = {0, NULL, NULL};
  static char *result = NULL;
  static unsigned int result_len = 0;
  unsigned int result_pos = 0;
  int num_matches = 0;
  int do_expansions_in_substs = 0;

  /* Do we have to do expansions in the substitution string. */
  for (i = 0; i < subst->u.str.len; i++)
    if (subst->u.str.data[i] == '$')
      {
        do_expansions_in_substs = 1;
        break;
      }

  pos = 0;
  while (1)
    {
      /* Search for match. */
      i = re_search (REGEXP (re), str->u.str.data, str->u.str.len,
                     pos, str->u.str.len - pos, &matches);
      if (i < 0)
        goto out;

      num_matches++;

      /* Everything before match. */
      APPEND (str->u.str.data + pos, matches.start[0] - pos);

      /* Append match. */
      if (!do_expansions_in_substs)
        APPEND (subst->u.str.data, subst->u.str.len);
      else
        {
          /* Must process substitution string. */
          for (i = 0; i < subst->u.str.len; i++)
            if (subst->u.str.data[i] == '$' && i + 1 < subst->u.str.len)
              {
                i++;
                switch (subst->u.str.data[i])
                  {
                  case '$':
                    APPEND ("$", 1);
                    break;

                  case '0':
                  case '1':
                  case '2':
                  case '3':
                  case '4':
                  case '5':
                  case '6':
                  case '7':
                  case '8':
                  case '9':
                    j = subst->u.str.data[i] - '0';
                    if (matches.start[j] >= 0)
                      APPEND (str->u.str.data + matches.start[j],
                              matches.end[j] - matches.start[j]);
                    break;

                  default:
                    /* Illegal substitution, just pass it through. */
                    APPEND ("$", 1);
                    APPEND (subst->u.str.data + i, 1);
                    break;
                  }
              }
            else
              APPEND (subst->u.str.data + i, 1);
        }

      /* Update pos. */
      pos = matches.end[0];

      if (!allp)
        break;
    }

out:
  if (num_matches == 0)
    {
      /* No matches, just return our original string. */
      node_free (re);
      node_free (subst);
      return str;
    }

  APPEND (str->u.str.data + pos, str->u.str.len - pos);

  /* Create result node. */
  node_free (str);
  node_free (re);
  node_free (subst);

  str = node_alloc (nSTRING);
  str->u.str.len = result_pos;
  str->u.str.data = xmalloc (result_pos);
  memcpy (str->u.str.data, result, result_pos);

  return str;
}


DEFUN (prim_regsub)
{
  ListItem *arg = args->head;
  Node *str, *re, *subst;

  str = MATCH_ARG (nSTRING);
  re = MATCH_ARG (nREGEXP);
  subst = MATCH_ARG (nSTRING);
  LAST_ARG ();

  return do_regsubsts (str, re, subst, 0);
}


DEFUN (prim_regsuball)
{
  ListItem *arg = args->head;
  Node *str, *re, *subst;

  str = MATCH_ARG (nSTRING);
  re = MATCH_ARG (nREGEXP);
  subst = MATCH_ARG (nSTRING);
  LAST_ARG ();

  return do_regsubsts (str, re, subst, 1);
}


DEFUN (prim_split)
{
  ListItem *arg = args->head;
  Node *re, *str, *n, *n2;
  int pos, i;

  re = MATCH_ARG (nREGEXP);
  str = MATCH_ARG (nSTRING);
  LAST_ARG ();

  /* Create a new array node. */
  n = node_alloc (nARRAY);
  n->u.array.allocated = 100;
  n->u.array.array = (Node **) xcalloc (n->u.array.allocated, sizeof (Node *));

  for (pos = 0; pos < str->u.str.len;)
    {
      i = re_search (REGEXP (re), str->u.str.data, str->u.str.len,
                     pos, str->u.str.len - pos, &re->u.re.matches);
      if (i < 0)
        /* No more matches. */
        break;

      /* Append the string before the first match. */
      n2 = node_alloc (nSTRING);
      n2->u.str.len = i - pos;
      n2->u.str.data = (char *) xmalloc (n2->u.str.len + 1);
      memcpy (n2->u.str.data, str->u.str.data + pos, n2->u.str.len);
      pos = re->u.re.matches.end[0];

      /*
       * Check that at least one item fits after us (no need to check
       * when appending the last item).
       */
      if (n->u.array.len + 1 >= n->u.array.allocated)
        {
          n->u.array.allocated += 100;
          n->u.array.array = (Node **) xrealloc (n->u.array.array,
                                                 n->u.array.allocated
                                                 * sizeof (Node *));
        }
      n->u.array.array[n->u.array.len++] = n2;
    }

  /* Append all the remaining data. */
  n2 = node_alloc (nSTRING);
  n2->u.str.len = str->u.str.len - pos;
  n2->u.str.data = (char *) xmalloc (n2->u.str.len + 1);
  memcpy (n2->u.str.data, str->u.str.data + pos, n2->u.str.len);

  n->u.array.array[n->u.array.len++] = n2;

  return n;
}


DEFUN (prim_sprintf)
{
  ListItem *arg = args->head;
  Node *fmt, *n;
  char buf[512];
  char ifmt[256];
  char ifmtopts[256];
  char *result = NULL;
  unsigned int result_pos = 0;
  unsigned int result_len = 0;
  int i, j;
  int argument_count = 0;
  char *cp;

  fmt = MATCH_ARG (nSTRING);
  cp = fmt->u.str.data;

  /* Process format string and match arguments. */
  for (i = 0; i < fmt->u.str.len; i++)
    {
      if (cp[i] == '%' && (i + 1 >= fmt->u.str.len || cp[i + 1] == '%'))
        {
          i++;
          APPEND (cp + i, 1);
        }
      else if (cp[i] == '%')
        {
          argument_count++;

          if (arg == NULL)
            {
              fprintf (stderr,
                       _("%s: primitive `%s': too few arguments for format\n"),
                       program, prim_name);
              exit (1);
            }
          n = eval_expr ((Expr *) arg->data, env);
          arg = arg->next;

          for (i++, j = 0; i < fmt->u.str.len && FMTSPECIAL (cp[i]); i++, j++)
            ifmtopts[j] = cp[i];
          ifmtopts[j] = '\0';

          if (i >= fmt->u.str.len)
            {
              APPEND ("%", 1);
              APPEND (ifmtopts, j);
              continue;
            }

          /* Field type. */
          switch (cp[i])
            {
            case 'x':
            case 'X':
            case 'd':
              if (n->type != nINTEGER)
                {
                no_match:
                  fprintf (stderr,
                           _("%s:%d: %s: argument %d doesn't match format\n"),
                           defs_file, linenum, prim_name, argument_count);
                  exit (1);
                }
              sprintf (ifmt, "%%%s%c", ifmtopts, cp[i]);
              sprintf (buf, ifmt, n->u.integer);

              APPEND (buf, strlen (buf));
              break;

            case 'f':
            case 'g':
            case 'e':
            case 'E':
              if (n->type != nREAL)
                goto no_match;

              sprintf (ifmt, "%%%s%c", ifmtopts, cp[i]);
              sprintf (buf, ifmt, n->u.real);

              APPEND (buf, strlen (buf));
              break;

            case 's':
              if (n->type != nSTRING)
                goto no_match;

              if (ifmtopts[0] != '\0')
                {
                  fprintf (stderr,
                           _("%s:%d: %s: no extra options can be specified for %%s\n"),
                           defs_file, linenum, prim_name);
                  exit (1);
                }
              APPEND (n->u.str.data, n->u.str.len);
              break;

            default:
              fprintf (stderr,
                       _("%s:%d: %s: illegal type specifier `%c'\n"),
                       defs_file, linenum, prim_name, cp[i]);
              exit (1);
              break;
            }
        }
      else
        APPEND (cp + i, 1);
    }

  node_free (fmt);

  n = node_alloc (nSTRING);
  n->u.str.len = result_pos;
  n->u.str.data = result;

  return n;
}


DEFUN (prim_strcmp)
{
  ListItem *arg = args->head;
  Node *s1, *s2;
  Node *n;
  int i, result;
  char *cp1, *cp2;

  s1 = MATCH_ARG (nSTRING);
  s2 = MATCH_ARG (nSTRING);
  LAST_ARG ();

  cp1 = s1->u.str.data;
  cp2 = s2->u.str.data;

  for (i = 0; i < s1->u.str.len && i < s2->u.str.len; i++)
    {
      if (cp1[i] < cp2[i])
        {
          result = -1;
          goto out;
        }
      if (cp1[i] > cp2[i])
        {
          result = 1;
          goto out;
        }
    }
  /* Strings are so far equal, check lengths. */
  if (s1->u.str.len < s2->u.str.len)
    result = -1;
  else if (s1->u.str.len > s2->u.str.len)
    result = 1;
  else
    result = 0;

out:
  node_free (s1);
  node_free (s2);
  n = node_alloc (nINTEGER);
  n->u.integer = result;

  return n;
}


DEFUN (prim_string)
{
  ListItem *arg = args->head;
  Node *n, *r;
  char buf[512];

  n = MATCH_ARG (nVOID);
  LAST_ARG ();

  r = node_alloc (nSTRING);

  switch (n->type)
    {
    case nVOID:
    case nREGEXP:
    case nARRAY:
      r->u.str.data = (char *) xcalloc (1, 1);
      r->u.str.len = 0;
      break;

    case nSYMBOL:
      r->u.str.len = strlen (n->u.sym);
      r->u.str.data = (char *) xmalloc (r->u.str.len);
      memcpy (r->u.str.data, n->u.sym, r->u.str.len);
      break;

    case nSTRING:
      r->u.str.len = n->u.str.len;
      r->u.str.data = (char *) xmalloc (n->u.str.len);
      memcpy (r->u.str.data, n->u.str.data, n->u.str.len);
      break;

    case nINTEGER:
      sprintf (buf, "%d", n->u.integer);
      r->u.str.len = strlen (buf);
      r->u.str.data = (char *) xmalloc (r->u.str.len);
      memcpy (r->u.str.data, buf, r->u.str.len);
      break;

    case nREAL:
      sprintf (buf, "%f", n->u.real);
      r->u.str.len = strlen (buf);
      r->u.str.data = (char *) xmalloc (r->u.str.len);
      memcpy (r->u.str.data, buf, r->u.str.len);
      break;
    }

  node_free (n);
  return r;
}


DEFUN (prim_strncmp)
{
  ListItem *arg = args->head;
  Node *s1, *s2, *len;
  Node *n;
  int i, result;
  char *cp1, *cp2;

  s1 = MATCH_ARG (nSTRING);
  s2 = MATCH_ARG (nSTRING);
  len = MATCH_ARG (nINTEGER);
  LAST_ARG ();

  cp1 = s1->u.str.data;
  cp2 = s2->u.str.data;

  for (i = 0; i < s1->u.str.len && i < s2->u.str.len && i < len->u.integer; i++)
    {
      if (cp1[i] < cp2[i])
        {
          result = -1;
          goto out;
        }
      if (cp1[i] > cp2[i])
        {
          result = 1;
          goto out;
        }
    }

  /* Check the limit length. */
  if (i >= len->u.integer)
    {
      result = 0;
      goto out;
    }

  /* One or both strings were shorter than limit, check lengths. */
  if (s1->u.str.len < s2->u.str.len)
    result = -1;
  else if (s1->u.str.len > s2->u.str.len)
    result = 1;
  else
    result = 0;

out:
  node_free (s1);
  node_free (s2);
  node_free (len);
  n = node_alloc (nINTEGER);
  n->u.integer = result;

  return n;
}


DEFUN (prim_substring)
{
  ListItem *arg = args->head;
  Node *str, *start, *end, *n;

  str = MATCH_ARG (nSTRING);
  start = MATCH_ARG (nINTEGER);
  end = MATCH_ARG (nINTEGER);
  LAST_ARG ();

  if (start->u.integer > end->u.integer)
    {
      fprintf (stderr,
               _("%s:%d: %s: start offset is bigger than end offset\n"),
               defs_file, linenum, prim_name);
      exit (1);
    }
  if (end->u.integer > str->u.str.len)
    {
      fprintf (stderr, _("%s:%d: %s: offset out of range\n"),
               defs_file, linenum, prim_name);
      exit (1);
    }

  n = node_alloc (nSTRING);
  n->u.str.len = end->u.integer - start->u.integer;
  /* +1 to avoid zero allocation */
  n->u.str.data = (char *) xmalloc (n->u.str.len + 1);

  memcpy (n->u.str.data, str->u.str.data + start->u.integer,
          n->u.str.len);

  node_free (str);
  node_free (start);
  node_free (end);

  return n;
}


/*
 * Global functions.
 */

static struct
{
  char *name;
  Primitive prim;
} prims[] =
  {
    {"call",                    prim_call},
    {"check_namerules",         prim_check_namerules},
    {"check_startrules",        prim_check_startrules},
    {"concat",                  prim_concat},
    {"float",                   prim_float},
    {"getenv",                  prim_getenv},
    {"int",                     prim_int},
    {"length",                  prim_length},
    {"list",                    prim_list},
    {"panic",                   prim_panic},
    {"prereq",                  prim_prereq},
    {"print",                   prim_print},
    {"range",                   prim_range},
    {"regexp",                  prim_regexp},
    {"regexp_syntax",           prim_regexp_syntax},
    {"regmatch",                prim_regmatch},
    {"regsub",                  prim_regsub},
    {"regsuball",               prim_regsuball},
    {"split",                   prim_split},
    {"sprintf",                 prim_sprintf},
    {"strcmp",                  prim_strcmp},
    {"string",                  prim_string},
    {"strncmp",                 prim_strncmp},
    {"substring",               prim_substring},

    {NULL, NULL},
  };

void
init_primitives ()
{
  void *old;
  int i;

  for (i = 0; prims[i].name; i++)
    if (!strhash_put (ns_prims, prims[i].name, strlen (prims[i].name),
                      (void *) prims[i].prim, &old))
      {
        fprintf (stderr, _("%s: out of memory\n"), program);
        exit (1);
      }
}