static void clean_atom_list(AtomHashEntry *HashPtr) { Atom atm = HashPtr->Entry; Atom *patm = &(HashPtr->Entry); while (atm != NIL) { AtomEntry *at = RepAtom(atm); if (AtomResetMark(at) || at->PropsOfAE != NIL || (AGCHook != NULL && !AGCHook(atm))) { patm = &(at->NextOfAE); atm = at->NextOfAE; } else { NOfAtoms--; if (IsWideAtom(atm)) { #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%S\n", at, at->WStrOfAE); #endif agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE); } else { #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE); #endif agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); } *patm = atm = at->NextOfAE; Yap_FreeCodeSpace((char *)at); } } }
Atom Yap_LookupMaybeWideAtomWithLength( const wchar_t *atom, size_t len0) { /* lookup atom in atom table */ Atom at; int wide = FALSE; size_t i = 0; while (i < len0) { // primary support for atoms with null chars wchar_t c = atom[i]; if (c > 255) { wide = TRUE; break; } if (c == '\0') { len0 = i; break; } i++; } if (wide) { wchar_t *ptr0; ptr0 = (wchar_t *)Yap_AllocCodeSpace(sizeof(wchar_t) * (len0 + 1)); if (!ptr0) return NIL; memcpy(ptr0, atom, len0 * sizeof(wchar_t)); ptr0[len0] = '\0'; at = LookupWideAtom(ptr0); Yap_FreeCodeSpace((char *)ptr0); return at; } else { unsigned char *ptr0; ptr0 = Yap_AllocCodeSpace((len0 + 1)); if (!ptr0) return NIL; for (i = 0; i < len0; i++) ptr0[i] = atom[i]; ptr0[len0] = '\0'; at = LookupAtom(ptr0); Yap_FreeCodeSpace(ptr0); return at; } }
static void kill_thread_engine (int wid, int always_die) { Prop p0 = AbsPredProp(REMOTE_ThreadHandle(wid).local_preds); GlobalEntry *gl = REMOTE_GlobalVariables(wid); REMOTE_ThreadHandle(wid).local_preds = NIL; REMOTE_GlobalVariables(wid) = NULL; /* kill all thread local preds */ while(p0) { PredEntry *ap = RepPredProp(p0); p0 = ap->NextOfPE; Yap_Abolish(ap); Yap_FreeCodeSpace((char *)ap); } while (gl) { gl->global = TermFoundVar; gl = gl->NextGE; } Yap_KillStacks(wid); REMOTE_ActiveSignals(wid) = 0L; if (REMOTE_ScratchPad(wid).ptr) free(REMOTE_ScratchPad(wid).ptr); REMOTE_ThreadHandle(wid).current_yaam_regs = NULL; if (REMOTE_ThreadHandle(wid).start_of_timesp) free(REMOTE_ThreadHandle(wid).start_of_timesp); if (REMOTE_ThreadHandle(wid).last_timep) free(REMOTE_ThreadHandle(wid).last_timep); if (REMOTE_ThreadHandle(wid).texit) { Yap_FreeCodeSpace((ADDR)REMOTE_ThreadHandle(wid).texit); } /* FreeCodeSpace requires LOCAL requires yaam_regs */ free(REMOTE_ThreadHandle(wid).default_yaam_regs); REMOTE_ThreadHandle(wid).default_yaam_regs = NULL; LOCK(GLOBAL_ThreadHandlesLock); if (REMOTE_ThreadHandle(wid).tdetach == MkAtomTerm(AtomTrue) || always_die) { REMOTE_ThreadHandle(wid).zombie = FALSE; REMOTE_ThreadHandle(wid).in_use = FALSE; DEBUG_TLOCK_ACCESS(1, wid); pthread_mutex_unlock(&(REMOTE_ThreadHandle(wid).tlock)); } UNLOCK(GLOBAL_ThreadHandlesLock); }
static void clean_atom_list(AtomHashEntry *HashPtr) { Atom atm = HashPtr->Entry; Atom *patm = &(HashPtr->Entry); while (atm != NIL) { AtomEntry *at = RepAtom(atm); if (AtomResetMark(at) || ( at->PropsOfAE != NIL && !IsBlob(at) ) || (GLOBAL_AGCHook != NULL && !GLOBAL_AGCHook(atm))) { patm = &(at->NextOfAE); atm = at->NextOfAE; } else { NOfAtoms--; if (IsBlob(atm)) { BlobPropEntry *b = RepBlobProp(at->PropsOfAE); if (b->NextOfPE != NIL) { patm = &(at->NextOfAE); atm = at->NextOfAE; continue; } NOfAtoms++; NOfBlobs--; Yap_FreeCodeSpace((char *)b); GLOBAL_agc_collected += sizeof(BlobPropEntry); GLOBAL_agc_collected += sizeof(AtomEntry)+sizeof(size_t)+at->rep.blob->length; } else if (IsWideAtom(atm)) { #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%S\n", at, at->WStrOfAE); #endif GLOBAL_agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE); } else { #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE); #endif GLOBAL_agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); } *patm = atm = at->NextOfAE; Yap_FreeCodeSpace((char *)at); } } }
Atom Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len) { /* lookup atom in atom table */ wchar_t *p = atom, c; size_t len0 = 0; Atom at; int wide = FALSE; while ((c = *p++)) { if (c > 255) wide = TRUE; len0++; if (len0 == len) break; } if (p[0] == '\0' && wide) return LookupWideAtom(atom); else if (wide) { wchar_t *ptr, *ptr0; p = atom; ptr0 = ptr = (wchar_t *)Yap_AllocCodeSpace(sizeof(wchar_t)*(len+1)); if (!ptr) return NIL; while (len--) {*ptr++ = *p++;} ptr[0] = '\0'; at = LookupWideAtom(ptr0); Yap_FreeCodeSpace((char *)ptr0); return at; } else { char *ptr, *ptr0; /* not really a wide atom */ p = atom; ptr0 = ptr = Yap_AllocCodeSpace(len+1); if (!ptr) return NIL; while (len--) {*ptr++ = *p++;} ptr[0] = '\0'; at = LookupAtom(ptr0); Yap_FreeCodeSpace(ptr0); return at; } }
Atom Yap_LookupAtomWithLength(const char *atom, size_t len0) { /* lookup atom in atom table */ Atom at; unsigned char *ptr; /* not really a wide atom */ ptr = Yap_AllocCodeSpace(len0 + 1); if (!ptr) return NIL; memcpy(ptr, atom, len0); ptr[len0] = '\0'; at = LookupAtom(ptr); Yap_FreeCodeSpace(ptr); return at; }
void Yap_ShutdownLoadForeign( void ) { ForeignObj *f_code; int err; f_code = ForeignCodeLoaded; while( f_code != NULL ) { StringList objs, libs; objs = f_code->objs; while( objs ) { err = shl_unload( *(shl_t *)objs->handle ); if( err ) { /* dunno how to properly report an error here */ perror( NULL ); return; } Yap_FreeCodeSpace( objs->handle ); objs = objs->next; } libs = f_code->libs; while( libs ) { err = shl_unload( *(shl_t *)libs->handle ); if( err ) { /* dunno how to properly report an error here */ perror( NULL ); return; } Yap_FreeCodeSpace( libs->handle ); libs = libs->next; } f_code = f_code->next; } }
Atom Yap_LookupMaybeWideAtom(wchar_t *atom) { /* lookup atom in atom table */ wchar_t *p = atom, c; size_t len = 0; char *ptr, *ptr0; Atom at; while ((c = *p++)) { if (c > 255) return LookupWideAtom(atom); len++; } /* not really a wide atom */ p = atom; ptr0 = ptr = Yap_AllocCodeSpace(len+1); if (!ptr) return NIL; while ((*ptr++ = *p++)); at = LookupAtom(ptr0); Yap_FreeCodeSpace(ptr0); return at; }
/* fe is supposed to be locked */ Prop Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) { PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p)); if (p == NULL) { WRITE_UNLOCK(fe->FRWLock); return NULL; } if (cur_mod == TermProlog || cur_mod == 0L) { p->ModuleOfPred = 0L; } else p->ModuleOfPred = cur_mod; // TRUE_FUNC_WRITE_LOCK(fe); INIT_LOCK(p->PELock); p->KindOfPE = PEProp; p->ArityOfPE = fe->ArityOfFE; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.NOfClauses = 0; p->PredFlags = 0L; p->src.OwnerFile = Yap_source_file_name(); p->OpcodeOfPred = UNDEF_OPCODE; p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->cs.p_code.ExpandCode = EXPAND_OP_CODE; p->TimeStampOfPred = 0L; p->LastCallOfPred = LUCALL_ASSERT; if (cur_mod == TermProlog) p->ModuleOfPred = 0L; else p->ModuleOfPred = cur_mod; Yap_NewModulePred(cur_mod, p); #ifdef TABLING p->TableOfPred = NULL; #endif /* TABLING */ #ifdef BEAM p->beamTable = NULL; #endif /* BEAM */ /* careful that they don't cross MkFunctor */ if (!trueGlobalPrologFlag(DEBUG_INFO_FLAG)) { p->PredFlags |= NoTracePredFlag; } p->FunctorOfPred = fe; 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); FUNC_WRITE_UNLOCK(fe); 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->NextPredOfHash = PredHash[hsh]; PredHash[hsh] = pe; fe->PropsOfFE = AbsPredProp(p); p->NextOfPE = AbsPredProp(pe); } else { p->NextPredOfHash = PredHash[hsh]; PredHash[hsh] = p; p->NextOfPE = fe->PropsOfFE->NextOfPE; fe->PropsOfFE->NextOfPE = AbsPredProp(p); } WRITE_UNLOCK(PredHashRWLock); } else { fe->PropsOfFE = AbsPredProp(p); p->NextOfPE = NIL; } FUNC_WRITE_UNLOCK(fe); { Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p, GPROF_NEW_PRED_FUNC); if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) { Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode) + 1, p, GPROF_NEW_PRED_FUNC); } } return AbsPredProp(p); }
void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code, pred_flags_t flags) { CACHE_REGS Atom atom = NIL; PredEntry *pe = NULL; yamop *p_code; StaticClause *cl = NULL; Functor f = NULL; while (atom == NIL) { if (flags & UserCPredFlag) atom = Yap_LookupAtom(Name); else atom = Yap_FullLookupAtom(Name); if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } if (Arity) { while (!f) { f = Yap_MkFunctor(atom, Arity); if (!f && !Yap_growheap(FALSE, 0L, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } } while (pe == NULL) { if (Arity) pe = RepPredProp(PredPropByFunc(f, CurrentModule)); else pe = RepPredProp(PredPropByAtom(atom, CurrentModule)); if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } if (pe->PredFlags & CPredFlag) { /* already exists */ flags = update_flags_from_prolog(flags, pe); cl = ClauseCodeToStaticClause(pe->CodeOfPred); if ((flags | StandardPredFlag | CPredFlag) != pe->PredFlags) { Yap_ClauseSpace -= cl->ClSize; Yap_FreeCodeSpace((ADDR)cl); cl = NULL; } } p_code = cl->ClCode; while (!cl) { UInt sz; if (flags & SafePredFlag) { sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code, Osbpp), p), l); } else { sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code, e), p), Osbpp), p), l); } cl = (StaticClause *)Yap_AllocCodeSpace(sz); if (!cl) { if (!Yap_growheap(FALSE, sz, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } else { Yap_ClauseSpace += sz; cl->ClFlags = StaticMask; cl->ClNext = NULL; cl->ClSize = sz; cl->usc.ClLine = Yap_source_line_no(); p_code = cl->ClCode; } } pe->CodeOfPred = p_code; pe->PredFlags = flags | StandardPredFlag | CPredFlag; pe->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1); pe->cs.f_code = code; if (!(flags & SafePredFlag)) { p_code->opc = Yap_opcode(_allocate); p_code = NEXTOP(p_code, e); } if (flags & UserCPredFlag) p_code->opc = Yap_opcode(_call_usercpred); else p_code->opc = Yap_opcode(_call_cpred); p_code->y_u.Osbpp.bmap = NULL; p_code->y_u.Osbpp.s = -Signed(RealEnvSize); p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe; p_code = NEXTOP(p_code, Osbpp); if (!(flags & SafePredFlag)) { p_code->opc = Yap_opcode(_deallocate); p_code->y_u.p.p = pe; p_code = NEXTOP(p_code, p); } p_code->opc = Yap_opcode(_procceed); p_code->y_u.p.p = pe; p_code = NEXTOP(p_code, p); p_code->opc = Yap_opcode(_Ystop); p_code->y_u.l.l = cl->ClCode; pe->OpcodeOfPred = pe->CodeOfPred->opc; }
void Yap_CloseScratchPad(void) { CACHE_REGS Yap_FreeCodeSpace(LOCAL_ScratchPad.ptr); LOCAL_ScratchPad.sz = SCRATCH_START_SIZE; LOCAL_ScratchPad.msz = SCRATCH_START_SIZE; }
/* fe is supposed to be locked */ Prop Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) { PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p)); if (p == NULL) { WRITE_UNLOCK(fe->FRWLock); return NULL; } if (cur_mod == TermProlog) p->ModuleOfPred = 0L; else p->ModuleOfPred = cur_mod; 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: note that this is not a valid pointer!! */ RepPredProp(fe->PropsOfFE)->NextOfPE = fe->PropsOfFE; } else { fe->PropsOfFE = AbsPredProp(p); p->NextOfPE = NIL; } INIT_LOCK(p->PELock); p->KindOfPE = PEProp; p->ArityOfPE = fe->ArityOfFE; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.NOfClauses = 0; p->PredFlags = 0L; p->src.OwnerFile = AtomNil; p->OpcodeOfPred = UNDEF_OPCODE; p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->cs.p_code.ExpandCode = EXPAND_OP_CODE; p->TimeStampOfPred = 0L; p->LastCallOfPred = LUCALL_ASSERT; if (cur_mod == TermProlog) p->ModuleOfPred = 0L; else p->ModuleOfPred = cur_mod; Yap_NewModulePred(cur_mod, p); INIT_LOCK(p->StatisticsForPred.lock); p->StatisticsForPred.NOfEntries = 0; p->StatisticsForPred.NOfHeadSuccesses = 0; p->StatisticsForPred.NOfRetries = 0; #ifdef TABLING p->TableOfPred = NULL; #endif /* TABLING */ #ifdef BEAM p->beamTable = NULL; #endif /* BEAM */ /* careful that they don't cross MkFunctor */ if (PRED_GOAL_EXPANSION_FUNC) { if (fe->PropsOfFE && (RepPredProp(fe->PropsOfFE)->PredFlags & GoalExPredFlag)) { p->PredFlags |= GoalExPredFlag; } } p->FunctorOfPred = fe; WRITE_UNLOCK(fe->FRWLock); { Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_FUNC); if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) { Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_FUNC); } } return AbsPredProp(p); }
/* * New user indexed predicate: * the first argument is the term. */ static YAP_Int p_new_udi( USES_REGS1 ) { Term spec = Deref(ARG1); PredEntry *p; UdiInfo blk; int info; /* get the predicate from the spec, copied from cdmgr.c */ if (IsVarTerm(spec)) { Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1"); return FALSE; } else if (!IsApplTerm(spec)) { Yap_Error(TYPE_ERROR_COMPOUND,spec,"new user index/1"); return FALSE; } else { Functor fun = FunctorOfTerm(spec); Term tmod = CurrentModule; while (fun == FunctorModule) { tmod = ArgOfTerm(1,spec); if (IsVarTerm(tmod) ) { Yap_Error(INSTANTIATION_ERROR, spec, "new user index/1"); return FALSE; } if (!IsAtomTerm(tmod) ) { Yap_Error(TYPE_ERROR_ATOM, spec, "new user index/1"); return FALSE; } spec = ArgOfTerm(2, spec); fun = FunctorOfTerm(spec); } p = RepPredProp(PredPropByFunc(fun, tmod)); } if (!p) return FALSE; /* boring, boring, boring! */ if ((p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) || (p->ModuleOfPred == PROLOG_MODULE)) { Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, spec, "udi/2"); return FALSE; } if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|TabledPredFlag)) { Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2"); return FALSE; } /* TODO: remove AtomRTree from atom list */ /* this is the real work */ blk = (UdiInfo) Yap_AllocCodeSpace(sizeof(struct udi_info)); memset((void *) blk,0, sizeof(struct udi_info)); if (!blk) { Yap_Error(OUT_OF_HEAP_ERROR, spec, "new user index/1"); return FALSE; } /*Init UdiInfo */ utarray_new(blk->args, &arg_icd); utarray_new(blk->clauselist, &cl_icd); blk->p = p; /*Now Init args list*/ info = p_udi_args_init(spec, p->ArityOfPE, blk); if (!info) { utarray_free(blk->args); utarray_free(blk->clauselist); Yap_FreeCodeSpace((char *) blk); return FALSE; } /*Push into the hash*/ HASH_ADD_UdiInfo(UdiControlBlocks, p, blk); p->PredFlags |= UDIPredFlag; return TRUE; }