diff --git a/C/absmi.c b/C/absmi.c index 493782721..6e38752b6 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -985,82 +985,22 @@ absmi(int inp) UNLOCK(cl->ClLock); } #else - if (PREG->u.EC.ClENV == 0) { + { Clause *cl = (Clause *)PREG->u.EC.ClBase; + if (!(cl->ClFlags |= InUseMask)) { + /* Clause *cl = (Clause *)PREG->u.EC.ClBase; - /* marking a new clause */ - PREG->u.EC.ClTrail = TR-(tr_fr_ptr)TrailBase; - PREG->u.EC.ClENV = LCL0-YENV; - cl->ClFlags |= InUseMask; - TRAIL_CLREF(cl); + PREG->u.EC.ClTrail = TR-(tr_fr_ptr)TrailBase; + PREG->u.EC.ClENV = LCL0-YENV;*/ + cl->ClFlags |= InUseMask; + TRAIL_CLREF(cl); + } } #endif PREG = NEXTOP(PREG, EC); GONext(); ENDBOp(); - /* exit logical pred */ - BOp(dealloc_for_logical_pred, l); - { - yamop *ecl = (yamop *)PREG->u.l.l; - PREG = NEXTOP(PREG, l); - /* check first if environment is protected */ - BEGP(pt0); - pt0 = (CELL *) YENV; -#ifdef FROZEN_STACKS - { - choiceptr top_b = PROTECT_FROZEN_B(B); - -#ifdef SBA - if (pt0 > (CELL *) top_b || pt0 < H) { - GONext(); - } -#else - if (pt0 > (CELL *) top_b) { - GONext(); - } -#endif - } -#else - if (pt0 > (CELL *)B) { - GONext(); - } -#endif /* FROZEN_STACKS */ - ENDP(pt0); -#if defined(YAPOR) || defined(THREADS) - { - Clause *cl = (Clause *)(ecl->u.EC.ClBase); - Term tc = AbsPair(((CELL *)&(cl->ClFlags))); - - /* Question: how do we find the trail cell we want to reset? */ - /* Quick hack: search for it */ - tr_fr_ptr trp = (((choiceptr) YENV[E_CB])->cp_tr); - while (TrailTerm(trp) != tc) { - trp++; - } - /* the correct solution would be to store this in the environment */ - RESET_VARIABLE(&TrailTerm(trp)); - LOCK(cl->ClLock); - DEC_CLREF_COUNT(cl); - UNLOCK(cl->ClLock); - } -#else - if (ecl->u.EC.ClENV == LCL0-YENV) { - Clause *cl = (Clause *)(ecl->u.EC.ClBase); - /* if the environment is protected we can't do nothing */ - /* unmark the clause */ - cl->ClFlags &= ~InUseMask; - ecl->u.EC.ClENV = 0; - RESET_VARIABLE((CELL *)((tr_fr_ptr)TrailBase+ecl->u.EC.ClTrail)); - if ((cl->ClFlags & ErasedMask) && (ecl->u.EC.ClRefs == 0)) { - ErCl(cl); - } - } -#endif - } - GONext(); - ENDBOp(); - /***************************************************************** * try and retry of dynamic predicates * *****************************************************************/ diff --git a/C/amasm.c b/C/amasm.c index f59f2d2ca..8fa045eb3 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -45,7 +45,6 @@ STATIC_PROTO(COUNT emit_count, (CELL)); STATIC_PROTO(OPCODE emit_op, (op_numbers)); STATIC_PROTO(void a_cl, (op_numbers)); STATIC_PROTO(void a_cle, (op_numbers)); -STATIC_PROTO(void a_cld, (op_numbers)); STATIC_PROTO(void a_e, (op_numbers)); STATIC_PROTO(void a_ue, (op_numbers, op_numbers)); STATIC_PROTO(void a_v, (op_numbers)); @@ -347,16 +346,6 @@ a_cle(op_numbers opcode) GONEXT(EC); } -static void -a_cld(op_numbers opcode) -{ - if (pass_no) { - code_p->opc = emit_op(opcode); - code_p->u.l.l = (CODEADDR)(((Clause *)code_addr)->u2.ClExt); - } - GONEXT(l); -} - inline static void a_e(op_numbers opcode) { @@ -1404,8 +1393,6 @@ a_deallocate(void) a_cle(_alloc_for_logical_pred); a_e(_allocate); } - if (CurrentPred->PredFlags & LogUpdatePredFlag) - a_cld(_dealloc_for_logical_pred); if (NEXTOPC == execute_op) { cpc = cpc->nextInst; a_p(_dexecute); diff --git a/C/dbase.c b/C/dbase.c index 82521d27c..2df6968cb 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -1225,6 +1225,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag) pp->Entry = (CELL) Tm; pp->Code = NULL; pp->DBRefs = NULL; + pp->NOfCells = 1; INIT_LOCK(pp->lock); INIT_DBREF_COUNT(pp); return(pp); @@ -1253,6 +1254,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag) pp->Entry = (CELL) Tm; pp->Code = NULL; pp->DBRefs = NULL; + pp->NOfCells = 1; INIT_LOCK(pp->lock); INIT_DBREF_COUNT(pp); return(pp); diff --git a/C/heapgc.c b/C/heapgc.c index 37b4642e5..3d54f0294 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -500,7 +500,7 @@ store_ref_in_dbtable(DBRef entry) if ((ADDR)new > TrailTop-1024) growtrail(64 * 1024L); new->val = entry; - new->lim = entry->Contents+entry->NOfCells; + new->lim = (CELL *)((CODEADDR)entry+SizeOfBlock((CODEADDR)entry)); new->left = new->right = NULL; if (db_vec == db_vec0) { db_vec++; @@ -526,6 +526,42 @@ store_ref_in_dbtable(DBRef entry) } } +/* init the table */ +static void +store_cl_in_dbtable(Clause *cl) +{ + dbentry parent = db_vec0; + dbentry new = db_vec; + + if ((ADDR)new > TrailTop-1024) + growtrail(64 * 1024L); + new->val = (DBRef)cl; + new->lim = (CELL *)((CODEADDR)cl + SizeOfBlock((CODEADDR)cl)); + new->left = new->right = NULL; + if (db_vec == db_vec0) { + db_vec++; + return; + } + db_vec++; + parent = db_vec0; + beg: + if ((DBRef)cl < parent->val) { + if (parent->right == NULL) { + parent->right = new; + } else { + parent = parent->right; + goto beg; + } + } else { + if (parent->left == NULL) { + parent->left = new; + } else { + parent = parent->left; + goto beg; + } + } +} + /* find an element in the dbentries table */ static DBRef find_ref_in_dbtable(DBRef entry) @@ -533,8 +569,9 @@ find_ref_in_dbtable(DBRef entry) dbentry current = db_vec0; while (current != NULL) { - if (current->val < entry && current->lim > (CELL *)entry) + if (current->val < entry && current->lim > (CELL *)entry) { return(current->val); + } if (entry < current->val) current = current->right; else @@ -554,6 +591,8 @@ mark_db_fixed(CELL *ptr) { static void init_dbtable(tr_fr_ptr trail_ptr) { + Clause *cl = DeadClauses; + db_vec0 = db_vec = (dbentry)TR; while (trail_ptr > (tr_fr_ptr)TrailBase) { register CELL trail_cell; @@ -565,6 +604,7 @@ init_dbtable(tr_fr_ptr trail_ptr) { if (!IsVarTerm(trail_cell) && IsPairTerm(trail_cell)) { CELL *pt0 = RepPair(trail_cell); /* DB pointer */ + CODEADDR entry; CELL flags; #ifdef FROZEN_STACKS /* TRAIL */ @@ -583,14 +623,18 @@ init_dbtable(tr_fr_ptr trail_ptr) { flags = Flags((CELL)pt0); /* for the moment, if all references to the term in the stacks are only pointers, reset the flag */ + entry = ((CODEADDR)pt0 - (CELL) &(((DBRef) NIL)->Flags)); if (FlagOn(DBClMask, flags)) { - if (FlagOn(DBNoVars, flags)) { - CODEADDR entry = ((CODEADDR)pt0 - (CELL) &(((DBRef) NIL)->Flags)); - store_ref_in_dbtable((DBRef)entry); - } + store_ref_in_dbtable((DBRef)entry); + } else { + store_cl_in_dbtable((Clause *)entry); } } } + while (cl != NULL) { + store_cl_in_dbtable(cl); + cl = cl->u.NextCl; + } if (db_vec == db_vec0) { /* could not find any entries: probably using LOG UPD semantics */ db_vec0 = NULL; @@ -879,15 +923,13 @@ mark_variable(CELL_PTR current) if ((Functor)cnext == FunctorDBRef) { DBRef tref = DBRefOfTerm(ccur); /* make sure the reference is marked as in use */ - if (tref->Flags & InUseMask) { - if ((tref->Flags & ErasedMask) && - tref->Parent != NULL && - tref->Parent->KindOfPE & LogUpdDBBit) { - *current = MkDBRefTerm(DBErasedMarker); - MARK(current); - } else { - tref->Flags |= GcFoundMask; - } + if ((tref->Flags & ErasedMask) && + tref->Parent != NULL && + tref->Parent->KindOfPE & LogUpdDBBit) { + *current = MkDBRefTerm(DBErasedMarker); + MARK(current); + } else { + tref->Flags |= GcFoundMask; } } else { mark_db_fixed(next); @@ -1065,11 +1107,15 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap) while (gc_ENV != NULL) { /* no more environments */ Int bmap = 0; int currv = 0; + Clause *cl; #ifdef DEBUG if (size < 0 || size > 512) YP_fprintf(YP_stderr,"Oops, env size for %p is %ld\n", gc_ENV, (unsigned long int)size); #endif + if ((cl = (Clause *)find_ref_in_dbtable((DBRef)gc_ENV[E_CP])) != NULL) { + cl->ClFlags |= GcFoundMask; + } /* for each saved variable */ if (size > EnvSizeInCells) { int tsize = size - EnvSizeInCells; @@ -1367,7 +1413,14 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose) op_numbers opnum; register OPCODE op; yamop *rtp = gc_B->cp_ap; + Clause *cl; + if ((cl = (Clause *)find_ref_in_dbtable((DBRef)rtp)) != NULL) { + cl->ClFlags |= GcFoundMask; + } + if ((cl = (Clause *)find_ref_in_dbtable((DBRef)(gc_B->cp_b))) != NULL) { + cl->ClFlags |= GcFoundMask; + } #ifdef EASY_SHUNTING current_B = gc_B; prev_HB = HB; @@ -1393,12 +1446,19 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose) } if (very_verbose) { switch (opnum) { + case _retry_c: + if (gc_B->cp_ap == RETRY_C_RECORDED_CODE + || gc_B->cp_ap == RETRY_C_RECORDED_K_CODE + || gc_B->cp_ap == RETRY_C_DRECORDED_CODE + || gc_B->cp_ap == RETRY_C_RECORDEDP_CODE) { + DBRef entryref = (DBRef)EXTRA_CBACK_ARG(3,1); + entryref->Flags |= GcFoundMask; + } case _or_else: case _or_last: case _Nstop: case _switch_last: case _switch_l_list: - case _retry_c: case _retry_userc: case _trust_logical_pred: case _retry_profiled: @@ -1751,6 +1811,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR) Int hp_entrs = 0, hp_erased = 0, hp_not_in_use = 0, hp_in_use_erased = 0, code_entries = 0; #endif + Clause **cptr, *cl; #ifndef FROZEN_STACKS /* @@ -1852,32 +1913,47 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR) #endif /* FROZEN_STACKS */ flags = Flags((CELL)pt0); #ifdef DEBUG - if (FlagOn(DBClMask, flags)) { - hp_entrs++; - if (!FlagOn(GcFoundMask, flags)) { - hp_not_in_use++; - if (FlagOn(ErasedMask, flags)) { - hp_erased++; - } - } else { - if (FlagOn(ErasedMask, flags)) { - hp_in_use_erased++; - } + hp_entrs++; + if (!FlagOn(GcFoundMask, flags)) { + hp_not_in_use++; + if (!FlagOn(DBClMask, flags)) { + code_entries++; + } + if (FlagOn(ErasedMask, flags)) { + hp_erased++; } } else { - code_entries++; + if (FlagOn(ErasedMask, flags)) { + hp_in_use_erased++; + } } #endif - - if (!FlagOn(GcFoundMask, flags)) { + if (!FlagOn(GcFoundMask, flags)) { if (FlagOn(DBClMask, flags)) { - Flags((CELL)pt0) = ResetFlag(InUseMask, flags); - if (FlagOn(ErasedMask, flags)) { - ErDBE((DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags))); + DBRef dbr = (DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags)); + dbr->Flags &= ~InUseMask; + DEC_DBREF_COUNT(dbr); + if (dbr->Flags & ErasedMask) { + ErDBE(dbr); + } + } else { + Clause *cl = ClauseFlagsToClause((CELL)pt0); + int erase; + DEC_CLREF_COUNT(cl); + cl->ClFlags &= ~InUseMask; + erase = (cl->ClFlags & ErasedMask) +#if defined(YAPOR) || defined(THREADS) + && (cl->ref_count == 0) +#endif + ; + if (erase) { + /* at this point, + no one is accessing the clause */ + ErCl(cl); } - RESET_VARIABLE(&TrailTerm(dest)); - discard_trail_entries++; } + RESET_VARIABLE(&TrailTerm(dest)); + discard_trail_entries++; } else { Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags); } @@ -1959,7 +2035,21 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR) (unsigned long int)(OldHeapUsed-HeapUsed), (unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)), (unsigned long int)OldHeapUsed); + } + cptr = &(DeadClauses); + cl = DeadClauses; + while (cl != NULL) { + if (!(cl->ClFlags & GcFoundMask)) { + char *ocl = (char *)cl; + cl = cl->u.NextCl; + *cptr = cl; + FreeCodeSpace(ocl); + } else { + cl->ClFlags &= ~GcFoundMask; + cptr = &(cl->u.NextCl); + cl = cl->u.NextCl; } + } } diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 78f8b4b56..4387806eb 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -252,10 +252,9 @@ OPCODE(profiled_retry_me ,ld), OPCODE(profiled_trust_me ,ld), OPCODE(profiled_retry_and_mark ,ld), - OPCODE(try_logical_pred ,EC), + OPCODE(try_logical_pred ,l), OPCODE(trust_logical_pred ,l), - OPCODE(alloc_for_logical_pred ,l), - OPCODE(dealloc_for_logical_pred,l), + OPCODE(alloc_for_logical_pred ,EC), #ifdef SFUNC OPCODE(get_s_f ,), OPCODE(put_s_f ,), diff --git a/H/rheap.h b/H/rheap.h index b311a05ab..361c10b5b 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -651,7 +651,6 @@ RestoreClause(Clause *Cl, int mode) case _retry_profiled: case _try_logical_pred: case _trust_logical_pred: - case _dealloc_for_logical_pred: case _execute: case _dexecute: case _jump: diff --git a/changes4.3.html b/changes4.3.html index df7a645a7..9e51b4042 100644 --- a/changes4.3.html +++ b/changes4.3.html @@ -16,6 +16,9 @@

Yap-4.3.23: