qly stuff.

This commit is contained in:
Vitor Santos Costa 2011-08-24 00:11:54 -03:00
parent 704989bf70
commit 7c0ba3b867
13 changed files with 1018 additions and 58 deletions

View File

@ -1938,6 +1938,24 @@ assertz_dynam_clause(PredEntry *p, yamop *cp)
p->cs.p_code.NOfClauses++;
}
void
Yap_AssertzClause(PredEntry *p, yamop *cp)
{
if (p->PredFlags & DynamicPredFlag) {
if (p->cs.p_code.FirstClause == NULL) {
add_first_dynamic(p, cp, FALSE);
} else {
assertz_dynam_clause(p, cp);
}
} else {
if (p->cs.p_code.FirstClause == NULL) {
add_first_static(p, cp, FALSE);
} else {
assertz_stat_clause(p, cp, FALSE);
}
}
}
static void expand_consult( void )
{
CACHE_REGS
@ -2070,7 +2088,6 @@ mark_preds_with_this_func(Functor f, Prop p0)
}
}
static int
addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
/*

685
C/qlyr.c Normal file
View File

@ -0,0 +1,685 @@
/*************************************************************************
* *
* 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 $ *
* *
*************************************************************************/
#if DEBUG
#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));
static Atom
LookupAtom(Atom oat)
{
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;
}
ERROR(UNKNOWN_ATOM);
return NIL;
}
static void
InsertAtom(Atom oat, Atom at)
{
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)
{
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;
}
ERROR(UNKNOWN_FUNCTOR);
return NIL;
}
static void
InsertFunctor(Functor ofun, Functor fun)
{
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)
{
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;
}
ERROR(UNKNOWN_FUNCTOR);
return NIL;
}
static void
InsertPredEntry(PredEntry *op, PredEntry *pe)
{
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)
{
CELL hash = (CELL)(op) % LOCAL_ImportFunctorHashTableSize;
import_opcode_hash_entry_t *f;
f = LOCAL_ImportOPCODEHashChain[hash];
while (f) {
if (f->oval == op) {
return f->val;
}
f = f->next;
}
ERROR(UNKNOWN_OPCODE);
return NIL;
}
static int
OpcodeID(OPCODE op)
{
CELL hash = (CELL)(op) % LOCAL_ImportFunctorHashTableSize;
import_opcode_hash_entry_t *f;
f = LOCAL_ImportOPCODEHashChain[hash];
while (f) {
if (f->oval == op) {
return f->id;
}
f = f->next;
}
ERROR(UNKNOWN_OPCODE);
return NIL;
}
static void
InsertOPCODE(OPCODE op, int i, OPCODE o)
{
CELL hash = (CELL)(op) % LOCAL_ImportFunctorHashTableSize;
import_opcode_hash_entry_t *f;
f = LOCAL_ImportOPCODEHashChain[hash];
while (f) {
if (f->oval == op) {
return;
}
f = f->next;
}
f = (import_opcode_hash_entry_t *)malloc(sizeof(import_opcode_hash_entry_t));
if (!f) {
return;
}
f->val = o;
f->oval = op;
f->id = i;
f->next = LOCAL_ImportOPCODEHashChain[hash];
LOCAL_ImportOPCODEHashChain[hash] = f;
}
static void
InitHash(void)
{
LOCAL_ImportFunctorHashTableSize = EXPORT_FUNCTOR_TABLE_SIZE;
LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc(1, sizeof(import_functor_hash_entry_t *)* LOCAL_ImportFunctorHashTableSize);
LOCAL_ImportAtomHashTableSize = EXPORT_ATOM_TABLE_SIZE;
LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc(1, sizeof(import_atom_hash_entry_t *)* LOCAL_ImportAtomHashTableSize);
LOCAL_ImportOPCODEHashTableSize = EXPORT_OPCODE_TABLE_SIZE;
LOCAL_ImportOPCODEHashChain = (import_opcode_hash_entry_t **)calloc(1, sizeof(import_opcode_hash_entry_t *)* LOCAL_ImportOPCODEHashTableSize);
LOCAL_ImportPredEntryHashTableSize = EXPORT_PRED_ENTRY_TABLE_SIZE;
LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc(1, sizeof(import_pred_entry_hash_entry_t *)* LOCAL_ImportPredEntryHashTableSize);
}
static void
CloseHash(void)
{
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;
}
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) (P)
#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 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 PredEntryAdjust(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 CellPtoHeapAdjust(P) (P)
#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) (P)
#define DBRefPAdjust(P) (P)
#define DBTermAdjust(P) (P)
#define LUIndexAdjust(P) (P)
#define SIndexAdjust(P) (P)
#define LocalAddrAdjust(P) (P)
#define GlobalAddrAdjust(P) (P)
#define OpListAdjust(P) (P)
#define PtoLUCAdjust(P) (P)
#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) (P)
#define TermToGlobalAdjust(P) (P)
#define PtoOpAdjust(P) PtoOpAdjust__(P PASS_REGS)
static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) {
if (ptr)
return (yamop *) ((char *) (ptr) + LOCAL_HDiff);
return ptr;
}
#define PtoLUClauseAdjust(P) (P)
#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 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
ReadHash(IOSTREAM *stream)
{
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);
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)) ERROR(OUT_OF_TEMP_SPACE);
read_bytes(stream, rep, (len+1)*sizeof(wchar_t));
at = Yap_LookupWideAtom(rep);
if (at == NIL) ERROR(OUT_OF_ATOM_SPACE);
} else if (tg == QLY_ATOM) {
char *rep = (char *)AllocTempSpace();
UInt len;
len = read_uint(stream);
if (!EnoughTempSpace(len)) ERROR(OUT_OF_TEMP_SPACE);
read_bytes(stream, rep, (len+1)*sizeof(char));
at = Yap_LookupAtom(rep);
if (at == NIL) ERROR(OUT_OF_ATOM_SPACE);
} else {
ERROR(BAD_ATOM);
}
InsertAtom(oat, at);
}
/* functors */
RCHECK(read_tag(stream) == QLY_START_FUNCTORS);
LOCAL_ImportFunctorHashTableNum = read_uint(stream);
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 = Yap_MkFunctor(at, arity);
InsertFunctor(of, f);
}
RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES);
LOCAL_ImportPredEntryHashTableNum = read_uint(stream);
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 = MkAtomTerm(AtomAdjust(omod));
if (arity) {
Functor of = (Functor)read_uint(stream);
Functor f = LookupFunctor(of);
pe = RepPredProp(PredPropByFunc(f,mod));
} else {
Atom oa = (Atom)read_uint(stream);
Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtom(a,mod));
}
InsertPredEntry(ope, pe);
}
}
static void
read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
if (pp->PredFlags & LogUpdatePredFlag) {
UInt i;
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_uint(stream);
UInt size = read_uint(stream);
LogUpdClause *cl = (LogUpdClause *)Yap_AllocCodeSpace(size);
read_bytes(stream, cl, size);
LOCAL_HDiff = (char *)cl-base;
RestoreLUClause(cl, pp);
Yap_AssertzClause(pp, cl->ClCode);
}
} else if (pp->PredFlags & MegaClausePredFlag) {
CACHE_REGS
char *base = (void *)read_uint(stream);
UInt size = read_uint(stream);
MegaClause *cl = (MegaClause *)Yap_AllocCodeSpace(size);
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
RestoreMegaClause(cl PASS_REGS);
pp->cs.p_code.FirstClause =
pp->cs.p_code.LastClause =
cl->ClCode;
} 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_AllocCodeSpace(size);
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
RestoreDynamicClause(cl, pp);
Yap_AssertzClause(pp, cl->ClCode);
}
} else {
UInt i;
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_uint(stream);
UInt size = read_uint(stream);
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace(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 arity = read_uint(stream);
UInt nclauses, flags;
PredEntry *ap;
if (arity) {
Functor f;
f = LookupFunctor((Functor)read_uint(stream));
if ((ap = RepPredProp(PredPropByFunc(f,mod))) == NULL) {
ERROR(OUT_OF_CODE_SPACE);
}
} else {
Atom a = LookupAtom((Atom)read_uint(stream));
if ((ap = RepPredProp(PredPropByAtom(a,mod))) == NULL) {
ERROR(OUT_OF_CODE_SPACE);
}
}
ap->ArityOfPE = arity;
flags = ap->PredFlags = read_uint(stream);
nclauses = read_uint(stream);
ap->cs.p_code.NOfClauses = 0;
read_clauses(stream, ap, nclauses, flags);
}
static void
save_module(IOSTREAM *stream, Term mod) {
CACHE_REGS
InitHash();
ReadHash(stream);
RCHECK(read_tag(stream) == QLY_START_MODULE);
mod = (Term)read_uint(stream);
while (read_tag(stream) == QLY_START_PREDICATE) {
read_pred(stream, mod);
}
RCHECK(read_tag(stream) == QLY_END_PREDICATES);
CloseHash();
}
static Int
p_read_module_preds( USES_REGS1 )
{
IOSTREAM *stream;
Term tmod = Deref(ARG2);
if (!Yap_getInputStream(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;
}
save_module(stream, tmod);
return TRUE;
}
#endif
void Yap_InitQLYR(void)
{
#if DEBUG
Yap_InitCPred("$read_module_preds", 2, p_read_module_preds, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
#endif
}

178
C/qlyw.c
View File

@ -8,7 +8,7 @@
* *
**************************************************************************
* *
* File: stdpreds.c *
* File: qlyw.c *
* comments: quick saver/loader *
* *
* Last rev: $Date: 2011-08-29$,$Author: vsc $ *
@ -18,6 +18,7 @@
#if DEBUG
#include <SWI-Stream.h>
#include "absmi.h"
#include "Foreign.h"
#include "alloc.h"
@ -27,19 +28,12 @@
#if HAVE_STRING_H
#include <string.h>
#endif
#include <SWI-Stream.h>
#include "qly.h"
STATIC_PROTO(void RestoreEntries, (PropEntry *, int USES_REGS));
STATIC_PROTO(void CleanCode, (PredEntry * USES_REGS));
#define EXPORT_ATOM_TABLE_SIZE (16*4096)
#define EXPORT_FUNCTOR_TABLE_SIZE (16*4096)
typedef struct export_atom_hash_entry_struct {
Atom val;
struct export_atom_hash_entry_struct *next;
} export_atom_hash_entry_t;
static void
LookupAtom(Atom at)
{
@ -59,18 +53,11 @@ LookupAtom(Atom at)
return;
}
a->val = at;
fprintf(stderr,"+%s\n",RepAtom(at)->StrOfAE);
a->next = LOCAL_ExportAtomHashChain[hash];
LOCAL_ExportAtomHashChain[hash] = a;
LOCAL_ExportAtomHashTableNum++;
}
typedef struct export_functor_hash_entry_struct {
Atom name;
UInt arity;
struct export_functor_hash_entry_struct *next;
} export_functor_hash_entry_t;
static void
LookupFunctor(Functor fun)
{
@ -91,6 +78,7 @@ LookupFunctor(Functor fun)
return;
}
LookupAtom(name);
f->val = fun;
f->name = name;
f->arity = arity;
f->next = LOCAL_ExportFunctorHashChain[hash];
@ -98,6 +86,42 @@ LookupFunctor(Functor fun)
LOCAL_ExportFunctorHashTableNum++;
}
static void
LookupPredEntry(PredEntry *pe)
{
CELL hash = (CELL)(pe) % LOCAL_ExportFunctorHashTableSize;
export_pred_entry_hash_entry_t *p;
UInt arity = pe->ArityOfPE;
p = LOCAL_ExportPredEntryHashChain[hash];
while (p) {
if (p->val == pe) {
return;
}
p = p->next;
}
p = (export_pred_entry_hash_entry_t *)malloc(sizeof(export_pred_entry_hash_entry_t));
if (!p) {
return;
}
p->arity = arity;
if (arity) {
p->u.f = pe->FunctorOfPred;
LookupFunctor(pe->FunctorOfPred);
} else {
p->u.a = (Atom)(pe->FunctorOfPred);
LookupAtom((Atom)(pe->FunctorOfPred));
}
if (pe->ModuleOfPred) {
p->module = AtomOfTerm(pe->ModuleOfPred);
} else {
p->module = AtomProlog;
}
p->next = LOCAL_ExportPredEntryHashChain[hash];
LOCAL_ExportPredEntryHashChain[hash] = p;
LOCAL_ExportPredEntryHashTableNum++;
}
static void
InitHash(void)
{
@ -105,6 +129,19 @@ InitHash(void)
LOCAL_ExportFunctorHashChain = (export_functor_hash_entry_t **)calloc(1, sizeof(export_functor_hash_entry_t *)* LOCAL_ExportFunctorHashTableSize);
LOCAL_ExportAtomHashTableSize = EXPORT_ATOM_TABLE_SIZE;
LOCAL_ExportAtomHashChain = (export_atom_hash_entry_t **)calloc(1, sizeof(export_atom_hash_entry_t *)* LOCAL_ExportAtomHashTableSize);
LOCAL_ExportPredEntryHashTableSize = EXPORT_PRED_ENTRY_TABLE_SIZE;
LOCAL_ExportPredEntryHashChain = (export_pred_entry_hash_entry_t **)calloc(1, sizeof(export_pred_entry_hash_entry_t *)* LOCAL_ExportPredEntryHashTableSize);
}
static void
CloseHash(void)
{
LOCAL_ExportFunctorHashTableSize = 0L;
free(LOCAL_ExportFunctorHashChain);
LOCAL_ExportAtomHashTableSize = 0L;
free(LOCAL_ExportAtomHashChain);
LOCAL_ExportPredEntryHashTableSize = 0L;
free(LOCAL_ExportPredEntryHashChain);
}
static inline Atom
@ -166,7 +203,22 @@ TermToGlobalOrAtomAdjust(Term t)
#define DoubleInCodeAdjust(P)
#define IntegerInCodeAdjust(P)
#define OpcodeAdjust(P) (P)
#define ModuleAdjust(P) (P)
static inline Term
ModuleAdjust(Term t)
{
if (!t) return t;
return AtomTermAdjust(t);
}
static inline PredEntry *
PredEntryAdjust(PredEntry *pe)
{
LookupPredEntry(pe);
return pe;
}
#define ExternalFunctionAdjust(P) (P)
#define DBRecordAdjust(P) (P)
#define PredEntryAdjust(P) (P)
@ -232,41 +284,11 @@ RestoreHashPreds( USES_REGS1 )
}
static void init_reg_copies(USES_REGS1)
{
}
static void
RestoreAtomList(Atom atm USES_REGS)
{
}
static void
mark_trail(USES_REGS1)
{
}
static void
mark_registers(USES_REGS1)
{
}
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
typedef enum {
QLY_START_PREDICATE,
QLY_END_PREDICATE,
QLY_START_CLAUSE,
QLY_END_CLAUSES,
QLY_FUNCTORS,
QLY_ATOMS,
QLY_ATOM_WIDE,
QLY_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);
@ -274,7 +296,8 @@ static size_t save_bytes(IOSTREAM *stream, void *ptr, size_t sz)
static size_t save_byte(IOSTREAM *stream, int byte)
{
return Sputc(byte, stream);
Sputc(byte, stream);
return 1;
}
static size_t save_uint(IOSTREAM *stream, UInt val)
@ -283,6 +306,12 @@ static size_t save_uint(IOSTREAM *stream, UInt val)
return save_bytes(stream, &v, sizeof(UInt));
}
static size_t save_int(IOSTREAM *stream, int val)
{
UInt v = val;
return save_bytes(stream, &v, sizeof(int));
}
static size_t save_tag(IOSTREAM *stream, qlf_tag_t tag)
{
return save_byte(stream, tag);
@ -292,8 +321,17 @@ static int
SaveHash(IOSTREAM *stream)
{
UInt i;
CHECK(save_tag(stream, QLY_ATOMS));
/* first, current opcodes */
CHECK(save_tag(stream, QLY_START_X));
save_uint(stream, (UInt)&ARG1);
CHECK(save_tag(stream, QLY_START_OPCODES));
save_int(stream, _std_top);
for (i= 0; i < _std_top; i++) {
save_uint(stream, (UInt)Yap_opcode(i));
}
CHECK(save_tag(stream, QLY_START_ATOMS));
CHECK(save_uint(stream, LOCAL_ExportAtomHashTableNum));
fprintf(stderr,"num=%ld\n",LOCAL_ExportAtomHashTableNum);
for (i = 0; i < LOCAL_ExportAtomHashTableSize; i++) {
export_atom_hash_entry_t *a = LOCAL_ExportAtomHashChain[i];
while (a) {
@ -303,7 +341,7 @@ SaveHash(IOSTREAM *stream)
if (IsWideAtom(at)) {
CHECK(save_tag(stream, QLY_ATOM_WIDE));
CHECK(save_uint(stream, wcslen(RepAtom(at)->WStrOfAE)));
CHECK(save_bytes(stream, at->WStrOfAE, wcslen(at->WStrOfAE)*sizeof(wchar_t)));
CHECK(save_bytes(stream, at->WStrOfAE, (wcslen(at->WStrOfAE)+1)*sizeof(wchar_t)));
} else {
CHECK(save_tag(stream, QLY_ATOM));
CHECK(save_uint(stream, strlen(RepAtom(at)->StrOfAE)));
@ -313,18 +351,34 @@ SaveHash(IOSTREAM *stream)
free(a0);
}
}
save_tag(stream, QLY_FUNCTORS);
save_tag(stream, QLY_START_FUNCTORS);
save_uint(stream, LOCAL_ExportFunctorHashTableNum);
for (i = 0; i < LOCAL_ExportFunctorHashTableSize; i++) {
export_functor_hash_entry_t *f = LOCAL_ExportFunctorHashChain[i];
while (f) {
export_functor_hash_entry_t *f0 = f;
CHECK(save_uint(stream, (UInt)(f->val)));
CHECK(save_uint(stream, f->arity));
CHECK(save_uint(stream, (CELL)(f->name)));
f = f->next;
free(f0);
}
}
save_tag(stream, QLY_START_PRED_ENTRIES);
save_uint(stream, LOCAL_ExportPredEntryHashTableNum);
for (i = 0; i < LOCAL_ExportPredEntryHashTableSize; i++) {
export_pred_entry_hash_entry_t *p = LOCAL_ExportPredEntryHashChain[i];
while (p) {
export_pred_entry_hash_entry_t *p0 = p;
CHECK(save_uint(stream, (UInt)(p->val)));
CHECK(save_uint(stream, p->arity));
CHECK(save_uint(stream, (UInt)p->module));
CHECK(save_uint(stream, (UInt)p->u.f));
p = p->next;
free(p0);
}
}
return 1;
}
static size_t
@ -334,13 +388,15 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
FirstC = pp->cs.p_code.FirstClause;
LastC = pp->cs.p_code.LastClause;
if (FirstC == NULL && LastC == NULL) {
return save_tag(stream, QLY_END_CLAUSES);
return 1;
}
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(FirstC);
while (cl != NULL) {
UInt size = cl->ClSize;
CHECK(save_uint(stream, (UInt)cl));
CHECK(save_uint(stream, size));
CHECK(save_bytes(stream, cl, size));
cl = cl->ClNext;
}
@ -348,6 +404,8 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
MegaClause *cl = ClauseCodeToMegaClause(FirstC);
UInt size = cl->ClSize;
CHECK(save_uint(stream, (UInt)cl));
CHECK(save_uint(stream, size));
CHECK(save_bytes(stream, cl, size));
} else if (pp->PredFlags & DynamicPredFlag) {
yamop *cl = FirstC;
@ -356,6 +414,8 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
DynamicClause *dcl = ClauseCodeToDynamicClause(cl);
UInt size = dcl->ClSize;
CHECK(save_uint(stream, (UInt)cl));
CHECK(save_uint(stream, size));
CHECK(save_bytes(stream, dcl, size));
if (cl == LastC) return 1;
cl = NextDynamicClause(cl);
@ -366,18 +426,20 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
do {
UInt size = cl->ClSize;
CHECK(save_uint(stream, (UInt)cl));
CHECK(save_uint(stream, size));
CHECK(save_bytes(stream, cl, size));
if (cl->ClCode == LastC) return 1;
cl = cl->ClNext;
} while (TRUE);
}
return save_tag(stream, QLY_END_CLAUSES);
return 1;
}
static size_t
save_pred(IOSTREAM *stream, PredEntry *ap) {
CHECK(save_uint(stream, (UInt)(ap->FunctorOfPred)));
CHECK(save_uint(stream, ap->ArityOfPE));
CHECK(save_uint(stream, (UInt)(ap->FunctorOfPred)));
CHECK(save_uint(stream, ap->PredFlags));
CHECK(save_uint(stream, ap->cs.p_code.NOfClauses));
return save_clauses(stream, ap);
@ -402,7 +464,6 @@ save_module(IOSTREAM *stream, Term mod) {
PredEntry *ap = Yap_ModulePred(mod);
InitHash();
while (ap) {
fprintf(stderr,"P %s\n",RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE);
if (ap->ArityOfPE) {
FuncAdjust(ap->FunctorOfPred);
} else {
@ -412,11 +473,16 @@ save_module(IOSTREAM *stream, Term mod) {
ap = ap->NextPredOfModule;
}
SaveHash(stream);
CHECK(save_tag(stream, QLY_START_MODULE));
CHECK(save_uint(stream, (UInt)mod));
ap = Yap_ModulePred(mod);
while (ap) {
CHECK(save_tag(stream, QLY_START_PREDICATE));
CHECK(save_pred(stream, ap));
ap = ap->NextPredOfModule;
}
CHECK(save_tag(stream, QLY_END_PREDICATES));
CloseHash();
return 1;
}

View File

@ -4482,6 +4482,7 @@ Yap_InitCPreds(void)
Yap_InitSysPreds();
Yap_InitUnify();
Yap_InitQLY();
Yap_InitQLYR();
#if defined CUT_C && defined MYDDAS_MYSQL
Yap_InitMYDDAS_MySQLPreds();
#endif

View File

@ -136,6 +136,7 @@ void STD_PROTO(Yap_Abolish,(struct pred_entry *));
void STD_PROTO(Yap_BuildMegaClause,(struct pred_entry *));
void STD_PROTO(Yap_EraseMegaClause,(yamop *,struct pred_entry *));
void STD_PROTO(Yap_ResetConsultStack,(void));
void STD_PROTO(Yap_AssertzClause,(struct pred_entry *, yamop *));
/* cmppreds.c */
@ -309,6 +310,7 @@ void STD_PROTO(Yap_InitReadUtil,(void));
/* qly.c */
void STD_PROTO(Yap_InitQLY,(void));
void STD_PROTO(Yap_InitQLYR,(void));
/* save.c */
int STD_PROTO(Yap_SavedInfo,(char *,char *,CELL *,CELL *,CELL *));

View File

@ -341,4 +341,32 @@
#define REMOTE_ExportFunctorHashTableSize(wid) REMOTE(wid)->ExportFunctorHashTableSize_
#define LOCAL_ExportFunctorHashTableNum LOCAL->ExportFunctorHashTableNum_
#define REMOTE_ExportFunctorHashTableNum(wid) REMOTE(wid)->ExportFunctorHashTableNum_
#define LOCAL_ExportPredEntryHashChain LOCAL->ExportPredEntryHashChain_
#define REMOTE_ExportPredEntryHashChain(wid) REMOTE(wid)->ExportPredEntryHashChain_
#define LOCAL_ExportPredEntryHashTableSize LOCAL->ExportPredEntryHashTableSize_
#define REMOTE_ExportPredEntryHashTableSize(wid) REMOTE(wid)->ExportPredEntryHashTableSize_
#define LOCAL_ExportPredEntryHashTableNum LOCAL->ExportPredEntryHashTableNum_
#define REMOTE_ExportPredEntryHashTableNum(wid) REMOTE(wid)->ExportPredEntryHashTableNum_
#define LOCAL_ImportAtomHashChain LOCAL->ImportAtomHashChain_
#define REMOTE_ImportAtomHashChain(wid) REMOTE(wid)->ImportAtomHashChain_
#define LOCAL_ImportAtomHashTableSize LOCAL->ImportAtomHashTableSize_
#define REMOTE_ImportAtomHashTableSize(wid) REMOTE(wid)->ImportAtomHashTableSize_
#define LOCAL_ImportAtomHashTableNum LOCAL->ImportAtomHashTableNum_
#define REMOTE_ImportAtomHashTableNum(wid) REMOTE(wid)->ImportAtomHashTableNum_
#define LOCAL_ImportFunctorHashChain LOCAL->ImportFunctorHashChain_
#define REMOTE_ImportFunctorHashChain(wid) REMOTE(wid)->ImportFunctorHashChain_
#define LOCAL_ImportFunctorHashTableSize LOCAL->ImportFunctorHashTableSize_
#define REMOTE_ImportFunctorHashTableSize(wid) REMOTE(wid)->ImportFunctorHashTableSize_
#define LOCAL_ImportFunctorHashTableNum LOCAL->ImportFunctorHashTableNum_
#define REMOTE_ImportFunctorHashTableNum(wid) REMOTE(wid)->ImportFunctorHashTableNum_
#define LOCAL_ImportOPCODEHashChain LOCAL->ImportOPCODEHashChain_
#define REMOTE_ImportOPCODEHashChain(wid) REMOTE(wid)->ImportOPCODEHashChain_
#define LOCAL_ImportOPCODEHashTableSize LOCAL->ImportOPCODEHashTableSize_
#define REMOTE_ImportOPCODEHashTableSize(wid) REMOTE(wid)->ImportOPCODEHashTableSize_
#define LOCAL_ImportPredEntryHashChain LOCAL->ImportPredEntryHashChain_
#define REMOTE_ImportPredEntryHashChain(wid) REMOTE(wid)->ImportPredEntryHashChain_
#define LOCAL_ImportPredEntryHashTableSize LOCAL->ImportPredEntryHashTableSize_
#define REMOTE_ImportPredEntryHashTableSize(wid) REMOTE(wid)->ImportPredEntryHashTableSize_
#define LOCAL_ImportPredEntryHashTableNum LOCAL->ImportPredEntryHashTableNum_
#define REMOTE_ImportPredEntryHashTableNum(wid) REMOTE(wid)->ImportPredEntryHashTableNum_

View File

@ -195,4 +195,18 @@ typedef struct worker_local {
struct export_functor_hash_entry_struct **ExportFunctorHashChain_;
UInt ExportFunctorHashTableSize_;
UInt ExportFunctorHashTableNum_;
struct export_pred_entry_hash_entry_struct **ExportPredEntryHashChain_;
UInt ExportPredEntryHashTableSize_;
UInt ExportPredEntryHashTableNum_;
struct import_atom_hash_entry_struct **ImportAtomHashChain_;
UInt ImportAtomHashTableSize_;
UInt ImportAtomHashTableNum_;
struct import_functor_hash_entry_struct **ImportFunctorHashChain_;
UInt ImportFunctorHashTableSize_;
UInt ImportFunctorHashTableNum_;
struct import_opcode_hash_entry_struct **ImportOPCODEHashChain_;
UInt ImportOPCODEHashTableSize_;
struct import_pred_entry_hash_entry_struct **ImportPredEntryHashChain_;
UInt ImportPredEntryHashTableSize_;
UInt ImportPredEntryHashTableNum_;
} w_local;

View File

@ -195,4 +195,18 @@ static void InitWorker(int wid) {
REMOTE_ExportFunctorHashChain(wid) = NULL;
REMOTE_ExportFunctorHashTableSize(wid) = 0;
REMOTE_ExportFunctorHashTableNum(wid) = 0;
REMOTE_ExportPredEntryHashChain(wid) = NULL;
REMOTE_ExportPredEntryHashTableSize(wid) = 0;
REMOTE_ExportPredEntryHashTableNum(wid) = 0;
REMOTE_ImportAtomHashChain(wid) = NULL;
REMOTE_ImportAtomHashTableSize(wid) = 0;
REMOTE_ImportAtomHashTableNum(wid) = 0;
REMOTE_ImportFunctorHashChain(wid) = NULL;
REMOTE_ImportFunctorHashTableSize(wid) = 0;
REMOTE_ImportFunctorHashTableNum(wid) = 0;
REMOTE_ImportOPCODEHashChain(wid) = NULL;
REMOTE_ImportOPCODEHashTableSize(wid) = 0;
REMOTE_ImportPredEntryHashChain(wid) = NULL;
REMOTE_ImportPredEntryHashTableSize(wid) = 0;
REMOTE_ImportPredEntryHashTableNum(wid) = 0;
}

94
H/qly.h Normal file
View File

@ -0,0 +1,94 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: qly.h *
* comments: quick saver/loader *
* *
* Last rev: $Date: 2011-08-29$,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* *
*************************************************************************/
#define EXPORT_ATOM_TABLE_SIZE (16*4096)
#define EXPORT_FUNCTOR_TABLE_SIZE (16*4096)
#define EXPORT_OPCODE_TABLE_SIZE (4096)
#define EXPORT_PRED_ENTRY_TABLE_SIZE (128)
typedef struct export_atom_hash_entry_struct {
Atom val;
struct export_atom_hash_entry_struct *next;
} export_atom_hash_entry_t;
typedef struct import_atom_hash_entry_struct {
Atom oval;
Atom val;
struct import_atom_hash_entry_struct *next;
} import_atom_hash_entry_t;
typedef struct export_functor_hash_entry_struct {
Functor val;
Atom name;
UInt arity;
struct export_functor_hash_entry_struct *next;
} export_functor_hash_entry_t;
typedef struct import_functor_hash_entry_struct {
Functor val;
Functor oval;
struct import_functor_hash_entry_struct *next;
} import_functor_hash_entry_t;
typedef struct import_opcode_hash_entry_struct {
OPCODE val;
int id;
OPCODE oval;
struct import_opcode_hash_entry_struct *next;
} import_opcode_hash_entry_t;
typedef struct export_pred_entry_hash_entry_struct {
PredEntry *val;
union {
Functor f;
Atom a;
} u;
Atom module;
UInt arity;
struct export_pred_entry_hash_entry_struct *next;
} export_pred_entry_hash_entry_t;
typedef struct import_pred_entry_hash_entry_struct {
PredEntry *val;
PredEntry *oval;
struct import_pred_entry_hash_entry_struct *next;
} import_pred_entry_hash_entry_t;
typedef enum {
QLY_START_X,
QLY_START_OPCODES,
QLY_START_ATOMS,
QLY_START_FUNCTORS,
QLY_START_PRED_ENTRIES,
QLY_START_MODULE,
QLY_START_PREDICATE,
QLY_END_PREDICATES,
QLY_ATOM_WIDE,
QLY_ATOM
} qlf_tag_t;
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define CHECK(F) { size_t r = (F); if (!r) return r; }
#define RCHECK(F) if(!(F)) { ERROR(MISMATCH); return; }
#define AllocTempSpace() (H)
#define EnoughTempSpace(sz) ((ASP-H)*sizeof(CELL) > sz)
#define ERROR(E)

View File

@ -194,5 +194,19 @@ static void RestoreWorker(int wid USES_REGS) {
}

View File

@ -174,6 +174,7 @@ HEADERS = \
$(srcdir)/H/index.h \
$(srcdir)/H/iopreds.h \
$(srcdir)/H/iswiatoms.h \
$(srcdir)/H/qly.h \
$(srcdir)/H/rclause.h \
$(srcdir)/H/rglobals.h \
$(srcdir)/H/rlocals.h \
@ -248,6 +249,7 @@ C_SOURCES= \
$(srcdir)/C/load_shl.c $(srcdir)/C/load_dyld.c \
$(srcdir)/C/mavar.c $(srcdir)/C/modules.c $(srcdir)/C/other.c \
$(srcdir)/C/parser.c \
$(srcdir)/C/qlyr.c \
$(srcdir)/C/qlyw.c \
$(srcdir)/C/save.c $(srcdir)/C/scanner.c \
$(srcdir)/C/sort.c $(srcdir)/C/stdpreds.c $(srcdir)/C/sysbits.c \
@ -358,7 +360,7 @@ ENGINE_OBJECTS = \
myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \
myddas_util.o myddas_statistics.o myddas_top_level.o \
myddas_wkb2prolog.o modules.o other.o \
parser.o qlyw.o save.o scanner.o sort.o stdpreds.o \
parser.o qlyr.o qlyw.o save.o scanner.o sort.o stdpreds.o \
sysbits.o threads.o tracer.o \
udi.o rtree.o rtree_udi.o\
unify.o userpreds.o utilpreds.o \
@ -444,6 +446,9 @@ init.o: $(srcdir)/C/init.c config.h
load_foreign.o: $(srcdir)/C/load_foreign.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/C/load_foreign.c -o $@
qlyr.o: $(srcdir)/C/qlyr.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/C/qlyr.c -o $@
qlyw.o: $(srcdir)/C/qlyw.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/C/qlyw.c -o $@

View File

@ -221,5 +221,19 @@ UInt ExportAtomHashTableNum =0
struct export_functor_hash_entry_struct **ExportFunctorHashChain =NULL
UInt ExportFunctorHashTableSize =0
UInt ExportFunctorHashTableNum =0
struct export_pred_entry_hash_entry_struct **ExportPredEntryHashChain =NULL
UInt ExportPredEntryHashTableSize =0
UInt ExportPredEntryHashTableNum =0
struct import_atom_hash_entry_struct **ImportAtomHashChain =NULL
UInt ImportAtomHashTableSize =0
UInt ImportAtomHashTableNum =0
struct import_functor_hash_entry_struct **ImportFunctorHashChain =NULL
UInt ImportFunctorHashTableSize =0
UInt ImportFunctorHashTableNum =0
struct import_opcode_hash_entry_struct **ImportOPCODEHashChain =NULL
UInt ImportOPCODEHashTableSize =0
struct import_pred_entry_hash_entry_struct **ImportPredEntryHashChain =NULL
UInt ImportPredEntryHashTableSize =0
UInt ImportPredEntryHashTableNum =0
END_WORKER_LOCAL

View File

@ -22,3 +22,9 @@ save_module(Mod) :-
'$save_module_preds'(S, Mod),
close(S).
read_module(Mod) :-
atom_concat(Mod,'.qly',F),
open(F, read, S, [type(binary)]),
'$read_module_preds'(S, Mod),
close(S).