yap-6.3/C/arrays.c

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		arrays.c						 *
* Last rev:								 *
* mods:									 *
* comments:	Array Manipulation Routines	                         *
*									 *
*************************************************************************/

/** @defgroup YAPArrays Named Arrays
@ingroup extensions
@{

The YAP system includes experimental support for arrays. The
support is enabled with the option `YAP_ARRAYS`.

There are two very distinct forms of arrays in YAP. The
<em>dynamic arrays</em> are a different way to access compound terms
created during the execution. Like any other terms, any bindings to
these terms and eventually the terms themselves will be destroyed during
backtracking. Our goal in supporting dynamic arrays is twofold. First,
they provide an alternative to the standard arg/3
built-in. Second, because dynamic arrays may have name that are globally
visible, a dynamic array can be visible from any point in the
program. In more detail, the clause

~~~~~
g(X) :- array_element(a,2,X).
~~~~~
will succeed as long as the programmer has used the built-in <tt>array/2</tt>
to create an array term with at least 3 elements in the current
environment, and the array was associated with the name `a`.  The
element `X` is a Prolog term, so one can bind it and any such
bindings will be undone when backtracking. Note that dynamic arrays do
not have a type: each element may be any Prolog term.

The <em>static arrays</em> are an extension of the database. They provide
a compact way for manipulating data-structures formed by characters,
integers, or floats imperatively. They can also be used to provide
two-way communication between YAP and external programs through
shared memory.

In order to efficiently manage space elements in a static array must
have a type. Currently, elements of static arrays in YAP should
have one of the following predefined types:

+ `byte`: an 8-bit signed character.
+ `unsigned_byte`: an 8-bit unsigned character.
+ `int`: Prolog integers. Size would be the natural size for
the machine's architecture.
+ `float`: Prolog floating point number. Size would be equivalent
to a double in `C`.
+ `atom`: a Prolog atom.
+ `dbref`: an internal database reference.
+ `term`: a generic Prolog term. Note that this will term will
not be stored in the array itself, but instead will be stored in the
Prolog internal database.


Arrays may be <em>named</em> or <em>anonymous</em>. Most arrays will be
<em>named</em>, that is associated with an atom that will be used to find
the array. Anonymous arrays do not have a name, and they are only of
interest if the `TERM_EXTENSIONS` compilation flag is enabled. In
this case, the unification and parser are extended to replace
occurrences of Prolog terms of the form `X[I]` by run-time calls to
array_element/3, so that one can use array references instead of
extra calls to arg/3. As an example:

~~~~~
g(X,Y,Z,I,J) :- X[I] is Y[J]+Z[I].
~~~~~
should give the same results as:

~~~~~
G(X,Y,Z,I,J) :-
        array_element(X,I,E1),
        array_element(Y,J,E2),
        array_element(Z,I,E3),
        E1 is E2+E3.
~~~~~

Note that the only limitation on array size are the stack size for
dynamic arrays; and, the heap size for static (not memory mapped)
arrays. Memory mapped arrays are limited by available space in the file
system and in the virtual memory space.

The following predicates manipulate arrays:




*/

#include "Yap.h"
#include "Yatom.h"
#include "clause.h"
#include "eval.h"
#include "heapgc.h"
#if HAVE_ERRNO_H
#include <errno.h>
#else
extern int errno;
#endif
#if HAVE_STRING_H
#include <string.h>
#endif

#if __simplescalar__
#ifdef HAVE_MMAP
#undef HAVE_MMAP
#endif
#endif

static Int compile_array_refs(USES_REGS1);
static Int array_refs_compiled(USES_REGS1);
static Int sync_mmapped_arrays(USES_REGS1);

/**
 * === Implementation Notes
 *
 * This file works together with pl/arrays.yap and arrays.h.
 *
 * YAP supports a very simple notion of arrays. Arrays may be
 * allocated dynamically or statically:
 *
 * o anonymous arrays are created during execution and allocated
 * in the heap. They have the lifetime of any other other heap
 * object. Any term can be an argument to a dynamic array.
 *
 * Dynamic arrays are named as a free variable and are
 * initialized with free variables.
 *
 * o named arrays are created during execution but allocated
 * in the code space. They have the lifetime of an heap
 * object. Any term can be an argument to a dynamic array.
 *
 * Named arrays are named with atoms and are initialized with
 * free variables.
 *
 * + static arrays are allocated in the heap. Their space is
 * never recovered unless explicitly said so by the
 * program. Arguments to these arrays must have fixed size,
 * and can only be atomic (at least for now).
 *
 * Static arrays can be named through an  atom. They are
 * initialized with [].
 *
 * Users create arrays by a declaration X array Arity. If X is an atom
 * A, then this it is a static array and A's the array name, otherwise
 * X refers to a dynamic array.
 *
 * As in C, arrays start counting from 0.
 *
 * Users access arrays by a token X[I] or a[I], this token can appear
 * anywhere within the computation, so a[2] = X[3*4] means that the
 * second element of global array a should unify with the 12th element
 * of array X. The mechanism used to implement this is the same
 * mechanism used to implement suspension variables.
 *
 * ==== Representation:
 *
 * Dynamic Arrays are represented as a compound term of arity N, where
 * N is the size of the array. Even so, I will not include array bound
 * checking for now.
 *
 * ~~~~
 * |--------------------------------------------------------------|
 * | $ARRAY/N|....
 * |______________________________________________________________
 * ~~~~
 *
 * Unbound Var is used as a place to point to.
 *
 * Static Arrays are represented as a special property for an atom,
 * with field size and
 *
 * A term of the form X[I] is represented as a Reference pointing to
 * the compound term:
 *
 * []([I],X)
 *
 */

static Int create_array(USES_REGS1);
static Int create_mmapped_array(USES_REGS1);
static Int array_references(USES_REGS1);
static Int create_static_array(USES_REGS1);
static Int resize_static_array(USES_REGS1);
static Int close_static_array(USES_REGS1);
static Int access_array(USES_REGS1);
static Int assign_static(USES_REGS1);
static Int assign_dynamic(USES_REGS1);

#if HAVE_MMAP

#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_SYS_MMAN_H
#include <sys/mman.h>
#endif
#if HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif

/* keep a list of mmaped blocks to synch on exit */

typedef struct MMAP_ARRAY_BLOCK {
  Atom name;
  void *start;
  size_t size;
  Int items;
  int fd;
  struct MMAP_ARRAY_BLOCK *next;
} mmap_array_block;

static Int CloseMmappedArray(StaticArrayEntry *pp, void *area USES_REGS) {
  mmap_array_block *ptr = GLOBAL_mmap_arrays, *optr = GLOBAL_mmap_arrays;

  while (ptr != NULL && ptr->start != area) {
    ptr = ptr->next;
    optr = ptr;
  }
  if (ptr == NULL) {
#if !defined(USE_SYSTEM_MALLOC)
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1,
              "close_mmapped_array (array chain incoherent)", strerror(errno));
#endif
    return FALSE;
  }
  if (munmap(ptr->start, ptr->size) == -1) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "close_mmapped_array (munmap: %s)",
              strerror(errno));
    return (FALSE);
  }
  optr->next = ptr->next;
  pp->ValueOfVE.ints = NULL;
  pp->ArrayEArity = 0;
  if (close(ptr->fd) < 0) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "close_mmapped_array (close: %s)",
              strerror(errno));
    return (FALSE);
  }
  Yap_FreeAtomSpace((char *)ptr);
  return (TRUE);
}

static void ResizeMmappedArray(StaticArrayEntry *pp, Int dim,
                               void *area USES_REGS) {
  mmap_array_block *ptr = GLOBAL_mmap_arrays;
  size_t total_size;
  while (ptr != NULL && ptr->start != area) {
    ptr = ptr->next;
  }
  if (ptr == NULL)
    return;
  /* This is a very stupid algorithm to change size for an array.

     First, we unmap it, then we actually change the size for the file,
     and last we initialize again
  */
  if (munmap(ptr->start, ptr->size) == -1) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "resize_mmapped_array (munmap: %s)",
              strerror(errno));
    return;
  }
  total_size = (ptr->size / ptr->items) * dim;
  if (ftruncate(ptr->fd, total_size) < 0) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1,
              "resize_mmapped_array (ftruncate: %s)", strerror(errno));
    return;
  }
  if (lseek(ptr->fd, total_size - 1, SEEK_SET) < 0) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "resize_mmapped_array (lseek: %s)",
              strerror(errno));
    return;
  }
  if (write(ptr->fd, "", 1) < 0) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "resize_mmapped_array (write: %s)",
              strerror(errno));
    return;
  }
  if ((ptr->start = (void *)mmap(0, (size_t)total_size, PROT_READ | PROT_WRITE,
                                 MAP_SHARED, ptr->fd, 0)) == (void *)-1) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "resize_mmapped_array (mmap: %s)",
              strerror(errno));
    return;
  }
  ptr->size = total_size;
  ptr->items = dim;
  pp->ValueOfVE.chars = ptr->start;
}

#endif

static Term GetTermFromArray(DBTerm *ref USES_REGS) {
  if (ref != NULL) {
    Term TRef;

    while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
      if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
        LOCAL_Error_TYPE = YAP_NO_ERROR;
        if (!Yap_growglobal(NULL)) {
          Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
                    LOCAL_ErrorMessage);
          return TermNil;
        }
      } else {
        LOCAL_Error_TYPE = YAP_NO_ERROR;
        if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, Yap_gcP())) {
          Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
          return TermNil;
        }
      }
    }
    return TRef;
  } else {
    P = (yamop *)FAILCODE;
    return TermNil;
  }
}

static Term GetNBTerm(live_term *ar, Int indx USES_REGS) {
  /* The object is now in use */
  Term livet = ar[indx].tlive;

  if (!IsVarTerm(livet)) {
    if (!IsApplTerm(livet)) {
      return livet;
    } else if (FunctorOfTerm(livet) == FunctorAtFoundOne) {
      return Yap_ReadTimedVar(livet);
    } else {
      return livet;
    }
  } else {
    Term termt = ar[indx].tstore;

    if (!IsUnboundVar(&(ar[indx].tlive))) {
      return livet;
    }
    if (IsVarTerm(termt)) {
      livet = MkVarTerm();
    } else if (IsAtomicTerm(termt)) {
      livet = termt;
    } else {
      DBTerm *ref = (DBTerm *)RepAppl(termt);
      if ((livet = GetTermFromArray(ref PASS_REGS)) == TermNil) {
        return TermNil;
      }
    }
    YapBind(&(ar[indx].tlive), livet);
    return livet;
  }
}

static ArrayEntry *GetArrayEntry(Atom at, int owner) {
  CACHE_REGS
  ArrayEntry *pp;
  AtomEntry *ae = RepAtom(at);

  READ_LOCK(ae->ARWLock);
  pp = RepArrayProp(ae->PropsOfAE);
  while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty
#if THREADS
         && pp->owner_id != worker_id
#endif
         )
    pp = RepArrayProp(pp->NextOfPE);
  READ_UNLOCK(ae->ARWLock);
  return pp;
}

static Term AccessNamedArray(Atom a, Int indx USES_REGS) {
  ArrayEntry *pp;
  AtomEntry *ae = RepAtom(a);

  pp = GetArrayEntry(ae, worker_id);

  if (!EndOfPAEntr(pp)) {
    if (ArrayIsDynamic(pp)) {
      Term out;
      READ_LOCK(pp->ArRWLock);
      if (IsVarTerm(pp->ValueOfVE) || pp->ArrayEArity <= indx || indx < 0) {
        READ_UNLOCK(pp->ArRWLock);
        P = (yamop *)FAILCODE;
        return (MkAtomTerm(AtomFoundVar));
      }
      out = RepAppl(pp->ValueOfVE)[indx + 1];
      READ_UNLOCK(pp->ArRWLock);
      return (out);
    } else {
      StaticArrayEntry *ptr = (StaticArrayEntry *)pp;

      READ_LOCK(ptr->ArRWLock);
      if (pp->ArrayEArity <= indx || indx < 0) {
        /*	Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx),
         * "access_array");*/
        READ_UNLOCK(ptr->ArRWLock);
        P = (yamop *)FAILCODE;
        return (MkAtomTerm(AtomFoundVar));
      }
      switch (ptr->ArrayType) {

      case array_of_ints: {
        Term out;
        out = MkIntegerTerm(ptr->ValueOfVE.ints[indx]);
        READ_UNLOCK(ptr->ArRWLock);
        return out;
      }
      case array_of_doubles: {
        Term out;
        out = MkEvalFl(ptr->ValueOfVE.floats[indx]);
        READ_UNLOCK(ptr->ArRWLock);
        return out;
      }
      case array_of_ptrs: {
        Term out;
        out = MkIntegerTerm((Int)(ptr->ValueOfVE.ptrs[indx]));
        READ_UNLOCK(ptr->ArRWLock);
        return out;
      }
      case array_of_atoms: {
        Term out;
        out = ptr->ValueOfVE.atoms[indx];
        READ_UNLOCK(ptr->ArRWLock);
        if (out == 0L)
          return TermNil;
        else
          return out;
      }
      /* just return the atom */
      case array_of_chars: {
        Term out;
        out = MkIntegerTerm((Int)(ptr->ValueOfVE.chars[indx]));
        READ_UNLOCK(ptr->ArRWLock);
        return out;
      }
      case array_of_uchars: {
        Term out;
        out = MkIntegerTerm((Int)(ptr->ValueOfVE.uchars[indx]));
        READ_UNLOCK(ptr->ArRWLock);
        return out;
      }
      case array_of_dbrefs: {
        /* The object is now in use */
        Term TRef = ptr->ValueOfVE.dbrefs[indx];

        READ_UNLOCK(ptr->ArRWLock);
        if (TRef != 0L) {
          DBRef ref = DBRefOfTerm(TRef);

#if MULTIPLE_STACKS
          LOCK(ref->lock);
          INC_DBREF_COUNT(ref);
          TRAIL_REF(ref); /* So that fail will erase it */
          UNLOCK(ref->lock);
#else
          if (ref->Flags & LogUpdMask) {
            LogUpdClause *cl = (LogUpdClause *)ref;

            if (!(cl->ClFlags & InUseMask)) {
              cl->ClFlags |= InUseMask;
              TRAIL_CLREF(cl);
            }
          } else {
            if (!(ref->Flags & InUseMask)) {
              ref->Flags |= InUseMask;
              TRAIL_REF(ref); /* So that fail will erase it */
            }
          }
#endif
        } else {
          P = (yamop *)FAILCODE;
          TRef = TermNil;
        }
        return TRef;
      }
      case array_of_nb_terms: {
        /* The object is now in use */
        Term out = GetNBTerm(ptr->ValueOfVE.lterms, indx PASS_REGS);

        READ_UNLOCK(ptr->ArRWLock);
        return out;
      }
      case array_of_terms: {
        /* The object is now in use */
        DBTerm *ref = ptr->ValueOfVE.terms[indx];

        READ_UNLOCK(ptr->ArRWLock);
        return GetTermFromArray(ref PASS_REGS);
      }
      default:
        READ_UNLOCK(ptr->ArRWLock);
        return TermNil;
      }
    }
  } else {
    Yap_Error(EXISTENCE_ERROR_ARRAY, MkAtomTerm(a), "named array");
    return (TermNil);
  }
}

/** @pred  array_element(+ _Name_, + _Index_, ? _Element_)


Unify  _Element_ with  _Name_[ _Index_]. It works for both
static and dynamic arrays, but it is read-only for static arrays, while
it can be used to unify with an element of a dynamic array.


*/

/// @memberof array_element/3
static Int access_array(USES_REGS1) {
  Term t = Deref(ARG1);
  Term ti = Deref(ARG2);
  Term tf;
  Int indx;

  if (IsNonVarTerm(ti)) {
    Term nti;
    if (IsIntegerTerm(nti = Yap_Eval(ti)))
      indx = IntegerOfTerm(nti);
    else {
      Yap_Error(TYPE_ERROR_INTEGER, ti, "access_array");
      return (FALSE);
    }
  } else {
    Yap_Error(INSTANTIATION_ERROR, ti, "access_array");
    return (TermNil);
  }

  if (IsNonVarTerm(t)) {
    if (IsApplTerm(t)) {
      if (indx >= ArityOfFunctor(FunctorOfTerm(t)) || indx < 0) {
        /*	Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx),
         * "access_array");*/
        P = (yamop *)FAILCODE;
        return (FALSE);
      }
      tf = (RepAppl(t))[indx + 1];
    } else if (IsAtomTerm(t)) {
      tf = AccessNamedArray(AtomOfTerm(t), indx PASS_REGS);
      if (tf == MkAtomTerm(AtomFoundVar)) {
        return (FALSE);
      }
    } else {
      Yap_Error(TYPE_ERROR_ARRAY, t, "access_array");
      return (FALSE);
    }
  } else {
    Yap_Error(INSTANTIATION_ERROR, t, "access_array");
    return (FALSE);
  }
  return Yap_unify(tf, ARG3);
}

static Int array_arg(USES_REGS1) {
  register Term ti = Deref(ARG3), t;
  register Int indx;

  if (IsNonVarTerm(ti)) {
    Term nti;
    if (IsIntegerTerm(nti = Yap_Eval(ti)))
      indx = IntegerOfTerm(nti);
    else {
      Yap_Error(TYPE_ERROR_INTEGER, ti, "access_array");
      return (FALSE);
    }
  } else {
    Yap_Error(INSTANTIATION_ERROR, ti, "array_arg");
    return (FALSE);
  }

  t = Deref(ARG2);
  if (IsNonVarTerm(t)) {
    if (IsApplTerm(t)) {
      return (Yap_unify(((RepAppl(t))[indx + 1]), ARG1));
    } else if (IsAtomTerm(t)) {
      Term tf = AccessNamedArray(AtomOfTerm(t), indx PASS_REGS);
      if (tf == MkAtomTerm(AtomFoundVar)) {
        return (FALSE);
      }
      return (Yap_unify(tf, ARG1));
    } else
      Yap_Error(TYPE_ERROR_ARRAY, t, "array_arg");
  } else
    Yap_Error(INSTANTIATION_ERROR, t, "array_arg");

  return (FALSE);
}

static void InitNamedArray(ArrayEntry *p, Int dim USES_REGS) {
  Term *tp;

  WRITE_LOCK(p->ArRWLock);
  /* Leave a pointer so that we can reclaim array space when
   * we backtrack or when we abort */
  /* place terms in reverse order */
  Bind_Global(&(p->ValueOfVE), AbsAppl(HR));
  tp = HR;
  tp[0] = (CELL)Yap_MkFunctor(AtomArray, dim);
  tp++;
  p->ArrayEArity = dim;
  /* Initialize the array as a set of variables */
  HR = tp + dim;
  for (; tp < HR; tp++) {
    RESET_VARIABLE(tp);
  }
  WRITE_UNLOCK(p->ArRWLock);
}

/* we assume the atom ae is already locked */
static void CreateNamedArray(PropEntry *pp, Int dim, AtomEntry *ae USES_REGS) {
  ArrayEntry *p;

  p = (ArrayEntry *)Yap_AllocAtomSpace(sizeof(*p));
  p->KindOfPE = ArrayProperty;
  p->TypeOfAE = DYNAMIC_ARRAY;
  AddPropToAtom(ae, (PropEntry *)p);
  INIT_RWLOCK(p->ArRWLock);
#if THREADS
  p->owner_id = worker_id;
#endif
  p->NextAE = LOCAL_DynamicArrays;
  LOCAL_DynamicArrays = p;
  InitNamedArray(p, dim PASS_REGS);
}

static void AllocateStaticArraySpace(StaticArrayEntry *p,
                                     static_array_types atype, void *old,
                                     size_t array_size USES_REGS) {
  size_t asize = 0;
  switch (atype) {
  case array_of_doubles:
    asize = array_size * sizeof(Float);
    break;
  case array_of_ints:
    asize = array_size * sizeof(Int);
    break;
  case array_of_chars:
    asize = array_size * sizeof(char);
    break;
  case array_of_uchars:
    asize = array_size * sizeof(unsigned char);
    break;
  case array_of_ptrs:
    asize = array_size * sizeof(AtomEntry *);
    break;
  case array_of_atoms:
  case array_of_terms:
  case array_of_nb_terms:
    asize = array_size * sizeof(live_term);
    break;
  case array_of_dbrefs:
    asize = array_size * sizeof(DBRef);
    break;
  }
  if (old == NULL) {
    while ((p->ValueOfVE.floats = (Float *)Yap_AllocCodeSpace(asize)) == NULL) {
      YAPLeaveCriticalSection();
      if (!Yap_growheap(FALSE, asize, NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
        return;
      }
      YAPEnterCriticalSection();
    }
  } else {
    while ((p->ValueOfVE.floats = (Float *)Yap_ReallocCodeSpace(old, asize)) ==
           NULL) {
      YAPLeaveCriticalSection();
      if (!Yap_growheap(FALSE, asize, NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
        return;
      }
      YAPEnterCriticalSection();
    }
  }
}

/* ae and p are assumed to be locked, if they exist */
static StaticArrayEntry *CreateStaticArray(AtomEntry *ae, size_t dim,
                                           static_array_types type,
                                           CODEADDR start_addr,
                                           StaticArrayEntry *p USES_REGS) {
  if (EndOfPAEntr(p)) {
    while ((p = (StaticArrayEntry *)Yap_AllocCodeSpace(sizeof(*p))) == NULL) {
      if (!Yap_growheap(FALSE, sizeof(*p), NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
        return NULL;
      }
    }
    p->KindOfPE = ArrayProperty;
    INIT_RWLOCK(p->ArRWLock);
    AddPropToAtom(ae, (PropEntry *)p);
    p->NextAE = LOCAL_StaticArrays;
    LOCAL_StaticArrays = p;
  }
  WRITE_LOCK(p->ArRWLock);
  p->ArrayEArity = dim;
  p->ArrayType = type;
  p->TypeOfAE = STATIC_ARRAY;
  if (start_addr == NULL) {
    size_t i;
    AllocateStaticArraySpace(p, type, NULL, dim PASS_REGS);
    if (p->ValueOfVE.ints == NULL) {
      WRITE_UNLOCK(p->ArRWLock);
      return p;
    }
    switch (type) {
    case array_of_ints:
      for (i = 0; i < dim; i++)
        p->ValueOfVE.ints[i] = 0;
      break;
    case array_of_chars:
      for (i = 0; i < dim; i++)
        p->ValueOfVE.chars[i] = '\0';
      break;
    case array_of_uchars:
      for (i = 0; i < dim; i++)
        p->ValueOfVE.uchars[i] = '\0';
      break;
    case array_of_doubles:
      for (i = 0; i < dim; i++)
        p->ValueOfVE.floats[i] = 0.0;
      break;
    case array_of_ptrs:
      for (i = 0; i < dim; i++)
        p->ValueOfVE.ptrs[i] = NULL;
      break;
    case array_of_atoms:
    case array_of_dbrefs:
      for (i = 0; i < dim; i++)
        p->ValueOfVE.atoms[i] = 0L;
      break;
    case array_of_terms:
      for (i = 0; i < dim; i++)
        p->ValueOfVE.terms[i] = NULL;
      break;
    case array_of_nb_terms:
      for (i = 0; i < dim; i++) {
        RESET_VARIABLE(&(p->ValueOfVE.lterms[i].tlive));
        p->ValueOfVE.lterms[i].tstore = TermNil;
      }
      break;
    }
  } else {
    /* external array */
    p->TypeOfAE |= MMAP_ARRAY;
    p->ValueOfVE.chars = (char *)start_addr;
  }
  WRITE_UNLOCK(p->ArRWLock);
  return p;
}

/* ae and p are assumed to be locked, if they exist */
StaticArrayEntry *Yap_StaticArray(Atom na, size_t dim, static_array_types type,
                                  CODEADDR start_addr, StaticArrayEntry *p) {
  CACHE_REGS
  StaticArrayEntry *e;
  ArrayEntry *e0 = GetArrayEntry(RepAtom(na), worker_id);
  if (e0 && ArrayIsDynamic(e0)) {
    e = NULL;
  } else {
    // initial version for e
    e = RepStaticArrayProp(AbsArrayProp(e0));
  }
  e = CreateStaticArray(RepAtom(na), dim, type, NULL, e PASS_REGS);
  return e;
}

static void ResizeStaticArray(StaticArrayEntry *pp, size_t dim USES_REGS) {
  statarray_elements old_v = pp->ValueOfVE;
  static_array_types type = pp->ArrayType;
  size_t old_dim = pp->ArrayEArity;
  size_t mindim = (dim < old_dim ? dim : old_dim), i;

  /* change official size */
  if (pp->ArrayEArity == 0) {
    return;
  }
  WRITE_LOCK(pp->ArRWLock);
  pp->ArrayEArity = dim;
#if HAVE_MMAP
  if (pp->TypeOfAE & MMAP_ARRAY) {
    ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars)PASS_REGS);
    WRITE_UNLOCK(pp->ArRWLock);
    return;
  }
#endif
  AllocateStaticArraySpace(pp, type, old_v.chars, dim PASS_REGS);
  switch (type) {
  case array_of_ints:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.ints[i] = 0;
    break;
  case array_of_chars:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.chars[i] = '\0';
    break;
  case array_of_uchars:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.uchars[i] = '\0';
    break;
  case array_of_doubles:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.floats[i] = 0.0;
    break;
  case array_of_ptrs:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.ptrs[i] = NULL;
    break;
  case array_of_atoms:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.atoms[i] = TermNil;
    break;
  case array_of_dbrefs:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.dbrefs[i] = 0L;
    break;
  case array_of_terms:
    for (i = mindim; i < dim; i++)
      pp->ValueOfVE.terms[i] = NULL;
    break;
  case array_of_nb_terms:
    for (i = mindim; i < dim; i++) {
      RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive));
      pp->ValueOfVE.lterms[i].tstore = TermNil;
    }
    break;
  }
  WRITE_UNLOCK(pp->ArRWLock);
}

static void ClearStaticArray(StaticArrayEntry *pp) {
  statarray_elements old_v = pp->ValueOfVE;
  static_array_types type = pp->ArrayType;
  Int dim = pp->ArrayEArity, i;

  /* change official size */
  if (pp->ArrayEArity == 0) {
    return;
  }
  WRITE_LOCK(pp->ArRWLock);
  switch (type) {
  case array_of_ints:
    memset((void *)pp->ValueOfVE.ints, 0, sizeof(Int) * dim);
    break;
  case array_of_chars:
    memset((void *)pp->ValueOfVE.chars, 0, sizeof(char) * dim);
    break;
  case array_of_uchars:
    memset((void *)pp->ValueOfVE.uchars, 0, sizeof(unsigned char) * dim);
    break;
  case array_of_doubles:
    memset((void *)pp->ValueOfVE.floats, 0, sizeof(double) * dim);
    break;
  case array_of_ptrs:
    memset((void *)pp->ValueOfVE.ptrs, 0, sizeof(void *) * dim);
    break;
  case array_of_atoms:
    for (i = 0; i < dim; i++)
      pp->ValueOfVE.atoms[i] = TermNil;
    break;
  case array_of_dbrefs:
    for (i = 0; i < dim; i++) {
      Term t0 = pp->ValueOfVE.dbrefs[i];
      if (t0 != 0L) {
        DBRef ptr = DBRefOfTerm(t0);

        if (ptr->Flags & LogUpdMask) {
          LogUpdClause *lup = (LogUpdClause *)ptr;
          //	  LOCK(lup->ClLock);
          lup->ClRefCount--;
          if (lup->ClRefCount == 0 && (lup->ClFlags & ErasedMask) &&
              !(lup->ClFlags & InUseMask)) {
            //	    UNLOCK(lup->ClLock);
            Yap_ErLogUpdCl(lup);
          } else {
            //	    UNLOCK(lup->ClLock);
          }
        } else {
          ptr->NOfRefsTo--;
          if (ptr->NOfRefsTo == 0 && (ptr->Flags & ErasedMask) &&
              !(ptr->Flags & InUseMask)) {
            Yap_ErDBE(ptr);
          }
        }
      }
      pp->ValueOfVE.dbrefs[i] = 0L;
    }
    break;
  case array_of_terms:
    for (i = 0; i < dim; i++) {
      DBTerm *ref = pp->ValueOfVE.terms[i];

      if (ref != NULL) {
        Yap_ReleaseTermFromDB(ref);
      }
      pp->ValueOfVE.terms[i] = NULL;
    }
    break;
  case array_of_nb_terms:
    for (i = 0; i < dim; i++) {
      Term told = pp->ValueOfVE.lterms[i].tstore;
      CELL *livep = &(pp->ValueOfVE.lterms[i].tlive);

      RESET_VARIABLE(livep);
      /* recover space */
      if (IsApplTerm(told)) {
        Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
      }
      pp->ValueOfVE.lterms[i].tstore = old_v.lterms[i].tstore;
    }
    break;
  }
  WRITE_UNLOCK(pp->ArRWLock);
}

/* create an array (?Name, + Size) */
static Int create_array(USES_REGS1) {
  Term ti;
  Term t;
  Int size;

restart:
  ti = Deref(ARG2);
  t = Deref(ARG1);
  {
    Term nti;
    if (IsVarTerm(ti)) {
      Yap_Error(INSTANTIATION_ERROR, ti, "create_array");
      return (FALSE);
    }
    if (IsIntegerTerm(nti = Yap_Eval(ti)))
      size = IntegerOfTerm(nti);
    else {
      Yap_Error(TYPE_ERROR_INTEGER, ti, "create_array");
      return (FALSE);
    }
  }

  if (IsVarTerm(t)) {
    /* Create an anonymous array */
    Functor farray;

    farray = Yap_MkFunctor(AtomArray, size);
    if (HR + 1 + size > ASP - 1024) {
      if (!Yap_gcl((1 + size) * sizeof(CELL), 2, ENV, Yap_gcP())) {
        Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
        return (FALSE);
      } else {
        if (HR + 1 + size > ASP - 1024) {
          if (!Yap_growstack(sizeof(CELL) * (size + 1 - (HR - ASP - 1024)))) {
            Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
            return FALSE;
          }
        }
      }
      goto restart;
    }
    t = AbsAppl(HR);
    *HR++ = (CELL)farray;
    for (; size >= 0; size--) {
      RESET_VARIABLE(HR);
      HR++;
    }
    return (Yap_unify(t, ARG1));
  } else if (IsAtomTerm(t)) {
    /* Create a named array */
    AtomEntry *ae = RepAtom(AtomOfTerm(t));
    PropEntry *pp;

    WRITE_LOCK(ae->ARWLock);
    pp = RepProp(ae->PropsOfAE);
    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty
#if THREADS
           && ((ArrayEntry *)pp)->owner_id != worker_id
#endif
           )
      pp = RepProp(pp->NextOfPE);
    if (EndOfPAEntr(pp)) {
      if (HR + 1 + size > ASP - 1024) {
        WRITE_UNLOCK(ae->ARWLock);
        if (!Yap_gcl((1 + size) * sizeof(CELL), 2, ENV, gc_P(P, CP))) {
          Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
          return (FALSE);
        } else
          goto restart;
      }
      CreateNamedArray(pp, size, ae PASS_REGS);
      WRITE_UNLOCK(ae->ARWLock);
      return (TRUE);
    } else {
      ArrayEntry *app = (ArrayEntry *)pp;

      WRITE_UNLOCK(ae->ARWLock);
      if (!IsVarTerm(app->ValueOfVE) || !IsUnboundVar(&app->ValueOfVE)) {
        if (size == app->ArrayEArity)
          return TRUE;
        Yap_Error(PERMISSION_ERROR_CREATE_ARRAY, t, "create_array",
                  ae->StrOfAE);
      } else {
        if (HR + 1 + size > ASP - 1024) {
          if (!Yap_gcl((1 + size) * sizeof(CELL), 2, ENV, gc_P(P, CP))) {
            Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
            return (FALSE);
          } else
            goto restart;
        }
        InitNamedArray(app, size PASS_REGS);
        return (TRUE);
      }
    }
  }
  return (FALSE);
}

/* create an array (+Name, + Size, +Props) */
static Int
    /** @pred  static_array(+ _Name_, + _Size_, + _Type_)


    Create a new static array with name  _Name_. Note that the  _Name_
    must be an atom (named array). The  _Size_ must evaluate to an
    integer.  The  _Type_ must be bound to one of types mentioned
    previously.
    */
    create_static_array(USES_REGS1) {
  Term ti = Deref(ARG2);
  Term t = Deref(ARG1);
  Term tprops = Deref(ARG3);
  Int size;
  static_array_types props;

  if (IsVarTerm(ti)) {
    Yap_Error(INSTANTIATION_ERROR, ti, "create static array");
    return (FALSE);
  } else {
    Term nti;

    if (IsIntegerTerm(nti = Yap_Eval(ti)))
      size = IntegerOfTerm(nti);
    else {
      Yap_Error(TYPE_ERROR_INTEGER, ti, "create static array");
      return (FALSE);
    }
  }

  if (IsVarTerm(tprops)) {
    Yap_Error(INSTANTIATION_ERROR, tprops, "create static array");
    return (FALSE);
  } else if (IsAtomTerm(tprops)) {
    char *atname = (char *)RepAtom(AtomOfTerm(tprops))->StrOfAE;
    if (!strcmp(atname, "int"))
      props = array_of_ints;
    else if (!strcmp(atname, "dbref"))
      props = array_of_dbrefs;
    else if (!strcmp(atname, "float"))
      props = array_of_doubles;
    else if (!strcmp(atname, "ptr"))
      props = array_of_ptrs;
    else if (!strcmp(atname, "atom"))
      props = array_of_atoms;
    else if (!strcmp(atname, "char"))
      props = array_of_chars;
    else if (!strcmp(atname, "unsigned_char"))
      props = array_of_uchars;
    else if (!strcmp(atname, "term"))
      props = array_of_terms;
    else if (!strcmp(atname, "nb_term"))
      props = array_of_nb_terms;
    else {
      Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, tprops, "create static array");
      return (FALSE);
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, tprops, "create static array");
    return (FALSE);
  }

  if (IsVarTerm(t)) {
    Yap_Error(INSTANTIATION_ERROR, t, "create static array");
    return (FALSE);
  } else if (IsAtomTerm(t)) {
    /* Create a named array */
    AtomEntry *ae = RepAtom(AtomOfTerm(t));
    StaticArrayEntry *pp;
    ArrayEntry *app;

    WRITE_LOCK(ae->ARWLock);
    pp = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepStaticArrayProp(pp->NextOfPE);

    app = (ArrayEntry *)pp;
    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
      pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
      if (pp == NULL || pp->ValueOfVE.ints == NULL) {
        WRITE_UNLOCK(ae->ARWLock);
        return FALSE;
      }
      WRITE_UNLOCK(ae->ARWLock);
      return TRUE;
    } else if (ArrayIsDynamic(app)) {
      if (IsVarTerm(app->ValueOfVE) && IsUnboundVar(&app->ValueOfVE)) {
        pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
        WRITE_UNLOCK(ae->ARWLock);
        if (pp == NULL) {
          return false;
        }
        return true;
      } else {
        WRITE_UNLOCK(ae->ARWLock);
        Yap_Error(PERMISSION_ERROR_CREATE_ARRAY, t,
                  "cannot create static array over dynamic array");
        return false;
      }
    } else {
      if (pp->ArrayEArity == size && pp->ArrayType == props) {
        WRITE_UNLOCK(ae->ARWLock);
        return true;
      }
      Yap_FreeCodeSpace(pp->ValueOfVE.floats);
      WRITE_UNLOCK(ae->ARWLock);
      return true;
    }
  }
  Yap_Error(TYPE_ERROR_ATOM, t, "create static array");
  return false;
}

/// create a new vectir in a given name Name. If one exists, destroy prrexisting
/// onr
StaticArrayEntry *Yap_StaticVector(Atom Name, size_t size,
                                   static_array_types props) {
  CACHE_REGS
  AtomEntry *ae = RepAtom(Name);

  WRITE_LOCK(ae->ARWLock);
  StaticArrayEntry *pp =
      RepStaticArrayProp(AbsArrayProp(GetArrayEntry(ae, worker_id)));
  if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
    pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
    if (pp == NULL || pp->ValueOfVE.ints == NULL) {
      WRITE_UNLOCK(ae->ARWLock);
      return FALSE;
    }
    WRITE_UNLOCK(ae->ARWLock);
    return pp;
  }
  return NULL;
}

/* has a static array associated (+Name) */
static Int static_array_properties(USES_REGS1) {
  Term t = Deref(ARG1);

  if (IsVarTerm(t)) {
    return (FALSE);
  } else if (IsAtomTerm(t)) {
    /* Create a named array */
    AtomEntry *ae = RepAtom(AtomOfTerm(t));
    StaticArrayEntry *pp;

    READ_LOCK(ae->ARWLock);
    pp = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepStaticArrayProp(pp->NextOfPE);
    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
      READ_UNLOCK(ae->ARWLock);
      return (FALSE);
    } else {
      static_array_types tp = pp->ArrayType;
      Int dim = pp->ArrayEArity;

      READ_UNLOCK(ae->ARWLock);
      if (dim <= 0 || !Yap_unify(ARG2, MkIntegerTerm(dim)))
        return (FALSE);
      switch (tp) {
      case array_of_ints:
        return (Yap_unify(ARG3, MkAtomTerm(AtomInt)));
      case array_of_dbrefs:
        return (Yap_unify(ARG3, MkAtomTerm(AtomDBref)));
      case array_of_doubles:
        return (Yap_unify(ARG3, MkAtomTerm(AtomFloat)));
      case array_of_ptrs:
        return (Yap_unify(ARG3, TermPointer));
      case array_of_chars:
        return (Yap_unify(ARG3, MkAtomTerm(AtomChar)));
      case array_of_uchars:
        return (Yap_unify(ARG3, MkAtomTerm(AtomUnsignedChar)));
      case array_of_terms:
        return (Yap_unify(ARG3, TermTerm));
      case array_of_nb_terms:
        return (Yap_unify(ARG3, TermTerm));
      case array_of_atoms:
        return (Yap_unify(ARG3, MkAtomTerm(AtomAtom)));
      }
    }
  }
  return (FALSE);
}

/* resize a static array (+Name, + Size, +Props) */
/* does not work for mmap arrays yet */
static Int resize_static_array(USES_REGS1) {
  Term ti = Deref(ARG3);
  Term t = Deref(ARG1);
  Int size;

  if (IsVarTerm(ti)) {
    Yap_Error(INSTANTIATION_ERROR, ti, "resize a static array");
    return (FALSE);
  } else {
    Term nti;

    if (IsIntegerTerm(nti = Yap_Eval(ti)))
      size = IntegerOfTerm(nti);
    else {
      Yap_Error(TYPE_ERROR_INTEGER, ti, "resize a static array");
      return (FALSE);
    }
  }

  if (IsVarTerm(t)) {
    Yap_Error(INSTANTIATION_ERROR, t, "resize a static array");
    return (FALSE);
  } else if (IsAtomTerm(t)) {
    /* resize a named array */
    Atom a = AtomOfTerm(t);
    StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropsOfAE);

    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepStaticArrayProp(pp->NextOfPE);
    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
      Yap_Error(PERMISSION_ERROR_RESIZE_ARRAY, t, "resize a static array");
      return (FALSE);
    } else {
      size_t osize = pp->ArrayEArity;
      ResizeStaticArray(pp, size PASS_REGS);
      return (Yap_unify(ARG2, MkIntegerTerm(osize)));
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, t, "resize a static array");
    return (FALSE);
  }
}

/* resize a static array (+Name, + Size, +Props) */
/* does not work for mmap arrays yet */
/** @pred  reset_static_array(+ _Name_)


Reset static array with name  _Name_ to its initial value.


*/
static Int clear_static_array(USES_REGS1) {
  Term t = Deref(ARG1);

  if (IsVarTerm(t)) {
    Yap_Error(INSTANTIATION_ERROR, t, "clear a static array");
    return FALSE;
  } else if (IsAtomTerm(t)) {
    /* resize a named array */
    Atom a = AtomOfTerm(t);
    StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropsOfAE);

    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepStaticArrayProp(pp->NextOfPE);
    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
      Yap_Error(PERMISSION_ERROR_RESIZE_ARRAY, t, "clear a static array");
      return FALSE;
    } else {
      ClearStaticArray(pp);
      return TRUE;
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, t, "clear a static array");
    return FALSE;
  }
}

/* Close a named array (+Name) */
/** @pred  close_static_array(+ _Name_)


Close an existing static array of name  _Name_. The  _Name_ must
be an atom (named array). Space for the array will be recovered and
further accesses to the array will return an error.


*/
static Int close_static_array(USES_REGS1) {
  /* does not work for mmap arrays yet */
  Term t = Deref(ARG1);

  if (IsVarTerm(t)) {
    Yap_Error(INSTANTIATION_ERROR, t, "close static array");
    return (FALSE);
  } else if (IsAtomTerm(t)) {
    /* Create a named array */
    AtomEntry *ae = RepAtom(AtomOfTerm(t));
    PropEntry *pp;

    READ_LOCK(ae->ARWLock);
    pp = RepProp(ae->PropsOfAE);
    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepProp(pp->NextOfPE);
    READ_UNLOCK(ae->ARWLock);
    if (EndOfPAEntr(pp)) {
      return (FALSE);
    } else {
      StaticArrayEntry *ptr = (StaticArrayEntry *)pp;
      if (ptr->ValueOfVE.ints != NULL) {
#if HAVE_MMAP
        Int val =
            CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars PASS_REGS);
#if USE_SYSTEM_MALLOC
        if (val) {
#endif
          return (val);
#if USE_SYSTEM_MALLOC
        }
#endif
#endif
        Yap_FreeAtomSpace((char *)(ptr->ValueOfVE.ints));
        ptr->ValueOfVE.ints = NULL;
        ptr->ArrayEArity = 0;
        return (TRUE);
      } else {
        return (FALSE);
      }
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, t, "close static array");
    return (FALSE);
  }
}

/** @pred  mmapped_array(+ _Name_, + _Size_, + _Type_, + _File_)


Similar to static_array/3, but the array is memory mapped to file
 _File_. This means that the array is initialized from the file, and
that any changes to the array will also be stored in the file.

This built-in is only available in operating systems that support the
system call `mmap`. Moreover, mmapped arrays do not store generic
terms (type `term`).


*/
static Int create_mmapped_array(USES_REGS1) {
#ifdef HAVE_MMAP
  Term ti = Deref(ARG2);
  Term t = Deref(ARG1);
  Term tprops = Deref(ARG3);
  Term tfile = Deref(ARG4);
  Int size;
  static_array_types props;
  size_t total_size;
  CODEADDR array_addr;
  int fd;

  if (IsVarTerm(ti)) {
    Yap_Error(INSTANTIATION_ERROR, ti, "create_mmapped_array");
    return (FALSE);
  } else {
    Term nti;

    if (IsIntegerTerm(nti = Yap_Eval(ti)))
      size = IntegerOfTerm(nti);
    else {
      Yap_Error(TYPE_ERROR_INTEGER, ti, "create_mmapped_array");
      return (FALSE);
    }
  }

  if (IsVarTerm(tprops)) {
    Yap_Error(INSTANTIATION_ERROR, tprops, "create_mmapped_array");
    return (FALSE);
  } else if (IsAtomTerm(tprops)) {
    char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE;
    if (!strcmp(atname, "int")) {
      props = array_of_ints;
      total_size = size * sizeof(Int);
    } else if (!strcmp(atname, "dbref")) {
      props = array_of_dbrefs;
      total_size = size * sizeof(Int);
    } else if (!strcmp(atname, "float")) {
      props = array_of_doubles;
      total_size = size * sizeof(Float);
    } else if (!strcmp(atname, "ptr")) {
      props = array_of_ptrs;
      total_size = size * sizeof(AtomEntry *);
    } else if (!strcmp(atname, "atom")) {
      props = array_of_atoms;
      total_size = size * sizeof(Term);
    } else if (!strcmp(atname, "char")) {
      props = array_of_chars;
      total_size = size * sizeof(char);
    } else if (!strcmp(atname, "unsigned_char")) {
      props = array_of_uchars;
      total_size = size * sizeof(unsigned char);
    } else {
      Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, tprops, "create_mmapped_array");
      return (FALSE);
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, tprops, "create_mmapped_array");
    return (FALSE);
  }

  if (IsVarTerm(tfile)) {
    Yap_Error(INSTANTIATION_ERROR, tfile, "create_mmapped_array");
    return (FALSE);
  } else if (IsAtomTerm(tfile)) {
    char *filename = RepAtom(AtomOfTerm(tfile))->StrOfAE;

    fd = open(filename, O_RDWR | O_CREAT, S_IRUSR | S_IWUSR);
    if (fd == -1) {
      Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "create_mmapped_array (open: %s)",
                strerror(errno));
      return (FALSE);
    }
    if (lseek(fd, total_size - 1, SEEK_SET) < 0)
      Yap_Error(SYSTEM_ERROR_INTERNAL, tfile,
                "create_mmapped_array (lseek: %s)", strerror(errno));
    if (write(fd, "", 1) < 0)
      Yap_Error(SYSTEM_ERROR_INTERNAL, tfile,
                "create_mmapped_array (write: %s)", strerror(errno));
    /*
      if (ftruncate(fd, total_size) < 0)
      Yap_Error(SYSTEM_ERROR_INTERNAL,tfile,"create_mmapped_array");
    */
    if ((array_addr =
             (CODEADDR)mmap(0, (size_t)total_size, PROT_READ | PROT_WRITE,
                            MAP_SHARED, fd, 0)) == (CODEADDR)-1)
      Yap_Error(SYSTEM_ERROR_INTERNAL, tfile, "create_mmapped_array (mmap: %s)",
                strerror(errno));
  } else {
    Yap_Error(TYPE_ERROR_ATOM, tfile, "create_mmapped_array");
    return (FALSE);
  }

  if (IsVarTerm(t)) {
    Yap_Error(INSTANTIATION_ERROR, t, "create_mmapped_array");
    return (FALSE);
  } else if (IsAtomTerm(t)) {
    /* Create a named array */
    AtomEntry *ae = RepAtom(AtomOfTerm(t));
    StaticArrayEntry *pp;

    WRITE_LOCK(ae->ARWLock);
    pp = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepStaticArrayProp(pp->NextOfPE);
    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
      mmap_array_block *ptr;

      if (EndOfPAEntr(pp)) {
        WRITE_UNLOCK(ae->ARWLock);
        return FALSE;
      } else {
        WRITE_LOCK(pp->ArRWLock);
      }
      CreateStaticArray(ae, size, props, array_addr, pp PASS_REGS);
      ptr = (mmap_array_block *)Yap_AllocAtomSpace(sizeof(mmap_array_block));
      ptr->name = AbsAtom(ae);
      ptr->size = total_size;
      ptr->items = size;
      ptr->start = (void *)array_addr;
      ptr->fd = fd;
      ptr->next = GLOBAL_mmap_arrays;
      GLOBAL_mmap_arrays = ptr;
      WRITE_UNLOCK(pp->ArRWLock);
      WRITE_UNLOCK(ae->ARWLock);
      return TRUE;
    } else {
      WRITE_UNLOCK(ae->ARWLock);
      Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, t, "create_mmapped_array",
                ae->StrOfAE);
      return (FALSE);
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, t, "create_mmapped_array");
    return FALSE;
  }
#else
  Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "create_mmapped_array (mmap)");
  return (FALSE);
#endif
}

/* This routine removes array references from complex terms? */
static void replace_array_references_complex(register CELL *pt0,
                                             register CELL *pt0_end,
                                             register CELL *ptn,
                                             Term Var USES_REGS) {

  register CELL **to_visit = (CELL **)Yap_PreAllocCodeSpace();
  CELL **to_visit_base = to_visit;

loop:
  while (pt0 < pt0_end) {
    register CELL d0;

    ++pt0;
    d0 = Derefa(pt0);
    if (IsVarTerm(d0)) {
      *ptn++ = d0;
    } else if (IsPairTerm(d0)) {
      /* store the terms to visit */
      *ptn++ = AbsPair(HR);
#ifdef RATIONAL_TREES
      to_visit[0] = pt0;
      to_visit[1] = pt0_end;
      to_visit[2] = ptn;
      to_visit[3] = (CELL *)*pt0;
      to_visit += 4;
      *pt0 = TermNil;
#else
      if (pt0 < pt0_end) {
        to_visit[0] = pt0;
        to_visit[1] = pt0_end;
        to_visit[2] = ptn;
        to_visit += 3;
      }
#endif
      pt0 = RepPair(d0) - 1;
      pt0_end = RepPair(d0) + 1;
      /* write the head and tail of the list */
      ptn = HR;
      HR += 2;
    } else if (IsApplTerm(d0)) {
      register Functor f;

      f = FunctorOfTerm(d0);
      /* store the terms to visit */
      if (IsExtensionFunctor(f)) {
        {
          *ptn++ = d0;
          continue;
        }
      }
      *ptn++ = AbsAppl(HR);
/* store the terms to visit */
#ifdef RATIONAL_TREES
      to_visit[0] = pt0;
      to_visit[1] = pt0_end;
      to_visit[2] = ptn;
      to_visit[3] = (CELL *)*pt0;
      to_visit += 4;
      *pt0 = TermNil;
#else
      if (pt0 < pt0_end) {
        to_visit[0] = pt0;
        to_visit[1] = pt0_end;
        to_visit[2] = ptn;
        to_visit += 3;
      }
#endif
      pt0 = RepAppl(d0);
      d0 = ArityOfFunctor(f);
      pt0_end = pt0 + d0;
      /* start writing the compound term */
      ptn = HR;
      *ptn++ = (CELL)f;
      HR += d0 + 1;
    } else { /* AtomOrInt */
      *ptn++ = d0;
    }
    /* just continue the loop */
  }

  /* Do we still have compound terms to visit */
  if (to_visit > (CELL **)to_visit_base) {
#ifdef RATIONAL_TREES
    to_visit -= 4;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    ptn = to_visit[2];
    *pt0 = (CELL)to_visit[3];
#else
    to_visit -= 3;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    ptn = to_visit[2];
#endif
    goto loop;
  }

  Bind_Global(PtrOfTerm(Var), TermNil);
  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
}

/*
 *
 * Given a term t0, build a new term tf of the form ta+tb, where ta is
 * obtained by replacing the array references in t0 by empty
 * variables, and tb is a list of array references and corresponding
 * variables.
 */
static Term replace_array_references(Term t0 USES_REGS) {
  Term t;

  t = Deref(t0);
  if (IsVarTerm(t)) {
    /* we found a variable */
    return (MkPairTerm(t, TermNil));
  } else if (IsAtomOrIntTerm(t)) {
    return (MkPairTerm(t, TermNil));
  } else if (IsPairTerm(t)) {
    Term VList = MkVarTerm();
    CELL *h0 = HR;

    HR += 2;
    replace_array_references_complex(RepPair(t) - 1, RepPair(t) + 1, h0,
                                     VList PASS_REGS);
    return MkPairTerm(AbsPair(h0), VList);
  } else {
    Term VList = MkVarTerm();
    CELL *h0 = HR;
    Functor f = FunctorOfTerm(t);

    *HR++ = (CELL)(f);
    HR += ArityOfFunctor(f);
    replace_array_references_complex(
        RepAppl(t), RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)), h0 + 1,
        VList PASS_REGS);
    return (MkPairTerm(AbsAppl(h0), VList));
  }
}

static Int array_references(USES_REGS1) {
  Term t = replace_array_references(ARG1 PASS_REGS);
  Term t1 = HeadOfTerm(t);
  Term t2 = TailOfTerm(t);

  return (Yap_unify(t1, ARG2) && Yap_unify(t2, ARG3));
}

/** @pred  update_array(+ _Name_, + _Index_, ? _Value_)


Attribute value  _Value_ to  _Name_[ _Index_]. Type
restrictions must be respected for static arrays. This operation is
available for dynamic arrays if `MULTI_ASSIGNMENT_VARIABLES` is
enabled (true by default). Backtracking undoes  _update_array/3_ for
dynamic arrays, but not for static arrays.

Note that update_array/3 actually uses `setarg/3` to update
elements of dynamic arrays, and `setarg/3` spends an extra cell for
every update. For intensive operations we suggest it may be less
expensive to unify each element of the array with a mutable terms and
to use the operations on mutable terms.


*/
static Int assign_static(USES_REGS1) {
  Term t1, t2, t3;
  StaticArrayEntry *ptr;
  Int indx;

  t2 = Deref(ARG2);
  if (IsNonVarTerm(t2)) {
    Term nti;

    if (IsIntegerTerm(nti = Yap_Eval(t2)))
      indx = IntegerOfTerm(nti);
    else {
      Yap_Error(TYPE_ERROR_INTEGER, t2, "update_array");
      return (FALSE);
    }
  } else {
    Yap_Error(INSTANTIATION_ERROR, t2, "update_array");
    return (FALSE);
  }
  t3 = Deref(ARG3);

  t1 = Deref(ARG1);
  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, "update_array");
    return (FALSE);
  }
  if (!IsAtomTerm(t1)) {
    if (IsApplTerm(t1)) {
      CELL *ptr;
      Functor f = FunctorOfTerm(t1);
      /* store the terms to visit */
      if (IsExtensionFunctor(f)) {
        Yap_Error(TYPE_ERROR_ARRAY, t1, "update_array");
        return (FALSE);
      }
      if (indx > 0 && indx > ArityOfFunctor(f)) {
        Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "update_array");
        return (FALSE);
      }
      ptr = RepAppl(t1) + indx + 1;
#ifdef MULTI_ASSIGNMENT_VARIABLES
      MaBind(ptr, t3);
      return (TRUE);
#else
      Yap_Error(SYSTEM_ERROR_INTERNAL, t2, "update_array");
      return (FALSE);
#endif
    } else {
      Yap_Error(TYPE_ERROR_ATOM, t1, "update_array");
      return (FALSE);
    }
  }
  {
    AtomEntry *ae = RepAtom(AtomOfTerm(t1));

    READ_LOCK(ae->ARWLock);
    ptr = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
      ptr = RepStaticArrayProp(ptr->NextOfPE);

    if (EndOfPAEntr(ptr)) {
      READ_UNLOCK(ae->ARWLock);
      Yap_Error(EXISTENCE_ERROR_ARRAY, t1, "assign_static %s",
                RepAtom(AtomOfTerm(t1))->StrOfAE);
      return FALSE;
    }

    if (ArrayIsDynamic((ArrayEntry *)ptr)) {
      ArrayEntry *pp = (ArrayEntry *)ptr;
      CELL *pt;

      WRITE_LOCK(pp->ArRWLock);
      READ_UNLOCK(ae->ARWLock);
      if (indx < 0 || indx >= pp->ArrayEArity) {
        Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
        WRITE_UNLOCK(pp->ArRWLock);
        return FALSE;
      }
      pt = RepAppl(pp->ValueOfVE) + indx + 1;
      WRITE_UNLOCK(pp->ArRWLock);
#ifdef MULTI_ASSIGNMENT_VARIABLES
      /* the evil deed is to be done now */
      MaBind(pt, t3);
      return TRUE;
#else
      Yap_Error(SYSTEM_ERROR_INTERNAL, t2, "update_array");
      return FALSE;
#endif
    }

    WRITE_LOCK(ptr->ArRWLock);
    READ_UNLOCK(ae->ARWLock);
    /* a static array */
    if (indx < 0 || indx >= ptr->ArrayEArity) {
      WRITE_UNLOCK(ptr->ArRWLock);
      Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
      return FALSE;
    }
    switch (ptr->ArrayType) {
    case array_of_ints: {
      Int i;
      Term nti;

      if (IsVarTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(INSTANTIATION_ERROR, t3, "assign_static");
        return FALSE;
      }

      if (IsIntegerTerm(nti = Yap_Eval(t3)))
        i = IntegerOfTerm(nti);
      else {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_INTEGER, t3, "assign_static");
        return (FALSE);
      }
      ptr->ValueOfVE.ints[indx] = i;
    } break;

    case array_of_chars: {
      Int i;
      Term nti;

      if (IsVarTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(INSTANTIATION_ERROR, t3, "assign_static");
        return FALSE;
      }
      if (IsIntegerTerm(nti = Yap_Eval(t3)))
        i = IntegerOfTerm(nti);
      else {
        Yap_Error(TYPE_ERROR_INTEGER, t3, "assign_static");
        return (FALSE);
      }
      if (i > 127 || i < -128) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_CHAR, t3, "assign_static");
        return FALSE;
      }
      ptr->ValueOfVE.chars[indx] = i;
    } break;

    case array_of_uchars: {
      Int i;
      Term nti;

      if (IsVarTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(INSTANTIATION_ERROR, t3, "assign_static");
        return FALSE;
      }
      if (IsIntegerTerm(nti = Yap_Eval(t3)))
        i = IntegerOfTerm(nti);
      else {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_INTEGER, t3, "assign_static");
        return FALSE;
      }
      if (i > 255 || i < 0) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_UCHAR, t3, "assign_static");
        return FALSE;
      }
      ptr->ValueOfVE.chars[indx] = i;
    } break;

    case array_of_doubles: {
      Float f;
      Term nti;

      if (IsVarTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(INSTANTIATION_ERROR, t3, "assign_static");
        return FALSE;
      }
      if (IsFloatTerm(nti = Yap_Eval(t3)))
        f = FloatOfTerm(nti);
      else if (IsIntegerTerm(nti))
        f = IntegerOfTerm(nti);
      else {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_FLOAT, t3, "assign_static");
        return FALSE;
      }
      ptr->ValueOfVE.floats[indx] = f;
    } break;

    case array_of_ptrs: {
      Int r;

      if (IsVarTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(INSTANTIATION_ERROR, t3, "assign_static");
        return FALSE;
      }
      if (IsIntegerTerm(t3))
        r = IntegerOfTerm(t3);
      else {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_PTR, t3, "assign_static");
        return FALSE;
      }
      ptr->ValueOfVE.ptrs[indx] = (AtomEntry *)r;
    } break;

    case array_of_atoms: {
      if (IsVarTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(INSTANTIATION_ERROR, t3, "assign_static");
        return FALSE;
      }
      if (!IsAtomTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_ATOM, t3, "assign_static");
        return FALSE;
      }
      ptr->ValueOfVE.atoms[indx] = t3;
    } break;

    case array_of_dbrefs: {

      Term t0 = ptr->ValueOfVE.dbrefs[indx];
      DBRef p = DBRefOfTerm(t3);

      if (IsVarTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(INSTANTIATION_ERROR, t3, "assign_static");
        return FALSE;
      }
      if (!IsDBRefTerm(t3)) {
        WRITE_UNLOCK(ptr->ArRWLock);
        Yap_Error(TYPE_ERROR_DBREF, t3, "assign_static");
        return FALSE;
      }
      ptr->ValueOfVE.dbrefs[indx] = t3;
      if (t0 != 0L) {
        DBRef ptr = DBRefOfTerm(t0);

        if (ptr->Flags & LogUpdMask) {
          LogUpdClause *lup = (LogUpdClause *)ptr;
          //	    LOCK(lup->ClLock);
          lup->ClRefCount--;
          if (lup->ClRefCount == 0 && (lup->ClFlags & ErasedMask) &&
              !(lup->ClFlags & InUseMask)) {
            //	      UNLOCK(lup->ClLock);
            Yap_ErLogUpdCl(lup);
          } else {
            //	      UNLOCK(lup->ClLock);
          }
        } else {
          ptr->NOfRefsTo--;
          if (ptr->NOfRefsTo == 0 && (ptr->Flags & ErasedMask) &&
              !(ptr->Flags & InUseMask)) {
            Yap_ErDBE(ptr);
          }
        }
      }

      if (p->Flags & LogUpdMask) {
        LogUpdClause *lup = (LogUpdClause *)p;
        //	  LOCK(lup->ClLock);
        lup->ClRefCount++;
        //	  UNLOCK(lup->ClLock);
      } else {
        p->NOfRefsTo++;
      }
    } break;

    case array_of_nb_terms:

    {
      Term told = ptr->ValueOfVE.lterms[indx].tstore;

      CELL *livep = &(ptr->ValueOfVE.lterms[indx].tlive);
      RESET_VARIABLE(livep);
      /* recover space */
      if (IsApplTerm(told)) {
        Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
      }
      if (IsVarTerm(t3)) {
        RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore));
      } else if (IsAtomicTerm(t3)) {
        ptr->ValueOfVE.lterms[indx].tstore = t3;
      } else {
        DBTerm *new = Yap_StoreTermInDB(t3, 3);
        if (!new) {
          WRITE_UNLOCK(ptr->ArRWLock);
          return FALSE;
        }
        ptr->ValueOfVE.lterms[indx].tstore = AbsAppl((CELL *)new);
      }
    } break;

    case array_of_terms: {

      DBTerm *ref = ptr->ValueOfVE.terms[indx];

      if (ref != NULL) {
        Yap_ReleaseTermFromDB(ref);
      }
      ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(t3, 3);
      if (ptr->ValueOfVE.terms[indx] == NULL) {
        WRITE_UNLOCK(ptr->ArRWLock);
        return FALSE;
      }
    } break;
    }
    WRITE_UNLOCK(ptr->ArRWLock);
    return TRUE;
  }
}

static Int assign_dynamic(USES_REGS1) {
  Term t1, t2, t3;
  StaticArrayEntry *ptr;
  Int indx;

  t2 = Deref(ARG2);
  if (IsNonVarTerm(t2)) {
    Term nti;
    if (IsIntegerTerm(nti = Yap_Eval(t2))) {
      indx = IntegerOfTerm(nti);
    } else {
      Yap_Error(TYPE_ERROR_INTEGER, t2, "update_array");
      return (FALSE);
    }
  } else {
    Yap_Error(INSTANTIATION_ERROR, t2, "update_array");
    return (FALSE);
  }
  t3 = Deref(ARG3);

  t1 = Deref(ARG1);
  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, "update_array");
    return (FALSE);
  }
  if (!IsAtomTerm(t1)) {
    if (IsApplTerm(t1)) {
      CELL *ptr;
      Functor f = FunctorOfTerm(t1);
      /* store the terms to visit */
      if (IsExtensionFunctor(f)) {
        Yap_Error(TYPE_ERROR_ARRAY, t1, "update_array");
        return (FALSE);
      }
      if (indx > 0 && indx > ArityOfFunctor(f)) {
        Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "update_array");
        return (FALSE);
      }
      ptr = RepAppl(t1) + indx + 1;
#ifdef MULTI_ASSIGNMENT_VARIABLES
      MaBind(ptr, t3);
      return (TRUE);
#else
      Yap_Error(SYSTEM_ERROR_INTERNAL, t2, "update_array");
      return (FALSE);
#endif
    } else {
      Yap_Error(TYPE_ERROR_ATOM, t1, "update_array");
      return (FALSE);
    }
  }
  {
    AtomEntry *ae = RepAtom(AtomOfTerm(t1));

    READ_LOCK(ae->ARWLock);
    ptr = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
      ptr = RepStaticArrayProp(ptr->NextOfPE);
    READ_UNLOCK(ae->ARWLock);
  }

  if (EndOfPAEntr(ptr)) {
    Yap_Error(EXISTENCE_ERROR_ARRAY, t1, "assign_static %s",
              RepAtom(AtomOfTerm(t1))->StrOfAE);
    return (FALSE);
  }

  if (ArrayIsDynamic((ArrayEntry *)ptr)) {
    ArrayEntry *pp = (ArrayEntry *)ptr;
    CELL *pt;
    WRITE_LOCK(pp->ArRWLock);
    if (indx < 0 || indx >= pp->ArrayEArity) {
      Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
      WRITE_UNLOCK(pp->ArRWLock);
      return (FALSE);
    }
    pt = RepAppl(pp->ValueOfVE) + indx + 1;
    WRITE_UNLOCK(pp->ArRWLock);
#ifdef MULTI_ASSIGNMENT_VARIABLES
    /* the evil deed is to be done now */
    MaBind(pt, t3);
    return TRUE;
#else
    Yap_Error(SYSTEM_ERROR_INTERNAL, t2, "update_array");
    return FALSE;
#endif
  }

  WRITE_LOCK(ptr->ArRWLock);
  /* a static array */
  if (indx < 0 || indx >= ptr->ArrayEArity) {
    WRITE_UNLOCK(ptr->ArRWLock);
    Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
    return FALSE;
  }
  switch (ptr->ArrayType) {
  case array_of_ints:
  case array_of_chars:
  case array_of_uchars:
  case array_of_doubles:
  case array_of_ptrs:
  case array_of_atoms:
  case array_of_dbrefs:
  case array_of_terms:
    WRITE_UNLOCK(ptr->ArRWLock);
    Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, t3, "assign_static");
    return FALSE;

  case array_of_nb_terms:
#ifdef MULTI_ASSIGNMENT_VARIABLES
  {
    Term t = ptr->ValueOfVE.lterms[indx].tlive;
    Functor f;
    /* we have a mutable term there */

    if (IsVarTerm(t) || !IsApplTerm(t) ||
        (f = FunctorOfTerm(t)) != FunctorAtFoundOne) {
      Term tn = Yap_NewTimedVar(t3);
      CELL *sp = RepAppl(tn);
      *sp = (CELL)FunctorAtFoundOne;
      YapBind(&(ptr->ValueOfVE.lterms[indx].tlive), tn);
    } else {
      Yap_UpdateTimedVar(t, t3);
    }
  }
    WRITE_UNLOCK(ptr->ArRWLock);
    return TRUE;
#else
    WRITE_UNLOCK(ptr->ArRWLock);
    Yap_Error(SYSTEM_ERROR_INTERNAL, t2, "update_array");
    return FALSE;
#endif
  }
  WRITE_UNLOCK(ptr->ArRWLock);
  return TRUE;
}

/** @pred  add_to_array_element(+ _Name_, + _Index_, + _Number_, ? _NewValue_)


Add  _Number_  _Name_[ _Index_] and unify  _NewValue_ with
the incremented value. Observe that  _Name_[ _Index_] must be an
number. If  _Name_ is a static array the type of the array must be
`int` or `float`. If the type of the array is `int` you
only may add integers, if it is `float` you may add integers or
floats. If  _Name_ corresponds to a dynamic array the array element
must have been previously bound to a number and `Number` can be
any kind of number.

The `add_to_array_element/3` built-in actually uses
`setarg/3` to update elements of dynamic arrays. For intensive
operations we suggest it may be less expensive to unify each element
of the array with a mutable terms and to use the operations on mutable
terms.




 */

static Int add_to_array_element(USES_REGS1) {
  Term t1, t2, t3;
  StaticArrayEntry *ptr;
  Int indx;

  t2 = Deref(ARG2);
  if (IsNonVarTerm(t2)) {
    Term nti;
    if (IsIntegerTerm(nti = Yap_Eval(t2))) {
      indx = IntegerOfTerm(nti);
    } else {
      Yap_Error(TYPE_ERROR_INTEGER, t2, "add_to_array_element");
      return (FALSE);
    }
  } else {
    Yap_Error(INSTANTIATION_ERROR, t2, "add_to_array_element");
    return (FALSE);
  }

  t1 = Deref(ARG1);
  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, "add_to_array_element");
    return (FALSE);
  }
  t3 = Deref(ARG3);
  if (IsVarTerm(t3)) {
    Yap_Error(INSTANTIATION_ERROR, t3, "add_to_array_element");
    return (FALSE);
  }
  if (!IsAtomTerm(t1)) {
    if (IsApplTerm(t1)) {
      CELL *ptr;
      Functor f = FunctorOfTerm(t1);
      Term ta;

      /* store the terms to visit */
      if (IsExtensionFunctor(f)) {
        Yap_Error(TYPE_ERROR_ARRAY, t1, "add_to_array_element");
        return (FALSE);
      }
      if (indx > 0 && indx > ArityOfFunctor(f)) {
        Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "add_to_array_element");
        return (FALSE);
      }
      ptr = RepAppl(t1) + indx + 1;
      ta = RepAppl(t1)[indx + 1];
      if (IsIntegerTerm(ta)) {
        if (IsIntegerTerm(t3)) {
          ta = MkIntegerTerm(IntegerOfTerm(ta) + IntegerOfTerm(t3));
        } else if (IsFloatTerm(t3)) {
          ta = MkFloatTerm(IntegerOfTerm(ta) + FloatOfTerm(t3));
        } else {
          Yap_Error(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
          return (FALSE);
        }
      } else if (IsFloatTerm(ta)) {
        if (IsFloatTerm(t3)) {
          ta = MkFloatTerm(FloatOfTerm(ta) + IntegerOfTerm(t3));
        } else if (IsFloatTerm(t3)) {
          ta = MkFloatTerm(FloatOfTerm(ta) + FloatOfTerm(t3));
        } else {
          Yap_Error(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
          return (FALSE);
        }
      } else {
        Yap_Error(TYPE_ERROR_NUMBER, ta, "add_to_array_element");
        return (FALSE);
      }
#ifdef MULTI_ASSIGNMENT_VARIABLES
      MaBind(ptr, ta);
      return (Yap_unify(ARG4, ta));
#else
      Yap_Error(SYSTEM_ERROR_INTERNAL, t2, "add_to_array_element");
      return (FALSE);
#endif
    } else {
      Yap_Error(TYPE_ERROR_ATOM, t1, "add_to_array_element");
      return (FALSE);
    }
  }
  {
    AtomEntry *ae = RepAtom(AtomOfTerm(t1));

    READ_LOCK(ae->ARWLock);
    ptr = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
      ptr = RepStaticArrayProp(ptr->NextOfPE);
    READ_UNLOCK(ae->ARWLock);
  }

  if (EndOfPAEntr(ptr)) {
    Yap_Error(EXISTENCE_ERROR_ARRAY, t1, "add_to_array_element %s",
              RepAtom(AtomOfTerm(t1))->StrOfAE);
    return (FALSE);
  }

  if (ArrayIsDynamic((ArrayEntry *)ptr)) {
    ArrayEntry *pp = (ArrayEntry *)ptr;
    CELL *pt;
    Term ta;

    WRITE_LOCK(pp->ArRWLock);
    if (indx < 0 || indx >= pp->ArrayEArity) {
      Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "add_to_array_element");
      READ_UNLOCK(pp->ArRWLock);
      return FALSE;
    }
    pt = RepAppl(pp->ValueOfVE) + indx + 1;
    ta = RepAppl(pp->ValueOfVE)[indx + 1];
    if (IsIntegerTerm(ta)) {
      if (IsIntegerTerm(t3)) {
        ta = MkIntegerTerm(IntegerOfTerm(ta) + IntegerOfTerm(t3));
      } else if (IsFloatTerm(t3)) {
        ta = MkFloatTerm(IntegerOfTerm(ta) + FloatOfTerm(t3));
      } else {
        WRITE_UNLOCK(pp->ArRWLock);
        Yap_Error(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
        return FALSE;
      }
    } else if (IsFloatTerm(ta)) {
      if (IsFloatTerm(t3)) {
        ta = MkFloatTerm(FloatOfTerm(ta) + IntegerOfTerm(t3));
      } else if (IsFloatTerm(t3)) {
        ta = MkFloatTerm(FloatOfTerm(ta) + FloatOfTerm(t3));
      } else {
        WRITE_UNLOCK(pp->ArRWLock);
        Yap_Error(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
        return FALSE;
      }
    } else {
      WRITE_UNLOCK(pp->ArRWLock);
      Yap_Error(TYPE_ERROR_NUMBER, ta, "add_to_array_element");
      return FALSE;
    }
    /* the evil deed is to be done now */
    MaBind(pt, ta);
    WRITE_UNLOCK(pp->ArRWLock);
    return Yap_unify(ARG4, t3);
  }

  WRITE_LOCK(ptr->ArRWLock);
  /* a static array */
  if (indx < 0 || indx >= ptr->ArrayEArity) {
    WRITE_UNLOCK(ptr->ArRWLock);
    Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "add_to_array_element");
    return FALSE;
  }
  switch (ptr->ArrayType) {
  case array_of_ints: {
    Int i = ptr->ValueOfVE.ints[indx];
    if (!IsIntegerTerm(t3)) {
      WRITE_UNLOCK(ptr->ArRWLock);
      Yap_Error(TYPE_ERROR_INTEGER, t3, "add_to_array_element");
      return FALSE;
    }
    i += IntegerOfTerm(t3);
    ptr->ValueOfVE.ints[indx] = i;
    WRITE_UNLOCK(ptr->ArRWLock);
    return Yap_unify(ARG4, MkIntegerTerm(i));
  } break;
  case array_of_doubles: {
    Float fl = ptr->ValueOfVE.floats[indx];

    if (IsFloatTerm(t3)) {
      fl += FloatOfTerm(t3);
    } else if (IsIntegerTerm(t3)) {
      fl += IntegerOfTerm(t3);
    } else {
      WRITE_UNLOCK(ptr->ArRWLock);
      Yap_Error(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
      return FALSE;
    }
    ptr->ValueOfVE.floats[indx] = fl;
    WRITE_UNLOCK(ptr->ArRWLock);
    return Yap_unify(ARG4, MkFloatTerm(fl));
  } break;
  default:
    WRITE_UNLOCK(ptr->ArRWLock);
    Yap_Error(TYPE_ERROR_NUMBER, t2, "add_to_array_element");
    return FALSE;
  }
}

static Int compile_array_refs(USES_REGS1) {
  compile_arrays = TRUE;
  return (TRUE);
}

static Int array_refs_compiled(USES_REGS1) { return compile_arrays; }

static Int sync_mmapped_arrays(USES_REGS1) {
#ifdef HAVE_MMAP
  mmap_array_block *ptr = GLOBAL_mmap_arrays;
  while (ptr != NULL) {
    msync(ptr->start, ptr->size, MS_SYNC);
    ptr = ptr->next;
  }
#endif
  return (TRUE);
}

/** @pred  static_array_to_term(? _Name_, ? _Term_)


Convert a static array with name
 _Name_ to a compound term of name  _Name_.

This built-in will silently fail if the there is no static array with
that name.


*/
static Int static_array_to_term(USES_REGS1) {
  Term t = Deref(ARG1);

  if (IsVarTerm(t)) {
    return FALSE;
  } else if (IsAtomTerm(t)) {
    /* Create a named array */
    AtomEntry *ae = RepAtom(AtomOfTerm(t));
    StaticArrayEntry *pp;

    READ_LOCK(ae->ARWLock);
    pp = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepStaticArrayProp(pp->NextOfPE);
    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
      READ_UNLOCK(ae->ARWLock);
      return (FALSE);
    } else {
      static_array_types tp = pp->ArrayType;
      Int dim = pp->ArrayEArity, indx;
      CELL *base;

      while (HR + 1 + dim > ASP - 1024) {
        if (!Yap_gcl((1 + dim) * sizeof(CELL), 2, ENV, gc_P(P, CP))) {
          Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
          return (FALSE);
        } else {
          if (HR + 1 + dim > ASP - 1024) {
            if (!Yap_growstack(sizeof(CELL) * (dim + 1 - (HR - ASP - 1024)))) {
              Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
              return FALSE;
            }
          }
        }
      }
      READ_LOCK(pp->ArRWLock);
      READ_UNLOCK(ae->ARWLock);
      base = HR;
      *HR++ = (CELL)Yap_MkFunctor(AbsAtom(ae), dim);
      switch (tp) {
      case array_of_ints: {
        CELL *sptr = HR;
        HR += dim;
        for (indx = 0; indx < dim; indx++) {
          *sptr++ = MkIntegerTerm(pp->ValueOfVE.ints[indx]);
        }
      } break;
      case array_of_dbrefs:
        for (indx = 0; indx < dim; indx++) {
          /* The object is now in use */
          Term TRef = pp->ValueOfVE.dbrefs[indx];

          if (TRef != 0L) {
            DBRef ref = DBRefOfTerm(TRef);
            LOCK(ref->lock);
#if MULTIPLE_STACKS
            INC_DBREF_COUNT(ref);
            TRAIL_REF(ref); /* So that fail will erase it */
#else
            if (!(ref->Flags & InUseMask)) {
              ref->Flags |= InUseMask;
              TRAIL_REF(ref); /* So that fail will erase it */
            }
#endif
            UNLOCK(ref->lock);
          } else {
            TRef = TermNil;
          }
          *HR++ = TRef;
        }
        break;
      case array_of_doubles: {
        CELL *sptr = HR;
        HR += dim;
        for (indx = 0; indx < dim; indx++) {
          *sptr++ = MkEvalFl(pp->ValueOfVE.floats[indx]);
        }
      } break;
      case array_of_ptrs: {
        CELL *sptr = HR;
        HR += dim;
        for (indx = 0; indx < dim; indx++) {
          *sptr++ = MkAddressTerm(pp->ValueOfVE.ptrs[indx]);
        }
      } break;
      case array_of_chars: {
        CACHE_REGS
        CELL *sptr = HR;
        HR += dim;
        for (indx = 0; indx < dim; indx++) {
          *sptr++ = MkIntTerm(pp->ValueOfVE.chars[indx]);
        }
      } break;
      case array_of_uchars: {
        CACHE_REGS
        CELL *sptr = HR;
        HR += dim;
        for (indx = 0; indx < dim; indx++) {
          *sptr++ = MkIntTerm(pp->ValueOfVE.uchars[indx]);
        }
      } break;
      case array_of_terms: {
        CELL *sptr = HR;
        HR += dim;
        for (indx = 0; indx < dim; indx++) {
          /* The object is now in use */
          DBTerm *ref = pp->ValueOfVE.terms[indx];

          Term TRef = GetTermFromArray(ref PASS_REGS);

          if (P == FAILCODE) {
            return FALSE;
          }

          *sptr++ = TRef;
        }
      } break;
      case array_of_nb_terms: {
        CELL *sptr = HR;
        HR += dim;
        for (indx = 0; indx < dim; indx++) {
          /* The object is now in use */
          Term To = GetNBTerm(pp->ValueOfVE.lterms, indx PASS_REGS);

          if (P == FAILCODE) {
            return FALSE;
          }

          *sptr++ = To;
        }
      } break;
      case array_of_atoms:
        for (indx = 0; indx < dim; indx++) {
          Term out;
          out = pp->ValueOfVE.atoms[indx];
          if (out == 0L)
            out = TermNil;
          *HR++ = out;
        }
        break;
      }
      READ_UNLOCK(pp->ArRWLock);
      return Yap_unify(AbsAppl(base), ARG2);
    }
  }
  Yap_Error(TYPE_ERROR_ATOM, t, "add_to_array_element");
  return FALSE;
}

/** @pred  static_array_location(+ _Name_, - _Ptr_)


Give the location or memory address for  a static array with name
 _Name_. The result is observed as an integer.
*/
static Int static_array_location(USES_REGS1) {
  Term t = Deref(ARG1);
  Int *ptr;

  if (IsVarTerm(t)) {
    return FALSE;
  } else if (IsAtomTerm(t)) {
    /* Create a named array */
    AtomEntry *ae = RepAtom(AtomOfTerm(t));
    StaticArrayEntry *pp;

    READ_LOCK(ae->ARWLock);
    pp = RepStaticArrayProp(ae->PropsOfAE);
    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
      pp = RepStaticArrayProp(pp->NextOfPE);
    if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
      READ_UNLOCK(ae->ARWLock);
      return FALSE;
    } else {
      ptr = pp->ValueOfVE.ints;
      READ_UNLOCK(ae->ARWLock);
    }
    return Yap_unify(ARG2, MkAddressTerm(ptr));
  }
  return FALSE;
}

void Yap_InitArrayPreds(void) {
  Yap_InitCPred("$create_array", 2, create_array, SyncPredFlag);
  Yap_InitCPred("$array_references", 3, array_references, SafePredFlag);
  Yap_InitCPred("$array_arg", 3, array_arg, SafePredFlag);
  Yap_InitCPred("static_array", 3, create_static_array,
                SafePredFlag | SyncPredFlag);
  Yap_InitCPred("resize_static_array", 3, resize_static_array,
                SafePredFlag | SyncPredFlag);
  Yap_InitCPred("mmapped_array", 4, create_mmapped_array,
                SafePredFlag | SyncPredFlag);
  Yap_InitCPred("update_array", 3, assign_static, SafePredFlag);
  Yap_InitCPred("dynamic_update_array", 3, assign_dynamic, SafePredFlag);
  Yap_InitCPred("add_to_array_element", 4, add_to_array_element, SafePredFlag);
  Yap_InitCPred("array_element", 3, access_array, 0);
  Yap_InitCPred("reset_static_array", 1, clear_static_array, SafePredFlag);
  Yap_InitCPred("close_static_array", 1, close_static_array, SafePredFlag);
  Yap_InitCPred("$sync_mmapped_arrays", 0, sync_mmapped_arrays, SafePredFlag);
  Yap_InitCPred("$compile_array_refs", 0, compile_array_refs, SafePredFlag);
  Yap_InitCPred("$array_refs_compiled", 0, array_refs_compiled, SafePredFlag);
  Yap_InitCPred("$static_array_properties", 3, static_array_properties,
                SafePredFlag);
  Yap_InitCPred("static_array_to_term", 2, static_array_to_term, 0L);
  Yap_InitCPred("static_array_location", 2, static_array_location, 0L);
}

/**
@}
*/