This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/qlyr.c

1179 lines
28 KiB
C
Raw Normal View History

2011-08-24 04:11:54 +01:00
/*************************************************************************
* *
* 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"
2013-04-25 23:15:04 +01:00
static void RestoreEntries(PropEntry *, int USES_REGS);
static void CleanCode(PredEntry * USES_REGS);
2011-08-24 04:11:54 +01:00
2011-08-28 01:23:14 +01:00
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,
2011-08-31 21:59:30 +01:00
UNKNOWN_DBREF = 7,
BAD_ATOM = 8,
MISMATCH = 9,
2011-09-01 14:20:21 +01:00
INCONSISTENT_CPRED = 10,
2014-10-02 14:57:50 +01:00
BAD_READ = 11,
BAD_HEADER = 12
2011-08-28 01:23:14 +01:00
} qlfr_err_t;
2013-01-18 14:29:41 +00:00
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",
2015-03-04 09:54:08 +00:00
"formatting mismatch in saved space",
2013-01-18 14:29:41 +00:00
"foreign predicate has different definition in saved space",
"bad read" };
2011-08-31 21:59:30 +01:00
static char *
Yap_AlwaysAllocCodeSpace(UInt size)
{
char *out;
while (!(out = Yap_AllocCodeSpace(size))) {
if (!Yap_growheap(FALSE, size, NULL)) {
return NULL;
}
}
return out;
}
2011-08-28 01:23:14 +01:00
static void
2011-10-21 19:12:21 +01:00
QLYR_ERROR(qlfr_err_t my_err)
2011-08-28 01:23:14 +01:00
{
2015-04-13 13:28:17 +01:00
// __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]);
2014-10-02 14:57:50 +01:00
Yap_exit(1);
2011-08-28 01:23:14 +01:00
}
2011-08-24 04:11:54 +01:00
static Atom
LookupAtom(Atom oat)
{
2015-04-13 13:28:17 +01:00
CACHE_REGS
2011-09-21 15:30:29 +01:00
CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
2011-08-24 04:11:54 +01:00
import_atom_hash_entry_t *a;
a = LOCAL_ImportAtomHashChain[hash];
while (a) {
if (a->oval == oat) {
return a->val;
}
a = a->next;
}
2015-04-13 13:28:17 +01:00
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ", oat);
2011-10-21 19:12:21 +01:00
QLYR_ERROR(UNKNOWN_ATOM);
2011-08-24 04:11:54 +01:00
return NIL;
}
static void
InsertAtom(Atom oat, Atom at)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 04:11:54 +01:00
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)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 04:11:54 +01:00
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;
}
2011-10-21 19:12:21 +01:00
QLYR_ERROR(UNKNOWN_FUNCTOR);
2011-08-24 04:11:54 +01:00
return NIL;
}
static void
InsertFunctor(Functor ofun, Functor fun)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 04:11:54 +01:00
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)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2014-09-23 22:37:08 +01:00
CELL hash;
2011-08-24 04:11:54 +01:00
import_pred_entry_hash_entry_t *p;
2014-09-23 22:37:08 +01:00
if (LOCAL_ImportPredEntryHashTableSize == 0)
return NULL;
hash = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
2011-08-24 04:11:54 +01:00
p = LOCAL_ImportPredEntryHashChain[hash];
while (p) {
if (p->oval == op) {
return p->val;
}
p = p->next;
}
2011-10-21 19:12:21 +01:00
QLYR_ERROR(UNKNOWN_PRED_ENTRY);
2011-08-24 04:11:54 +01:00
return NIL;
}
static void
InsertPredEntry(PredEntry *op, PredEntry *pe)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2014-09-23 22:37:08 +01:00
CELL hash;
2011-08-24 04:11:54 +01:00
import_pred_entry_hash_entry_t *p;
2014-09-23 22:37:08 +01:00
if (LOCAL_ImportPredEntryHashTableSize == 0)
2014-09-25 09:47:38 +01:00
return;
2014-09-23 22:37:08 +01:00
hash = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
2011-08-24 04:11:54 +01:00
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)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 12:40:06 +01:00
CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
2011-08-24 04:11:54 +01:00
import_opcode_hash_entry_t *f;
f = LOCAL_ImportOPCODEHashChain[hash];
while (f) {
if (f->oval == op) {
return f->val;
}
f = f->next;
}
2011-10-21 19:12:21 +01:00
QLYR_ERROR(UNKNOWN_OPCODE);
2011-08-24 04:11:54 +01:00
return NIL;
}
static int
OpcodeID(OPCODE op)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 12:40:06 +01:00
CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
2011-08-24 04:11:54 +01:00
import_opcode_hash_entry_t *f;
f = LOCAL_ImportOPCODEHashChain[hash];
while (f) {
if (f->oval == op) {
return f->id;
}
f = f->next;
}
2011-10-21 19:12:21 +01:00
QLYR_ERROR(UNKNOWN_OPCODE);
2011-08-24 04:11:54 +01:00
return NIL;
}
static void
2011-08-24 12:40:06 +01:00
InsertOPCODE(OPCODE op0, int i, OPCODE op)
2011-08-24 04:11:54 +01:00
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 12:40:06 +01:00
CELL hash = (CELL)(op0) % LOCAL_ImportOPCODEHashTableSize;
2011-08-24 04:11:54 +01:00
import_opcode_hash_entry_t *f;
f = LOCAL_ImportOPCODEHashChain[hash];
while (f) {
2011-08-24 12:40:06 +01:00
if (f->oval == op0) {
2011-08-24 04:11:54 +01:00
return;
}
f = f->next;
}
f = (import_opcode_hash_entry_t *)malloc(sizeof(import_opcode_hash_entry_t));
if (!f) {
return;
}
2011-08-24 12:40:06 +01:00
f->val = op;
f->oval = op0;
2011-08-24 04:11:54 +01:00
f->id = i;
f->next = LOCAL_ImportOPCODEHashChain[hash];
LOCAL_ImportOPCODEHashChain[hash] = f;
}
2011-08-31 21:59:30 +01:00
static DBRef
2012-06-12 14:50:36 +01:00
LookupDBRef(DBRef dbr, int inc_ref)
2011-08-31 21:59:30 +01:00
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2014-09-22 18:13:35 +01:00
CELL hash;
2011-08-31 21:59:30 +01:00
import_dbref_hash_entry_t *p;
2014-09-22 18:13:35 +01:00
if (LOCAL_ImportDBRefHashTableSize == 0)
return NULL;
hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
2011-08-31 21:59:30 +01:00
p = LOCAL_ImportDBRefHashChain[hash];
while (p) {
if (p->oval == dbr) {
2012-06-12 14:50:36 +01:00
if (inc_ref) {
p->count++;
}
2011-08-31 21:59:30 +01:00
return p->val;
}
p = p->next;
}
2011-10-21 19:12:21 +01:00
QLYR_ERROR(UNKNOWN_DBREF);
2011-08-31 21:59:30 +01:00
return NIL;
}
static LogUpdClause *
LookupMayFailDBRef(DBRef dbr)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2014-09-22 18:13:35 +01:00
CELL hash;
2011-08-31 21:59:30 +01:00
import_dbref_hash_entry_t *p;
2014-09-22 18:13:35 +01:00
if (LOCAL_ImportDBRefHashTableSize == 0)
return NULL;
hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
2011-08-31 21:59:30 +01:00
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)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-31 21:59:30 +01:00
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;
}
2011-08-24 04:11:54 +01:00
static void
InitHash(void)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 04:11:54 +01:00
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)
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 04:11:54 +01:00
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;
2011-08-31 21:59:30 +01:00
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) {
2012-08-23 15:04:58 +01:00
fprintf(stderr,"WARNING: unused reference %p %p\n",a->val, a->oval);
2011-08-31 21:59:30 +01:00
}
#endif
a = a->next;
free(a0);
}
}
LOCAL_ImportDBRefHashTableSize = 0;
free(LOCAL_ImportDBRefHashChain);
LOCAL_ImportDBRefHashChain = NULL;
2011-08-24 04:11:54 +01:00
}
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))
2015-04-13 13:28:17 +01:00
#define REINIT_LOCK(P)
#define REINIT_RWLOCK(P)
2011-08-24 04:11:54 +01:00
#define BlobTypeAdjust(P) (P)
#define NoAGCAtomAdjust(P) (P)
2015-04-13 13:28:17 +01:00
#define OrArgAdjust(P)
#define TabEntryAdjust(P)
2011-08-24 04:11:54 +01:00
#define IntegerAdjust(D) (D)
#define AddrAdjust(P) (P)
#define MFileAdjust(P) (P)
2011-08-25 03:20:20 +01:00
#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);
}
2011-08-24 04:11:54 +01:00
#define ConstantAdjust(P) (P)
#define ArityAdjust(P) (P)
2015-04-13 13:28:17 +01:00
#define DoubleInCodeAdjust(P)
#define IntegerInCodeAdjust(Pxb)
2011-08-24 04:11:54 +01:00
static inline PredEntry *
PtoPredAdjust(PredEntry *p)
{
return LookupPredEntry(p);
}
2011-08-24 12:40:06 +01:00
static inline PredEntry *
PredEntryAdjust(PredEntry *p)
{
return LookupPredEntry(p);
}
2011-08-24 04:11:54 +01:00
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
2011-08-25 03:20:20 +01:00
#define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS)
static inline DBTerm *
DBTermAdjust__ (DBTerm * dbtp USES_REGS)
{
2011-08-31 22:10:31 +01:00
return (DBTerm *) (CharP (dbtp) + LOCAL_HDiff);
2011-08-25 03:20:20 +01:00
}
2011-08-31 21:59:30 +01:00
#define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS)
static inline CELL *
CellPtoHeapAdjust__ (CELL * dbtp USES_REGS)
{
return (CELL *) (CharP (dbtp) + LOCAL_HDiff);
}
2011-08-24 04:11:54 +01:00
#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)
2011-08-31 21:59:30 +01:00
2012-06-12 14:50:36 +01:00
#define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS)
2011-08-31 21:59:30 +01:00
static inline DBRef
2012-06-12 14:50:36 +01:00
DBRefAdjust__ (DBRef dbtp, int do_reference USES_REGS)
2011-08-31 21:59:30 +01:00
{
2012-06-12 14:50:36 +01:00
return LookupDBRef(dbtp, do_reference);
2011-08-31 21:59:30 +01:00
}
#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS)
static inline DBRef *
DBRefPAdjust__ (DBRef * dbtp USES_REGS)
{
return (DBRef *) ((char *)(dbtp) + LOCAL_HDiff);
}
2011-08-24 04:11:54 +01:00
#define LUIndexAdjust(P) (P)
#define SIndexAdjust(P) (P)
#define LocalAddrAdjust(P) (P)
#define GlobalAddrAdjust(P) (P)
#define OpListAdjust(P) (P)
2011-08-31 21:59:30 +01:00
#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);
}
2011-08-24 04:11:54 +01:00
#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)
2011-08-25 03:20:20 +01:00
#define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS)
static inline CELL *
PtoHeapCellAdjust__ (CELL * ptr USES_REGS)
{
2011-08-31 21:59:30 +01:00
LogUpdClause *out;
if ((out = LookupMayFailDBRef((DBRef)ptr)))
return (CELL *)out;
2011-08-31 22:10:31 +01:00
return (CELL *) (CharP (ptr) + LOCAL_HDiff);
2011-08-25 03:20:20 +01:00
}
2011-08-24 04:11:54 +01:00
#define TermToGlobalAdjust(P) (P)
#define PtoOpAdjust(P) PtoOpAdjust__(P PASS_REGS)
static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) {
2011-08-31 21:59:30 +01:00
if (ptr) {
if (ptr == LOCAL_ImportFAILCODE)
return FAILCODE;
2011-08-24 04:11:54 +01:00
return (yamop *) ((char *) (ptr) + LOCAL_HDiff);
2011-08-31 21:59:30 +01:00
}
2011-08-24 04:11:54 +01:00
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)
2014-12-14 11:52:07 +00:00
#define CodeConstCharPAdjust(P) (P)
2011-08-24 04:11:54 +01:00
#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
2015-06-19 00:32:38 +01:00
read_bytes(FILE *stream, void *ptr, size_t sz)
2011-08-24 04:11:54 +01:00
{
2015-06-19 00:32:38 +01:00
return fread(ptr, sz, 1, stream);
2011-08-24 04:11:54 +01:00
}
static unsigned char
2015-06-19 00:32:38 +01:00
read_byte(FILE *stream)
2011-08-24 04:11:54 +01:00
{
2015-06-19 00:32:38 +01:00
return getc(stream);
2011-08-24 04:11:54 +01:00
}
2011-08-28 01:23:14 +01:00
static BITS16
2015-06-19 00:32:38 +01:00
read_bits16(FILE *stream)
2011-08-28 01:23:14 +01:00
{
BITS16 v;
2011-08-31 21:59:30 +01:00
read_bytes(stream, &v, sizeof(BITS16));
2011-08-28 01:23:14 +01:00
return v;
}
2011-08-24 04:11:54 +01:00
static UInt
2015-06-19 00:32:38 +01:00
read_UInt(FILE *stream)
2011-08-24 04:11:54 +01:00
{
UInt v;
read_bytes(stream, &v, sizeof(UInt));
return v;
}
static Int
2015-06-19 00:32:38 +01:00
read_Int(FILE *stream)
2011-08-24 04:11:54 +01:00
{
Int v;
read_bytes(stream, &v, sizeof(Int));
2011-08-24 04:11:54 +01:00
return v;
}
static qlf_tag_t
2015-06-19 00:32:38 +01:00
read_tag(FILE *stream)
2011-08-24 04:11:54 +01:00
{
int ch = read_byte(stream);
return ch;
}
2015-01-18 01:32:13 +00:00
static UInt
2015-06-19 00:32:38 +01:00
read_predFlags(FILE *stream)
{
pred_flags_t v;
read_bytes(stream, &v, sizeof(pred_flags_t));
return v;
}
2014-10-02 14:57:50 +01:00
static bool
2015-06-19 00:32:38 +01:00
checkChars(FILE *stream, char s[])
2014-10-02 14:57:50 +01:00
{
int ch, c;
char *p = s;
2015-04-13 13:28:17 +01:00
2014-10-02 14:57:50 +01:00
while ((ch = *p++)) {
if ((c = read_byte(stream)) != ch ) {
return false;
}
}
return TRUE;
}
static Atom
2015-06-19 00:32:38 +01:00
get_header(FILE *stream)
2011-08-31 21:59:30 +01:00
{
2014-10-02 14:57:50 +01:00
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 );
2011-08-31 21:59:30 +01:00
while ((ch = read_byte(stream)));
2014-10-02 14:57:50 +01:00
return at;
}
static Int
p_get_header( USES_REGS1 )
{
2015-06-19 00:32:38 +01:00
FILE *stream;
2014-10-02 14:57:50 +01:00
Term t1 = Deref(ARG1);
Atom at;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
return FALSE;
}
2015-06-19 00:32:38 +01:00
if (!(stream = Yap_GetInputStream(t1, "header scanning in qload")) ) {
2014-10-02 14:57:50 +01:00
return FALSE;
}
if ((at = get_header( stream )) == NIL)
return FALSE;
return Yap_unify( ARG2, MkAtomTerm( at ) );
2011-08-31 21:59:30 +01:00
}
2011-08-24 04:11:54 +01:00
static void
2015-06-19 00:32:38 +01:00
ReadHash(FILE *stream)
2011-08-24 04:11:54 +01:00
{
2011-09-21 15:30:29 +01:00
CACHE_REGS
2011-08-24 04:11:54 +01:00
UInt i;
RCHECK(read_tag(stream) == QLY_START_X);
LOCAL_XDiff = (char *)(&ARG1) - (char *)read_UInt(stream);
2011-08-24 04:11:54 +01:00
RCHECK(read_tag(stream) == QLY_START_OPCODES);
RCHECK(read_Int(stream) == _std_top);
2011-08-31 21:59:30 +01:00
for (i= 0; i <= _std_top; i++) {
InsertOPCODE((OPCODE)read_UInt(stream), i, Yap_opcode(i));
2011-08-24 04:11:54 +01:00
}
RCHECK(read_tag(stream) == QLY_START_ATOMS);
LOCAL_ImportAtomHashTableNum = read_UInt(stream);
2012-08-23 00:57:13 +01:00
LOCAL_ImportAtomHashTableSize = LOCAL_ImportAtomHashTableNum*2;
2012-08-23 15:04:58 +01:00
LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc(LOCAL_ImportAtomHashTableSize, sizeof(import_atom_hash_entry_t *));
2011-08-24 04:11:54 +01:00
for (i = 0; i < LOCAL_ImportAtomHashTableNum; i++) {
Atom oat = (Atom)read_UInt(stream);
2011-08-24 04:11:54 +01:00
Atom at;
qlf_tag_t tg = read_tag(stream);
2015-04-13 13:28:17 +01:00
2011-08-24 04:11:54 +01:00
if (tg == QLY_ATOM_WIDE) {
wchar_t *rep = (wchar_t *)AllocTempSpace();
UInt len;
len = read_UInt(stream);
2011-10-21 19:12:21 +01:00
if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE);
2011-08-24 04:11:54 +01:00
read_bytes(stream, rep, (len+1)*sizeof(wchar_t));
2011-08-31 21:59:30 +01:00
while (!(at = Yap_LookupWideAtom(rep))) {
if (!Yap_growheap(FALSE, 0, NULL)) {
exit(1);
}
}
2011-10-21 19:12:21 +01:00
if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE);
2011-08-24 04:11:54 +01:00
} else if (tg == QLY_ATOM) {
char *rep = (char *)AllocTempSpace();
UInt len;
len = read_UInt(stream);
2011-10-21 19:12:21 +01:00
if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE);
2011-08-24 04:11:54 +01:00
read_bytes(stream, rep, (len+1)*sizeof(char));
2011-08-31 21:59:30 +01:00
while (!(at = Yap_FullLookupAtom(rep))) {
if (!Yap_growheap(FALSE, 0, NULL)) {
exit(1);
}
}
2011-10-21 19:12:21 +01:00
if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE);
2011-08-24 04:11:54 +01:00
} else {
2011-10-21 19:12:21 +01:00
QLYR_ERROR(BAD_ATOM);
2011-08-31 21:59:30 +01:00
return;
2011-08-24 04:11:54 +01:00
}
InsertAtom(oat, at);
}
/* functors */
RCHECK(read_tag(stream) == QLY_START_FUNCTORS);
LOCAL_ImportFunctorHashTableNum = read_UInt(stream);
2012-08-23 00:57:13 +01:00
LOCAL_ImportFunctorHashTableSize = 2*LOCAL_ImportFunctorHashTableNum;
2012-08-23 15:04:58 +01:00
LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc(LOCAL_ImportFunctorHashTableSize, sizeof(import_functor_hash_entry_t *));
2011-08-24 04:11:54 +01:00
for (i = 0; i < LOCAL_ImportFunctorHashTableNum; i++) {
Functor of = (Functor)read_UInt(stream);
UInt arity = read_UInt(stream);
Atom oat = (Atom)read_UInt(stream);
2011-08-24 04:11:54 +01:00
Atom at = AtomAdjust(oat);
2011-08-31 21:59:30 +01:00
Functor f;
while (!(f = Yap_MkFunctor(at, arity))) {
if (!Yap_growheap(FALSE, 0, NULL)) {
exit(1);
}
}
2011-08-24 04:11:54 +01:00
InsertFunctor(of, f);
}
RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES);
LOCAL_ImportPredEntryHashTableNum = read_UInt(stream);
2012-08-23 00:57:13 +01:00
LOCAL_ImportPredEntryHashTableSize = 2*LOCAL_ImportPredEntryHashTableNum;
2012-08-23 15:04:58 +01:00
LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc( LOCAL_ImportPredEntryHashTableSize, sizeof(import_pred_entry_hash_entry_t *));
2011-08-24 04:11:54 +01:00
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;
2015-04-13 13:28:17 +01:00
if (omod) {
mod = MkAtomTerm(AtomAdjust(omod));
if (mod == TermProlog) mod = 0;
2011-10-13 16:46:29 +01:00
} else {
mod = TermProlog;
}
2011-08-28 01:23:14 +01:00
if (mod != IDB_MODULE) {
if (arity) {
Functor of = (Functor)read_UInt(stream);
2011-08-28 01:23:14 +01:00
Functor f = LookupFunctor(of);
while(!(pe = RepPredProp(PredPropByFuncAndMod(f,mod)))) {
2011-08-31 21:59:30 +01:00
if (!Yap_growheap(FALSE, 0, NULL)) {
exit(1);
}
}
2011-08-28 01:23:14 +01:00
} else {
Atom oa = (Atom)read_UInt(stream);
2011-08-28 01:23:14 +01:00
Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtomAndMod(a,mod));
2011-08-28 01:23:14 +01:00
}
2011-08-24 04:11:54 +01:00
} else {
2014-10-02 14:57:50 +01:00
/* IDB */
2011-08-28 01:23:14 +01:00
if (arity == (UInt)-1) {
UInt i = read_UInt(stream);
2011-08-28 01:23:14 +01:00
pe = Yap_FindLUIntKey(i);
} else if (arity == (UInt)(-2)) {
Atom oa = (Atom)read_UInt(stream);
2011-08-28 01:23:14 +01:00
Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtomAndMod(a,mod));
2014-10-02 14:57:50 +01:00
pe->PredFlags |= AtomDBPredFlag;
2011-08-28 01:23:14 +01:00
} else {
Functor of = (Functor)read_UInt(stream);
2011-08-28 01:23:14 +01:00
Functor f = LookupFunctor(of);
pe = RepPredProp(PredPropByFuncAndMod(f,mod));
2011-08-28 01:23:14 +01:00
}
2014-10-02 14:57:50 +01:00
pe->PredFlags |= LogUpdatePredFlag;
pe->ArityOfPE = 3;
2014-10-02 14:57:50 +01:00
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
pe->OpcodeOfPred = Yap_opcode(_op_fail);
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE;
}
2011-08-24 04:11:54 +01:00
}
InsertPredEntry(ope, pe);
}
2011-08-31 21:59:30 +01:00
RCHECK(read_tag(stream) == QLY_START_DBREFS);
LOCAL_ImportDBRefHashTableNum = read_UInt(stream);
2014-09-23 22:37:08 +01:00
LOCAL_ImportDBRefHashTableSize = 2*LOCAL_ImportDBRefHashTableNum+17;
2012-08-23 15:04:58 +01:00
LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc(LOCAL_ImportDBRefHashTableSize, sizeof(import_dbref_hash_entry_t *));
2011-08-31 21:59:30 +01:00
for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) {
LogUpdClause *ocl = (LogUpdClause *)read_UInt(stream);
UInt sz = read_UInt(stream);
UInt nrefs = read_UInt(stream);
2011-08-31 21:59:30 +01:00
LogUpdClause *ncl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(sz);
if (!ncl) {
2015-04-13 13:28:17 +01:00
QLYR_ERROR(OUT_OF_CODE_SPACE);
}
2011-08-31 21:59:30 +01:00
ncl->Id = FunctorDBRef;
ncl->ClRefCount = nrefs;
InsertDBRef((DBRef)ocl,(DBRef)ncl);
}
RCHECK(read_tag(stream) == QLY_FAILCODE);
LOCAL_ImportFAILCODE = (yamop *)read_UInt(stream);
2011-08-24 04:11:54 +01:00
}
static void
2015-06-19 00:32:38 +01:00
read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
2011-09-21 15:30:29 +01:00
CACHE_REGS
2015-04-13 13:28:17 +01:00
if (flags & LogUpdatePredFlag) {
2011-08-28 01:23:14 +01:00
/* 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);
}
2011-08-31 21:59:30 +01:00
if (!nclauses) {
return;
}
while ((read_tag(stream) == QLY_START_LU_CLAUSE)) {
char *base = (void *)read_UInt(stream);
UInt size = read_UInt(stream);
2011-08-31 21:59:30 +01:00
LogUpdClause *cl;
Int nrefs = 0;
2011-08-24 04:11:54 +01:00
2011-08-31 21:59:30 +01:00
if ((cl = LookupMayFailDBRef((DBRef)base))) {
nrefs = cl->ClRefCount;
} else {
cl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(size);
}
2011-08-24 04:11:54 +01:00
read_bytes(stream, cl, size);
2011-08-31 21:59:30 +01:00
cl->ClFlags &= ~InUseMask;
cl->ClRefCount = nrefs;
LOCAL_HDiff = (char *)cl-base;
2011-09-21 15:30:29 +01:00
RestoreLUClause(cl, pp PASS_REGS);
2011-08-24 04:11:54 +01:00
Yap_AssertzClause(pp, cl->ClCode);
}
2015-04-13 13:28:17 +01:00
} else if (flags & MegaClausePredFlag) {
2011-08-24 04:11:54 +01:00
CACHE_REGS
char *base = (void *)read_UInt(stream);
UInt mask = read_UInt(stream);
UInt size = read_UInt(stream);
2011-08-31 21:59:30 +01:00
MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size);
2011-08-24 04:11:54 +01:00
2011-08-28 01:23:14 +01:00
if (nclauses) {
Yap_Abolish(pp);
}
2011-08-24 04:11:54 +01:00
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
2013-01-11 18:36:34 +00:00
cl->ClFlags = mask;
2011-08-24 04:11:54 +01:00
pp->cs.p_code.FirstClause =
pp->cs.p_code.LastClause =
cl->ClCode;
pp->PredFlags |= MegaClausePredFlag;
/* enter index mode */
2015-04-13 13:28:17 +01:00
if (mask & ExoMask) {
struct index_t **icl = (struct index_t **)(cl->ClCode);
2013-01-11 18:36:34 +00:00
pp->OpcodeOfPred = Yap_opcode(_enter_exo);
icl[0] = NULL;
icl[1] = NULL;
} else {
pp->OpcodeOfPred = INDEX_OPCODE;
}
2015-04-13 13:28:17 +01:00
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);
2015-04-13 13:28:17 +01:00
} else if (flags & DynamicPredFlag) {
2011-08-24 04:11:54 +01:00
UInt i;
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_UInt(stream);
UInt size = read_UInt(stream);
2011-08-31 21:59:30 +01:00
DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size);
2015-04-13 13:28:17 +01:00
2011-08-24 04:11:54 +01:00
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
2011-09-20 11:36:49 +01:00
INIT_LOCK(cl->ClLock);
2011-09-21 15:30:29 +01:00
RestoreDynamicClause(cl, pp PASS_REGS);
2011-08-24 04:11:54 +01:00
Yap_AssertzClause(pp, cl->ClCode);
}
} else {
UInt i;
2011-08-28 01:23:14 +01:00
2015-04-13 13:28:17 +01:00
if (flags & SYSTEM_PRED_FLAGS) {
2011-08-28 01:23:14 +01:00
if (nclauses) {
2015-04-13 13:28:17 +01:00
QLYR_ERROR(INCONSISTENT_CPRED);
2011-08-28 01:23:14 +01:00
}
return;
}
Yap_Abolish(pp);
2011-08-24 04:11:54 +01:00
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_UInt(stream);
UInt size = read_UInt(stream);
2011-08-31 21:59:30 +01:00
StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size);
2011-08-24 04:11:54 +01:00
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
RestoreStaticClause(cl PASS_REGS);
Yap_AssertzClause(pp, cl->ClCode);
}
}
}
static void
2015-06-19 00:32:38 +01:00
read_pred(FILE *stream, Term mod) {
2015-04-13 13:28:17 +01:00
pred_flags_t flags, fl1;
UInt nclauses;
2011-08-24 04:11:54 +01:00
PredEntry *ap;
ap = LookupPredEntry((PredEntry *)read_UInt(stream));
flags = read_predFlags(stream);
nclauses = read_UInt(stream);
2011-08-31 21:59:30 +01:00
if (ap->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(ap);
}
2015-04-13 13:28:17 +01:00
#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);
2015-03-04 09:54:08 +00:00
/* printf(" %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); */
2015-04-13 13:28:17 +01:00
else if (ap->ModuleOfPred != IDB_MODULE)
__android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags);
2015-03-04 09:54:08 +00:00
/* printf(" %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); */
2015-04-13 13:28:17 +01:00
else
__android_log_print(ANDROID_LOG_INFO, "YAP "," number\n");
#endif
fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
2015-01-18 01:32:13 +00:00
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
2013-12-11 01:05:51 +00:00
ap->PredFlags |= fl1;
2011-08-28 01:23:14 +01:00
if (flags & NumberDBPredFlag) {
ap->src.IndxId = read_UInt(stream);
2011-08-28 01:23:14 +01:00
} else {
ap->src.OwnerFile = (Atom)read_UInt(stream);
2015-04-13 13:28:17 +01:00
if (ap->src.OwnerFile) {
2011-08-28 01:23:14 +01:00
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;
}
2015-04-13 13:28:17 +01:00
if (nclauses)
read_clauses(stream, ap, nclauses, flags);
2015-06-19 00:32:38 +01:00
#if DEBUG
//Yap_PrintPredName( ap );
#endif
2015-04-13 13:28:17 +01:00
if (flags & HiddenPredFlag) {
2015-01-18 01:32:13 +00:00
Yap_HidePred(ap);
2012-10-19 18:10:48 +01:00
}
2011-08-24 04:11:54 +01:00
}
2011-08-28 01:23:14 +01:00
static void
2015-06-19 00:32:38 +01:00
read_ops(FILE *stream) {
2011-08-28 01:23:14 +01:00
Int x;
while ((x = read_tag(stream)) != QLY_END_OPS) {
Atom at = (Atom)read_UInt(stream);
Term mod = (Term)read_UInt(stream);
2011-08-28 01:23:14 +01:00
OpEntry *op;
at = AtomAdjust(at);
2011-08-31 21:59:30 +01:00
if (mod)
mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
2011-08-28 01:23:14 +01:00
op = Yap_OpPropForModule(at, mod);
op->Prefix = read_bits16(stream);
op->Infix = read_bits16(stream);
op->Posfix = read_bits16(stream);
2011-09-20 11:36:49 +01:00
WRITE_UNLOCK(op->OpRWLock);
2011-08-28 01:23:14 +01:00
}
}
2011-08-24 04:11:54 +01:00
static void
2015-06-19 00:32:38 +01:00
read_module(FILE *stream) {
2011-08-31 21:59:30 +01:00
qlf_tag_t x;
2014-09-22 18:13:35 +01:00
InitHash();
2011-08-24 04:11:54 +01:00
ReadHash(stream);
2011-08-28 01:23:14 +01:00
while ((x = read_tag(stream)) == QLY_START_MODULE) {
Term mod = (Term)read_UInt(stream);
2014-09-22 18:13:35 +01:00
if (mod == 0)
mod = TermProlog;
2011-08-28 01:23:14 +01:00
mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
2011-08-31 21:59:30 +01:00
if (mod)
2014-09-22 18:13:35 +01:00
while ((x = read_tag(stream)) == QLY_START_PREDICATE) {
read_pred(stream, mod);
}
2011-08-24 04:11:54 +01:00
}
2011-08-28 01:23:14 +01:00
read_ops(stream);
2011-08-24 04:11:54 +01:00
CloseHash();
}
static Int
p_read_module_preds( USES_REGS1 )
{
2015-06-19 00:32:38 +01:00
FILE *stream;
Term t1 = Deref(ARG1);
2011-08-24 04:11:54 +01:00
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);
}
2015-06-19 00:32:38 +01:00
if (!(stream = Yap_GetInputStream(t1, "scanning preducate modules")) ) {
2011-08-24 04:11:54 +01:00
return FALSE;
}
2011-08-24 12:40:06 +01:00
read_module(stream);
2011-08-24 04:11:54 +01:00
return TRUE;
}
2012-04-15 00:01:02 +01:00
static void
ReInitProlog(void)
2012-04-15 00:01:02 +01:00
{
Term t = MkAtomTerm(AtomInitProlog);
2012-04-15 00:01:02 +01:00
YAP_RunGoalOnce(t);
}
2011-08-31 21:59:30 +01:00
static Int
2015-06-19 00:32:38 +01:00
qload_program( USES_REGS1 )
2011-08-31 21:59:30 +01:00
{
2015-06-19 00:32:38 +01:00
FILE *stream;
Term t1 = Deref(ARG1);
2011-08-31 21:59:30 +01:00
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
return FALSE;
}
2015-06-19 00:32:38 +01:00
if ((stream = Yap_GetInputStream(t1, "from read_program")) ) {
2011-08-31 21:59:30 +01:00
return FALSE;
}
2015-06-19 00:32:38 +01:00
Yap_Reset( YAP_RESET_FROM_RESTORE );
2014-10-02 14:57:50 +01:00
if (get_header( stream ) == NIL)
return FALSE;
2011-08-31 21:59:30 +01:00
read_module(stream);
2015-06-19 00:32:38 +01:00
fclose( stream );
2011-08-31 21:59:30 +01:00
/* back to the top level we go */
ReInitProlog();
2015-06-19 00:32:38 +01:00
return true;
2011-08-31 21:59:30 +01:00
}
2015-04-13 13:28:17 +01:00
int
2011-08-31 21:59:30 +01:00
Yap_Restore(char *s, char *lib_dir)
{
2015-04-13 13:32:32 +01:00
CACHE_REGS
2015-06-19 00:32:38 +01:00
FILE *stream = Yap_OpenRestore(s, lib_dir);
2015-04-13 13:28:17 +01:00
if (!stream)
2011-08-31 21:59:30 +01:00
return -1;
2013-01-18 14:29:41 +00:00
GLOBAL_RestoreFile = s;
2014-10-02 14:57:50 +01:00
if (get_header( stream ) == NIL)
return FALSE;
2011-08-31 21:59:30 +01:00
read_module(stream);
2015-06-19 00:32:38 +01:00
fclose( stream );
2013-01-18 14:29:41 +00:00
GLOBAL_RestoreFile = NULL;
2015-04-13 13:28:17 +01:00
CurrentModule = USER_MODULE;
2011-08-31 21:59:30 +01:00
return DO_ONLY_CODE;
}
2011-08-24 04:11:54 +01:00
void Yap_InitQLYR(void)
{
2015-06-19 00:32:38 +01:00
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);
2011-09-01 14:20:21 +01:00
if (FALSE) {
restore_codes();
}
2011-08-24 04:11:54 +01:00
}