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 <SWI-Stream.h>
#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_PROTO(void  RestoreEntries, (PropEntry *, int USES_REGS));
STATIC_PROTO(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
} qlfr_err_t;

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)
{
  fprintf(stderr,"Error %d\n", my_err);
  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;
  }
  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 = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
  import_pred_entry_hash_entry_t *p;

  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 = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
  import_pred_entry_hash_entry_t *p;

  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 = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
  import_dbref_hash_entry_t *p;

  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 = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
  import_dbref_hash_entry_t *p;

  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 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(IOSTREAM *stream, void *ptr, size_t sz)
{
  return Sfread(ptr, sz, 1, stream);
}

static unsigned char
read_byte(IOSTREAM *stream)
{
  return  Sgetc(stream);
}

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

static UInt
read_uint(IOSTREAM *stream)
{
  UInt v;
  read_bytes(stream, &v, sizeof(UInt));
  return v;
}

static int
read_int(IOSTREAM *stream)
{
  int v;
  read_bytes(stream, &v, sizeof(int));
  return v;
}

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

static void
read_header(IOSTREAM *stream)
{
  int ch;
  while ((ch = read_byte(stream)));
}

static void
ReadHash(IOSTREAM *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 {
      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));
      } else {
	Functor of = (Functor)read_uint(stream);
	Functor f = LookupFunctor(of);
	pe = RepPredProp(PredPropByFuncAndMod(f,mod));
      }
      pe->ArityOfPE = 3;
    }
    InsertPredEntry(ope, pe);
  }
  RCHECK(read_tag(stream) == QLY_START_DBREFS);
  LOCAL_ImportDBRefHashTableNum = read_uint(stream);
  LOCAL_ImportDBRefHashTableSize = 2*LOCAL_ImportDBRefHashTableNum;
  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(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
  CACHE_REGS
  if (pp->PredFlags & 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 (pp->PredFlags & 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 (pp->PredFlags & 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 (pp->PredFlags & 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(IOSTREAM *stream, Term mod) {
  UInt flags;
  UInt nclauses, fl1;
  PredEntry *ap;

  ap = LookupPredEntry((PredEntry *)read_uint(stream));
  flags = read_uint(stream);
  nclauses = read_uint(stream);
  if (ap->PredFlags & IndexedPredFlag) {
    Yap_RemoveIndexation(ap);
  }
  fl1 = flags & STATIC_PRED_FLAGS;
  ap->PredFlags &= ~STATIC_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;
  read_clauses(stream, ap, nclauses, flags);
  if (flags & HiddenPredFlag) {
    Yap_HidePred(ap);
  }
}

static void
read_ops(IOSTREAM *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(IOSTREAM *stream) {
  qlf_tag_t x;

  InitHash();
  read_header(stream);
  ReadHash(stream);
  while ((x = read_tag(stream)) == QLY_START_MODULE) {
    Term mod = (Term)read_uint(stream);

    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 )
{
  IOSTREAM *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(AtomOfTerm(t1))) ) {
    return FALSE;
  }
  read_module(stream);
  return TRUE;
}

static void
ReInitProlog(void)
{
  Term t = MkAtomTerm(AtomInitProlog);
#if defined(YAPOR) || defined(TABLING)
  Yap_init_root_frames();
#endif /* YAPOR || TABLING */
  Yap_InitYaamRegs( 0 );
  YAP_RunGoalOnce(t);
}



static Int
p_read_program( USES_REGS1 )
{
  IOSTREAM *stream;
  void YAP_Reset(void);
  Term t1 = Deref(ARG1);

  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
    return FALSE;
  }
  if (!IsAtomTerm(t1)) {
    Yap_Error(TYPE_ERROR_ATOM,t1,"read_program/3");
    return(FALSE);
  }
  if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
    return FALSE;
  }
  YAP_Reset();
  read_module(stream);
  Sclose( stream );
  /* back to the top level we go */
  Yap_CloseSlots(PASS_REGS1);
  ReInitProlog();
  Yap_RestartYap( 3 );
  return TRUE;
}

int 
Yap_Restore(char *s, char *lib_dir)
{
  IOSTREAM *stream  = Yap_OpenRestore(s, lib_dir);
  if (!stream) 
    return -1;
  read_module(stream);
  Sclose( stream );
  return DO_ONLY_CODE;
}


void Yap_InitQLYR(void)
{
  Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag);
  Yap_InitCPred("$qload_program", 1, p_read_program, SyncPredFlag|UserCPredFlag);
  if (FALSE) {
    restore_codes();
  }
}