diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of /home/denys/src/yap/yap-6.3

Browse Source
This commit is contained in:
Denys Duchier 2011-08-30 15:44:32 +02:00
commit 4b214db717
11 changed files with 440 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
C/adtdefs.c
View File

@ -487,6 +487,48 @@ Yap_HasOp(Atom a)
}
}
OpEntry *
Yap_OpPropForModule(Atom a, Term mod)
{ /* look property list of atom a for kind */
CACHE_REGS
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
OpEntry *info;
if (mod == TermProlog)
mod = PROLOG_MODULE;
WRITE_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp)) {
OpEntry *info = NULL;
if ( pp->KindOfPE == OpProperty) {
info = (OpEntry *)pp;
if (info->OpModule == mod)
return info;
}
}
if (EndOfPAEntr(info)) {
info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
info->KindOfPE = Ord(OpProperty);
info->OpModule = mod;
info->OpName = a;
LOCK(OpListLock);
info->OpNext = OpList;
OpList = info;
UNLOCK(OpListLock);
AddPropToAtom(ae, (PropEntry *)info);
INIT_RWLOCK(info->OpRWLock);
WRITE_LOCK(info->OpRWLock);
WRITE_UNLOCK(ae->ARWLock);
info->Prefix = info->Infix = info->Posfix = 0;
} else {
WRITE_LOCK(info->OpRWLock);
WRITE_UNLOCK(ae->ARWLock);
}
return NULL;
}
OpEntry *
Yap_GetOpProp(Atom a, op_type type USES_REGS)
{ /* look property list of atom a for kind */

2
C/heapgc.c
View File

@ -1915,7 +1915,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose
if (pe == NULL) {
fprintf(GLOBAL_stderr,"%% marked " UInt_FORMAT " (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]);
} else if (pe->ArityOfPE) {
fprintf(GLOBAL_stderr,"%% %s/%d marked " UInt_FORMAT " (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, Yap_op_names[opnum]);
fprintf(GLOBAL_stderr,"%% %s/" UInt_FORMAT " marked " UInt_FORMAT " (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, Yap_op_names[opnum]);
} else {
fprintf(GLOBAL_stderr,"%% %s marked " UInt_FORMAT " (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, Yap_op_names[opnum]);
}

135
C/qlyr.c
View File

@ -34,6 +34,26 @@
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,
BAD_ATOM = 7,
MISMATCH = 8,
INCONSISTENT_CPRED = 8
} qlfr_err_t;
static void
ERROR(qlfr_err_t my_err)
{
fprintf(stderr,"Error %d\n", my_err);
exit(1);
}
static Atom
LookupAtom(Atom oat)
{
@ -151,6 +171,7 @@ InsertPredEntry(PredEntry *op, PredEntry *pe)
p->val = pe;
p->oval = op;
p->next = LOCAL_ImportPredEntryHashChain[hash];
fprintf(stderr,"+op = %lx\n", op);
LOCAL_ImportPredEntryHashChain[hash] = p;
}
@ -184,6 +205,7 @@ OpcodeID(OPCODE op)
}
f = f->next;
}
fprintf(stderr,"-op = %lx\n", op);
ERROR(UNKNOWN_OPCODE);
return NIL;
}
@ -484,6 +506,14 @@ read_byte(IOSTREAM *stream)
return Sgetc(stream);
}
static BITS16
read_bits16(IOSTREAM *stream)
{
BITS16 v;
return read_bytes(stream, &v, sizeof(BITS16));
return v;
}
static UInt
read_uint(IOSTREAM *stream)
{
@ -566,14 +596,29 @@ ReadHash(IOSTREAM *stream)
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));
if (mod != IDB_MODULE) {
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));
}
} else {
Atom oa = (Atom)read_uint(stream);
Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtom(a,mod));
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(PredPropByAtom(a,mod));
} else {
Functor of = (Functor)read_uint(stream);
Functor f = LookupFunctor(of);
pe = RepPredProp(PredPropByFunc(f,mod));
}
}
InsertPredEntry(ope, pe);
}
@ -581,10 +626,21 @@ ReadHash(IOSTREAM *stream)
static void
read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
if (pp->PredFlags & LogUpdatePredFlag) {
UInt i;
/* first, clean up whatever was there */
if (pp->cs.p_code.NOfClauses) {
LogUpdClause *cl;
if (pp->PredFlags & IndexedPredFlag)
Yap_RemoveIndexation(pp);
cl = ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause);
do {
LogUpdClause *ncl = cl->ClNext;
Yap_ErLogUpdCl(cl);
cl = ncl;
} while (cl != NULL);
}
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_uint(stream);
UInt size = read_uint(stream);
@ -595,13 +651,15 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
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);
if (nclauses) {
Yap_Abolish(pp);
}
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
RestoreMegaClause(cl PASS_REGS);
@ -625,6 +683,14 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
} else {
UInt i;
if (pp->PredFlags & (UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) {
if (nclauses) {
ERROR(INCONSISTENT_CPRED);
}
return;
}
Yap_Abolish(pp);
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_uint(stream);
UInt size = read_uint(stream);
@ -662,25 +728,56 @@ read_pred(IOSTREAM *stream, Term mod) {
flags = ap->PredFlags = read_uint(stream);
nclauses = read_uint(stream);
ap->cs.p_code.NOfClauses = 0;
fl1 = flags & (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag);
fl1 = flags & (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag);
ap->PredFlags |= fl1;
if (flags & NumberDBPredFlag) {
ap->src.IndxId = read_uint(stream);
} else {
ap->src.OwnerFile = (Atom)read_uint(stream);
if (ap->src.OwnerFile && !(flags & MultiFileFlag)) {
ap->src.OwnerFile = AtomAdjust(ap->src.OwnerFile);
}
}
read_clauses(stream, ap, nclauses, flags);
}
static void
read_ops(IOSTREAM *stream) {
Int x;
while ((x = read_tag(stream)) != QLY_END_OPS) {
Atom at = (Atom)read_uint(stream);
Term mod;
OpEntry *op;
at = AtomAdjust(at);
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);
}
}
static void
read_module(IOSTREAM *stream) {
CACHE_REGS
Term mod;
Int x;
InitHash();
ReadHash(stream);
RCHECK(read_tag(stream) == QLY_START_MODULE);
mod = (Term)read_uint(stream);
mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
while (read_tag(stream) == QLY_START_PREDICATE) {
read_pred(stream, mod);
while ((x = read_tag(stream)) == QLY_START_MODULE) {
fprintf(stderr,"x0 = %ld\n", x);
Term mod = (Term)read_uint(stream);
mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
while ((x = read_tag(stream)) == QLY_START_PREDICATE) {
fprintf(stderr,"x1 = %ld\n", x);
read_pred(stream, mod);
}
fprintf(stderr,"xa = %ld\n", x);
}
RCHECK(read_tag(stream) == QLY_END_PREDICATES);
fprintf(stderr,"xb = %ld\n", x);
read_ops(stream);
CloseHash();
}
@ -701,7 +798,7 @@ p_read_module_preds( USES_REGS1 )
void Yap_InitQLYR(void)
{
#if DEBUG
Yap_InitCPred("$read_module_preds", 1, p_read_module_preds, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
#endif
}

164
C/qlyw.c
View File

@ -106,12 +106,26 @@ LookupPredEntry(PredEntry *pe)
}
p->arity = arity;
p->val = pe;
if (arity) {
p->u.f = pe->FunctorOfPred;
LookupFunctor(pe->FunctorOfPred);
if (pe->ModuleOfPred != IDB_MODULE) {
if (arity) {
p->u.f = pe->FunctorOfPred;
LookupFunctor(pe->FunctorOfPred);
} else {
p->u.a = (Atom)(pe->FunctorOfPred);
LookupAtom((Atom)(pe->FunctorOfPred));
}
} else {
p->u.a = (Atom)(pe->FunctorOfPred);
LookupAtom((Atom)(pe->FunctorOfPred));
if (pe->PredFlags & AtomDBPredFlag) {
p->u.a = (Atom)(pe->FunctorOfPred);
p->arity = (CELL)(-2);
LookupAtom((Atom)(pe->FunctorOfPred));
} else if (!(pe->PredFlags & NumberDBPredFlag)) {
p->u.f = pe->FunctorOfPred;
p->arity = (CELL)(-1);
LookupFunctor(pe->FunctorOfPred);
} else {
p->u.f = pe->FunctorOfPred;
}
}
if (pe->ModuleOfPred) {
p->module = AtomOfTerm(pe->ModuleOfPred);
@ -314,6 +328,12 @@ static size_t save_byte(IOSTREAM *stream, int byte)
return 1;
}
static size_t save_bits16(IOSTREAM *stream, BITS16 val)
{
BITS16 v = val;
return save_bytes(stream, &v, sizeof(BITS16));
}
static size_t save_uint(IOSTREAM *stream, UInt val)
{
UInt v = val;
@ -407,10 +427,13 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
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));
if (pp->TimeStampOfPred >= cl->ClTimeStart &&
pp->TimeStampOfPred <= cl->ClTimeEnd) {
UInt size = cl->ClSize;
CHECK(save_uint(stream, (UInt)cl));
CHECK(save_uint(stream, size));
CHECK(save_bytes(stream, cl, size));
}
cl = cl->ClNext;
}
} else if (pp->PredFlags & MegaClausePredFlag) {
@ -455,6 +478,7 @@ save_pred(IOSTREAM *stream, PredEntry *ap) {
CHECK(save_uint(stream, (UInt)(ap->FunctorOfPred)));
CHECK(save_uint(stream, ap->PredFlags));
CHECK(save_uint(stream, ap->cs.p_code.NOfClauses));
CHECK(save_uint(stream, ap->src.IndxId));
return save_clauses(stream, ap);
}
@ -471,6 +495,62 @@ clean_pred(PredEntry *pp USES_REGS) {
return TRUE;
}
static size_t
mark_pred(PredEntry *ap)
{
if (ap->ModuleOfPred != IDB_MODULE) {
if (ap->ArityOfPE) {
FuncAdjust(ap->FunctorOfPred);
} else {
AtomAdjust((Atom)(ap->FunctorOfPred));
}
} else {
if (ap->PredFlags & AtomDBPredFlag) {
AtomAdjust((Atom)(ap->FunctorOfPred));
} else if (!(ap->PredFlags & NumberDBPredFlag)) {
FuncAdjust(ap->FunctorOfPred);
}
}
if (!(ap->PredFlags & (MultiFileFlag|NumberDBPredFlag)) &&
ap->src.OwnerFile) {
AtomAdjust(ap->src.OwnerFile);
}
CHECK(clean_pred(ap PASS_REGS));
return 1;
}
static size_t
mark_ops(IOSTREAM *stream, Term mod) {
OpEntry *op = OpList;
while (op) {
if (!mod || op->OpModule == mod) {
AtomAdjust(op->OpName);
if (op->OpModule)
AtomTermAdjust(op->OpModule);
}
op = op->OpNext;
}
return 1;
}
static size_t
save_ops(IOSTREAM *stream, Term mod) {
OpEntry *op = OpList;
while (op) {
if (!mod || op->OpModule == mod) {
CHECK(save_tag(stream, QLY_NEW_OP));
save_uint(stream, (UInt)op->OpName);
save_uint(stream, (UInt)op->OpModule);
save_bits16(stream, op->Prefix);
save_bits16(stream, op->Infix);
save_bits16(stream, op->Posfix);
}
op = op->OpNext;
}
CHECK(save_tag(stream, QLY_END_OPS));
return 1;
}
static size_t
save_module(IOSTREAM *stream, Term mod) {
CACHE_REGS
@ -478,14 +558,11 @@ save_module(IOSTREAM *stream, Term mod) {
InitHash();
ModuleAdjust(mod);
while (ap) {
if (ap->ArityOfPE) {
FuncAdjust(ap->FunctorOfPred);
} else {
AtomAdjust((Atom)(ap->FunctorOfPred));
}
CHECK(clean_pred(ap PASS_REGS));
CHECK(mark_pred(ap));
ap = ap->NextPredOfModule;
}
/* just to make sure */
mark_ops(stream, mod);
SaveHash(stream);
CHECK(save_tag(stream, QLY_START_MODULE));
CHECK(save_uint(stream, (UInt)mod));
@ -496,6 +573,49 @@ save_module(IOSTREAM *stream, Term mod) {
ap = ap->NextPredOfModule;
}
CHECK(save_tag(stream, QLY_END_PREDICATES));
CHECK(save_tag(stream, QLY_END_MODULES));
save_ops(stream, mod);
CloseHash();
return 1;
}
static size_t
save_program(IOSTREAM *stream) {
CACHE_REGS
ModEntry *me = CurrentModules;
InitHash();
/* should we allow the user to see hidden predicates? */
while (me) {
PredEntry *pp;
AtomAdjust(me->AtomOfME);
pp = me->PredForME;
while (pp != NULL) {
CHECK(mark_pred(pp));
pp = pp->NextPredOfModule;
}
me = me->NextME;
}
/* just to make sure */
mark_ops(stream, 0);
SaveHash(stream);
me = CurrentModules;
while (me) {
PredEntry *pp;
pp = me->PredForME;
CHECK(save_tag(stream, QLY_START_MODULE));
CHECK(save_uint(stream, (UInt)MkAtomTerm(me->AtomOfME)));
while (pp != NULL) {
CHECK(save_tag(stream, QLY_START_PREDICATE));
CHECK(save_pred(stream, pp));
pp = pp->NextPredOfModule;
}
CHECK(save_tag(stream, QLY_END_PREDICATES));
me = me->NextME;
}
CHECK(save_tag(stream, QLY_END_MODULES));
save_ops(stream, 0);
CloseHash();
return 1;
}
@ -520,12 +640,24 @@ p_save_module_preds( USES_REGS1 )
return save_module(stream, tmod) != 0;
}
static Int
p_save_program( USES_REGS1 )
{
IOSTREAM *stream;
if (!Yap_getOutputStream(Yap_InitSlot(Deref(ARG1) PASS_REGS), &stream)) {
return FALSE;
}
return save_program(stream) != 0;
}
#endif
void Yap_InitQLY(void)
{
#if DEBUG
Yap_InitCPred("$save_module_preds", 2, p_save_module_preds, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
Yap_InitCPred("$qsave_module_preds", 2, p_save_module_preds, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
Yap_InitCPred("$qsave_program", 1, p_save_program, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
#endif
}

2
H/Yapproto.h
View File

@ -58,7 +58,7 @@ Term STD_PROTO(Yap_NWideStringToListOfAtoms,(wchar_t *, size_t));
Term STD_PROTO(Yap_NWideStringToDiffListOfAtoms,(wchar_t *, Term, size_t));
int STD_PROTO(Yap_AtomIncreaseHold,(Atom));
int STD_PROTO(Yap_AtomDecreaseHold,(Atom));
struct operator_entry *STD_PROTO(Yap_OpPropForModule,(Atom, Term));
Int STD_PROTO(Yap_InitSlot,(Term CACHE_TYPE));
Int STD_PROTO(Yap_NewSlots,(int CACHE_TYPE));
int STD_PROTO(Yap_RecoverSlots,(int CACHE_TYPE));

1
H/Yatom.h
View File

@ -727,7 +727,6 @@ typedef struct pred_entry
{
Atom OwnerFile; /* File where the predicate was defined */
Int IndxId; /* Index for a certain key */
struct mfile *file_srcs; /* for multifile predicates */
} src;
#if defined(YAPOR) || defined(THREADS)
lockvar PELock; /* a simple lock to protect expansion */

24
H/qly.h
View File

@ -70,16 +70,19 @@ typedef struct import_pred_entry_hash_entry_struct {
} 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
QLY_START_X = 0,
QLY_START_OPCODES = 1,
QLY_START_ATOMS = 2,
QLY_START_FUNCTORS = 3,
QLY_START_PRED_ENTRIES = 4,
QLY_START_MODULE = 5,
QLY_END_MODULES = 6,
QLY_NEW_OP = 7,
QLY_END_OPS = 8,
QLY_START_PREDICATE = 9,
QLY_END_PREDICATES = 10,
QLY_ATOM_WIDE = 11,
QLY_ATOM = 12
} qlf_tag_t;
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
@ -89,6 +92,5 @@ typedef enum {
#define AllocTempSpace() (H)
#define EnoughTempSpace(sz) ((ASP-H)*sizeof(CELL) > sz)
#define ERROR(E)

1
H/rclause.h
View File

@ -11,6 +11,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
op_numbers op;
if (max && pc >= max) return;
op = Yap_op_from_opcode(pc->opc);
fprintf(stderr,"op=%d\n", op);
pc->opc = Yap_opcode(op);
#ifdef DEBUG_RESTORE2
fprintf(stderr, "%s ", Yap_op_names[op]);

11
H/rheap.h
View File

@ -1116,9 +1116,10 @@ RestoreDB(DBEntry *pp USES_REGS)
static void
CleanClauses(yamop *First, yamop *Last, PredEntry *pp USES_REGS)
{
if (!First)
return;
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(First);
while (cl != NULL) {
RestoreLUClause(cl, pp PASS_REGS);
cl = cl->ClNext;
@ -1338,12 +1339,8 @@ CleanCode(PredEntry *pp USES_REGS)
pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred));
}
if (!(pp->PredFlags & NumberDBPredFlag)) {
if (pp->PredFlags & MultiFileFlag) {
if (pp->src.file_srcs)
pp->src.file_srcs = MFileAdjust(pp->src.file_srcs);
} else {
if (pp->src.OwnerFile)
pp->src.OwnerFile = AtomAdjust(pp->src.OwnerFile);
if (pp->src.OwnerFile) {
pp->src.OwnerFile = AtomAdjust(pp->src.OwnerFile);
}
}
pp->OpcodeOfPred = Yap_opcode(Yap_op_from_opcode(pp->OpcodeOfPred));

9
H/sshift.h
View File

@ -49,7 +49,6 @@
// #define IntegerAdjust(D) IntegerAdjust__(P PASS_REGS)
#define AddrAdjust(P) AddrAdjust__(P PASS_REGS)
#define BlockAdjust(P) BlockAdjust__(P PASS_REGS)
#define MFileAdjust(P) MFileAdjust__(P PASS_REGS)
#define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS)
#define ConstantAdjust(P) ConstantAdjust__(P PASS_REGS)
#define ArityAdjust(P) ArityAdjust__(P PASS_REGS)
@ -607,14 +606,6 @@ AtomEntryAdjust__ (AtomEntry * at USES_REGS)
return (AtomEntry *) ((AtomEntry *) (CharP (at) + LOCAL_HDiff));
}
inline EXTERN struct mfile *MFileAdjust__ (struct mfile * CACHE_TYPE);
inline EXTERN struct mfile *
MFileAdjust__ (struct mfile * at USES_REGS)
{
return (struct mfile *) (CharP (at) + LOCAL_HDiff);
}
inline EXTERN GlobalEntry *GlobalEntryAdjust__ (GlobalEntry * CACHE_TYPE);
inline EXTERN GlobalEntry *

123
pl/qly.yap
View File

@ -16,15 +16,120 @@
* *
*************************************************************************/
save_module(Mod) :-
atom_concat(Mod,'.qly',F),
open(F, write, S, [type(binary)]),
'$save_module_preds'(S, Mod),
qsave_program(File) :-
open(File, write, S, [type(binary)]),
'$qsave_program'(S),
close(S).
qsave_module(Mod) :-
recorded('$module', '$module'(F,Mod,Exps), _),
'$fetch_parents_module'(Mod, Parents),
'$fetch_imports_module'(Mod, Imps),
'$fetch_multi_files_module'(Mod, MFs),
'$fetch_meta_predicates_module'(Mod, Metas),
'$fetch_module_transparents_module'(Mod, ModTransps),
asserta(Mod:'@mod_info'(F, Exps, Parents, Imps, Metas, ModTransps)),
atom_concat(Mod,'.qly',OF),
open(OF, write, S, [type(binary)]),
'$qsave_module_preds'(S, Mod),
close(S),
abolish(Mod:'@mod_info'/6),
fail.
qsave_module(_).
qload_program(File) :-
open(File, read, S, [type(binary)]),
'$qload_module_preds'(S),
close(S).
read_module(Mod) :-
atom_concat(Mod,'.qly',F),
open(F, read, S, [type(binary)]),
'$read_module_preds'(S),
close(S).
qload_module(Mod) :-
atom_concat(Mod,'.qly',IF),
open(IF, read, S, [type(binary)]),
'$qload_module_preds'(S),
close(S),
fail.
qload_module(Mod) :-
'$complete_read'(Mod).
'$complete_read'(Mod) :-
retract(Mod:'@mod_info'(F, Exps, Parents, Imps, Metas, ModTransps)),
abolish(Mod:'$mod_info'/6),
recorda('$module', '$module'(F,Mod,Exps), _),
'$install_parents_module'(Mod, Parents),
'$install_imports_module'(Mod, Imps),
'$install_multi_files_module'(Mod, MFs),
'$install_meta_predicates_module'(Mod, Metas),
'$install_module_transparents_module'(Mod, ModTransps).
'$fetch_imports_module'(Mod, Imports) :-
findall(Info, '$fetch_import_module'(Mod, Info), Imports).
% detect an importerator that is local to the module.
'$fetch_import_module'(Mod, '$import'(Mod0,Mod,G0,G,N,K)) :-
recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _).
'$fetch_parents_module'(Mod, Parents) :-
findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents).
'$fetch_module_transparents_module'(Mod, Module_Transparents) :-
findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents).
% detect an module_transparenterator that is local to the module.
'$fetch_module_transparent_module'(Mod, '$module_transparent'(F,Mod,N,P)) :-
prolog:'$module_transparent'(F,Mod0,N,P), Mod0 == Mod.
'$fetch_meta_predicates_module'(Mod, Meta_Predicates) :-
findall(Info, '$fetch_meta_predicate_module'(Mod, Info), Meta_Predicates).
% detect an meta_predicateerator that is local to the module.
'$fetch_meta_predicate_module'(Mod, '$meta_predicate'(F,Mod,N,P)) :-
prolog:'$meta_predicate'(F,Mod0,N,P), Mod0 == Mod.
'$fetch_multi_files_module'(Mod, Multi_Files) :-
findall(Info, '$fetch_multi_file_module'(Mod, Info), Multi_Files).
% detect an multi_fileerator that is local to the module.
'$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _).
'$fetch_term_expansions_module'(Mod, Term_Expansions) :-
findall(Info, '$fetch_term_expansion_module'(Mod, Info), Term_Expansions).
% detect an term_expansionerator that is local to the module.
'$fetch_term_expansion_module'(Mod,'$defined'(FileName,Name,Arity,Mod)) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _).
'$install_ops_module'(_, []).
'$install_ops_module'(Mod, op(X,Y,Op).Ops) :-
op(X, Y, Mod:Op),
'$install_ops_module'(Mod, Ops).
'$install_imports_module'(_, []).
'$install_imports_module'(Mod, Import.Imports) :-
recordz('$import', Import, _),
'$install_imports_module'(Mod, Imports).
'$install_parents_module'(_, []).
'$install_parents_module'(Mod, Parent.Parents) :-
assert(prolog:Parent),
'$install_parents_module'(Mod, Parents).
'$install_module_transparents_module'(_, []).
'$install_module_transparents_module'(Mod, Module_Transparent.Module_Transparents) :-
assert(prolog:Module_Transparent),
'$install_module_transparents_module'(Mod, Module_Transparents).
'$install_meta_predicates_module'(_, []).
'$install_meta_predicates_module'(Mod, Meta_Predicate.Meta_Predicates) :-
assert(prolog:Meta_Predicate),
'$install_meta_predicates_module'(Mod, Meta_Predicates).
'$install_multi_files_module'(_, []).
'$install_multi_files_module'(Mod, Multi_File.Multi_Files) :-
recordz('$multifile_defs',Multi_File, _).
'$install_multi_files_module'(Mod, Multi_Files).