diff --git a/C/absmi.c b/C/absmi.c index 499801bf2..87250d96c 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,11 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2007-10-28 11:23:39 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-06 17:02:08 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.227 2007/10/28 11:23:39 vsc +* fix overflow +* * Revision 1.226 2007/10/28 00:54:09 vsc * new version of viterbi implementation * fix all:atvars reporting bad info @@ -4311,6 +4314,42 @@ Yap_absmi(int inp) FAIL(); #endif ENDOp(); + + + Op(get_dbterm, xc); + BEGD(d0); + d0 = XREG(PREG->u.xc.x); + deref_head(d0, gdbterm_unk); + + gdbterm_nonvar: + BEGD(d1); + /* we have met a preexisting dbterm */ + d1 = XREG(PREG->u.xc.c); + PREG = NEXTOP(PREG, xc); + UnifyBound(d0,d1); + ENDD(d1); + + BEGP(pt0); + deref_body(d0, pt0, gdbterm_unk, gdbterm_nonvar); + /* Enter Write mode */ + /* set d1 to be the new structure we are going to create */ + START_PREFETCH(xc); + BEGD(d1); + d1 = PREG->u.xc.c; + PREG = NEXTOP(PREG, xc); + BIND(pt0, d1, bind_gdbterm); +#ifdef COROUTINING + DO_TRAIL(pt0, d1); + if (pt0 < H0) Yap_WakeUp(pt0); + bind_gdbterm: +#endif + GONext(); + ENDD(d1); + END_PREFETCH(); + ENDP(pt0); + + ENDD(d0); + ENDOp(); /************************************************************************\ * Optimised Get List Instructions * @@ -6340,7 +6379,7 @@ Yap_absmi(int inp) derefa_body(d0, pt0, ubigint_unk, ubigint_nonvar); BEGD(d1); - d1 = AbsAppl(PREG->u.oi.i); + d1 = PREG->u.oc.c; PREG = NEXTOP(PREG, oi); BIND_GLOBAL(pt0, d1, bind_ubigint); #ifdef COROUTINING @@ -6402,6 +6441,66 @@ Yap_absmi(int inp) #endif ENDOp(); + Op(unify_dbterm, oc); + BEGD(d0); + BEGP(pt0); + pt0 = SREG++; + d0 = *pt0; + deref_head(d0, udbterm_unk); + udbterm_nonvar: + BEGD(d1); + /* we have met a preexisting dbterm */ + d1 = XREG(PREG->u.oc.c); + PREG = NEXTOP(PREG, oc); + UnifyBound(d0,d1); + ENDD(d1); + + derefa_body(d0, pt0, udbterm_unk, udbterm_nonvar); + BEGD(d1); + d1 = AbsAppl(PREG->u.oi.i); + PREG = NEXTOP(PREG, oi); + BIND_GLOBAL(pt0, d1, bind_udbterm); +#ifdef COROUTINING + DO_TRAIL(pt0, d1); + if (pt0 < H0) Yap_WakeUp(pt0); + bind_udbterm: +#endif + GONext(); + ENDD(d1); + ENDP(pt0); + ENDD(d0); + ENDOp(); + + Op(unify_l_dbterm, oc); + BEGD(d0); + CACHE_S(); + READ_IN_S(); + d0 = *S_SREG; + deref_head(d0, uldbterm_unk); + uldbterm_nonvar: + BEGD(d1); + /* we have met a preexisting dbterm */ + d1 = XREG(PREG->u.oc.c); + PREG = NEXTOP(PREG, oc); + UnifyBound(d0,d1); + ENDD(d1); + + derefa_body(d0, S_SREG, uldbterm_unk, uldbterm_nonvar); + BEGD(d1); + d1 = PREG->u.oc.c; + PREG = NEXTOP(PREG, oc); + BIND_GLOBAL(S_SREG, d1, bind_uldbterm); +#ifdef COROUTINING + DO_TRAIL(S_SREG, d1); + if (S_SREG < H0) Yap_WakeUp(S_SREG); + bind_uldbterm: +#endif + GONext(); + ENDD(d1); + ENDCACHE_S(); + ENDD(d0); + ENDOp(); + OpW(unify_list_write, o); PREG = NEXTOP(PREG, o); BEGD(d0); diff --git a/C/adtdefs.c b/C/adtdefs.c index 6cfa732db..d8c3b3701 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -558,7 +558,7 @@ Yap_GetExpPropHavingLock(AtomEntry *ae, unsigned int arity) return (p0); } -static void +static int ExpandPredHash(void) { UInt new_size = PredHashTableSize+PredHashIncrement; @@ -567,7 +567,7 @@ ExpandPredHash(void) UInt i; if (!np) { - Yap_Error(FATAL_ERROR,TermNil,"Could not allocate space for pred table"); + return FALSE; } for (i = 0; i < new_size; i++) { np[i] = NULL; @@ -586,6 +586,7 @@ ExpandPredHash(void) PredHashTableSize = new_size; PredHash = np; Yap_FreeAtomSpace((ADDR)oldp); + return TRUE; } /* fe is supposed to be locked */ @@ -594,6 +595,44 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) { PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p)); + if (p == NULL) { + WRITE_UNLOCK(fe->FRWLock); + return NULL; + } + if (fe->PropsOfFE) { + UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize); + + WRITE_LOCK(PredHashRWLock); + if (10*(PredsInHashTable+1) > 6*PredHashTableSize) { + if (!ExpandPredHash()) { + Yap_FreeCodeSpace((ADDR)p); + WRITE_UNLOCK(PredHashRWLock); + WRITE_UNLOCK(fe->FRWLock); + return NULL; + } + /* retry hashing */ + hsh = PRED_HASH(fe, cur_mod, PredHashTableSize); + } + PredsInHashTable++; + if (p->ModuleOfPred == 0L) { + PredEntry *pe = RepPredProp(fe->PropsOfFE); + + hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize); + /* should be the first one */ + pe->NextOfPE = AbsPredProp(PredHash[hsh]); + PredHash[hsh] = pe; + fe->PropsOfFE = AbsPredProp(p); + } else { + p->NextOfPE = AbsPredProp(PredHash[hsh]); + PredHash[hsh] = p; + } + WRITE_UNLOCK(PredHashRWLock); + /* make sure that we have something here */ + RepPredProp(fe->PropsOfFE)->NextOfPE = fe->PropsOfFE; + } else { + fe->PropsOfFE = AbsPredProp(p); + p->NextOfPE = NIL; + } INIT_RWLOCK(p->PRWLock); INIT_LOCK(p->PELock); p->KindOfPE = PEProp; @@ -630,33 +669,6 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) } } p->FunctorOfPred = fe; - if (fe->PropsOfFE) { - UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize); - - WRITE_LOCK(PredHashRWLock); - if (p->ModuleOfPred == 0L) { - PredEntry *pe = RepPredProp(fe->PropsOfFE); - - hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize); - /* should be the first one */ - pe->NextOfPE = AbsPredProp(PredHash[hsh]); - PredHash[hsh] = pe; - fe->PropsOfFE = AbsPredProp(p); - } else { - p->NextOfPE = AbsPredProp(PredHash[hsh]); - PredHash[hsh] = p; - } - PredsInHashTable++; - if (10*PredsInHashTable > 6*PredHashTableSize) { - ExpandPredHash(); - } - WRITE_UNLOCK(PredHashRWLock); - /* make sure that we have something here */ - RepPredProp(fe->PropsOfFE)->NextOfPE = fe->PropsOfFE; - } else { - fe->PropsOfFE = AbsPredProp(p); - p->NextOfPE = NIL; - } WRITE_UNLOCK(fe->FRWLock); #ifdef LOW_PROF if (ProfilerOn && diff --git a/C/agc.c b/C/agc.c index b8b9c07dd..fee2e81ac 100644 --- a/C/agc.c +++ b/C/agc.c @@ -147,6 +147,7 @@ AtomAdjust(Atom a) #define PtoOpAdjust(P) (P) #define PtoLUClauseAdjust(P) (P) #define PtoLUIndexAdjust(P) (P) +#define PtoDBTLAdjust(P) (P) #define PtoPredAdjust(P) (P) #define PropAdjust(P) (P) #define TrailAddrAdjust(P) (P) diff --git a/C/amasm.c b/C/amasm.c index f251eeeb2..d02a1d225 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,11 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2007-06-23 17:31:50 $ * +* Last rev: $Date: 2007-11-06 17:02:09 $ * * $Log: not supported by cvs2svn $ +* Revision 1.95 2007/06/23 17:31:50 vsc +* pin cluses with floats. +* * Revision 1.94 2006/12/27 01:32:37 vsc * diverse fixes * @@ -237,7 +240,7 @@ STATIC_PROTO(yamop *a_xigl, (op_numbers, yamop *, int, struct PSEUDO *)); STATIC_PROTO(yamop *a_ucons, (int *, compiler_vm_op, yamop *, int, struct intermediates *)); STATIC_PROTO(yamop *a_uvar, (yamop *, int, struct intermediates *)); STATIC_PROTO(yamop *a_wvar, (yamop *, int, struct intermediates *)); -STATIC_PROTO(yamop *do_pass, (int, yamop **, int, int *, struct intermediates *, UInt)); +STATIC_PROTO(yamop *do_pass, (int, yamop **, int, int *, int *,struct intermediates *, UInt)); #ifdef DEBUG_OPCODES STATIC_PROTO(void DumpOpCodes, (void)); #endif @@ -439,6 +442,14 @@ add_clref(CELL clause_code, int pass_no) } } +static void +add_to_dbtermsl(struct intermediates *cip, Term t) +{ + DBTerm *dbt = TermToDBTerm(t); + dbt->ag.NextDBT = cip->dbterml->dbterms; + cip->dbterml->dbterms = dbt; +} + static yamop * a_lucl(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip, clause_info *cla) { @@ -809,6 +820,19 @@ a_blob(CELL rnd1, op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int return code_p; } +inline static yamop * +a_wdbt(CELL rnd1, op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip) +{ + if (pass_no) { + code_p->opc = emit_op(opcode); + code_p->u.c.c = rnd1; + add_to_dbtermsl(cip, cip->cpc->rnd1); + } + *clause_has_dbtermp = TRUE; + GONEXT(c); + return code_p; +} + inline static yamop * a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip) { @@ -824,6 +848,20 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs return code_p; } +inline static yamop * +a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip) +{ + if (pass_no) { + code_p->opc = emit_op(opcode); + code_p->u.oc.opcw = emit_op(opcode_w); + code_p->u.oc.c = cip->cpc->rnd1; + add_to_dbtermsl(cip, cip->cpc->rnd1); + } + *clause_has_dbtermp = TRUE; + GONEXT(oc); + return code_p; +} + inline static yamop * a_ud(op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_no, struct PSEUDO *cpc) { @@ -1050,6 +1088,20 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru return code_p; } +inline static yamop * +a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip) +{ + if (pass_no) { + code_p->opc = emit_op(opcode); + code_p->u.xc.x = emit_x(cip->cpc->rnd2); + code_p->u.xc.c = cip->cpc->rnd1; + add_to_dbtermsl(cip, cip->cpc->rnd1); + } + *clause_has_dbtermp = TRUE; + GONEXT(xc); + return code_p; +} + inline static yamop * a_rli(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip) { @@ -2631,7 +2683,7 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed #endif /* YAPOR */ static yamop * -do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp, struct intermediates *cip, UInt size) +do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp, int *clause_has_dbtermp, struct intermediates *cip, UInt size) { #ifdef YAPOR #define EITHER_INST 50 @@ -2687,6 +2739,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp if (*clause_has_blobsp) { cl_u->luc.ClFlags |= HasBlobsMask; } + if (*clause_has_dbtermp) { + cl_u->luc.ClFlags |= HasDBTMask; + } cl_u->luc.ClExt = NULL; cl_u->luc.ClPrev = cl_u->luc.ClNext = NULL; #if defined(YAPOR) || defined(THREADS) @@ -2701,6 +2756,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp if (*clause_has_blobsp) { cl_u->ic.ClFlags |= HasBlobsMask; } + if (*clause_has_dbtermp) { + cl_u->ic.ClFlags |= HasDBTMask; + } cl_u->ic.ClSize = size; cl_u->ic.ClRefCount = 0; #if defined(YAPOR) || defined(THREADS) @@ -2719,6 +2777,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp if (*clause_has_blobsp) { cl_u->sc.ClFlags |= HasBlobsMask; } + if (*clause_has_dbtermp) { + cl_u->sc.ClFlags |= HasDBTMask; + } } code_p = cl_u->sc.ClCode; } @@ -2869,6 +2930,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp case get_bigint_op: code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip); break; + case get_dbterm_op: + code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip); + break; case put_num_op: case put_atom_op: code_p = a_rc(_put_atom, code_p, pass_no, cip); @@ -2884,6 +2948,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp case put_bigint_op: code_p = a_rb(_put_atom, clause_has_blobsp, code_p, pass_no, cip); break; + case put_dbterm_op: + code_p = a_dbt(_put_atom, clause_has_dbtermp, code_p, pass_no, cip); + break; case get_list_op: code_p = a_glist(&do_not_optimise_uatom, code_p, pass_no, cip); break; @@ -2941,6 +3008,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp case unify_bigint_op: code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip); break; + case unify_dbterm_op: + code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write, clause_has_dbtermp, code_p, pass_no, cip); + break; case unify_last_num_op: case unify_last_atom_op: code_p = a_uc(cip->cpc->rnd1, _unify_l_atom, _unify_l_atom_write, code_p, pass_no); @@ -2956,6 +3026,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp case unify_last_bigint_op: code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip); break; + case unify_last_dbterm_op: + code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write, clause_has_dbtermp, code_p, pass_no, cip); + break; case write_num_op: case write_atom_op: code_p = a_ucons(&do_not_optimise_uatom, write_atom_op, code_p, pass_no, cip); @@ -2971,6 +3044,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp case write_bigint_op: code_p = a_blob(cip->cpc->rnd1, _write_atom, clause_has_blobsp, code_p, pass_no, cip); break; + case write_dbterm_op: + code_p = a_wdbt(cip->cpc->rnd1, _write_atom, clause_has_dbtermp, code_p, pass_no, cip); + break; case unify_list_op: code_p = a_ue(_unify_list, _unify_list_write, code_p, pass_no); break; @@ -3026,7 +3102,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp case cutexit_op: code_p = a_cut(&clinfo, code_p, pass_no, cip); if (cip->CurrentPred->PredFlags & LogUpdatePredFlag && - *clause_has_blobsp && + (*clause_has_blobsp || *clause_has_dbtermp) && !clinfo.alloc_found) code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip); #if THREADS @@ -3129,7 +3205,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp break; case procceed_op: if (cip->CurrentPred->PredFlags & LogUpdatePredFlag && - *clause_has_blobsp && + (*clause_has_blobsp || *clause_has_dbtermp) && !clinfo.alloc_found) code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip); #if THREADS @@ -3425,6 +3501,23 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep) return x; } +static DBTermList * +init_dbterms_list(yamop *code_p, PredEntry *ap) +{ + DBTermList *new; + if ((new = (DBTermList *)Yap_AllocCodeSpace(sizeof(DBTermList))) == NULL) { + return NULL; + } + new->dbterms = NULL; + new->clause_code = code_p; + new->p = ap; + LOCK(DBTermsListLock); + new->next_dbl = DBTermsList; + DBTermsList = new; + UNLOCK(DBTermsListLock); + return new; +} + yamop * Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates *cip) @@ -3438,10 +3531,14 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates yamop *entry_code; yamop *code_p; int clause_has_blobs = FALSE; + int clause_has_dbterm = FALSE; cip->label_offset = (int *)cip->freep; cip->code_addr = NULL; - code_p = do_pass(0, &entry_code, mode, &clause_has_blobs, cip, size); + code_p = do_pass(0, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size); + if (clause_has_dbterm) { + cip->dbterml = init_dbterms_list(code_p, ap); + } if (ap->PredFlags & DynamicPredFlag) { size = (CELL)NEXTOP(NEXTOP(NEXTOP((yamop *)(((DynamicClause *)NULL)->ClCode),ld),sla),e); @@ -3475,7 +3572,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates } cl = (StaticClause *)((CODEADDR)x-(UInt)size); cip->code_addr = (yamop *)cl; - code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, cip, size); + code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size); /* make sure we copy after second pass */ cl->usc.ClSource = x; cl->ClSize = osize; @@ -3502,7 +3599,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates Yap_IndexSpace_Tree += size; } } - code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, cip, size); + code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size); ProfEnd=code_p; #ifdef LOW_PROF if (ProfilerOn && diff --git a/C/cdmgr.c b/C/cdmgr.c index 5ee3da7ad..8057cedd3 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2007-11-01 10:01:35 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-06 17:02:11 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.208 2007/11/01 10:01:35 vsc +* fix uninitalised lock and reconsult test. +* * Revision 1.207 2007/10/29 22:48:54 vsc * small fixes * @@ -619,6 +622,11 @@ static Term BlobTermAdjust(Term t) #endif } +static void +RestoreDBTerm(DBTerm *dbr) +{ +} + #include "rclause.h" #ifdef DEBUG @@ -4048,6 +4056,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { case _get_atom: case _put_atom: case _get_bigint: + case _get_dbterm: pc = NEXTOP(pc,xc); break; /* instructions type cc */ @@ -4164,6 +4173,8 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { case _unify_l_atom: case _unify_bigint: case _unify_l_bigint: + case _unify_dbterm: + case _unify_l_dbterm: pc = NEXTOP(pc,oc); break; /* instructions type osc */ diff --git a/C/compiler.c b/C/compiler.c index b1659df67..0cd1d9556 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -11,8 +11,11 @@ * File: compiler.c * * comments: Clause compiler * * * -* Last rev: $Date: 2007-03-27 13:48:51 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-06 17:02:11 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.84 2007/03/27 13:48:51 vsc +* fix number of overflows (comments by Bart Demoen). +* * Revision 1.83 2007/03/26 15:18:43 vsc * debugging and clause/3 over tabled predicates would kill YAP. * @@ -481,8 +484,9 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl return (p->VarOfCE); } /* first occurrence */ - if (cglobs->onbranch || level > 1) + if (cglobs->onbranch || level > 1) { return t; + } ++(cglobs->n_common_exps); p = (CExpEntry *) Yap_AllocCMem(sizeof(CExpEntry), &cglobs->cint); @@ -491,7 +495,7 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl if (H >= (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } p->NextCE = cglobs->common_exps; cglobs->common_exps = p; @@ -526,7 +530,7 @@ compile_sf_term(Term t, int argno, int level) Yap_Error_Term = TermNil; Yap_ErrorMessage = "illegal argument of soft functor"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 2); + longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } else c_var(t, -argno, arity, level, cglobs); @@ -553,7 +557,7 @@ c_args(Term app, unsigned int level, compiler_struct *cglobs) Yap_Error_Term = TermNil; Yap_ErrorMessage = "exceed maximum arity of compiled goal"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 2); + longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } if (Arity > cglobs->max_args) cglobs->max_args = Arity; @@ -562,6 +566,52 @@ c_args(Term app, unsigned int level, compiler_struct *cglobs) c_arg(i, ArgOfTerm(i, app), Arity, level, cglobs); } +static int +try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_struct *cglobs) +{ + DBTerm *dbt; + int g; + CELL *h0 = H; + + while ((g=Yap_SizeGroundTerm(t,TRUE)) < 0) { + /* oops, too deep a term */ + save_machine_regs(); + Yap_Error_Size = 0; + longjmp(cglobs->cint.CompilerBotch, OUT_OF_AUX_BOTCH); + } + if (g < 16) + return FALSE; + /* store ground term away */ + H = CellPtr(cglobs->cint.freep); + if ((dbt = Yap_StoreTermInDB(t, -1)) == NULL) { + H = h0; + switch(Yap_Error_TYPE) { + case OUT_OF_STACK_ERROR: + Yap_Error_TYPE = YAP_NO_ERROR; + longjmp(cglobs->cint.CompilerBotch,OUT_OF_STACK_BOTCH); + case OUT_OF_TRAIL_ERROR: + Yap_Error_TYPE = YAP_NO_ERROR; + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TRAIL_BOTCH); + case OUT_OF_HEAP_ERROR: + Yap_Error_TYPE = YAP_NO_ERROR; + longjmp(cglobs->cint.CompilerBotch,OUT_OF_HEAP_BOTCH); + case OUT_OF_AUXSPACE_ERROR: + Yap_Error_TYPE = YAP_NO_ERROR; + longjmp(cglobs->cint.CompilerBotch,OUT_OF_AUX_BOTCH); + default: + longjmp(cglobs->cint.CompilerBotch,COMPILER_ERR_BOTCH); + } + } + H = h0; + if (level == 0) + Yap_emit((cglobs->onhead ? get_dbterm_op : put_dbterm_op), dbt->Entry, argno, &cglobs->cint); + else + Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_dbterm_op + : unify_dbterm_op) : + write_dbterm_op), dbt->Entry, Zero, &cglobs->cint); + return TRUE; +} + static void c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct *cglobs) { @@ -641,6 +691,12 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct write_num_op), (CELL) t, Zero, &cglobs->cint); } else if (IsPairTerm(t)) { if (optimizer_on && level < 6) { + if (!(cglobs->cint.CurrentPred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) { + if (try_store_as_dbterm(t, argno, arity, level, cglobs)) + return; + } + if (try_store_as_dbterm(t, argno, arity, level, cglobs)) + return; t = optimize_ce(t, arity, level, cglobs); if (IsVarTerm(t)) { c_var(t, argno, arity, level, cglobs); @@ -656,7 +712,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct ++level; c_arg(1, HeadOfTerm(t), 2, level, cglobs); if (argno == (Int)arity) { - /* optimise for tail recursion */ + /* optimise for tail recursion */ t = TailOfTerm(t); goto restart; } @@ -690,11 +746,14 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct #endif if (optimizer_on) { + if (!(cglobs->cint.CurrentPred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) { + if (try_store_as_dbterm(t, argno, arity, level, cglobs)) + return; + } t = optimize_ce(t, arity, level, cglobs); if (IsVarTerm(t)) { c_var(t, argno, arity, level, cglobs); return; - } } if (level == 0) @@ -803,7 +862,7 @@ c_test(Int Op, Term t1, compiler_struct *cglobs) { Yap_bip_name(Op, s); sprintf(Yap_ErrorMessage, "when compiling %s/1", s); save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 1); + longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } if (IsNewVar(t)) { /* in this case, var trivially succeeds and the others trivially fail */ @@ -858,7 +917,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct * Yap_bip_name(Op, s); sprintf(Yap_ErrorMessage, "when compiling %s/2", s); save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 1); + longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } else if (IsVarTerm(t2)) { if (IsNewVar(t2)) { char s[32]; @@ -869,7 +928,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct * Yap_bip_name(Op, s); sprintf(Yap_ErrorMessage, "when compiling %s/2", s); save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 1); + longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } else { /* first temp */ Int v1 = --cglobs->tmpreg; @@ -987,7 +1046,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct * if (H+2 >= (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } RESET_VARIABLE(H); RESET_VARIABLE(H+1); @@ -999,7 +1058,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct * if (H >= (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } RESET_VARIABLE(H); H++; @@ -1128,7 +1187,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct * if (H+1+arity >= (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } tnew = AbsAppl(H); *H++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),arity); @@ -1177,7 +1236,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct * if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } c_var(tmpvar,f_flag,(unsigned int)Op, 0, cglobs); c_eq(tmpvar,t3, cglobs); @@ -1204,7 +1263,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct * if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } c_var(tmpvar,f_flag,(unsigned int)Op, 0, cglobs); /* I have to dit here, before I do the unification */ @@ -1298,7 +1357,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs) Yap_Error_Term = M; Yap_ErrorMessage = "in module name"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 1); + longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } Goal = ArgOfTerm(2, Goal); mod = M; @@ -1495,7 +1554,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs) if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } savecpc = cglobs->cint.cpc; savencpc = FirstP->nextInst; @@ -1574,7 +1633,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs) if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } push_branch(cglobs->onbranch, commitvar, cglobs); ++cglobs->curbranch; @@ -1609,7 +1668,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs) if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } cglobs->onlast = FALSE; c_var(commitvar, save_b_flag, 1, 0, cglobs); @@ -1723,7 +1782,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs) if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } c_eq(t2, a2, cglobs); c_var(a1, bt1_flag, 2, 0, cglobs); @@ -1736,7 +1795,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs) if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } c_eq(t1, a1, cglobs); @@ -1750,7 +1809,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs) if (H == (CELL *)cglobs->cint.freep0) { /* oops, too many new variables */ save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch,4); + longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH); } c_eq(t2, a2, cglobs); c_var(t1, bt1_flag, 2, 0, cglobs); @@ -2110,7 +2169,7 @@ clear_bvarray(int var, CELL *bvarray Yap_Error_Term = TermNil; Yap_ErrorMessage = "compiler internal error: variable initialised twice"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 2); + longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } cglobs->pbvars++; #endif @@ -2151,7 +2210,7 @@ push_bvmap(int label, PInstr *pcpc, compiler_struct *cglobs) Yap_Error_Term = TermNil; Yap_ErrorMessage = "Too many embedded disjunctions"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 2); + longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } /* the label instruction */ bvstack[bvindex].lab = label; @@ -2174,7 +2233,7 @@ reset_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs) Yap_Error_Term = TermNil; Yap_ErrorMessage = "No embedding in disjunctions"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 2); + longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } env_size = (bvstack[bvindex-1].pc)->rnd1; size = env_size/(8*sizeof(CELL)); @@ -2194,7 +2253,7 @@ pop_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs) Yap_Error_Term = TermNil; Yap_ErrorMessage = "Too few embedded disjunctions"; /* save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 2); */ + longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); */ } reset_bvmap(bvarray, nperm, cglobs); bvindex--; @@ -2462,7 +2521,7 @@ checktemp(Int arg, Int rn, compiler_vm_op ic, compiler_struct *cglobs) Yap_Error_Term = TermNil; Yap_ErrorMessage = "too many temporaries"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 1); + longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } v->NoOfVE = cglobs->vadr = vadr = TempVar | target1; v->KindOfVE = TempVar; @@ -2591,7 +2650,7 @@ c_layout(compiler_struct *cglobs) Yap_Error_Term = TermNil; Yap_ErrorMessage = "wrong number of variables found in bitmap"; save_machine_regs(); - longjmp(cglobs->cint.CompilerBotch, 2); + longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } #endif } @@ -3034,56 +3093,91 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src) int botch_why; /* may botch while doing a different module */ /* first, initialise cglobs->cint.CompilerBotch to handle all cases of interruptions */ - compiler_struct cglobs; + compiler_struct cglobs; - /* make sure we know there was no error yet */ - Yap_ErrorMessage = NULL; - if ((botch_why = setjmp(cglobs.cint.CompilerBotch)) == 3) { - /* out of local stack, just duplicate the stack */ + /* make sure we know there was no error yet */ + Yap_ErrorMessage = NULL; + if ((botch_why = setjmp(cglobs.cint.CompilerBotch))) { restore_machine_regs(); reset_vars(cglobs.vtable); - { - Int osize = 2*sizeof(CELL)*(ASP-H); - ARG1 = inp_clause; - ARG3 = src; + switch(botch_why) { + case OUT_OF_STACK_BOTCH: + /* out of local stack, just duplicate the stack */ + { + Int osize = 2*sizeof(CELL)*(ASP-H); + ARG1 = inp_clause; + ARG3 = src; - YAPLeaveCriticalSection(); - if (!Yap_gcl(Yap_Error_Size, NOfArgs, ENV, P)) { - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Term = inp_clause; - } - if (osize > ASP-H) { - if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) { + YAPLeaveCriticalSection(); + if (!Yap_gcl(Yap_Error_Size, NOfArgs, ENV, P)) { Yap_Error_TYPE = OUT_OF_STACK_ERROR; Yap_Error_Term = inp_clause; } + if (osize > ASP-H) { + if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) { + Yap_Error_TYPE = OUT_OF_STACK_ERROR; + Yap_Error_Term = inp_clause; + } + } + YAPEnterCriticalSection(); + src = ARG3; + inp_clause = ARG1; + } + break; + case OUT_OF_AUX_BOTCH: + /* out of local stack, just duplicate the stack */ + YAPLeaveCriticalSection(); + ARG1 = inp_clause; + ARG3 = src; + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL)) { + Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + Yap_Error_Term = inp_clause; } YAPEnterCriticalSection(); src = ARG3; inp_clause = ARG1; + break; + case OUT_OF_TEMPS_BOTCH: + /* out of temporary cells */ + if (maxvnum < 16*1024) { + maxvnum *= 2; + } else { + maxvnum += 4096; + } + break; + case OUT_OF_HEAP_BOTCH: + /* not enough heap */ + ARG1 = inp_clause; + ARG3 = src; + YAPLeaveCriticalSection(); + if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { + Yap_Error_TYPE = OUT_OF_HEAP_ERROR; + Yap_Error_Term = inp_clause; + return NULL; + } + YAPEnterCriticalSection(); + src = ARG3; + inp_clause = ARG1; + break; + case OUT_OF_TRAIL_BOTCH: + /* not enough trail */ + ARG1 = inp_clause; + ARG3 = src; + YAPLeaveCriticalSection(); + if (!Yap_growtrail(0L, FALSE)) { + Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + Yap_Error_Term = inp_clause; + return NULL; + } + YAPEnterCriticalSection(); + src = ARG3; + inp_clause = ARG1; + break; + default: + return NULL; } - } else if (botch_why == 4) { - /* out of temporary cells */ - restore_machine_regs(); - reset_vars(cglobs.vtable); - if (maxvnum < 16*1024) { - maxvnum *= 2; - } else { - maxvnum += 4096; - } - } else if (botch_why == 2) { - /* not enough heap */ - restore_machine_regs(); - reset_vars(cglobs.vtable); - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_Error_Term = TermNil; - return 0; } my_clause = inp_clause; - if (Yap_ErrorMessage) { - reset_vars(cglobs.vtable); - return (0); - } HB = H; Yap_ErrorMessage = NULL; Yap_Error_Size = 0; @@ -3092,6 +3186,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src) cglobs.cint.CodeStart = cglobs.cint.cpc = NULL; cglobs.cint.BlobsStart = cglobs.cint.icpc = NULL; + cglobs.cint.dbterml = NULL; cglobs.cint.freep = cglobs.cint.freep0 = (char *) (H + maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps+MaxTemps); diff --git a/C/computils.c b/C/computils.c index 913394dc4..f493e608d 100644 --- a/C/computils.c +++ b/C/computils.c @@ -11,8 +11,12 @@ * File: computils.c * * comments: some useful routines for YAP's compiler * * * -* Last rev: $Date: 2006-09-20 20:03:51 $ * +* Last rev: $Date: 2007-11-06 17:02:12 $ * * $Log: not supported by cvs2svn $ +* Revision 1.30 2006/09/20 20:03:51 vsc +* improve indexing on floats +* fix sending large lists to DB +* * Revision 1.29 2005/12/05 17:16:10 vsc * write_depth/3 * overflow handlings and garbage collection @@ -89,7 +93,7 @@ AllocCMem (int size, struct intermediates *cip) if (ASP <= CellPtr (cip->freep) + 256) { Yap_Error_Size = 256+((char *)cip->freep - (char *)H); save_machine_regs(); - longjmp(cip->CompilerBotch,3); + longjmp(cip->CompilerBotch, OUT_OF_STACK_BOTCH); } return (p); } @@ -563,6 +567,8 @@ static char *opformat[] = "put_num\t\t%n,%r", "get_float\t\t%w,%r", "put_float\t\t%w,%r", + "get_dbterm\t%w,%r", + "put_dbterm\t%w,%r", "align_float", "get_longint\t\t%w,%r", "put_longint\t\t%w,%r", @@ -583,6 +589,8 @@ static char *opformat[] = "write_num\t%n", "unify_float\t%w", "write_float\t%w", + "unify_dbterm\t%w", + "write_dbterm\t%w", "unify_longint\t%w", "write_longint\t%w", "unify_bigint\t%l", @@ -649,7 +657,8 @@ static char *opformat[] = "unify_last_local\t%v", "unify_last_atom\t%a", "unify_last_num\t%n", - "unify_last_float\t%w", + "unify_last_float\t%w", + "unify_last_dbterm\t%w", "unify_last_longint\t%w", "unify_last_bigint\t%l", "pvar_bitmap\t%l,%b", diff --git a/C/dbase.c b/C/dbase.c index 6522d3da7..3f5706d03 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -1258,7 +1258,7 @@ CreateDBWithDBRef(Term Tm, DBProp p, struct db_globs *dbg) ppt->Contents[1] = (CELL)dbr; ppt->DBRefs = (DBRef *)(ppt->Contents+2); #ifdef COROUTINING - ppt->attachments = 0L; + ppt->ag.attachments = 0L; #endif return pp; } @@ -1278,7 +1278,7 @@ CreateDBTermForAtom(Term Tm, UInt extra_size, struct db_globs *dbg) { ppt->NOfCells = 0; ppt->DBRefs = NULL; #ifdef COROUTINING - ppt->attachments = 0; + ppt->ag.attachments = 0; #endif ppt->DBRefs = NULL; ppt->Entry = Tm; @@ -1301,7 +1301,7 @@ CreateDBTermForVar(UInt extra_size, struct db_globs *dbg) ppt->NOfCells = 0; ppt->DBRefs = NULL; #ifdef COROUTINING - ppt->attachments = 0; + ppt->ag.attachments = 0; #endif ppt->DBRefs = NULL; ppt->Entry = (CELL)(&(ppt->Entry)); @@ -1331,7 +1331,7 @@ CreateDBRefForAtom(Term Tm, DBProp p, int InFlag, struct db_globs *dbg) { pp->DBT.DBRefs = NULL; pp->DBT.NOfCells = 0; #ifdef COROUTINING - pp->DBT.attachments = 0; + pp->DBT.ag.attachments = 0; #endif return(pp); } @@ -1355,7 +1355,7 @@ CreateDBRefForVar(Term Tm, DBProp p, int InFlag, struct db_globs *dbg) { pp->DBT.NOfCells = 0; pp->DBT.DBRefs = NULL; #ifdef COROUTINING - pp->DBT.attachments = 0; + pp->DBT.ag.attachments = 0; #endif INIT_LOCK(pp->lock); INIT_DBREF_COUNT(pp); @@ -1582,7 +1582,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc ppt->NOfCells = NOfCells; #ifdef COROUTINING - ppt->attachments = attachments; + ppt->ag.attachments = attachments; #endif if (pp0 != pp) { nar = ppt->Contents; @@ -1617,14 +1617,14 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc ppt->Entry = AdjustIDBPtr(tt,(CELL)ppt-(CELL)ppt0); #ifdef COROUTINING if (attachments) - ppt->attachments = AdjustIDBPtr(attachments,(CELL)ppt-(CELL)ppt0); + ppt->ag.attachments = AdjustIDBPtr(attachments,(CELL)ppt-(CELL)ppt0); else - ppt->attachments = 0L; + ppt->ag.attachments = 0L; #endif } else { ppt->Entry = tt; #ifdef COROUTINING - ppt->attachments = attachments; + ppt->ag.attachments = attachments; #endif } if (flag & DBWithRefs) { @@ -2440,7 +2440,7 @@ GetDBTerm(DBTerm *DBSP) if (IsVarTerm(t) #if COROUTINING - && !DBSP->attachments + && !DBSP->ag.attachments #endif ) { return MkVarTerm(); @@ -2475,8 +2475,8 @@ GetDBTerm(DBTerm *DBSP) linkblk(lp, HOld-1, (CELL)HOld-(CELL)(DBSP->Contents)); } #ifdef COROUTINING - if (DBSP->attachments != 0L) { - if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->attachments,(CELL)HOld-(CELL)(DBSP->Contents)))) { + if (DBSP->ag.attachments != 0L) { + if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->ag.attachments,(CELL)HOld-(CELL)(DBSP->Contents)))) { H = HOld; Yap_Error_TYPE = OUT_OF_ATTVARS_ERROR; Yap_Error_Size = 0; @@ -4949,16 +4949,18 @@ StoreTermInDB(Term t, int nargs) InQueue, &needs_vars, 0, &dbg)) == NULL) { if (Yap_Error_TYPE == YAP_NO_ERROR) { break; + } else if (nargs == -1) { + return NULL; } else { XREGS[nargs+1] = t; if (recover_from_record_error(nargs+1)) { t = Deref(XREGS[nargs+1]); } else { - return FALSE; + return NULL; } } } - return(x); + return x; } DBTerm * diff --git a/C/grow.c b/C/grow.c index b3b996489..65fb73720 100644 --- a/C/grow.c +++ b/C/grow.c @@ -891,6 +891,8 @@ fix_compiler_instructions(PInstr *pcpc) case align_float_op: case get_bigint_op: case put_bigint_op: + case get_dbterm_op: + case put_dbterm_op: case get_list_op: case put_list_op: case get_struct_op: @@ -906,7 +908,10 @@ fix_compiler_instructions(PInstr *pcpc) case write_longint_op: case unify_bigint_op: case unify_last_bigint_op: + case unify_dbterm_op: + case unify_last_dbterm_op: case write_bigint_op: + case write_dbterm_op: case unify_list_op: case write_list_op: case unify_struct_op: diff --git a/C/index.c b/C/index.c index ff8be69f1..aede243af 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2007-10-28 11:23:40 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.188 2007/10/28 11:23:40 vsc +* fix overflow +* * Revision 1.187 2007/09/22 08:38:05 vsc * nb_ extra stuff plus an indexing overflow fix. * @@ -1093,6 +1096,7 @@ has_cut(yamop *pc) case _get_atom: case _put_atom: case _get_bigint: + case _get_dbterm: pc = NEXTOP(pc,xc); break; /* instructions type cc */ @@ -1218,6 +1222,8 @@ has_cut(yamop *pc) case _unify_l_atom: case _unify_bigint: case _unify_l_bigint: + case _unify_dbterm: + case _unify_l_dbterm: pc = NEXTOP(pc,oc); break; /* instructions type osc */ @@ -1947,6 +1953,9 @@ add_info(ClauseDef *clause, UInt regno) } break; */ + case _get_dbterm: + clause->Tag = (CELL)NULL; + return; case _copy_idb_term: case _unify_idb_term: if (regno == 2) { @@ -2180,6 +2189,10 @@ add_info(ClauseDef *clause, UInt regno) case _unify_l_bigint: cl = NEXTOP(cl,oc); break; + case _unify_dbterm: + case _unify_l_dbterm: + cl = NEXTOP(cl,oc); + break; case _unify_n_atoms_write: case _unify_n_atoms: cl = NEXTOP(cl,osc); @@ -2817,6 +2830,10 @@ add_head_info(ClauseDef *clause, UInt regno) case _unify_l_bigint: cl = NEXTOP(cl,oc); break; + case _unify_dbterm: + case _unify_l_dbterm: + cl = NEXTOP(cl,oc); + break; case _unify_n_atoms_write: case _unify_n_atoms: cl = NEXTOP(cl,osc); @@ -2827,6 +2844,9 @@ add_head_info(ClauseDef *clause, UInt regno) case _unify_l_struc: cl = NEXTOP(cl,of); break; + case _get_dbterm: + clause->Tag = (CELL)NULL; + return; case _unify_idb_term: case _copy_idb_term: if (regno != 2) { @@ -3100,6 +3120,10 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno) } argno--; break; + case _unify_dbterm: + case _unify_l_dbterm: + clause->Tag = (CELL)NULL; + return; case _unify_n_atoms: if (argno <= cl->u.osc.s) { clause->Tag = cl->u.osc.c; @@ -3133,8 +3157,11 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno) cl = NEXTOP(cl,os); break; #endif + case _get_dbterm: case _unify_idb_term: case _copy_idb_term: + clause->Tag = (CELL)NULL; + return; { Term t = clause->u.c_sreg[argno]; diff --git a/C/stdpreds.c b/C/stdpreds.c index 24d36b522..ca855a65d 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -11,8 +11,11 @@ * File: stdpreds.c * * comments: General-purpose C implemented system predicates * * * -* Last rev: $Date: 2007-10-18 08:24:16 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.122 2007/10/18 08:24:16 vsc +* fix global variables +* * Revision 1.121 2007/10/10 09:44:24 vsc * some more fixes to make YAP swi compatible * fix absolute_file_name (again) @@ -2884,10 +2887,24 @@ p_flags(void) if (IsVarTerm(t1)) return (FALSE); if (IsAtomTerm(t1)) { - pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod)); + while ((pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod)))== NULL) { + if (!Yap_growheap(FALSE, 0, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate"); + return FALSE; + } + t1 = Deref(ARG1); + mod = Deref(ARG2); + } } else if (IsApplTerm(t1)) { Functor funt = FunctorOfTerm(t1); - pe = RepPredProp(PredPropByFunc(funt, mod)); + while ((pe = RepPredProp(PredPropByFunc(funt, mod)))== NULL) { + if (!Yap_growheap(FALSE, 0, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, ARG1, "while generating new predicate"); + return FALSE; + } + t1 = Deref(ARG1); + mod = Deref(ARG2); + } } else return (FALSE); if (EndOfPAEntr(pe)) @@ -3858,7 +3875,7 @@ Yap_InitCPreds(void) Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag|HiddenPredFlag); #endif /* Accessing and changing the flags for a predicate */ - Yap_InitCPred("$flags", 4, p_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("$flags", 4, p_flags, SyncPredFlag|HiddenPredFlag); /* hiding and unhiding some predicates */ Yap_InitCPred("hide", 1, p_hide, SafePredFlag|SyncPredFlag); Yap_InitCPred("unhide", 1, p_unhide, SafePredFlag|SyncPredFlag); diff --git a/C/utilpreds.c b/C/utilpreds.c index f7c95cf3d..5073a9418 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1044,7 +1044,7 @@ p_ground(void) /* ground(+T) */ Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) - return(TRUE); + return TRUE; else if ((out = ground_complex_term(RepAppl(t), RepAppl(t)+ ArityOfFunctor(fun))) >= 0) { @@ -1060,6 +1060,174 @@ p_ground(void) /* ground(+T) */ } } +static int +SizeOfExtension(Term t) +{ + Functor f = FunctorOfTerm(t); + if (f== FunctorDouble) { + return 2 + sizeof(Float)/sizeof(CELL); + } + if (f== FunctorLongInt) { + return 2 + sizeof(Float)/sizeof(CELL); + } + if (f== FunctorDBRef) { + return 0; + } + if (f== FunctorBigInt) { + CELL *pt = RepAppl(t)+1; + return 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); + } + return 0; +} + + +static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, int ground) +{ + + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + Int sz = 0; + + to_visit0 = to_visit; + loop: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar: + { + if (IsPairTerm(d0)) { + sz += 2; + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { + sz += SizeOfExtension(d0); + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + sz += (1+d0); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } + + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + if (!ground) + continue; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; + } +#endif + return 0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; + } + return sz; + + aux_overflow: + /* unwind stack */ +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + return -1; +} + +int +Yap_SizeGroundTerm(Term t, int ground) +{ + if (IsVarTerm(t)) { + if (!ground) + return 1; + return 0; + } else if (IsPrimitiveTerm(t)) { + return 1; + } else if (IsPairTerm(t)) { + int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground); + if (sz <= 0) + return sz; + return sz+2; +} else { + int sz = 0; + Functor fun = FunctorOfTerm(t); + + if (IsExtensionFunctor(fun)) + return 1+ SizeOfExtension(t); + + sz = sz_ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun), + ground); + if (sz <= 0) + return sz; + return 1+ArityOfFunctor(fun)+sz; + } +} + static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term v) diff --git a/H/Heap.h b/H/Heap.h index d7b0ef29d..9c4256182 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.118 2007-10-10 09:44:24 vsc Exp $ * +* version: $Id: Heap.h,v 1.119 2007-11-06 17:02:12 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -338,6 +338,7 @@ typedef struct various_codes { lockvar dead_static_clauses_lock; /* protect DeadStaticClauses */ lockvar dead_mega_clauses_lock; /* protect DeadMegaClauses */ lockvar dead_static_indices_lock; /* protect DeadStaticIndices */ + lockvar dbterms_list_lock; /* protect DBTermList */ int heap_top_owner; #ifdef LOW_LEVEL_TRACER lockvar low_level_trace_lock; @@ -349,6 +350,7 @@ typedef struct various_codes { struct static_clause *dead_static_clauses; struct static_mega_clause *dead_mega_clauses; struct static_index *dead_static_indices; + struct dbterm_list *dbterms_list; Atom atom_abol, atom_alarm, @@ -945,6 +947,7 @@ struct various_codes *Yap_heap_regs; #define ParserErrorStyle Yap_heap_regs->parser_error_style #define DeadStaticClauses Yap_heap_regs->dead_static_clauses #define DeadMegaClauses Yap_heap_regs->dead_mega_clauses +#define DBTermsList Yap_heap_regs->dbterms_list #define DeadStaticIndices Yap_heap_regs->dead_static_indices #define SizeOfOverflow Yap_heap_regs->size_of_overflow #define LastWtimePtr Yap_heap_regs->last_wtime @@ -959,6 +962,7 @@ struct various_codes *Yap_heap_regs; #define ThreadsTotalTime Yap_heap_regs->threads_total_time #define DeadStaticClausesLock Yap_heap_regs->dead_static_clauses_lock #define DeadMegaClausesLock Yap_heap_regs->dead_mega_clauses_lock +#define DBTermsListLock Yap_heap_regs->dbterms_list_lock #define DeadStaticIndicesLock Yap_heap_regs->dead_static_indices_lock #define ModulesLock Yap_heap_regs->modules_lock #endif diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index e2aa6fc2e..497fed09d 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -11,8 +11,11 @@ * File: YapOpcodes.h * * comments: Central Table with all YAP opcodes * * * -* Last rev: $Date: 2006-10-10 14:08:17 $ * +* Last rev: $Date: 2007-11-06 17:02:12 $ * * $Log: not supported by cvs2svn $ +* Revision 1.40 2006/10/10 14:08:17 vsc +* small fixes on threaded implementation. +* * Revision 1.39 2006/09/20 20:03:51 vsc * improve indexing on floats * fix sending large lists to DB @@ -182,6 +185,7 @@ OPCODE(get_float ,xd), OPCODE(get_longint ,xi), OPCODE(get_bigint ,xc), + OPCODE(get_dbterm ,xc), OPCODE(get_list ,x), OPCODE(get_struct ,xf), OPCODE(unify_x_var ,ox), @@ -192,6 +196,7 @@ OPCODE(unify_float ,od), OPCODE(unify_longint ,oc), OPCODE(unify_bigint ,oc), + OPCODE(unify_dbterm ,oc), OPCODE(unify_list ,o), OPCODE(unify_struct ,of), OPCODE(put_x_var ,xx), @@ -318,6 +323,7 @@ OPCODE(unify_l_float ,od), OPCODE(unify_l_longint ,oi), OPCODE(unify_l_bigint ,oc), + OPCODE(unify_l_dbterm ,oc), OPCODE(unify_l_void ,o), OPCODE(unify_l_n_voids ,os), OPCODE(unify_l_x_loc ,ox), diff --git a/H/Yapproto.h b/H/Yapproto.h index a48d47a1c..d7ceb89ed 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.80 2007-10-18 08:24:16 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.81 2007-11-06 17:02:12 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -325,6 +325,7 @@ void STD_PROTO(Yap_InitUserBacks,(void)); /* utilpreds.c */ Term STD_PROTO(Yap_CopyTerm,(Term)); +int STD_PROTO(Yap_SizeGroundTerm,(Term, int)); void STD_PROTO(Yap_InitUtilCPreds,(void)); /* yap.c */ diff --git a/H/Yatom.h b/H/Yatom.h index 23060abe3..c5fa4cd00 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -798,6 +798,7 @@ IsPredProperty (int flags) /* There are several flags for code and data base entries */ typedef enum { + HasDBTMask = 0x400000, /* includes a pointer to a DBTerm */ MegaMask = 0x200000, /* mega clause */ FactMask = 0x100000, /* a fact */ SwitchRootMask = 0x80000, /* root for the index tree */ @@ -821,7 +822,10 @@ typedef enum typedef struct DB_TERM { #ifdef COROUTINING - CELL attachments; /* attached terms */ + union { + CELL attachments; /* attached terms */ + struct DB_TERM *NextDBT; + } ag; #endif struct DB_STRUCT **DBRefs; /* pointer to other references */ CELL NOfCells; /* Size of Term */ @@ -829,6 +833,18 @@ typedef struct DB_TERM Term Contents[MIN_ARRAY]; /* stored term */ } DBTerm; +inline EXTERN DBTerm *TermToDBTerm(Term); + +inline EXTERN DBTerm *TermToDBTerm(Term X) +{ + if (IsPairTerm(X)) { + return(DBTerm *)((char *)RepPair(X) - (CELL) &(((DBTerm *) NULL)->Contents)); + } else { + return(DBTerm *)((char *)RepAppl(X) - (CELL) &(((DBTerm *) NULL)->Contents)); + } +} + + /* The ordering of the first 3 fields should be compatible with lu_clauses */ typedef struct DB_STRUCT { diff --git a/H/clause.h b/H/clause.h index ffaf67cfb..9f40fb0ba 100644 --- a/H/clause.h +++ b/H/clause.h @@ -158,6 +158,14 @@ typedef union clause_ptr { struct static_index *si; } ClausePointer; +typedef struct dbterm_list { + /* a list of dbterms associated with a clause */ + DBTerm *dbterms; + yamop *clause_code; + PredEntry *p; + struct dbterm_list *next_dbl; +} DBTermList; + #define ClauseCodeToDynamicClause(p) ((DynamicClause *)((CODEADDR)(p)-(CELL)(((DynamicClause *)NULL)->ClCode))) #define ClauseCodeToStaticClause(p) ((StaticClause *)((CODEADDR)(p)-(CELL)(((StaticClause *)NULL)->ClCode))) #define ClauseCodeToLogUpdClause(p) ((LogUpdClause *)((CODEADDR)(p)-(CELL)(((LogUpdClause *)NULL)->ClCode))) diff --git a/H/compile.h b/H/compile.h index 704f82e7e..af5bd5a46 100644 --- a/H/compile.h +++ b/H/compile.h @@ -30,6 +30,8 @@ typedef enum compiler_op { put_num_op, get_float_op, put_float_op, + get_dbterm_op, + put_dbterm_op, align_float_op, get_longint_op, put_longint_op, @@ -50,6 +52,8 @@ typedef enum compiler_op { write_num_op, unify_float_op, write_float_op, + unify_dbterm_op, + write_dbterm_op, unify_longint_op, write_longint_op, unify_bigint_op, @@ -117,6 +121,7 @@ typedef enum compiler_op { unify_last_atom_op, unify_last_num_op, unify_last_float_op, + unify_last_dbterm_op, unify_last_longint_op, unify_last_bigint_op, mark_initialised_pvars_op, @@ -231,6 +236,13 @@ typedef struct CEXPENTRY { struct CEXPENTRY *NextCE; } CExpEntry; +#define COMPILER_ERR_BOTCH 1 +#define OUT_OF_HEAP_BOTCH 2 +#define OUT_OF_STACK_BOTCH 3 +#define OUT_OF_TEMPS_BOTCH 4 +#define OUT_OF_AUX_BOTCH 5 +#define OUT_OF_TRAIL_BOTCH 6 + typedef struct intermediates { char *freep; @@ -239,6 +251,7 @@ typedef struct intermediates { struct PSEUDO *CodeStart; struct PSEUDO *icpc; struct PSEUDO *BlobsStart; + struct dbterm_list *dbterml; int *label_offset; Int *uses; Term *contents; diff --git a/H/rclause.h b/H/rclause.h index c939b47f0..8e585081c 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -12,8 +12,11 @@ * File: rclause.h * * comments: walk through a clause * * * -* Last rev: $Date: 2006-11-27 17:42:03 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.18 2006/11/27 17:42:03 vsc +* support for UNICODE, and other bug fixes. +* * Revision 1.17 2006/10/10 14:08:17 vsc * small fixes on threaded implementation. * @@ -464,6 +467,7 @@ restore_opcodes(yamop *pc) case _get_atom: case _put_atom: case _get_bigint: + case _get_dbterm: pc->u.xc.x = XAdjust(pc->u.xc.x); { Term t = pc->u.xc.c; @@ -474,7 +478,6 @@ restore_opcodes(yamop *pc) } pc = NEXTOP(pc,xc); break; - /* instructions type cc */ case _get_2atoms: { Term t = pc->u.cc.c1; @@ -744,6 +747,8 @@ restore_opcodes(yamop *pc) case _unify_l_atom: case _unify_bigint: case _unify_l_bigint: + case _unify_dbterm: + case _unify_l_dbterm: pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw)); { Term t = pc->u.oc.c; diff --git a/H/rheap.h b/H/rheap.h index dda0d023e..062792771 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,13 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2007-10-10 09:44:24 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.77 2007/10/10 09:44:24 vsc +* some more fixes to make YAP swi compatible +* fix absolute_file_name (again) +* fix setarg +* * Revision 1.76 2007/09/28 23:18:17 vsc * handle learning from interpretations. * @@ -188,8 +193,6 @@ do_clean_susp_clauses(yamop *ipc) { #include "rclause.h" -/* Restoring the heap */ - /* adjusts terms stored in the data base, when they have no variables */ static Term AdjustDBTerm(Term trm, Term *p_base) @@ -232,12 +235,16 @@ AdjustDBTerm(Term trm, Term *p_base) } static void -RestoreDBTerm(DBTerm *dbr) +RestoreDBTerm(DBTerm *dbr, int attachments) { + if (attachments) { #ifdef COROUTINING - if (dbr->attachments) - dbr->attachments = AdjustDBTerm(dbr->attachments, dbr->Contents); + if (dbr->ag.attachments) + dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents); #endif + } else { + dbr->ag.NextDBT = DBTermAdjust(dbr->ag.NextDBT); + } if (dbr->DBRefs != NULL) { DBRef *cp; DBRef tm; @@ -250,6 +257,8 @@ RestoreDBTerm(DBTerm *dbr) dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents); } +/* Restoring the heap */ + /* Restores a prolog clause, in its compiled form */ static void RestoreStaticClause(StaticClause *cl) @@ -313,7 +322,7 @@ RestoreLUClause(LogUpdClause *cl, PredEntry *pp) } if (cl->ClSource) { cl->ClSource = DBTermAdjust(cl->ClSource); - RestoreDBTerm(cl->ClSource); + RestoreDBTerm(cl->ClSource, TRUE); } if (cl->ClPrev) { cl->ClPrev = PtoLUCAdjust(cl->ClPrev); @@ -325,6 +334,20 @@ RestoreLUClause(LogUpdClause *cl, PredEntry *pp) restore_opcodes(cl->ClCode); } +static void +RestoreDBTermEntry(struct dbterm_list *dbl) { + DBTerm *dbt; + + dbl->dbterms = DBTermAdjust(dbl->dbterms); + dbl->clause_code = PtoOpAdjust(dbl->clause_code); + dbl->next_dbl = PtoDBTLAdjust(dbl->next_dbl); + dbl->p = PredEntryAdjust(dbl->p); + while (dbt) { + RestoreDBTerm(dbt, FALSE); + dbt = dbt->ag.NextDBT; + } +} + static void CleanLUIndex(LogUpdIndex *idx) { @@ -503,6 +526,14 @@ restore_codes(void) mc = mc->ClNext; } } + if (Yap_heap_regs->dbterms_list) { + struct dbterm_list *dbl = PtoDBTLAdjust(Yap_heap_regs->dbterms_list); + Yap_heap_regs->dbterms_list = dbl; + while (dbl) { + RestoreDBTermEntry(dbl); + dbl = dbl->next_dbl; + } + } if (Yap_heap_regs->dead_static_indices) { StaticIndex *si = (StaticIndex *)AddrAdjust((ADDR)(Yap_heap_regs->dead_static_indices)); Yap_heap_regs->dead_static_indices = si; @@ -705,23 +736,23 @@ restore_codes(void) Yap_heap_regs->yap_lib_dir = (char *)AddrAdjust((ADDR)Yap_heap_regs->yap_lib_dir); Yap_heap_regs->pred_goal_expansion = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_goal_expansion); + PredEntryAdjust(Yap_heap_regs->pred_goal_expansion); Yap_heap_regs->pred_meta_call = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_meta_call); + PredEntryAdjust(Yap_heap_regs->pred_meta_call); Yap_heap_regs->pred_dollar_catch = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_dollar_catch); + PredEntryAdjust(Yap_heap_regs->pred_dollar_catch); Yap_heap_regs->pred_recorded_with_key = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_recorded_with_key); + PredEntryAdjust(Yap_heap_regs->pred_recorded_with_key); Yap_heap_regs->pred_log_upd_clause = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_log_upd_clause); + PredEntryAdjust(Yap_heap_regs->pred_log_upd_clause); Yap_heap_regs->pred_log_upd_clause0 = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_log_upd_clause0); + PredEntryAdjust(Yap_heap_regs->pred_log_upd_clause0); Yap_heap_regs->pred_static_clause = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_static_clause); + PredEntryAdjust(Yap_heap_regs->pred_static_clause); Yap_heap_regs->pred_throw = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_throw); + PredEntryAdjust(Yap_heap_regs->pred_throw); Yap_heap_regs->pred_handle_throw = - (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_handle_throw); + PredEntryAdjust(Yap_heap_regs->pred_handle_throw); #if DEBUG if (Yap_heap_regs->db_erased_list) { Yap_heap_regs->db_erased_list = @@ -816,7 +847,7 @@ RestoreDBEntry(DBRef dbr) else fprintf(stderr, " a var\n"); #endif - RestoreDBTerm(&(dbr->DBT)); + RestoreDBTerm(&(dbr->DBT), TRUE); if (dbr->Parent) { dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent)); } @@ -1029,7 +1060,7 @@ restore_static_array(StaticArrayEntry *ae) } else { DBTerm *db = (DBTerm *)RepAppl(reg); db = DBTermAdjust(db); - RestoreDBTerm(db); + RestoreDBTerm(db, TRUE); base->tstore = AbsAppl((CELL *)db); } } @@ -1048,7 +1079,7 @@ restore_static_array(StaticArrayEntry *ae) base++; } else { *base++ = reg = DBTermAdjust(reg); - RestoreDBTerm(reg); + RestoreDBTerm(reg, TRUE); } } } diff --git a/H/sshift.h b/H/sshift.h index ac5491ba0..5c40c97bf 100644 --- a/H/sshift.h +++ b/H/sshift.h @@ -568,6 +568,15 @@ PtoStCAdjust (struct static_clause *ptr) } +inline EXTERN struct dbterm_list *PtoDBTLAdjust (struct dbterm_list *); + +inline EXTERN struct dbterm_list * +PtoDBTLAdjust (struct dbterm_list * addr) +{ + return (struct dbterm_list *) ((ADDR) (CharP (addr) + HDiff)); +} + + #if PRECOMPUTE_REGADDRESS inline EXTERN wamreg XAdjust (wamreg); diff --git a/changes-5.1.html b/changes-5.1.html index 69840a3ce..7029d9d07 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -17,6 +17,10 @@

Yap-5.1.3: