yap-6.3/C/qly.c

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

#include "config.h"
#if HAVE_STRING_H
#include <string.h>
#endif
#include <SWI-Stream.h>
#include <Yap.h>
#include <Yatom.h>
#include <clause.h>

#define NEXTOP(V,TYPE)    ((yamop *)(&((V)->u.TYPE.next)))

typedef enum {
  QLF_START_CLAUSE,
  QLF_END_CLAUSES,
  QLF_CONSTANT_INT,
  QLF_CONSTANT_ATOM,
  QLF_ATOM,
  QLF_WIDE_ATOM
} qlf_tag_t;

#define CHECK(F) { size_t r = (F); if (!r) return r; }

static size_t save_bytes(IOSTREAM *stream, void *ptr, size_t sz)
{
  return Sfwrite(ptr, sz, 1, stream);
}

static size_t save_term(IOSTREAM *stream, Term t)
{
  size_t len = Yap_ExportTerm(t, (char *)H, sizeof(CELL)*(ASP-H));
  if (len <= 0) return 0;
  return save_bytes(stream, (char *)H, len);
}

static size_t save_tag(IOSTREAM *stream, qlf_tag_t tag)
{
  return save_bytes(stream, &tag, sizeof(qlf_tag_t));
}

static size_t save_pointer(IOSTREAM *stream, void *ptr)
{
  void *p = ptr;
  return save_bytes(stream, &p, sizeof(void *));
}

static size_t save_uint(IOSTREAM *stream, UInt val)
{
  UInt v = val;
  return save_bytes(stream, &v, sizeof(UInt));
}

static size_t save_int(IOSTREAM *stream, Int val)
{
  Int v = val;
  return save_bytes(stream, &v, sizeof(Int));
}

static size_t save_atom(IOSTREAM *stream, Atom at)
{
  if (IsWideAtom(at)) {
    size_t sz = wcslen(RepAtom(at)->WStrOfAE);
    CHECK(save_tag(stream, QLF_WIDE_ATOM));
    CHECK(save_uint(stream, sz));
    return save_bytes(stream, RepAtom(at)->WStrOfAE, (sz+1)*sizeof(wchar_t));
  } else {
    size_t sz = strlen(RepAtom(at)->StrOfAE);
    CHECK(save_tag(stream, QLF_ATOM));
    return save_bytes(stream, RepAtom(at)->StrOfAE, (sz+1)*sizeof(char));
  }
}

static size_t save_Arity(IOSTREAM *stream, Int a)
{
  return save_uint(stream, a);
}

static size_t save_CellPtoHeap(IOSTREAM *stream, CELL *ptr)
{
  return save_pointer(stream, ptr);
}

static size_t save_ConstantTerm(IOSTREAM *stream, Term t)
{
  if (IsIntTerm(t)) {
    CHECK(save_tag(stream, QLF_CONSTANT_INT));
    return save_int(stream, IntOfTerm(t));
  }
  CHECK(save_tag(stream, QLF_CONSTANT_ATOM));
  return save_atom(stream, AtomOfTerm(t));
}

static size_t save_DoubleInCode(IOSTREAM *stream, CELL *t)
{
  return save_bytes(stream, (void *)(t+1), sizeof(double));
}

static size_t save_Constant(IOSTREAM *stream, COUNT c)
{
  return save_bytes(stream, (void *)&c, sizeof(COUNT));
}

static size_t save_DBGroundTerm(IOSTREAM *stream, Term t)
{
  return save_term(stream, t);
}

static size_t save_Func(IOSTREAM *stream, Functor f)
{
  CHECK(save_atom(stream, NameOfFunctor(f)));
  return save_Arity(stream, ArityOfFunctor(f));
}

static size_t save_ExternalFunction(IOSTREAM *stream, CPredicate f)
{
  Yap_Error(INTERNAL_ERROR, TermNil, "trying to save an ExternalFunction");
  return 0;
}

static size_t save_IntegerInCode(IOSTREAM *stream, CELL *t)
{
  return save_int(stream, t[1]);
}

static size_t save_Integer(IOSTREAM *stream, Int i)
{
  return save_int(stream, i);
}

static size_t save_PtoLUIndex(IOSTREAM *stream, struct logic_upd_index *p)
{
  Yap_Error(INTERNAL_ERROR, TermNil, "trying to save PtoLUIndex");
  return 0;
}

static size_t save_PtoOp(IOSTREAM *stream, yamop *l)
{
  return save_pointer(stream, (void *)l);
}

static size_t save_PtoLUClause(IOSTREAM *stream, struct logic_upd_clause *t)
{
  Yap_Error(INTERNAL_ERROR, TermNil, "trying to save PtoLUIndex");
  return 0;
}

static size_t save_BlobTermInCode(IOSTREAM *stream, Term t)
{
  return save_pointer(stream, (void *)RepAppl(t));
}

static size_t save_Opcode(IOSTREAM *stream, OPCODE op)
{
  return save_int(stream, Yap_op_from_opcode(op));
}

#ifdef YAPOR
static size_t save_OrArg(IOSTREAM *stream, unsigned int i)
{
  return save_uint(stream, i);
}
#endif /* YAPOR */

static size_t save_PtoPred(IOSTREAM *stream, struct pred_entry *ap)
{
  if (ap->ModuleOfPred) {
    CHECK(save_atom(stream, AtomOfTerm(ap->ModuleOfPred)));
  } else {
    CHECK(save_atom(stream, AtomProlog));
  }
  if (ap->ArityOfPE) {
    CHECK(save_int(stream, ap->ArityOfPE));
    return save_atom(stream, NameOfFunctor(ap->FunctorOfPred));
  } else {
    CHECK(save_int(stream, 0));
    return save_atom(stream, (Atom)(ap->FunctorOfPred));
  }
}

static size_t save_Module(IOSTREAM *stream, Term tmod)
{
  if (tmod == 0) {
    return save_atom(stream, AtomProlog);
  } else {
    return save_atom(stream, AtomOfTerm(tmod));
  }
}

#ifdef TABLING
static size_t save_TabEntry(IOSTREAM *stream, struct table_entry *ap)
{
  return save_pointer(stream, NULL);
}
#endif

#if PRECOMPUTE_REGADDRESS
#define arg_from_x(I)		(((CELL *)(I))-XREGS)
#else
#define arg_from_x(I)		(I)
#endif /* PRECOMPUTE_REGADDRESS */

static size_t save_X(IOSTREAM *stream, wamreg reg)
{
  return save_int(stream, arg_from_x(reg));
}

static size_t save_Y(IOSTREAM *stream, yslot reg)
{
  return save_int(stream, reg);
}

static size_t
save_code(IOSTREAM *stream, yamop *pc, yamop *max) {
#include "saveclause.h"
  if (max && max > pc) {
    return save_bytes(stream, pc, (char *)max-(char *)pc);
  }
  return 1;
}

static size_t
save_lu_clause(IOSTREAM *stream, LogUpdClause *cl) {
  CHECK(save_tag(stream, QLF_START_CLAUSE));
  CHECK(save_term(stream, cl->ClSource->Entry));
  return save_code(stream, cl->ClCode, (yamop *)cl->ClSource);
}

static size_t
save_dynamic_clause(IOSTREAM *stream, DynamicClause *cl) {
  CHECK(save_tag(stream, QLF_START_CLAUSE));
  return save_code(stream, cl->ClCode, NULL);
}

static size_t
save_static_clause(IOSTREAM *stream, StaticClause *cl) {
  CHECK(save_tag(stream, QLF_START_CLAUSE));
  if (!(cl->ClFlags & FactMask)) {
    Yap_DebugPlWrite(cl->usc.ClSource->Entry);fprintf(stderr,"\n");
    CHECK(save_term(stream, cl->usc.ClSource->Entry));
    return save_code(stream, cl->ClCode, (yamop *)(cl->usc.ClSource));
  } else {
    return save_code(stream, cl->ClCode, NULL);
  }
}

static size_t
save_mega_clause(IOSTREAM *stream, MegaClause *cl) {
  UInt i;
  yamop *ptr;
  UInt ncls = cl->ClPred->cs.p_code.NOfClauses;

  for (i = 0, ptr = cl->ClCode; i < ncls; i++) {
    yamop *nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
    CHECK(save_tag(stream, QLF_START_CLAUSE));
    CHECK(save_code(stream, ptr, nextptr));
    ptr = nextptr;
  }
  return 1;
}

static size_t
save_clauses(IOSTREAM *stream, PredEntry *pp) {
  yamop        *FirstC, *LastC;

  FirstC = pp->cs.p_code.FirstClause;
  LastC = pp->cs.p_code.LastClause;
  if (FirstC == NULL && LastC == NULL) {
    return save_tag(stream, QLF_END_CLAUSES);
  }
  if (pp->PredFlags & LogUpdatePredFlag) {
    LogUpdClause *cl = ClauseCodeToLogUpdClause(FirstC);

    while (cl != NULL) {
      CHECK(save_lu_clause(stream, cl));
      cl = cl->ClNext;
    }
  } else if (pp->PredFlags & MegaClausePredFlag) {
    MegaClause *cl = ClauseCodeToMegaClause(FirstC);

    CHECK(save_mega_clause(stream, cl));
  } else if (pp->PredFlags & DynamicPredFlag) {
    yamop *cl = FirstC;

    do {
      CHECK(save_dynamic_clause(stream, ClauseCodeToDynamicClause(cl)));
      if (cl == LastC) return 1;
      cl = NextDynamicClause(cl);
    } while (TRUE);
  } else {
    StaticClause *cl = ClauseCodeToStaticClause(FirstC);

    do {
      CHECK(save_static_clause(stream, cl));
      if (cl->ClCode == LastC) return 1;
      cl = cl->ClNext;
    } while (TRUE);
  }
  return save_tag(stream, QLF_END_CLAUSES);
}

static size_t
save_pred(IOSTREAM *stream, PredEntry *ap) {
  CHECK(save_Func(stream, ap->FunctorOfPred));
  CHECK(save_uint(stream, ap->ArityOfPE));
  CHECK(save_uint(stream, ap->PredFlags));
  CHECK(save_uint(stream, ap->cs.p_code.NOfClauses));
  return save_clauses(stream, ap);
}

static size_t
save_module(IOSTREAM *stream, Term mod) {
  PredEntry *ap = Yap_ModulePred(mod);
  while (ap) {
    CHECK(save_pred(stream, ap));
    ap = ap->NextPredOfModule;
  }
  return 1;
}

static Int
p_save_module_preds( USES_REGS1 )
{
  IOSTREAM *stream;
  Term tmod = Deref(ARG2);

  if (!Yap_getOutputStream(Yap_InitSlot(Deref(ARG1) PASS_REGS), &stream)) {
    return FALSE;
  }
  if (IsVarTerm(tmod)) {
    Yap_Error(INSTANTIATION_ERROR,tmod,"save_module/2");
    return FALSE;
  }
  if (!IsAtomTerm(tmod)) {
    Yap_Error(TYPE_ERROR_ATOM,tmod,"save_module/2");
    return FALSE;
  }
  return save_module(stream, tmod) != 0;
}

void Yap_InitQLY(void)
{
  Yap_InitCPred("$save_module_preds", 2, p_save_module_preds, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
}