From 51e635f0c9c41ccfaa2d4c83b8201b8c8899458b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 31 Aug 2011 13:59:30 -0700 Subject: [PATCH] more QLY stuff. --- C/c_interface.c | 27 ++-- C/init.c | 4 +- C/qlyr.c | 324 ++++++++++++++++++++++++++++++++++++++++-------- C/qlyw.c | 82 ++++++++++-- C/save.c | 42 +++++-- C/tracer.c | 8 ++ H/Yapproto.h | 4 +- H/Yatom.h | 2 +- H/dlocals.h | 14 +++ H/hlocals.h | 7 ++ H/ilocals.h | 7 ++ H/qly.h | 39 ++++-- H/rclause.h | 1 - H/rlocals.h | 7 ++ Makefile.in | 2 +- misc/LOCALS | 7 ++ pl/boot.yap | 17 ++- pl/init.yap | 27 +++- pl/preds.yap | 24 +++- pl/qly.yap | 33 ++++- 20 files changed, 570 insertions(+), 108 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 171539545..0cbff73e0 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2378,10 +2378,18 @@ YAP_RunGoalOnce(Term t) CACHE_REGS Term out; yamop *old_CP = CP; + Int oldPrologMode = LOCAL_PrologMode; + BACKUP_MACHINE_REGS(); LOCAL_PrologMode = UserMode; out = Yap_RunTopGoal(t); - LOCAL_PrologMode = UserCCallMode; + LOCAL_PrologMode = oldPrologMode; + if (!(oldPrologMode & UserCCallMode)) { + /* called from top-level */ + LOCAL_AllowRestart = FALSE; + RECOVER_MACHINE_REGS(); + return out; + } if (out) { choiceptr cut_pt, ob; @@ -2810,7 +2818,7 @@ construct_init_file(char *boot_file, char *BootFile) /* this routine is supposed to be called from an external program that wants to control Yap */ -#if defined(USE_SYSTEM_MALLOC) +#if defined(USE_SYSTEM_MALLOC) && FALSE #define BOOT_FROM_SAVED_STATE FALSE #else #define BOOT_FROM_SAVED_STATE TRUE @@ -2840,8 +2848,8 @@ YAP_Init(YAP_init_args *yap_init) yap_init->SavedState = NULL; } #endif - if (BOOT_FROM_SAVED_STATE && !do_bootstrap) { - if (Yap_SavedInfo (yap_init->SavedState, yap_init->YapLibDir, &Trail, &Stack, &Heap) != 1) { + if (FALSE && BOOT_FROM_SAVED_STATE && !do_bootstrap) { + if (Yap_SavedInfo (yap_init->SavedState, yap_init->YapLibDir, &Trail, &Stack, &Heap)) { yap_init->ErrorNo = LOCAL_Error_TYPE; yap_init->ErrorCause = LOCAL_ErrorMessage; return YAP_BOOT_ERROR; @@ -3146,9 +3154,14 @@ YAP_Reset(void) if (B != NULL) { while (B->cp_b != NULL) B = B->cp_b; - P = (yamop *)FAILCODE; - if (Yap_exec_absmi(0) != 0) - return(FALSE); + P = FAILCODE; + if (Yap_exec_absmi(0) != 0) { + GLOBAL_Initialised = TRUE; + + Yap_InitYaamRegs(); + RECOVER_MACHINE_REGS(); + return FALSE; + } } /* reinitialise the engine */ Yap_InitYaamRegs(); diff --git a/C/init.c b/C/init.c index 2daa79290..cc0d3cf93 100644 --- a/C/init.c +++ b/C/init.c @@ -796,9 +796,9 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, StaticClause *cl; yamop *code = ((StaticClause *)NULL)->ClCode; if (flags & UserCPredFlag) - pe->PredFlags = UserCPredFlag | CompiledPredFlag | StandardPredFlag | flags; + pe->PredFlags = UserCPredFlag | BackCPredFlag| CompiledPredFlag | StandardPredFlag | flags; else - pe->PredFlags = CompiledPredFlag | StandardPredFlag; + pe->PredFlags = CompiledPredFlag | StandardPredFlag | BackCPredFlag; #ifdef YAPOR pe->PredFlags |= SequentialPredFlag; diff --git a/C/qlyr.c b/C/qlyr.c index 0768871e3..caa6a6f0e 100644 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -16,8 +16,6 @@ * * *************************************************************************/ -#if DEBUG - #include #include "absmi.h" #include "Foreign.h" @@ -42,11 +40,24 @@ typedef enum { UNKNOWN_FUNCTOR = 4, UNKNOWN_PRED_ENTRY = 5, UNKNOWN_OPCODE = 6, - BAD_ATOM = 7, - MISMATCH = 8, - INCONSISTENT_CPRED = 8 + UNKNOWN_DBREF = 7, + BAD_ATOM = 8, + MISMATCH = 9, + INCONSISTENT_CPRED = 10 } qlfr_err_t; +static char * +Yap_AlwaysAllocCodeSpace(UInt size) +{ + char *out; + while (!(out = Yap_AllocCodeSpace(size))) { + if (!Yap_growheap(FALSE, size, NULL)) { + return NULL; + } + } + return out; +} + static void ERROR(qlfr_err_t my_err) { @@ -171,7 +182,6 @@ 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; } @@ -205,7 +215,6 @@ OpcodeID(OPCODE op) } f = f->next; } - fprintf(stderr,"-op = %lx\n", op); ERROR(UNKNOWN_OPCODE); return NIL; } @@ -233,6 +242,65 @@ InsertOPCODE(OPCODE op0, int i, OPCODE op) LOCAL_ImportOPCODEHashChain[hash] = f; } +static DBRef +LookupDBRef(DBRef dbr) +{ + CELL hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize; + import_dbref_hash_entry_t *p; + + p = LOCAL_ImportDBRefHashChain[hash]; + while (p) { + if (p->oval == dbr) { + p->count++; + return p->val; + } + p = p->next; + } + ERROR(UNKNOWN_DBREF); + return NIL; +} + +static LogUpdClause * +LookupMayFailDBRef(DBRef dbr) +{ + CELL hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize; + import_dbref_hash_entry_t *p; + + p = LOCAL_ImportDBRefHashChain[hash]; + while (p) { + if (p->oval == dbr) { + p->count++; + return (LogUpdClause *)p->val; + } + p = p->next; + } + return NULL; +} + +static void +InsertDBRef(DBRef dbr0, DBRef dbr) +{ + CELL hash = (CELL)(dbr0) % LOCAL_ImportDBRefHashTableSize; + import_dbref_hash_entry_t *p; + + p = LOCAL_ImportDBRefHashChain[hash]; + while (p) { + if (p->oval == dbr0) { + return; + } + p = p->next; + } + p = (import_dbref_hash_entry_t *)malloc(sizeof(import_dbref_hash_entry_t)); + if (!p) { + return; + } + p->val = dbr; + p->oval = dbr0; + p->count = 0; + p->next = LOCAL_ImportDBRefHashChain[hash]; + LOCAL_ImportDBRefHashChain[hash] = p; +} + static void InitHash(void) { @@ -244,6 +312,8 @@ InitHash(void) 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); + LOCAL_ImportDBRefHashTableSize = EXPORT_DBREF_TABLE_SIZE; + LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc(1, sizeof(import_dbref_hash_entry_t *)* LOCAL_ImportDBRefHashTableSize); } static void @@ -294,6 +364,22 @@ CloseHash(void) LOCAL_ImportPredEntryHashTableSize = 0; free(LOCAL_ImportPredEntryHashChain); LOCAL_ImportPredEntryHashChain = NULL; + for (i=0; i < LOCAL_ImportDBRefHashTableSize; i++) { + import_dbref_hash_entry_t *a = LOCAL_ImportDBRefHashChain[i]; + while (a) { + import_dbref_hash_entry_t *a0 = a; +#ifdef DEBUG + if (!a->count) { + fprintf(stderr,"WARNING: unused reference %p\n",a); + } +#endif + a = a->next; + free(a0); + } + } + LOCAL_ImportDBRefHashTableSize = 0; + free(LOCAL_ImportDBRefHashChain); + LOCAL_ImportDBRefHashChain = NULL; } static inline Atom @@ -410,7 +496,14 @@ DBTermAdjust__ (DBTerm * dbtp USES_REGS) { return (DBTerm *) ((DBTerm *) (CharP (dbtp) + LOCAL_HDiff)); } -#define CellPtoHeapAdjust(P) (P) + +#define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS) +static inline CELL * +CellPtoHeapAdjust__ (CELL * dbtp USES_REGS) +{ + return (CELL *) (CharP (dbtp) + LOCAL_HDiff); +} + #define PtoAtomHashEntryAdjust(P) (P) #define CellPtoHeapCellAdjust(P) (P) #define CellPtoTRAdjust(P) (P) @@ -419,14 +512,35 @@ DBTermAdjust__ (DBTerm * dbtp USES_REGS) #define DelayAddrAdjust(P) (P) #define DelayAdjust(P) (P) #define GlobalAdjust(P) (P) -#define DBRefAdjust(P) (P) -#define DBRefPAdjust(P) (P) + +#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS) +static inline DBRef +DBRefAdjust__ (DBRef dbtp USES_REGS) +{ + return LookupDBRef(dbtp); +} + +#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS) +static inline DBRef * +DBRefPAdjust__ (DBRef * dbtp USES_REGS) +{ + return (DBRef *) ((char *)(dbtp) + LOCAL_HDiff); +} + #define LUIndexAdjust(P) (P) #define SIndexAdjust(P) (P) #define LocalAddrAdjust(P) (P) #define GlobalAddrAdjust(P) (P) #define OpListAdjust(P) (P) -#define PtoLUCAdjust(P) (P) + +#define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS) +#define PtoLUClauseAdjust(P) PtoLUCAdjust__(P PASS_REGS) +static inline LogUpdClause * +PtoLUCAdjust__ (LogUpdClause * dbtp USES_REGS) +{ + return (LogUpdClause *) ((char *)(dbtp) + LOCAL_HDiff); +} + #define PtoStCAdjust(P) (P) #define PtoArrayEAdjust(P) (P) #define PtoArraySAdjust(P) (P) @@ -439,17 +553,22 @@ DBTermAdjust__ (DBTerm * dbtp USES_REGS) static inline CELL * PtoHeapCellAdjust__ (CELL * ptr USES_REGS) { + LogUpdClause *out; + if ((out = LookupMayFailDBRef((DBRef)ptr))) + return (CELL *)out; return (CELL *) (((CELL *) (CharP (ptr) + LOCAL_HDiff))); } #define TermToGlobalAdjust(P) (P) #define PtoOpAdjust(P) PtoOpAdjust__(P PASS_REGS) static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) { - if (ptr) + if (ptr) { + if (ptr == LOCAL_ImportFAILCODE) + return FAILCODE; return (yamop *) ((char *) (ptr) + LOCAL_HDiff); + } return ptr; } -#define PtoLUClauseAdjust(P) (P) #define PtoLUIndexAdjust(P) (P) #define PtoDBTLAdjust(P) (P) #define PtoPtoPredAdjust(P) (P) @@ -503,14 +622,14 @@ read_bytes(IOSTREAM *stream, void *ptr, size_t sz) static unsigned char read_byte(IOSTREAM *stream) { - return Sgetc(stream); + return Sgetc(stream); } static BITS16 read_bits16(IOSTREAM *stream) { BITS16 v; - return read_bytes(stream, &v, sizeof(BITS16)); + read_bytes(stream, &v, sizeof(BITS16)); return v; } @@ -537,6 +656,13 @@ read_tag(IOSTREAM *stream) return ch; } +static void +read_header(IOSTREAM *stream) +{ + int ch; + while ((ch = read_byte(stream))); +} + static void ReadHash(IOSTREAM *stream) { @@ -545,7 +671,7 @@ ReadHash(IOSTREAM *stream) 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++) { + for (i= 0; i <= _std_top; i++) { InsertOPCODE((OPCODE)read_uint(stream), i, Yap_opcode(i)); } RCHECK(read_tag(stream) == QLY_START_ATOMS); @@ -562,7 +688,11 @@ ReadHash(IOSTREAM *stream) 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); + while (!(at = Yap_LookupWideAtom(rep))) { + if (!Yap_growheap(FALSE, 0, NULL)) { + exit(1); + } + } if (at == NIL) ERROR(OUT_OF_ATOM_SPACE); } else if (tg == QLY_ATOM) { char *rep = (char *)AllocTempSpace(); @@ -571,10 +701,15 @@ ReadHash(IOSTREAM *stream) len = read_uint(stream); if (!EnoughTempSpace(len)) ERROR(OUT_OF_TEMP_SPACE); read_bytes(stream, rep, (len+1)*sizeof(char)); - at = Yap_LookupAtom(rep); + while (!(at = Yap_FullLookupAtom(rep))) { + if (!Yap_growheap(FALSE, 0, NULL)) { + exit(1); + } + } if (at == NIL) ERROR(OUT_OF_ATOM_SPACE); } else { ERROR(BAD_ATOM); + return; } InsertAtom(oat, at); } @@ -586,7 +721,12 @@ ReadHash(IOSTREAM *stream) UInt arity = read_uint(stream); Atom oat = (Atom)read_uint(stream); Atom at = AtomAdjust(oat); - Functor f = Yap_MkFunctor(at, arity); + Functor f; + while (!(f = Yap_MkFunctor(at, arity))) { + if (!Yap_growheap(FALSE, 0, NULL)) { + exit(1); + } + } InsertFunctor(of, f); } RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES); @@ -600,7 +740,11 @@ ReadHash(IOSTREAM *stream) if (arity) { Functor of = (Functor)read_uint(stream); Functor f = LookupFunctor(of); - pe = RepPredProp(PredPropByFunc(f,mod)); + while(!(pe = RepPredProp(PredPropByFunc(f,mod)))) { + if (!Yap_growheap(FALSE, 0, NULL)) { + exit(1); + } + } } else { Atom oa = (Atom)read_uint(stream); Atom a = LookupAtom(oa); @@ -622,18 +766,29 @@ ReadHash(IOSTREAM *stream) } InsertPredEntry(ope, pe); } + RCHECK(read_tag(stream) == QLY_START_DBREFS); + LOCAL_ImportDBRefHashTableNum = read_uint(stream); + for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) { + LogUpdClause *ocl = (LogUpdClause *)read_uint(stream); + UInt sz = read_uint(stream); + UInt nrefs = read_uint(stream); + LogUpdClause *ncl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(sz); + ncl->Id = FunctorDBRef; + ncl->ClRefCount = nrefs; + InsertDBRef((DBRef)ocl,(DBRef)ncl); + } + RCHECK(read_tag(stream) == QLY_FAILCODE); + LOCAL_ImportFAILCODE = (yamop *)read_uint(stream); } static void read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { if (pp->PredFlags & LogUpdatePredFlag) { - UInt i; + pp->TimeStampOfPred = 0L; /* 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; @@ -641,13 +796,24 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { cl = ncl; } while (cl != NULL); } - for (i = 0; i < nclauses; i++) { + if (!nclauses) { + return; + } + while ((read_tag(stream) == QLY_START_LU_CLAUSE)) { char *base = (void *)read_uint(stream); UInt size = read_uint(stream); - LogUpdClause *cl = (LogUpdClause *)Yap_AllocCodeSpace(size); + LogUpdClause *cl; + Int nrefs = 0; + if ((cl = LookupMayFailDBRef((DBRef)base))) { + nrefs = cl->ClRefCount; + } else { + cl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(size); + } read_bytes(stream, cl, size); - LOCAL_HDiff = base-(char *)cl; + cl->ClFlags &= ~InUseMask; + cl->ClRefCount = nrefs; + LOCAL_HDiff = (char *)cl-base; RestoreLUClause(cl, pp); Yap_AssertzClause(pp, cl->ClCode); } @@ -655,7 +821,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { CACHE_REGS char *base = (void *)read_uint(stream); UInt size = read_uint(stream); - MegaClause *cl = (MegaClause *)Yap_AllocCodeSpace(size); + MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size); if (nclauses) { Yap_Abolish(pp); @@ -672,7 +838,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { for (i = 0; i < nclauses; i++) { char *base = (void *)read_uint(stream); UInt size = read_uint(stream); - DynamicClause *cl = (DynamicClause *)Yap_AllocCodeSpace(size); + DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size); LOCAL_HDiff = (char *)cl-base; read_bytes(stream, cl, size); @@ -684,7 +850,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { UInt i; - if (pp->PredFlags & (UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) { + if (pp->PredFlags & SYSTEM_PRED_FLAGS) { if (nclauses) { ERROR(INCONSISTENT_CPRED); } @@ -694,7 +860,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { for (i = 0; i < nclauses; i++) { char *base = (void *)read_uint(stream); UInt size = read_uint(stream); - StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace(size); + StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size); LOCAL_HDiff = (char *)cl-base; read_bytes(stream, cl, size); @@ -706,29 +872,52 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) { static void read_pred(IOSTREAM *stream, Term mod) { + UInt flags = read_uint(stream); UInt arity = read_uint(stream); - UInt nclauses, flags, fl1; + UInt nclauses, fl1; PredEntry *ap; - if (arity) { - Functor f; - - f = LookupFunctor((Functor)read_uint(stream)); - if ((ap = RepPredProp(PredPropByFunc(f,mod))) == NULL) { - ERROR(OUT_OF_CODE_SPACE); + if (mod == IDB_MODULE) { + if (flags & AtomDBPredFlag) { + Atom a = LookupAtom((Atom)read_uint(stream)); + if ((ap = RepPredProp(PredPropByAtom(a,mod))) == NULL) { + ERROR(OUT_OF_CODE_SPACE); + } + } else if (flags & NumberDBPredFlag) { + Int i = (Int)read_uint(stream); + if ((ap = Yap_FindLUIntKey(i)) == NULL) { + ERROR(OUT_OF_CODE_SPACE); + } + } else { + Functor 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 (arity) { + Functor f; - if ((ap = RepPredProp(PredPropByAtom(a,mod))) == NULL) { - ERROR(OUT_OF_CODE_SPACE); + f = LookupFunctor((Functor)read_uint(stream)); + if ((ap = RepPredProp(PredPropByFunc(f,mod))) == NULL) { + ERROR(OUT_OF_CODE_SPACE); + } + } else { + Atom a; + + 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; - fl1 = flags & (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag); + if (ap->PredFlags & IndexedPredFlag) { + Yap_RemoveIndexation(ap); + } + fl1 = flags & STATIC_PRED_FLAGS; + ap->PredFlags &= ~STATIC_PRED_FLAGS; ap->PredFlags |= fl1; if (flags & NumberDBPredFlag) { ap->src.IndxId = read_uint(stream); @@ -746,11 +935,12 @@ read_ops(IOSTREAM *stream) { Int x; while ((x = read_tag(stream)) != QLY_END_OPS) { Atom at = (Atom)read_uint(stream); - Term mod; + Term mod = (Term)read_uint(stream); OpEntry *op; at = AtomAdjust(at); - mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod))); + if (mod) + mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod))); op = Yap_OpPropForModule(at, mod); op->Prefix = read_bits16(stream); op->Infix = read_bits16(stream); @@ -762,21 +952,20 @@ read_ops(IOSTREAM *stream) { static void read_module(IOSTREAM *stream) { CACHE_REGS - Int x; + qlf_tag_t x; + InitHash(); + read_header(stream); ReadHash(stream); 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))); + if (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); } - fprintf(stderr,"xb = %ld\n", x); read_ops(stream); CloseHash(); } @@ -793,12 +982,41 @@ p_read_module_preds( USES_REGS1 ) return TRUE; } -#endif +static Int +p_read_program( USES_REGS1 ) +{ + IOSTREAM *stream; + void YAP_Reset(void); + + if (!Yap_getInputStream(Yap_InitSlot(Deref(ARG1) PASS_REGS), &stream)) { + return FALSE; + } + YAP_Reset(); + read_module(stream); + Sclose( stream ); + /* back to the top level we go */ + Yap_CloseSlots(); + + siglongjmp(LOCAL_RestartEnv, 3); + return TRUE; +} + +int +Yap_Restore(char *s, char *lib_dir) +{ + CACHE_REGS + IOSTREAM *stream = Yap_OpenRestore(s, lib_dir); + if (!stream) + return -1; + read_module(stream); + Sclose( stream ); + return DO_ONLY_CODE; +} + void Yap_InitQLYR(void) { -#if DEBUG Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|HiddenPredFlag|UserCPredFlag); -#endif + Yap_InitCPred("$qload_program", 1, p_read_program, SyncPredFlag|HiddenPredFlag|UserCPredFlag); } diff --git a/C/qlyw.c b/C/qlyw.c index b05598e62..11a04fe8a 100644 --- a/C/qlyw.c +++ b/C/qlyw.c @@ -16,8 +16,6 @@ * * *************************************************************************/ -#if DEBUG - #include #include "absmi.h" #include "Foreign.h" @@ -138,6 +136,32 @@ LookupPredEntry(PredEntry *pe) LOCAL_ExportPredEntryHashTableNum++; } +static void +LookupDBRef(DBRef ref) +{ + CELL hash = Unsigned(ref) % LOCAL_ExportDBRefHashTableSize; + export_dbref_hash_entry_t *a; + + a = LOCAL_ExportDBRefHashChain[hash]; + while (a) { + if (a->val == ref) { + a->refs++; + return; + } + a = a->next; + } + a = (export_dbref_hash_entry_t *)malloc(sizeof(export_dbref_hash_entry_t)); + if (!a) { + return; + } + a->val = ref; + a->sz = ((LogUpdClause *)ref)->ClSize; + a->refs = 1; + a->next = LOCAL_ExportDBRefHashChain[hash]; + LOCAL_ExportDBRefHashChain[hash] = a; + LOCAL_ExportDBRefHashTableNum++; +} + static void InitHash(void) { @@ -150,6 +174,9 @@ InitHash(void) LOCAL_ExportPredEntryHashTableNum = 0; 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); + LOCAL_ExportDBRefHashTableNum = 0; + LOCAL_ExportDBRefHashTableSize = EXPORT_DBREF_TABLE_SIZE; + LOCAL_ExportDBRefHashChain = (export_dbref_hash_entry_t **)calloc(1, sizeof(export_dbref_hash_entry_t *)* LOCAL_ExportDBRefHashTableSize); } static void @@ -164,6 +191,9 @@ CloseHash(void) LOCAL_ExportPredEntryHashTableNum = 0; LOCAL_ExportPredEntryHashTableSize = 0L; free(LOCAL_ExportPredEntryHashChain); + LOCAL_ExportDBRefHashTableNum = 0; + LOCAL_ExportDBRefHashTableSize = 0L; + free(LOCAL_ExportDBRefHashChain); } static inline Atom @@ -264,7 +294,15 @@ PtoPredAdjust(PredEntry *pe) #define DelayAddrAdjust(P) (P) #define DelayAdjust(P) (P) #define GlobalAdjust(P) (P) -#define DBRefAdjust(P) (P) + +#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS) +static inline DBRef +DBRefAdjust__ (DBRef dbt USES_REGS) +{ + LookupDBRef(dbt); + return dbt; +} + #define DBRefPAdjust(P) (P) #define DBTermAdjust(P) (P) #define LUIndexAdjust(P) (P) @@ -360,7 +398,7 @@ SaveHash(IOSTREAM *stream) save_uint(stream, (UInt)&ARG1); CHECK(save_tag(stream, QLY_START_OPCODES)); save_int(stream, _std_top); - for (i= 0; i < _std_top; i++) { + for (i= 0; i <= _std_top; i++) { save_uint(stream, (UInt)Yap_opcode(i)); } CHECK(save_tag(stream, QLY_START_ATOMS)); @@ -411,6 +449,21 @@ SaveHash(IOSTREAM *stream) free(p0); } } + save_tag(stream, QLY_START_DBREFS); + save_uint(stream, LOCAL_ExportDBRefHashTableNum); + for (i = 0; i < LOCAL_ExportDBRefHashTableSize; i++) { + export_dbref_hash_entry_t *p = LOCAL_ExportDBRefHashChain[i]; + while (p) { + export_dbref_hash_entry_t *p0 = p; + CHECK(save_uint(stream, (UInt)(p->val))); + CHECK(save_uint(stream, p->sz)); + CHECK(save_uint(stream, p->refs)); + p = p->next; + free(p0); + } + } + save_tag(stream, QLY_FAILCODE); + save_uint(stream, (UInt)FAILCODE); return 1; } @@ -430,12 +483,14 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) { if (pp->TimeStampOfPred >= cl->ClTimeStart && pp->TimeStampOfPred <= cl->ClTimeEnd) { UInt size = cl->ClSize; + CHECK(save_tag(stream, QLY_START_LU_CLAUSE)); CHECK(save_uint(stream, (UInt)cl)); CHECK(save_uint(stream, size)); CHECK(save_bytes(stream, cl, size)); } cl = cl->ClNext; } + CHECK(save_tag(stream, QLY_END_LU_CLAUSES)); } else if (pp->PredFlags & MegaClausePredFlag) { MegaClause *cl = ClauseCodeToMegaClause(FirstC); UInt size = cl->ClSize; @@ -459,6 +514,9 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) { } else { StaticClause *cl = ClauseCodeToStaticClause(FirstC); + if (pp->PredFlags & SYSTEM_PRED_FLAGS) { + return 1; + } do { UInt size = cl->ClSize; @@ -474,9 +532,9 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) { static size_t save_pred(IOSTREAM *stream, PredEntry *ap) { + CHECK(save_uint(stream, ap->PredFlags)); 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)); CHECK(save_uint(stream, ap->src.IndxId)); return save_clauses(stream, ap); @@ -579,12 +637,22 @@ save_module(IOSTREAM *stream, Term mod) { return 1; } +int +save_header(IOSTREAM *stream) +{ + char msg[256]; + + sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s", YAP_BINDIR, YAP_SVERSION); + return save_bytes(stream, msg, strlen(msg)+1); +} + static size_t save_program(IOSTREAM *stream) { CACHE_REGS ModEntry *me = CurrentModules; InitHash(); + save_header( stream ); /* should we allow the user to see hidden predicates? */ while (me) { PredEntry *pp; @@ -651,13 +719,9 @@ p_save_program( USES_REGS1 ) return save_program(stream) != 0; } -#endif - void Yap_InitQLY(void) { -#if DEBUG 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 } diff --git a/C/save.c b/C/save.c index c148f802d..dd69ecb20 100644 --- a/C/save.c +++ b/C/save.c @@ -18,6 +18,7 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90"; #endif +#include "SWI-Stream.h" #if _MSC_VER || defined(__MINGW32__) #include #include @@ -122,7 +123,7 @@ STATIC_PROTO(void restore_heap, (void)); STATIC_PROTO(void ShowAtoms, (void)); STATIC_PROTO(void ShowEntries, (PropEntry *)); #endif -STATIC_PROTO(int OpenRestore, (char *, char *, CELL *, CELL *, CELL *, CELL *)); +STATIC_PROTO(int OpenRestore, (char *, char *, CELL *, CELL *, CELL *, CELL *, IOSTREAM **)); STATIC_PROTO(void CloseRestore, (void)); #ifndef _WIN32 STATIC_PROTO(int check_opcodes, (OPCODE [])); @@ -1414,10 +1415,14 @@ cat_file_name(char *s, char *prefix, char *name, unsigned int max_length) strncat(s, name, max_length-1); } -static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, char *buf) { +static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, char *buf, IOSTREAM **streamp) { int mode; - + if (streamp) { + if ((*streamp = Sopen_file(inpf, "rb"))) + return FAIL_RESTORE; + return DO_ONLY_CODE; + } if ((splfild = open_file(inpf, O_RDONLY)) < 0) { return FAIL_RESTORE; } @@ -1432,7 +1437,7 @@ static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL * } static int -OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap) +OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, IOSTREAM **streamp) { CACHE_REGS int mode = FAIL_RESTORE; @@ -1464,7 +1469,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac strncat(LOCAL_FileNameBuf, inpf, YAP_FILENAME_MAX-1); } if (inpf != NULL && (splfild = open_file(inpf, O_RDONLY)) > 0) { - if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { return mode; } } @@ -1475,11 +1480,11 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac */ if (YapLibDir != NULL) { cat_file_name(LOCAL_FileNameBuf, Yap_LibDir, inpf, YAP_FILENAME_MAX); - if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { return mode; } } else { - if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { return mode; } } @@ -1488,7 +1493,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac char *yap_env = getenv("YAPLIBDIR"); if (yap_env != NULL) { cat_file_name(LOCAL_FileNameBuf, yap_env, inpf, YAP_FILENAME_MAX); - if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { return mode; } } @@ -1497,7 +1502,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac if (YAP_LIBDIR != NULL) { cat_file_name(LOCAL_FileNameBuf, YAP_LIBDIR, inpf, YAP_FILENAME_MAX); if ((splfild = open_file(LOCAL_FileNameBuf, O_RDONLY)) > 0) { - if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { return mode; } } @@ -1537,7 +1542,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac pt[1] = '\0'; strncat(LOCAL_FileNameBuf,"lib/Yap/startup.yss",YAP_FILENAME_MAX); } - if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { return mode; } } @@ -1557,6 +1562,15 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac return FAIL_RESTORE; } +IOSTREAM * +Yap_OpenRestore(char *inpf, char *YapLibDir) +{ + IOSTREAM *stream = NULL; + + OpenRestore(inpf, YapLibDir, NULL, NULL, NULL, NULL, &stream); + return stream; +} + static void CloseRestore(void) { @@ -1636,10 +1650,12 @@ RestoreHeap(OPCODE old_ops[] USES_REGS) int Yap_SavedInfo(char *FileName, char *YapLibDir, CELL *ATrail, CELL *AStack, CELL *AHeap) { + return DO_ONLY_CODE; + CELL MyTrail, MyStack, MyHeap, MyState; int mode; - mode = OpenRestore(FileName, YapLibDir, &MyState, &MyTrail, &MyStack, &MyHeap); + mode = OpenRestore(FileName, YapLibDir, &MyState, &MyTrail, &MyStack, &MyHeap, NULL); if (mode == FAIL_RESTORE) { return -1; } @@ -1730,7 +1746,7 @@ Restore(char *s, char *lib_dir USES_REGS) OPCODE old_ops[_std_top+1]; CELL MyTrail, MyStack, MyHeap, MyState; - if ((restore_mode = OpenRestore(s, lib_dir, &MyState, &MyTrail, &MyStack, &MyHeap)) == FAIL_RESTORE) + if ((restore_mode = OpenRestore(s, lib_dir, &MyState, &MyTrail, &MyStack, &MyHeap, NULL)) == FAIL_RESTORE) return(FALSE); Yap_ShutdownLoadForeign(); in_limbo = TRUE; @@ -1784,7 +1800,7 @@ Restore(char *s, char *lib_dir USES_REGS) } int -Yap_Restore(char *s, char *lib_dir) +Yap_SavedStateRestore(char *s, char *lib_dir) { CACHE_REGS return Restore(s, lib_dir PASS_REGS); diff --git a/C/tracer.c b/C/tracer.c index 36f0094b1..fc82b2134 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -23,6 +23,7 @@ #include "YapHeap.h" #include "attvar.h" #include "yapio.h" +#include "clause.h" #include "tracer.h" STATIC_PROTO(int TracePutchar, (int, int)); @@ -167,6 +168,13 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCAL_ThreadHandle.thread_inst_count++; #endif #ifdef COMMENTED + { + choiceptr b_p = B; + while (b_p) { + fprintf(stderr,"%p %ld\n",b_p,Yap_op_from_opcode(b_p->cp_ap->opc)); + b_p = b_p->cp_b; + } + } { choiceptr myB = B; while (myB) myB = myB->cp_b; } diff --git a/H/Yapproto.h b/H/Yapproto.h index 4b0a36dbe..0b713443e 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -310,11 +310,13 @@ void STD_PROTO(Yap_InitReadUtil,(void)); /* qly.c */ void STD_PROTO(Yap_InitQLY,(void)); +int STD_PROTO(Yap_Restore,(char *, char *)); void STD_PROTO(Yap_InitQLYR,(void)); /* save.c */ int STD_PROTO(Yap_SavedInfo,(char *,char *,CELL *,CELL *,CELL *)); -int STD_PROTO(Yap_Restore,(char *, char *)); +int STD_PROTO(Yap_SavedStateRestore,(char *, char *)); +struct io_stream *STD_PROTO(Yap_OpenRestore,(char *, char *)); void STD_PROTO(Yap_InitSavePreds,(void)); /* scanner.c */ diff --git a/H/Yatom.h b/H/Yatom.h index 639853405..da5b1979c 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -674,7 +674,7 @@ typedef enum TabledPredFlag = 0x00000040L, /* is tabled */ SequentialPredFlag = 0x00000020L, /* may not create parallel choice points! */ ProfiledPredFlag = 0x00000010L, /* pred is being profiled */ - /* MyddasPredFlag = 0x00000008L, Myddas Imported pred */ + BackCPredFlag = 0x00000008L, /* Myddas Imported pred */ ModuleTransparentPredFlag = 0x00000004L, /* ModuleTransparent pred */ SWIEnvPredFlag = 0x00000002L, /* new SWI interface */ UDIPredFlag = 0x00000001L /* User Defined Indexing */ diff --git a/H/dlocals.h b/H/dlocals.h index 19c098eb0..796a5a2df 100644 --- a/H/dlocals.h +++ b/H/dlocals.h @@ -347,6 +347,12 @@ #define REMOTE_ExportPredEntryHashTableSize(wid) REMOTE(wid)->ExportPredEntryHashTableSize_ #define LOCAL_ExportPredEntryHashTableNum LOCAL->ExportPredEntryHashTableNum_ #define REMOTE_ExportPredEntryHashTableNum(wid) REMOTE(wid)->ExportPredEntryHashTableNum_ +#define LOCAL_ExportDBRefHashChain LOCAL->ExportDBRefHashChain_ +#define REMOTE_ExportDBRefHashChain(wid) REMOTE(wid)->ExportDBRefHashChain_ +#define LOCAL_ExportDBRefHashTableSize LOCAL->ExportDBRefHashTableSize_ +#define REMOTE_ExportDBRefHashTableSize(wid) REMOTE(wid)->ExportDBRefHashTableSize_ +#define LOCAL_ExportDBRefHashTableNum LOCAL->ExportDBRefHashTableNum_ +#define REMOTE_ExportDBRefHashTableNum(wid) REMOTE(wid)->ExportDBRefHashTableNum_ #define LOCAL_ImportAtomHashChain LOCAL->ImportAtomHashChain_ #define REMOTE_ImportAtomHashChain(wid) REMOTE(wid)->ImportAtomHashChain_ #define LOCAL_ImportAtomHashTableSize LOCAL->ImportAtomHashTableSize_ @@ -369,4 +375,12 @@ #define REMOTE_ImportPredEntryHashTableSize(wid) REMOTE(wid)->ImportPredEntryHashTableSize_ #define LOCAL_ImportPredEntryHashTableNum LOCAL->ImportPredEntryHashTableNum_ #define REMOTE_ImportPredEntryHashTableNum(wid) REMOTE(wid)->ImportPredEntryHashTableNum_ +#define LOCAL_ImportDBRefHashChain LOCAL->ImportDBRefHashChain_ +#define REMOTE_ImportDBRefHashChain(wid) REMOTE(wid)->ImportDBRefHashChain_ +#define LOCAL_ImportDBRefHashTableSize LOCAL->ImportDBRefHashTableSize_ +#define REMOTE_ImportDBRefHashTableSize(wid) REMOTE(wid)->ImportDBRefHashTableSize_ +#define LOCAL_ImportDBRefHashTableNum LOCAL->ImportDBRefHashTableNum_ +#define REMOTE_ImportDBRefHashTableNum(wid) REMOTE(wid)->ImportDBRefHashTableNum_ +#define LOCAL_ImportFAILCODE LOCAL->ImportFAILCODE_ +#define REMOTE_ImportFAILCODE(wid) REMOTE(wid)->ImportFAILCODE_ diff --git a/H/hlocals.h b/H/hlocals.h index 8fd130d41..e16640167 100644 --- a/H/hlocals.h +++ b/H/hlocals.h @@ -198,6 +198,9 @@ typedef struct worker_local { struct export_pred_entry_hash_entry_struct **ExportPredEntryHashChain_; UInt ExportPredEntryHashTableSize_; UInt ExportPredEntryHashTableNum_; + struct export_dbref_hash_entry_struct **ExportDBRefHashChain_; + UInt ExportDBRefHashTableSize_; + UInt ExportDBRefHashTableNum_; struct import_atom_hash_entry_struct **ImportAtomHashChain_; UInt ImportAtomHashTableSize_; UInt ImportAtomHashTableNum_; @@ -209,4 +212,8 @@ typedef struct worker_local { struct import_pred_entry_hash_entry_struct **ImportPredEntryHashChain_; UInt ImportPredEntryHashTableSize_; UInt ImportPredEntryHashTableNum_; + struct import_dbref_hash_entry_struct **ImportDBRefHashChain_; + UInt ImportDBRefHashTableSize_; + UInt ImportDBRefHashTableNum_; + yamop *ImportFAILCODE_; } w_local; diff --git a/H/ilocals.h b/H/ilocals.h index 0361ee57b..8547c4494 100644 --- a/H/ilocals.h +++ b/H/ilocals.h @@ -198,6 +198,9 @@ static void InitWorker(int wid) { REMOTE_ExportPredEntryHashChain(wid) = NULL; REMOTE_ExportPredEntryHashTableSize(wid) = 0; REMOTE_ExportPredEntryHashTableNum(wid) = 0; + REMOTE_ExportDBRefHashChain(wid) = NULL; + REMOTE_ExportDBRefHashTableSize(wid) = 0; + REMOTE_ExportDBRefHashTableNum(wid) = 0; REMOTE_ImportAtomHashChain(wid) = NULL; REMOTE_ImportAtomHashTableSize(wid) = 0; REMOTE_ImportAtomHashTableNum(wid) = 0; @@ -209,4 +212,8 @@ static void InitWorker(int wid) { REMOTE_ImportPredEntryHashChain(wid) = NULL; REMOTE_ImportPredEntryHashTableSize(wid) = 0; REMOTE_ImportPredEntryHashTableNum(wid) = 0; + REMOTE_ImportDBRefHashChain(wid) = NULL; + REMOTE_ImportDBRefHashTableSize(wid) = 0; + REMOTE_ImportDBRefHashTableNum(wid) = 0; + REMOTE_ImportFAILCODE(wid) = NULL; } diff --git a/H/qly.h b/H/qly.h index e699bb4a7..a46096fd3 100644 --- a/H/qly.h +++ b/H/qly.h @@ -20,6 +20,7 @@ #define EXPORT_FUNCTOR_TABLE_SIZE (16*4096) #define EXPORT_OPCODE_TABLE_SIZE (4096) #define EXPORT_PRED_ENTRY_TABLE_SIZE (128) +#define EXPORT_DBREF_TABLE_SIZE (128) typedef struct export_atom_hash_entry_struct { Atom val; @@ -69,22 +70,44 @@ typedef struct import_pred_entry_hash_entry_struct { struct import_pred_entry_hash_entry_struct *next; } import_pred_entry_hash_entry_t; +typedef struct export_dbref_hash_entry_struct { + DBRef val; + UInt sz; + UInt refs; + struct export_dbref_hash_entry_struct *next; +} export_dbref_hash_entry_t; + +typedef struct import_dbref_hash_entry_struct { + DBRef val; + DBRef oval; + int count; + struct import_dbref_hash_entry_struct *next; +} import_dbref_hash_entry_t; + typedef enum { 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 + QLY_START_DBREFS = 5, + QLY_START_MODULE = 6, + QLY_END_MODULES = 7, + QLY_START_LU_CLAUSE = 8, + QLY_END_LU_CLAUSES = 9, + QLY_NEW_OP = 10, + QLY_END_OPS = 11, + QLY_START_PREDICATE = 12, + QLY_END_PREDICATES = 13, + QLY_ATOM_WIDE = 14, + QLY_FAILCODE = 15, + QLY_ATOM = 16 } qlf_tag_t; +#define STATIC_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|BackCPredFlag) + +#define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag) + #define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next))) #define CHECK(F) { size_t r = (F); if (!r) return r; } diff --git a/H/rclause.h b/H/rclause.h index b709eafe9..9541aa78b 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -11,7 +11,6 @@ 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]); diff --git a/H/rlocals.h b/H/rlocals.h index 8da42dded..02aa07679 100644 --- a/H/rlocals.h +++ b/H/rlocals.h @@ -201,6 +201,13 @@ static void RestoreWorker(int wid USES_REGS) { + + + + + + + diff --git a/Makefile.in b/Makefile.in index fcb49ff39..90f5fd769 100644 --- a/Makefile.in +++ b/Makefile.in @@ -712,7 +712,7 @@ all: startup.yss startup.yss: yap@EXEC_SUFFIX@ $(PL_SOURCES) -rm -f startup.yss - echo "bootstrap('$(srcdir)/pl/init.yap'). module(user). save_program('startup.yss')." | @PRE_INSTALL_ENV@ ./yap -b $(srcdir)/pl/boot.yap + echo "bootstrap('$(srcdir)/pl/init.yap'). module(user). qsave_program('startup.yss')." | @PRE_INSTALL_ENV@ ./yap -b $(srcdir)/pl/boot.yap yap@EXEC_SUFFIX@: $(HEADERS) yap.o @YAPLIB@ $(MPI_CC) $(EXECUTABLE_CFLAGS) $(LDFLAGS) -o yap yap.o @YAPLIB@ $(LIBS) @MPI_LIBS@ diff --git a/misc/LOCALS b/misc/LOCALS index 8dc22279d..b4ccb1e9d 100644 --- a/misc/LOCALS +++ b/misc/LOCALS @@ -224,6 +224,9 @@ UInt ExportFunctorHashTableNum =0 struct export_pred_entry_hash_entry_struct **ExportPredEntryHashChain =NULL UInt ExportPredEntryHashTableSize =0 UInt ExportPredEntryHashTableNum =0 +struct export_dbref_hash_entry_struct **ExportDBRefHashChain =NULL +UInt ExportDBRefHashTableSize =0 +UInt ExportDBRefHashTableNum =0 struct import_atom_hash_entry_struct **ImportAtomHashChain =NULL UInt ImportAtomHashTableSize =0 UInt ImportAtomHashTableNum =0 @@ -235,5 +238,9 @@ UInt ImportOPCODEHashTableSize =0 struct import_pred_entry_hash_entry_struct **ImportPredEntryHashChain =NULL UInt ImportPredEntryHashTableSize =0 UInt ImportPredEntryHashTableNum =0 +struct import_dbref_hash_entry_struct **ImportDBRefHashChain =NULL +UInt ImportDBRefHashTableSize =0 +UInt ImportDBRefHashTableNum =0 +yamop *ImportFAILCODE =NULL END_WORKER_LOCAL diff --git a/pl/boot.yap b/pl/boot.yap index 36c29462c..888d88d79 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -36,6 +36,13 @@ true :- true. '$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)). '$init_system' :- + ( + '$undefined'('$init_preds',prolog) + -> + true + ; + '$init_state' + ), % do catch as early as possible ( '$access_yap_flags'(15, 0), @@ -202,7 +209,6 @@ true :- true. '$enter_top_level' :- get_value('$top_level_goal',GA), GA \= [], !, set_value('$top_level_goal',[]), - format('hello1 ~w~n',[GA]), '$run_atom_goal'(GA), set_value('$live','$false'). '$enter_top_level' :- @@ -221,23 +227,24 @@ true :- true. % % first, recover what we need from the saved state... % -'$startup_saved_state' :- +'$startup_saved_state' :- !. +'$do_saved_state' :- '$init_path_extensions', fail. % use if we come from a save_program and we have SWI's shlib -'$startup_saved_state' :- +'$do_saved_state' :- recorded('$reload_foreign_libraries',G,R), erase(R), shlib:reload_foreign_libraries, fail. % use if we come from a save_program and we have a goal to execute -'$startup_saved_state' :- +'$do_saved_state' :- recorded('$restore_goal',G,R), erase(R), prompt(_,'| '), '$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)), fail. -'$startup_saved_state'. +'$do_saved_state'. % then recover program. '$startup_reconsult' :- diff --git a/pl/init.yap b/pl/init.yap index 681e1a52a..34f6c7e5c 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -38,7 +38,30 @@ otherwise. :- set_value('$doindex',true). -% force having indexing code for throw. +% just create a choice-point +% the 6th argument marks the time-stamp. +'$do_log_upd_clause'(_,_,_,_,_,_). +'$do_log_upd_clause'(A,B,C,D,E,_) :- + '$continue_log_update_clause'(A,B,C,D,E). +'$do_log_upd_clause'(_,_,_,_,_,_). + + +'$do_log_upd_clause_erase'(_,_,_,_,_,_). +'$do_log_upd_clause_erase'(A,B,C,D,E,_) :- + '$continue_log_update_clause_erase'(A,B,C,D,E). +'$do_log_upd_clause_erase'(_,_,_,_,_,_). + +'$do_log_upd_clause0'(_,_,_,_,_,_). +'$do_log_upd_clause0'(A,B,C,D,_,_) :- + '$continue_log_update_clause'(A,B,C,D). +'$do_log_upd_clause0'(_,_,_,_,_,_). + + +'$do_static_clause'(_,_,_,_,_). +'$do_static_clause'(A,B,C,D,E) :- + '$continue_static_clause'(A,B,C,D,E). +'$do_static_clause'(_,_,_,_,_). + :- '$handle_throw'(_,_,_), !. :- bootstrap('errors.yap'). @@ -216,6 +239,8 @@ user:prolog_file_type(A, executable) :- :- multifile user:portray_message/2. +:- dynamic user:portray_message/2. + :- multifile user:exception/3. :- dynamic user:exception/3. diff --git a/pl/preds.yap b/pl/preds.yap index 4ad149317..2ab2aacbe 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -311,28 +311,42 @@ clause(V,Q,R) :- '$continue_log_update_clause'(A,B,C,D,E). '$do_log_upd_clause'(_,_,_,_,_,_). -:- '$do_log_upd_clause'(_,_,_,_,_,_), !. '$do_log_upd_clause_erase'(_,_,_,_,_,_). '$do_log_upd_clause_erase'(A,B,C,D,E,_) :- '$continue_log_update_clause_erase'(A,B,C,D,E). '$do_log_upd_clause_erase'(_,_,_,_,_,_). -:- '$do_log_upd_clause_erase'(_,_,_,_,_,_), !. - '$do_log_upd_clause0'(_,_,_,_,_,_). '$do_log_upd_clause0'(A,B,C,D,_,_) :- '$continue_log_update_clause'(A,B,C,D). '$do_log_upd_clause0'(_,_,_,_,_,_). -:- '$do_log_upd_clause0'(_,_,_,_,_,_), !. '$do_static_clause'(_,_,_,_,_). '$do_static_clause'(A,B,C,D,E) :- '$continue_static_clause'(A,B,C,D,E). '$do_static_clause'(_,_,_,_,_). -:- '$do_static_clause'(_,_,_,_,_), !. + +'$init_preds' :- + once('$handle_throw'(_,_,_)), + fail. +'$init_preds' :- + once('$do_static_clause'(_,_,_,_,_)), + fail. +'$init_preds' :- + once('$do_log_upd_clause0'(_,_,_,_,_,_)), + fail. +'$init_preds' :- + once('$do_log_upd_clause'(_,_,_,_,_,_)), + fail. +'$init_preds' :- + once('$do_log_upd_clause_erase'(_,_,_,_,_,_)), + fail. +'$init_preds'. + +:- '$init_preds'. nth_clause(V,I,R) :- var(V), var(R), !, '$do_error'(instantiation_error,nth_clause(V,I,R)). diff --git a/pl/qly.yap b/pl/qly.yap index 85e8737b3..cda13bee0 100644 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -17,10 +17,41 @@ *************************************************************************/ qsave_program(File) :- + '$save_program_status', open(File, write, S, [type(binary)]), '$qsave_program'(S), close(S). +'$save_program_status' :- + findall(F:V,yap_flag(F,V),L), + recordz('$program_state',L,_). + +'$init_state' :- + recorded('$program_state', _, _), !, + '$do_init_state'. +'$init_state'. + +'$do_init_state' :- + '$init_preds', + fail. +'$do_init_state' :- + recorded('$program_state',L,R), + erase(R), + lists:member(F:V,L), + catch(yap_flag(F,V),_,fail), + fail. +'$do_init_state' :- + set_value('$user_module',user), '$protect'. +'$do_init_state' :- + '$current_module'(prolog), + module(user), + fail. +'$do_init_state' :- + '$init_system', + fail. +'$do_init_state'. + + qsave_module(Mod) :- recorded('$module', '$module'(F,Mod,Exps), _), '$fetch_parents_module'(Mod, Parents), @@ -39,7 +70,7 @@ qsave_module(_). qload_program(File) :- open(File, read, S, [type(binary)]), - '$qload_module_preds'(S), + '$qload_program'(S), close(S). qload_module(Mod) :-