yap-6.3/C/qlyr.c

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985--	 *
*									 *
**************************************************************************
*									 *
* File:		qlyr.c							 *
* comments:	quick saver/loader					 *
*									 *
* Last rev:     $Date: 2011-08-29$,$Author: vsc $			 *
* $Log: not supported by cvs2svn $					 *
*									 *
*************************************************************************/

#include "absmi.h"
#include "Foreign.h"
#include "alloc.h"
#include "yapio.h"
#include "iopreds.h"
#include "attvar.h"
#if HAVE_STRING_H
#include <string.h>
#endif

#include "qly.h"

static void  RestoreEntries(PropEntry *, int USES_REGS);
static void  CleanCode(PredEntry * USES_REGS);

typedef enum {
  OUT_OF_TEMP_SPACE = 0,
  OUT_OF_ATOM_SPACE = 1,
  OUT_OF_CODE_SPACE = 2,
  UNKNOWN_ATOM = 3,
  UNKNOWN_FUNCTOR = 4,
  UNKNOWN_PRED_ENTRY = 5,
  UNKNOWN_OPCODE = 6,
  UNKNOWN_DBREF = 7,
  BAD_ATOM = 8,
  MISMATCH = 9,
  INCONSISTENT_CPRED = 10,
  BAD_READ = 11,
  BAD_HEADER = 12
} qlfr_err_t;

static char *
qlyr_error[] = { "out of temporary space",
		"out of temporary space",
		"out of code space",
		"unknown atom in saved space",
		"unknown functor in saved space",
		"unknown predicate in saved space",
		"unknown YAAM opcode in saved space",
		"unknown data-base reference in saved space",
		"corrupted atom in saved space",
		 "formatting mismatch in saved space",
		"foreign predicate has different definition in saved space",
		"bad read" };

static char *
Yap_AlwaysAllocCodeSpace(UInt size)
{
  char *out;
  while (!(out = Yap_AllocCodeSpace(size))) {
    if (!Yap_growheap(FALSE, size, NULL)) {
      return NULL;
    }
  }
  return out;
}

static void
QLYR_ERROR(qlfr_err_t my_err)
{
  // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
    Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
  Yap_exit(1);
}

static Atom
LookupAtom(Atom oat)
{
 CACHE_REGS
 CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
 import_atom_hash_entry_t *a;

  a = LOCAL_ImportAtomHashChain[hash];
  while (a) {
    if (a->oval == oat) {
      return a->val;
    }
    a = a->next;
  }
  //  __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ", oat);
  QLYR_ERROR(UNKNOWN_ATOM);
  return NIL;
}

static void
InsertAtom(Atom oat, Atom at)
{
  CACHE_REGS
  CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
  import_atom_hash_entry_t *a;

  a = LOCAL_ImportAtomHashChain[hash];
  while (a) {
    if (a->oval == oat) {
      return;
    }
    a = a->next;
  }
  a = (import_atom_hash_entry_t *)malloc(sizeof(import_atom_hash_entry_t));
  if (!a) {
    return;
  }
  a->val = at;
  a->oval = oat;
  a->next = LOCAL_ImportAtomHashChain[hash];
  LOCAL_ImportAtomHashChain[hash] = a;
}

static Functor
LookupFunctor(Functor ofun)
{
  CACHE_REGS
  CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize;
  import_functor_hash_entry_t *f;

  f = LOCAL_ImportFunctorHashChain[hash];
  while (f) {
    if (f->oval == ofun) {
      return f->val;
    }
    f = f->next;
  }
  QLYR_ERROR(UNKNOWN_FUNCTOR);
  return NIL;
}

static void
InsertFunctor(Functor ofun, Functor fun)
{
  CACHE_REGS
  CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize;
  import_functor_hash_entry_t *f;

  f = LOCAL_ImportFunctorHashChain[hash];
  while (f) {
    if (f->oval == ofun) {
      return;
    }
    f = f->next;
  }
  f = (import_functor_hash_entry_t *)malloc(sizeof(import_functor_hash_entry_t));
  if (!f) {
    return;
  }
  f->val = fun;
  f->oval = ofun;
  f->next = LOCAL_ImportFunctorHashChain[hash];
  LOCAL_ImportFunctorHashChain[hash] = f;
}

static PredEntry *
LookupPredEntry(PredEntry *op)
{
  CACHE_REGS
  CELL hash;
  import_pred_entry_hash_entry_t *p;

  if (LOCAL_ImportPredEntryHashTableSize == 0)
    return NULL;
  hash = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
  p = LOCAL_ImportPredEntryHashChain[hash];
  while (p) {
    if (p->oval == op) {
      return p->val;
    }
    p = p->next;
  }
  QLYR_ERROR(UNKNOWN_PRED_ENTRY);
  return NIL;
}

static void
InsertPredEntry(PredEntry *op, PredEntry *pe)
{
  CACHE_REGS
  CELL hash;
  import_pred_entry_hash_entry_t *p;

  if (LOCAL_ImportPredEntryHashTableSize == 0)
    return;
  hash = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
  p = LOCAL_ImportPredEntryHashChain[hash];
  while (p) {
    if (p->oval == op) {
      return;
    }
    p = p->next;
  }
  p = (import_pred_entry_hash_entry_t *)malloc(sizeof(import_pred_entry_hash_entry_t));
  if (!p) {
    return;
  }
  p->val = pe;
  p->oval = op;
  p->next = LOCAL_ImportPredEntryHashChain[hash];
  LOCAL_ImportPredEntryHashChain[hash] = p;
}

static OPCODE
LookupOPCODE(OPCODE op)
{
  CACHE_REGS
  CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
  import_opcode_hash_entry_t *f;

  f = LOCAL_ImportOPCODEHashChain[hash];
  while (f) {
    if (f->oval == op) {
      return f->val;
    }
    f = f->next;
  }
  QLYR_ERROR(UNKNOWN_OPCODE);
  return NIL;
}

static int
OpcodeID(OPCODE op)
{
  CACHE_REGS
  CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
  import_opcode_hash_entry_t *f;

  f = LOCAL_ImportOPCODEHashChain[hash];
  while (f) {
    if (f->oval == op) {
      return f->id;
    }
    f = f->next;
  }
  QLYR_ERROR(UNKNOWN_OPCODE);
  return NIL;
}

static void
InsertOPCODE(OPCODE op0, int i, OPCODE op)
{
  CACHE_REGS
  CELL hash = (CELL)(op0) % LOCAL_ImportOPCODEHashTableSize;
  import_opcode_hash_entry_t *f;
  f = LOCAL_ImportOPCODEHashChain[hash];
  while (f) {
    if (f->oval == op0) {
      return;
    }
    f = f->next;
  }
  f = (import_opcode_hash_entry_t *)malloc(sizeof(import_opcode_hash_entry_t));
  if (!f) {
    return;
  }
  f->val = op;
  f->oval = op0;
  f->id = i;
  f->next = LOCAL_ImportOPCODEHashChain[hash];
  LOCAL_ImportOPCODEHashChain[hash] = f;
}

static DBRef
LookupDBRef(DBRef dbr, int inc_ref)
{
  CACHE_REGS
  CELL hash;
  import_dbref_hash_entry_t *p;

  if (LOCAL_ImportDBRefHashTableSize == 0)
    return NULL;
  hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
  p = LOCAL_ImportDBRefHashChain[hash];
  while (p) {
    if (p->oval == dbr) {
      if (inc_ref) {
	p->count++;
      }
      return p->val;
    }
    p = p->next;
  }
  QLYR_ERROR(UNKNOWN_DBREF);
  return NIL;
}

static LogUpdClause *
LookupMayFailDBRef(DBRef dbr)
{
  CACHE_REGS
  CELL hash;
  import_dbref_hash_entry_t *p;

  if (LOCAL_ImportDBRefHashTableSize == 0)
    return NULL;
  hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
  p = LOCAL_ImportDBRefHashChain[hash];
  while (p) {
    if (p->oval == dbr) {
      p->count++;
      return (LogUpdClause *)p->val;
    }
    p = p->next;
  }
  return NULL;
}

static void
InsertDBRef(DBRef dbr0, DBRef dbr)
{
  CACHE_REGS
  CELL hash = (CELL)(dbr0) % LOCAL_ImportDBRefHashTableSize;
  import_dbref_hash_entry_t *p;

  p = LOCAL_ImportDBRefHashChain[hash];
  while (p) {
    if (p->oval == dbr0) {
      return;
    }
    p = p->next;
  }
  p = (import_dbref_hash_entry_t *)malloc(sizeof(import_dbref_hash_entry_t));
  if (!p) {
    return;
  }
  p->val = dbr;
  p->oval = dbr0;
  p->count = 0;
  p->next = LOCAL_ImportDBRefHashChain[hash];
  LOCAL_ImportDBRefHashChain[hash] = p;
}

static void
InitHash(void)
{
  CACHE_REGS
  LOCAL_ImportOPCODEHashTableSize = EXPORT_OPCODE_TABLE_SIZE;
  LOCAL_ImportOPCODEHashChain = (import_opcode_hash_entry_t **)calloc(1, sizeof(import_opcode_hash_entry_t *)* LOCAL_ImportOPCODEHashTableSize);
}

static void
CloseHash(void)
{
  CACHE_REGS
  UInt i;
  for (i=0; i < LOCAL_ImportFunctorHashTableSize; i++) {
    import_functor_hash_entry_t *a = LOCAL_ImportFunctorHashChain[i];
    while (a) {
      import_functor_hash_entry_t *a0 = a;
      a = a->next;
      free(a0);
    }
  }
  LOCAL_ImportFunctorHashTableSize = 0;
  free(LOCAL_ImportFunctorHashChain);
  LOCAL_ImportFunctorHashChain = NULL;
  for (i=0; i < LOCAL_ImportAtomHashTableSize; i++) {
    import_atom_hash_entry_t *a = LOCAL_ImportAtomHashChain[i];
    while (a) {
      import_atom_hash_entry_t *a0 = a;
      a = a->next;
      free(a0);
    }
  }
  LOCAL_ImportAtomHashTableSize = 0;
  free(LOCAL_ImportAtomHashChain);
  LOCAL_ImportAtomHashChain = NULL;
  for (i=0; i < LOCAL_ImportOPCODEHashTableSize; i++) {
    import_opcode_hash_entry_t *a = LOCAL_ImportOPCODEHashChain[i];
    while (a) {
      import_opcode_hash_entry_t *a0 = a;
      a = a->next;
      free(a0);
    }
  }
  LOCAL_ImportOPCODEHashTableSize = 0;
  free(LOCAL_ImportOPCODEHashChain);
  LOCAL_ImportOPCODEHashChain = NULL;
  for (i=0; i < LOCAL_ImportPredEntryHashTableSize; i++) {
    import_pred_entry_hash_entry_t *a = LOCAL_ImportPredEntryHashChain[i];
    while (a) {
      import_pred_entry_hash_entry_t *a0 = a;
      a = a->next;
      free(a0);
    }
  }
  LOCAL_ImportPredEntryHashTableSize = 0;
  free(LOCAL_ImportPredEntryHashChain);
  LOCAL_ImportPredEntryHashChain = NULL;
  for (i=0; i < LOCAL_ImportDBRefHashTableSize; i++) {
    import_dbref_hash_entry_t *a = LOCAL_ImportDBRefHashChain[i];
    while (a) {
      import_dbref_hash_entry_t *a0 = a;
#ifdef DEBUG
      if (!a->count) {
	fprintf(stderr,"WARNING: unused reference %p %p\n",a->val, a->oval);
      }
#endif
      a = a->next;
      free(a0);
    }
  }
  LOCAL_ImportDBRefHashTableSize = 0;
  free(LOCAL_ImportDBRefHashChain);
  LOCAL_ImportDBRefHashChain = NULL;
}

static inline Atom
AtomAdjust(Atom a)
{
  return LookupAtom(a);
}

static inline Functor
FuncAdjust(Functor f)
{
  return LookupFunctor(f);
  return f;
}


static inline Term
AtomTermAdjust(Term t)
{
  return MkAtomTerm(LookupAtom(AtomOfTerm(t)));
}

static inline Term
TermToGlobalOrAtomAdjust(Term t)
{
  if (t && IsAtomTerm(t))
    return AtomTermAdjust(t);
  return t;
}

#define IsOldCode(P) FALSE
#define IsOldCodeCellPtr(P) FALSE
#define IsOldDelay(P) FALSE
#define IsOldDelayPtr(P) FALSE
#define IsOldLocalInTR(P) FALSE
#define IsOldLocalInTRPtr(P) FALSE
#define IsOldGlobal(P) FALSE
#define IsOldGlobalPtr(P) FALSE
#define IsOldTrail(P) FALSE
#define IsOldTrailPtr(P) FALSE

#define CharP(X) ((char *)(X))

#define REINIT_LOCK(P)
#define REINIT_RWLOCK(P)
#define BlobTypeAdjust(P) (P)
#define NoAGCAtomAdjust(P) (P)
#define OrArgAdjust(P)
#define TabEntryAdjust(P)
#define IntegerAdjust(D)  (D)
#define AddrAdjust(P) (P)
#define MFileAdjust(P) (P)

#define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS)
static inline Term
CodeVarAdjust__ (Term var USES_REGS)
{
  if (var == 0L)
    return var;
  return (Term)(CharP(var) + LOCAL_HDiff);
}

#define ConstantAdjust(P) (P)
#define ArityAdjust(P) (P)
#define DoubleInCodeAdjust(P)
#define IntegerInCodeAdjust(Pxb)

static inline PredEntry *
PtoPredAdjust(PredEntry *p)
{
  return LookupPredEntry(p);
}

static inline PredEntry *
PredEntryAdjust(PredEntry *p)
{
  return LookupPredEntry(p);
}

static inline OPCODE
OpcodeAdjust(OPCODE OP) {
  return LookupOPCODE(OP);
}

static inline Term
ModuleAdjust(Term M) {
  if (!M)
    return M;
  return AtomTermAdjust(M);
}

#define ExternalFunctionAdjust(P) (P)
#define DBRecordAdjust(P) (P)
#define ModEntryPtrAdjust(P) (P)
#define AtomEntryAdjust(P) (P)
#define GlobalEntryAdjust(P) (P)
#define BlobTermInCodeAdjust(P) BlobTermInCodeAdjust__(P PASS_REGS)
#if TAGS_FAST_OPS
static inline Term
BlobTermInCodeAdjust__ (Term t USES_REGS)
{
  return (Term) ((char *)(t) - LOCAL_HDiff);
}
#else
static inline Term
BlobTermInCodeAdjust__ (Term t USES_REGS)
{
  return (Term) ((char *)(t) + LOCAL_HDiff);
}
#endif
#define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS)
static inline DBTerm *
DBTermAdjust__ (DBTerm * dbtp USES_REGS)
{
  return (DBTerm *) (CharP (dbtp) + LOCAL_HDiff);
}

#define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS)
static inline CELL *
CellPtoHeapAdjust__ (CELL * dbtp USES_REGS)
{
  return (CELL *) (CharP (dbtp) + LOCAL_HDiff);
}

#define PtoAtomHashEntryAdjust(P) (P)
#define CellPtoHeapCellAdjust(P) (P)
#define CellPtoTRAdjust(P) (P)
#define CodeAddrAdjust(P) (P)
#define ConsultObjAdjust(P) (P)
#define DelayAddrAdjust(P) (P)
#define DelayAdjust(P) (P)
#define GlobalAdjust(P) (P)

#define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS)
static inline DBRef
DBRefAdjust__ (DBRef dbtp, int do_reference USES_REGS)
{
  return LookupDBRef(dbtp, do_reference);
}

#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS)
static inline DBRef *
DBRefPAdjust__ (DBRef * dbtp USES_REGS)
{
  return (DBRef *) ((char *)(dbtp) + LOCAL_HDiff);
}

#define LUIndexAdjust(P) (P)
#define SIndexAdjust(P) (P)
#define LocalAddrAdjust(P) (P)
#define GlobalAddrAdjust(P) (P)
#define OpListAdjust(P) (P)

#define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS)
#define PtoLUClauseAdjust(P) PtoLUCAdjust__(P PASS_REGS)
static inline LogUpdClause *
PtoLUCAdjust__ (LogUpdClause * dbtp USES_REGS)
{
  return (LogUpdClause *) ((char *)(dbtp) + LOCAL_HDiff);
}

#define PtoStCAdjust(P) (P)
#define PtoArrayEAdjust(P) (P)
#define PtoArraySAdjust(P) (P)
#define PtoGlobalEAdjust(P) (P)
#define PtoDelayAdjust(P) (P)
#define PtoGloAdjust(P) (P)
#define PtoLocAdjust(P) (P)

#define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS)
static inline CELL *
PtoHeapCellAdjust__ (CELL * ptr USES_REGS)
{
  LogUpdClause *out;
  if ((out = LookupMayFailDBRef((DBRef)ptr)))
    return (CELL *)out;
  return (CELL *) (CharP (ptr) + LOCAL_HDiff);
}

#define TermToGlobalAdjust(P) (P)
#define PtoOpAdjust(P) PtoOpAdjust__(P PASS_REGS)
static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) {
  if (ptr) {
    if (ptr == LOCAL_ImportFAILCODE)
      return FAILCODE;
    return (yamop *) ((char *) (ptr) + LOCAL_HDiff);
  }
  return ptr;
}
#define PtoLUIndexAdjust(P) (P)
#define PtoDBTLAdjust(P) (P)
#define PtoPtoPredAdjust(P) (P)
#define OpRTableAdjust(P) (P)
#define OpEntryAdjust(P) (P)
#define PropAdjust(P) (P)
#define TrailAddrAdjust(P) (P)
#if PRECOMPUTE_REGADDRESS
#define XAdjust(P) XAdjust__(P PASS_REGS)
static inline wamreg
XAdjust__ (wamreg reg USES_REGS)
{
  return (wamreg) ((wamreg) ((reg) + LOCAL_XDiff));
}
#else
#define XAdjust(X) (X)
#endif
#define YAdjust(X) (X)
#define HoldEntryAdjust(P) (P)
#define CodeCharPAdjust(P) (P)
#define CodeConstCharPAdjust(P) (P)
#define CodeVoidPAdjust(P) (P)
#define HaltHookAdjust(P) (P)

#define recompute_mask(dbr)

#define rehash(oldcode, NOfE, KindOfEntries)

#define RestoreSWIHash()

#define Yap_op_from_opcode(OP) OpcodeID(OP)

#include "rheap.h"

static void
RestoreHashPreds( USES_REGS1 )
{
}


static void
RestoreAtomList(Atom atm USES_REGS)
{
}

static size_t
read_bytes(FILE *stream, void *ptr, size_t sz)
{
  return fread(ptr, sz, 1, stream);
}

static unsigned char
read_byte(FILE *stream)
{
  return  getc(stream);
}

static BITS16
read_bits16(FILE *stream)
{
  BITS16 v;
  read_bytes(stream, &v, sizeof(BITS16));
  return v;
}

static UInt
read_UInt(FILE *stream)
{
  UInt v;
  read_bytes(stream, &v, sizeof(UInt));
  return v;
}

static Int
read_Int(FILE *stream)
{
  Int v;
  read_bytes(stream, &v, sizeof(Int));
  return v;
}

static qlf_tag_t
read_tag(FILE *stream)
{
  int ch = read_byte(stream);
  return ch;
}

static UInt
read_predFlags(FILE *stream)
{
  pred_flags_t v;
  read_bytes(stream, &v, sizeof(pred_flags_t));
  return v;
}

static bool
checkChars(FILE *stream, char s[])
{
  int ch, c;
  char *p = s;

  while ((ch = *p++)) {
    if ((c  = read_byte(stream)) != ch ) {
      return false;
    }
  }
  return TRUE;
}

static Atom
get_header(FILE *stream)
{
  char s[256], *p = s, ch;
  Atom at;

  if (!checkChars( stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-" ))
    return NIL;
  while ((ch = read_byte(stream)) != '\n');
  if (!checkChars( stream, "exec $exec_dir/yap $0 \"$@\"\nsaved " ))
    return NIL;
  while ((ch = read_byte(stream)) != ',')
    *p++ = ch;
  *p++ = '\0';
  at = Yap_LookupAtom( s );
  while ((ch = read_byte(stream)));
  return at;
}

static Int
p_get_header( USES_REGS1 )
{
  FILE *stream;
  Term t1 = Deref(ARG1);
  Atom at;
    Int rc;

  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
    return FALSE;
  }
  if (!(stream = Yap_GetInputStream(t1, "header scanning in qload")) ) {
    return FALSE;
  }
  if ((at = get_header( stream )) == NIL)
    rc = FALSE;
  else rc = Yap_unify( ARG2, MkAtomTerm( at ) );
    return rc;
}

static void
ReadHash(FILE *stream)
{
  CACHE_REGS
  UInt i;
  RCHECK(read_tag(stream) == QLY_START_X);
  LOCAL_XDiff = (char *)(&ARG1) - (char *)read_UInt(stream);
  RCHECK(read_tag(stream) == QLY_START_OPCODES);
  RCHECK(read_Int(stream) == _std_top);
  for (i= 0; i <= _std_top; i++) {
    InsertOPCODE((OPCODE)read_UInt(stream), i, Yap_opcode(i));
  }
  RCHECK(read_tag(stream) == QLY_START_ATOMS);
  LOCAL_ImportAtomHashTableNum = read_UInt(stream);
  LOCAL_ImportAtomHashTableSize = LOCAL_ImportAtomHashTableNum*2;
  LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc(LOCAL_ImportAtomHashTableSize, sizeof(import_atom_hash_entry_t *));
  for (i = 0; i < LOCAL_ImportAtomHashTableNum; i++) {
    Atom oat = (Atom)read_UInt(stream);
    Atom at;
    qlf_tag_t tg = read_tag(stream);

    if (tg == QLY_ATOM_WIDE) {
      wchar_t *rep = (wchar_t *)AllocTempSpace();
      UInt len;

      len = read_UInt(stream);
      if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE);
      read_bytes(stream, rep, (len+1)*sizeof(wchar_t));
      while (!(at = Yap_LookupWideAtom(rep))) {
	if (!Yap_growheap(FALSE, 0, NULL)) {
	  exit(1);
	}
      }
      if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE);
    } else if (tg == QLY_ATOM) {
      char *rep = (char *)AllocTempSpace();
      UInt len;

      len = read_UInt(stream);
      if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE);
      read_bytes(stream, rep, (len+1)*sizeof(char));
      while (!(at = Yap_FullLookupAtom(rep))) {
	if (!Yap_growheap(FALSE, 0, NULL)) {
	  exit(1);
	}
      }
      if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE);
    } else {
      QLYR_ERROR(BAD_ATOM);
      return;
    }
    InsertAtom(oat, at);
  }
  /* functors */
  RCHECK(read_tag(stream) == QLY_START_FUNCTORS);
  LOCAL_ImportFunctorHashTableNum = read_UInt(stream);
  LOCAL_ImportFunctorHashTableSize = 2*LOCAL_ImportFunctorHashTableNum;
  LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc(LOCAL_ImportFunctorHashTableSize, sizeof(import_functor_hash_entry_t *));
  for (i = 0; i < LOCAL_ImportFunctorHashTableNum; i++) {
    Functor of = (Functor)read_UInt(stream);
    UInt arity = read_UInt(stream);
    Atom oat = (Atom)read_UInt(stream);
    Atom at = AtomAdjust(oat);
    Functor f;
    while (!(f = Yap_MkFunctor(at, arity))) {
      if (!Yap_growheap(FALSE, 0, NULL)) {
	exit(1);
      }
    }
    InsertFunctor(of, f);
  }
  RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES);
  LOCAL_ImportPredEntryHashTableNum = read_UInt(stream);
  LOCAL_ImportPredEntryHashTableSize = 2*LOCAL_ImportPredEntryHashTableNum;
  LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc( LOCAL_ImportPredEntryHashTableSize, sizeof(import_pred_entry_hash_entry_t *));
  for (i = 0; i < LOCAL_ImportPredEntryHashTableNum; i++) {
    PredEntry *ope = (PredEntry *)read_UInt(stream), *pe;
    UInt arity = read_UInt(stream);
    Atom omod = (Atom)read_UInt(stream);
    Term mod;

    if (omod) {
      mod = MkAtomTerm(AtomAdjust(omod));
      if (mod == TermProlog) mod = 0;
    } else {
      mod = TermProlog;
    }

    if (mod != IDB_MODULE) {
      if (arity) {
	Functor of = (Functor)read_UInt(stream);
	Functor f = LookupFunctor(of);
	while(!(pe = RepPredProp(PredPropByFuncAndMod(f,mod)))) {
	  if (!Yap_growheap(FALSE, 0, NULL)) {
	    exit(1);
	  }
	}
      } else {
	Atom oa = (Atom)read_UInt(stream);
	Atom a = LookupAtom(oa);
	pe = RepPredProp(PredPropByAtomAndMod(a,mod));
      }
    } else {
      /* IDB */
      if (arity == (UInt)-1) {
	UInt i = read_UInt(stream);
	pe = Yap_FindLUIntKey(i);
      }	else if (arity == (UInt)(-2)) {
	Atom oa = (Atom)read_UInt(stream);
	Atom a = LookupAtom(oa);
	pe = RepPredProp(PredPropByAtomAndMod(a,mod));
	pe->PredFlags |= AtomDBPredFlag;
      } else {
	Functor of = (Functor)read_UInt(stream);
	Functor f = LookupFunctor(of);
	pe = RepPredProp(PredPropByFuncAndMod(f,mod));
      }
      pe->PredFlags |= LogUpdatePredFlag;
      pe->ArityOfPE = 3;
      if (pe->OpcodeOfPred == UNDEF_OPCODE) {
	pe->OpcodeOfPred = Yap_opcode(_op_fail);
	pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE;
      }
    }
    InsertPredEntry(ope, pe);
  }
  RCHECK(read_tag(stream) == QLY_START_DBREFS);
  LOCAL_ImportDBRefHashTableNum = read_UInt(stream);
  LOCAL_ImportDBRefHashTableSize = 2*LOCAL_ImportDBRefHashTableNum+17;
  LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc(LOCAL_ImportDBRefHashTableSize, sizeof(import_dbref_hash_entry_t *));
  for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) {
    LogUpdClause *ocl = (LogUpdClause *)read_UInt(stream);
    UInt sz = read_UInt(stream);
    UInt nrefs = read_UInt(stream);
    LogUpdClause *ncl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(sz);
    if (!ncl) {
      QLYR_ERROR(OUT_OF_CODE_SPACE);
    }
    ncl->Id = FunctorDBRef;
    ncl->ClRefCount = nrefs;
    InsertDBRef((DBRef)ocl,(DBRef)ncl);
  }
  RCHECK(read_tag(stream) == QLY_FAILCODE);
  LOCAL_ImportFAILCODE = (yamop *)read_UInt(stream);
}

static void
read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
  CACHE_REGS
  if (flags & LogUpdatePredFlag) {
    /* first, clean up whatever was there */
    if (pp->cs.p_code.NOfClauses) {
      LogUpdClause *cl;
      cl = ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause);
      do {
	LogUpdClause *ncl = cl->ClNext;
	Yap_ErLogUpdCl(cl);
	cl = ncl;
      } while (cl != NULL);
    }
    if (!nclauses) {
      return;
    }
    while ((read_tag(stream) == QLY_START_LU_CLAUSE)) {
      char *base = (void *)read_UInt(stream);
      UInt size = read_UInt(stream);
      LogUpdClause *cl;
      Int nrefs = 0;

      if ((cl = LookupMayFailDBRef((DBRef)base))) {
	nrefs = cl->ClRefCount;
      } else {
	cl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(size);
      }
      read_bytes(stream, cl, size);
      cl->ClFlags &= ~InUseMask;
      cl->ClRefCount = nrefs;
      LOCAL_HDiff = (char *)cl-base;
      RestoreLUClause(cl, pp PASS_REGS);
      Yap_AssertzClause(pp, cl->ClCode);
    }
  } else if (flags & MegaClausePredFlag) {
    CACHE_REGS
    char *base = (void *)read_UInt(stream);
    UInt mask = read_UInt(stream);
    UInt size = read_UInt(stream);
    MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size);

    if (nclauses) {
      Yap_Abolish(pp);
    }
    LOCAL_HDiff = (char *)cl-base;
    read_bytes(stream, cl, size);
    cl->ClFlags = mask;
    pp->cs.p_code.FirstClause =
      pp->cs.p_code.LastClause =
      cl->ClCode;
    pp->PredFlags |= MegaClausePredFlag;
    /* enter index mode */
    if (mask & ExoMask) {
      struct index_t **icl = (struct index_t **)(cl->ClCode);
      pp->OpcodeOfPred = Yap_opcode(_enter_exo);
      icl[0] = NULL;
      icl[1] = NULL;
    } else {
      pp->OpcodeOfPred = INDEX_OPCODE;
    }
    pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred));
    /* This must be set for restoremegaclause */
    pp->cs.p_code.NOfClauses = nclauses;
    RestoreMegaClause(cl PASS_REGS);
  } else if (flags & DynamicPredFlag) {
    UInt i;

    for (i = 0; i < nclauses; i++) {
      char *base = (void *)read_UInt(stream);
      UInt size = read_UInt(stream);
      DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size);

      LOCAL_HDiff = (char *)cl-base;
      read_bytes(stream, cl, size);
      INIT_LOCK(cl->ClLock);
      RestoreDynamicClause(cl, pp PASS_REGS);
      Yap_AssertzClause(pp, cl->ClCode);
    }

  } else {
    UInt i;


    if (flags & SYSTEM_PRED_FLAGS) {
      if (nclauses) {
	QLYR_ERROR(INCONSISTENT_CPRED);
      }
      return;
    }
    Yap_Abolish(pp);
    for (i = 0; i < nclauses; i++) {
      char *base = (void *)read_UInt(stream);
      UInt size = read_UInt(stream);
      StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size);

      LOCAL_HDiff = (char *)cl-base;
      read_bytes(stream, cl, size);
      RestoreStaticClause(cl PASS_REGS);
      Yap_AssertzClause(pp, cl->ClCode);
    }
  }
}

static void
read_pred(FILE *stream, Term mod) {
  pred_flags_t flags, fl1;
  UInt nclauses;
  PredEntry *ap;

  ap = LookupPredEntry((PredEntry *)read_UInt(stream));
  flags = read_predFlags(stream);
  nclauses = read_UInt(stream);
  if (ap->PredFlags & IndexedPredFlag) {
    Yap_RemoveIndexation(ap);
  }
#if 0
  if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE)
      __android_log_print(ANDROID_LOG_INFO, "YAP ", "   %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags);
  /*   printf("   %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); */
  else if (ap->ModuleOfPred != IDB_MODULE)
  __android_log_print(ANDROID_LOG_INFO, "YAP ","   %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags);
  /*   printf("   %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); */
  else
      __android_log_print(ANDROID_LOG_INFO, "YAP ","   number\n");
#endif
  fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
  ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
  ap->PredFlags |= fl1;
  if (flags & NumberDBPredFlag) {
    ap->src.IndxId = read_UInt(stream);
  } else {
    ap->src.OwnerFile = (Atom)read_UInt(stream);

    if (ap->src.OwnerFile) {
      ap->src.OwnerFile = AtomAdjust(ap->src.OwnerFile);
    }
  }
  ap->TimeStampOfPred = read_UInt(stream);
  /* multifile predicates cannot reside in module 0 */
  if (flags & MultiFileFlag && ap->ModuleOfPred == PROLOG_MODULE) {
    ap->ModuleOfPred = TermProlog;
  }
  if (nclauses)
    read_clauses(stream, ap, nclauses, flags);
#if DEBUG
  //Yap_PrintPredName( ap );
#endif

  if (flags & HiddenPredFlag) {
    Yap_HidePred(ap);
  }
}

static void
read_ops(FILE *stream)  {
  Int x;
  while ((x = read_tag(stream)) != QLY_END_OPS) {
    Atom at = (Atom)read_UInt(stream);
    Term mod = (Term)read_UInt(stream);
    OpEntry *op;

    at = AtomAdjust(at);
    if (mod)
      mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
    op = Yap_OpPropForModule(at, mod);
    op->Prefix =   read_bits16(stream);
    op->Infix =   read_bits16(stream);
    op->Posfix =   read_bits16(stream);
    WRITE_UNLOCK(op->OpRWLock);
  }
}


static void
read_module(FILE *stream) {
  qlf_tag_t x;

  InitHash();
  ReadHash(stream);
  while ((x = read_tag(stream)) == QLY_START_MODULE) {
    Term mod = (Term)read_UInt(stream);
    if (mod == 0)
      mod = TermProlog;
    mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
    if (mod)
      while ((x = read_tag(stream)) == QLY_START_PREDICATE) {
	read_pred(stream, mod);
      }
  }
  read_ops(stream);
  CloseHash();
}

static Int
p_read_module_preds( USES_REGS1 )
{
  FILE *stream;
  Term t1 = Deref(ARG1);

  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR,t1,"read_qly/3");
    return FALSE;
  }
  if (!IsAtomTerm(t1)) {
    Yap_Error(TYPE_ERROR_ATOM,t1,"read_qly/3");
    return(FALSE);
  }
  if (!(stream = Yap_GetInputStream(t1, "scanning preducate modules")) ) {
    return FALSE;
  }
  read_module(stream);
  return TRUE;
}

static void
ReInitProlog(void)
{
  Term t = MkAtomTerm(AtomInitProlog);
  YAP_RunGoalOnce(t);
}



static Int
qload_program( USES_REGS1 )
{
  FILE *stream;
  Term t1 = Deref(ARG1);

  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
    return FALSE;
  }
  if ((stream = Yap_GetInputStream(t1, "from read_program")) ) {
    return FALSE;
  }
  Yap_Reset( YAP_RESET_FROM_RESTORE );
  if (get_header( stream ) == NIL)
    return FALSE;
  read_module(stream);
  fclose( stream );
  /* back to the top level we go */
  ReInitProlog();
  return true;
}

int
Yap_Restore(char *s, char *lib_dir)
{
  CACHE_REGS
  
  FILE *stream  = Yap_OpenRestore(s, lib_dir);
  if (!stream)
    return -1;
  GLOBAL_RestoreFile = s;
  if (get_header( stream ) == NIL)
    return FALSE;
  read_module(stream);
  fclose( stream );
  GLOBAL_RestoreFile = NULL;
  CurrentModule = USER_MODULE;
  return DO_ONLY_CODE;
}


void Yap_InitQLYR(void)
{
  Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag|HiddenPredFlag);
  Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds, SyncPredFlag|HiddenPredFlag);
  Yap_InitCPred("$qload_program", 1, qload_program, SyncPredFlag|HiddenPredFlag);
  Yap_InitCPred("$q_header", 2, p_get_header, SyncPredFlag|HiddenPredFlag);
  if (FALSE) {
    restore_codes();
  }
}