diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

new heap allocation code

Browse Source 
new atom table growth code and hash algorithm
more fixes for new indexing algorithm


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@905 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-10-28 01:16:03 +00:00
parent 5244795d97
commit 5e4816eb5a
27 changed files with 489 additions and 205 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
C/absmi.c
View File

@ -287,7 +287,9 @@ Yap_absmi(int inp)
noheapleft:
CFREG = CalculateStackGap();
saveregs();
if (!Yap_growheap(FALSE, 0)) {
if (NOfAtoms > 2*AtomHashTableSize) {
Yap_growatomtable();
} else if (!Yap_growheap(FALSE, 0)) {
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs();
FAIL();
@ -6355,40 +6357,25 @@ Yap_absmi(int inp)
ENDBOp();
BOp(expand_index, e);
saveregs();
{
PredEntry *pe = PredFromExpandCode(PREG);
yamop *pt0;
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
PREG = Yap_ExpandIndex(pe);
saveregs();
pt0 = Yap_ExpandIndex(pe);
/* restart index */
setregs();
PREG = pt0;
CACHED_A1() = ARG1;
JMPNext();
}
ENDBOp();
BOp(check_var_for_index, xxp);
{
CELL *pt0 = XREGS+PREG->u.xxp.x;
do {
if (!IsVarTerm(*pt0)) {
saveregs();
Yap_RemoveIndexation(PREG->u.xxp.p);
setregs();
PREG = PREG->u.xxp.p->CodeOfPred;
JMPNext();
}
pt0++;
} while (pt0 <= XREGS+PREG->u.xxp.x1);
}
PREG = NEXTOP(PREG,xxp);
JMPNext();
ENDBOp();
BOp(undef_p, e);
/* save S for module name */
{
@ -6794,12 +6781,12 @@ Yap_absmi(int inp)
d0 = CACHED_A1();
deref_head(d0, jump_if_unk);
/* non var */
jump_if_nonvar:
jump0_if_nonvar:
PREG = NEXTOP(PREG, l);
JMPNext();
BEGP(pt0);
deref_body(d0, pt0, jump_if_unk, jump_if_nonvar);
deref_body(d0, pt0, jump_if_unk, jump0_if_nonvar);
/* variable */
PREG = PREG->u.l.l;
ENDP(pt0);
@ -6807,6 +6794,24 @@ Yap_absmi(int inp)
ENDD(d0);
ENDBOp();
BOp(jump_if_nonvar, xl);
BEGD(d0);
d0 = XREG(PREG->u.xl.x);
deref_head(d0, jump2_if_unk);
/* non var */
jump2_if_nonvar:
PREG = PREG->u.xl.l;
JMPNext();
BEGP(pt0);
deref_body(d0, pt0, jump2_if_unk, jump2_if_nonvar);
/* variable */
PREG = NEXTOP(PREG, xl);
ENDP(pt0);
JMPNext();
ENDD(d0);
ENDBOp();
BOp(if_not_then, clll);
BEGD(d0);
d0 = CACHED_A1();
@ -6840,7 +6845,7 @@ Yap_absmi(int inp)
#define HASH_SHIFT 6
BOp(switch_on_func, sl);
BOp(switch_on_func, ssl);
BEGD(d1);
d1 = *SREG++;
/* we use a very simple hash function to find elements in a
@ -6884,7 +6889,7 @@ Yap_absmi(int inp)
ENDD(d1);
ENDBOp();
BOp(switch_on_cons, sl);
BOp(switch_on_cons, ssl);
BEGD(d1);
d1 = I_R;
/* we use a very simple hash function to find elements in a
@ -11358,11 +11363,11 @@ Yap_absmi(int inp)
#endif
if (CFREG != CalculateStackGap())
goto creep_pe;
saveregs();
saveregs_and_ycache();
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
}
setregs();
setregs_and_ycache();
goto execute_end;
ENDCACHE_Y_AS_ENV();
}
@ -11589,13 +11594,13 @@ Yap_absmi(int inp)
ASP = E_YREG;
if (CFREG == (CELL)(LCL0+1)) {
CFREG = CalculateStackGap();
saveregs();
saveregs_and_ycache();
if (!Yap_growheap(FALSE, 0)) {
Yap_Error(SYSTEM_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs();
setregs_and_ycache();
FAIL();
}
setregs();
setregs_and_ycache();
goto execute_after_comma;
}
#ifdef COROUTINING

15
C/adtdefs.c
View File

@ -148,7 +148,7 @@ LookupAtom(char *atom)
/* compute hash */
p = (unsigned char *)atom;
hash = HashFunction(p) % MaxHash;
hash = HashFunction(p) % AtomHashTableSize;
WRITE_LOCK(HashChain[hash].AERWLock);
a = HashChain[hash].Entry;
/* search atom in chain */
@ -157,16 +157,20 @@ LookupAtom(char *atom)
WRITE_UNLOCK(HashChain[hash].AERWLock);
return(a);
}
NOfAtoms++;
/* add new atom to start of chain */
ae = (AtomEntry *) Yap_AllocAtomSpace((sizeof *ae) + strlen(atom) + 1);
a = AbsAtom(ae);
ae->NextOfAE = HashChain[hash].Entry;
HashChain[hash].Entry = a;
ae->PropsOfAE = NIL;
if (ae->StrOfAE != atom)
strcpy(ae->StrOfAE, atom);
ae->NextOfAE = HashChain[hash].Entry;
HashChain[hash].Entry = a;
INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(HashChain[hash].AERWLock);
if (NOfAtoms > 2*AtomHashTableSize) {
CreepFlag = Unsigned(LCL0+1);
}
return (a);
}
@ -196,7 +200,7 @@ Yap_LookupAtomWithAddress(char *atom, AtomEntry *ae)
/* compute hash */
p = (unsigned char *)atom;
hash = HashFunction(p) % MaxHash;
hash = HashFunction(p) % AtomHashTableSize;
/* ask for a WRITE lock because it is highly unlikely we shall find anything */
WRITE_LOCK(HashChain[hash].AERWLock);
a = HashChain[hash].Entry;
@ -226,9 +230,10 @@ Yap_ReleaseAtom(Atom atom)
/* compute hash */
p = (unsigned char *)name;
hash = HashFunction(p) % MaxHash;
hash = HashFunction(p) % AtomHashTableSize;
WRITE_LOCK(HashChain[hash].AERWLock);
if (HashChain[hash].Entry == atom) {
NOfAtoms--;
HashChain[hash].Entry = ap->NextOfAE;
WRITE_UNLOCK(HashChain[hash].AERWLock);
return;

6
C/agc.c
View File

@ -163,7 +163,7 @@ mark_atoms(void)
AtomEntry *at;
restore_codes();
for (i = 0; i < MaxHash; ++i) {
for (i = 0; i < AtomHashTableSize; ++i) {
atm = HashPtr->Entry;
if (atm) {
at = RepAtom(atm);
@ -306,7 +306,7 @@ clean_atoms(void)
Atom *patm;
AtomEntry *at;
for (i = 0; i < MaxHash; ++i) {
for (i = 0; i < AtomHashTableSize; ++i) {
atm = HashPtr->Entry;
patm = &(HashPtr->Entry);
while (atm != NIL) {
@ -314,6 +314,7 @@ clean_atoms(void)
if (AtomResetMark(at) || (AGCHook != NULL && !AGCHook(atm))) {
patm = &(at->NextOfAE);
atm = at->NextOfAE;
NOfAtoms--;
} else {
#ifdef DEBUG_RESTORE2
fprintf(stderr, "Purged %s\n", at->StrOfAE);
@ -332,6 +333,7 @@ clean_atoms(void)
at = RepAtom(CleanAtomMarkedBit(atm));
if (AtomResetMark(at) || (AGCHook != NULL && !AGCHook(atm))) {
patm = &(atm->NextOfAE);
NOfAtoms--;
atm = at->NextOfAE;
} else {
#ifdef DEBUG_RESTORE2

100
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.36 2003-10-19 00:33:10 vsc Exp $ *
* version:$Id: alloc.c,v 1.37 2003-10-28 01:16:02 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -231,12 +231,15 @@ AllocHeap(unsigned int size)
BlockHeader *b, *n;
YAP_SEG_SIZE *sp;
size += 2*sizeof(YAP_SEG_SIZE);
#if SIZEOF_INT_P==4
size = (((size + 7) & 0xfffffff8L) >> 2) + 2; /* size in dwords + 2 */
size = (((size + 7) & 0xfffffff8L) >> 2); /* size in dwords + 2 */
#endif
#if SIZEOF_INT_P==8
size = (((size + 7) & 0xfffffffffffffff8LL) >> 3) + 2; /* size in dwords + 2 */
size = (((size + 7) & 0xfffffffffffffff8LL) >> 3); /* size in dwords + 2 */
#endif
if (size < (sizeof(YAP_SEG_SIZE)+sizeof(BlockHeader))/sizeof(CELL))
size = (sizeof(YAP_SEG_SIZE)+sizeof(BlockHeader))/sizeof(CELL);
LOCK(FreeBlocksLock);
if ((b = GetBlock(size))) {
if (b->b_size >= size + 6 + 1) {
@ -339,6 +342,9 @@ Yap_ReleasePreAllocCodeSpace(ADDR ptr)
static void
FreeCodeSpace(char *p)
{
if (p == 0x2adc37e4) {
printf("Erasing my block\n");
}
FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE))));
}
@ -476,6 +482,10 @@ Yap_FreeWorkSpace(void)
#define USE_FIXED 1
#endif
#ifndef MAP_FIXED
#define MAP_FIXED 1
#endif
static MALLOC_T WorkSpaceTop;
static MALLOC_T
@ -582,7 +592,7 @@ InitWorkSpace(Int s)
}
static int
ExtendWorkSpace(Int s)
ExtendWorkSpace(Int s, int fixed_allocation)
{
#ifdef YAPOR
abort_optyap("function ExtendWorkSpace called");
@ -591,16 +601,22 @@ ExtendWorkSpace(Int s)
MALLOC_T a;
prolog_exec_mode OldPrologMode = Yap_PrologMode;
MALLOC_T base = WorkSpaceTop;
if (fixed_allocation == MAP_FIXED)
base = WorkSpaceTop;
else
base = 0L;
#if defined(_AIX) || defined(__hpux)
Yap_PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
a = mmap(base, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
#elif defined(__APPLE__)
Yap_PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
a = mmap(base, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | fixed_allocation, -1, 0);
#else
int fd;
Yap_PrologMode = ExtendStackMode;
@ -664,11 +680,11 @@ ExtendWorkSpace(Int s)
return FALSE;
}
}
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
a = mmap(base, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE
#if !defined(__linux)
/* use MAP_FIXED, otherwise God knows where you will be placed */
|MAP_FIXED
|fixed_allocation
#endif
, fd, 0);
if (close(fd) == -1) {
@ -696,14 +712,21 @@ ExtendWorkSpace(Int s)
Yap_PrologMode = OldPrologMode;
return FALSE;
}
if (a != WorkSpaceTop) {
Yap_ErrorMessage = Yap_ErrorSay;
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
Yap_PrologMode = OldPrologMode;
return FALSE;
if (fixed_allocation) {
if (a != WorkSpaceTop) {
Yap_ErrorMessage = Yap_ErrorSay;
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
Yap_PrologMode = OldPrologMode;
return FALSE;
}
} else if (a < WorkSpaceTop) {
Yap_ErrorMessage = Yap_ErrorSay;
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could grew memory at lower addresses than %p, got %p", WorkSpaceTop, a );
Yap_PrologMode = OldPrologMode;
return FALSE;
}
WorkSpaceTop = (char *) a + s;
Yap_PrologMode = OldPrologMode;
return TRUE;
@ -752,7 +775,7 @@ InitWorkSpace(Int s)
}
static int
ExtendWorkSpace(Int s)
ExtendWorkSpace(Int s, int fixed_allocation)
{
MALLOC_T ptr;
int shm_id;
@ -828,7 +851,7 @@ InitWorkSpace(Int s)
}
static int
ExtendWorkSpace(Int s)
ExtendWorkSpace(Int s, fixed_allocation)
{
MALLOC_T ptr = (MALLOC_T)sbrk(s);
prolog_exec_mode OldPrologMode = Yap_PrologMode;
@ -958,35 +981,35 @@ InitWorkSpace(Int s)
}
static int
ExtendWorkSpace(Int s)
ExtendWorkSpace(Int s, int fixed_allocation)
{
MALLOC_T ptr;
prolog_exec_mode OldPrologMode = Yap_PrologMode;
Yap_PrologMode = ExtendStackMode;
total_space += s;
if (total_space < MAX_SPACE) return(TRUE);
if (total_space < MAX_SPACE) return TRUE;
ptr = (MALLOC_T)realloc((void *)Yap_HeapBase, total_space);
if (ptr == NULL) {
Yap_ErrorMessage = Yap_ErrorSay;
snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes", s);
Yap_PrologMode = OldPrologMode;
return(FALSE);
return FALSE;
}
if (ptr != (MALLOC_T)Yap_HeapBase) {
Yap_ErrorMessage = Yap_ErrorSay;
snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not expand contiguous stacks %d bytes", s);
Yap_PrologMode = OldPrologMode;
return(FALSE);
return FALSE;
}
if ((CELL)ptr & MBIT) {
Yap_ErrorMessage = Yap_ErrorSay;
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"memory at %p conflicts with MBIT %lx", ptr, (unsigned long)MBIT);
Yap_PrologMode = OldPrologMode;
return(FALSE);
return FALSE;
}
Yap_PrologMode = OldPrologMode;
return TRUE;
@ -1092,5 +1115,34 @@ Yap_InitMemory(int Trail, int Heap, int Stack)
int
Yap_ExtendWorkSpace(Int s)
{
return ExtendWorkSpace(s);
return ExtendWorkSpace(s, MAP_FIXED);
}
UInt
Yap_ExtendWorkSpaceThroughHole(UInt s)
{
MALLOC_T WorkSpaceTop0 = WorkSpaceTop;
if (ExtendWorkSpace(s, 0))
return WorkSpaceTop-WorkSpaceTop0;
return -1;
}
void
Yap_AllocHole(UInt actual_request, UInt total_size)
{
/* where we were when the hole was created,
also where is the hole store */
ADDR WorkSpaceTop0 = WorkSpaceTop-total_size;
BlockHeader *newb = (BlockHeader *)HeapTop;
BlockHeader *endb = (BlockHeader *)(WorkSpaceTop0-sizeof(YAP_SEG_SIZE));
YAP_SEG_SIZE bsiz = (WorkSpaceTop0-HeapTop)/sizeof(CELL)-2*sizeof(YAP_SEG_SIZE)/sizeof(CELL);
/* push HeapTop to after hole */
HeapTop = WorkSpaceTop-actual_request;
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
/* now simulate a block */
endb->b_size = (HeapTop-WorkSpaceTop0)/sizeof(CELL) | InUseFlag;
newb->b_size = bsiz;
AddToFreeList(newb);
}

31
C/amasm.c
View File

@ -79,6 +79,7 @@ STATIC_PROTO(void a_gl, (op_numbers));
STATIC_PROTO(void a_bfunc, (CELL));
STATIC_PROTO(wamreg compile_cmp_flags, (char *));
STATIC_PROTO(void a_igl, (op_numbers));
STATIC_PROTO(void a_xigl, (op_numbers));
STATIC_PROTO(void a_ucons, (compiler_vm_op));
STATIC_PROTO(void a_uvar, (void));
STATIC_PROTO(void a_wvar, (void));
@ -456,19 +457,6 @@ a_vv(op_numbers opcode, op_numbers opcodew)
GONEXT(oxx);
}
inline static void
a_xxp(op_numbers opcode)
{
if (pass_no) {
PredEntry *ap = (PredEntry *)(cpc->rnd2);
code_p->opc = emit_op(opcode);
code_p->u.xxp.x = cpc->rnd1;
code_p->u.xxp.x1 = ap->ArityOfPE;
code_p->u.xxp.p = ap;
}
GONEXT(xxp);
}
inline static void
a_vr(op_numbers opcode)
{
@ -1032,6 +1020,17 @@ a_igl(op_numbers opcode)
GONEXT(l);
}
static void
a_xigl(op_numbers opcode)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xl.x = emit_xreg2();
code_p->u.xl.l = emit_a(cpc->rnd1);
}
GONEXT(xl);
}
static void
a_4sw(op_numbers opcode)
{
@ -2496,6 +2495,9 @@ do_pass(void)
case jump_v_op:
a_igl(_jump_if_var);
break;
case jump_nv_op:
a_xigl(_jump_if_nonvar);
break;
case switch_on_type_op:
a_4sw(_switch_on_type);
break;
@ -2528,9 +2530,6 @@ do_pass(void)
case index_blob_op:
a_e(_index_blob);
break;
case check_var_op:
a_xxp(_check_var_for_index);
break;
case mark_initialised_pvars_op:
a_bmap();
break;

7
C/cdmgr.c
View File

@ -289,9 +289,6 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
case _index_blob:
ipc = NEXTOP(ipc,e);
break;
case _check_var_for_index:
ipc = NEXTOP(ipc,xxp);
break;
case _retry:
case _retry_killed:
case _retry_profiled:
@ -331,6 +328,10 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
case _jump_if_var:
ipc = NEXTOP(ipc,l);
break;
/* instructions type xl */
case _jump_if_nonvar:
ipc = NEXTOP(ipc,xl);
break;
/* instructions type e */
case _switch_on_type:
ipc = NEXTOP(ipc,llll);

1
C/computils.c
View File

@ -575,6 +575,7 @@ static char *opformat[] =
"trust\t\t%g\t%x",
"try_in\t\t%g\t%x",
"jump_if_var\t\t%g",
"jump_if_nonvar\t\t%g",
"cache_arg\t%r",
"cache_sub_arg\t%d",
"switch_on_type\t%h\t%h\t%h\t%h",

67
C/dbase.c
View File

@ -3437,13 +3437,64 @@ p_first_instance(void)
return(Yap_unify(ARG3, TRef));
}
static UInt
index_sz(LogUpdIndex *x)
{
UInt sz = Yap_SizeOfBlock((CODEADDR)x);
x = x->ChildIndex;
while (x != NULL) {
sz += index_sz(x);
x = x->SiblingIndex;
}
return sz;
}
static Int
lu_statistics(PredEntry *pe)
{
UInt sz = 0, cls = 0, isz = 0;
/* count number of clauses and size */
LogUpdClause *x;
if (pe->cs.p_code.FirstClause == NULL) {
cls = 0;
sz = 0;
} else {
x = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause);
while (x != NULL) {
cls++;
sz += Yap_SizeOfBlock((CODEADDR)x);
if (x->ClSource != NULL)
sz += Yap_SizeOfBlock((CODEADDR)x->ClSource);
x = x->ClNext;
}
}
if (pe->PredFlags & IndexedPredFlag) {
isz = index_sz(ClauseCodeToLogUpdIndex(pe->cs.p_code.TrueCodeOfPred));
} else {
isz = 0;
}
return
Yap_unify(ARG2,MkIntegerTerm(cls)) &&
Yap_unify(ARG3,MkIntegerTerm(sz)) &&
Yap_unify(ARG4,MkIntegerTerm(isz));
}
static Int
p_key_statistics(void)
{
Register DBProp p;
Register DBRef x;
UInt sz = 0, cls = 0;
if (EndOfPAEntr(p = FetchDBPropFromKey(Deref(ARG1), 0, TRUE, "key_statistics/3"))) {
Term twork = Deref(ARG1);
PredEntry *pe;
if ((pe = find_lu_entry(twork)) != NULL) {
return lu_statistics(pe);
}
if (EndOfPAEntr(p = FetchDBPropFromKey(twork, 0, TRUE, "key_statistics/3"))) {
/* This is not a key property */
return(FALSE);
}
@ -3454,8 +3505,10 @@ p_key_statistics(void)
sz += Yap_SizeOfBlock((CODEADDR)x);
x = NextDBRef(x);
}
return(Yap_unify(ARG2,MkIntegerTerm(cls)) &&
Yap_unify(ARG3,MkIntegerTerm(sz)));
return
Yap_unify(ARG2,MkIntegerTerm(cls)) &&
Yap_unify(ARG3,MkIntegerTerm(sz)) &&
Yap_unify(ARG4,MkIntTerm(0));
}
@ -4149,7 +4202,7 @@ cont_current_key(void)
if ((a = RepAtom(a)->NextOfAE) == NIL) {
i++;
while (i < MaxHash) {
while (i < AtomHashTableSize) {
/* protect current hash table line, notice that the current
LOCK/UNLOCK algorithm assumes new entries are added to
the *front* of the list, otherwise I should have locked
@ -4164,7 +4217,7 @@ cont_current_key(void)
READ_UNLOCK(HashChain[i].AERWLock);
i++;
}
if (i == MaxHash) {
if (i == AtomHashTableSize) {
/* we have left the atom hash table */
/* we don't have a lock over the hash table any longer */
if (IsAtomTerm(first)) {
@ -4559,7 +4612,7 @@ Yap_InitDBPreds(void)
Yap_InitCPred("$hold_index", 3, p_hold_index, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$fetch_reference_from_index", 3, p_fetch_reference_from_index, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$resize_int_keys", 1, p_resize_int_keys, SafePredFlag|SyncPredFlag);
Yap_InitCPred("key_statistics", 3, p_key_statistics, SyncPredFlag);
Yap_InitCPred("key_statistics", 4, p_key_statistics, SyncPredFlag);
Yap_InitCPred("nth_instance", 3, p_nth_instance, SyncPredFlag);
Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag);
Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag);
@ -4572,7 +4625,7 @@ Yap_InitBackDB(void)
RETRY_C_RECORDED_K_CODE = NEXTOP(PredRecordedWithKey->cs.p_code.FirstClause,lds);
Yap_InitCPredBack("$recordedp", 3, 3, in_rdedp, co_rdedp, SyncPredFlag);
RETRY_C_RECORDEDP_CODE = NEXTOP(RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recordedp"), 3),0))->cs.p_code.FirstClause,lds);
Yap_InitCPredBack("current_key", 2, 4, init_current_key, cont_current_key,
Yap_InitCPredBack("$current_immediate_key", 2, 4, init_current_key, cont_current_key,
SyncPredFlag);
}

2
C/exec.c
View File

@ -1469,7 +1469,7 @@ p_clean_ifcp(void) {
static Int
JumpToEnv(Term t) {
yamop *pos = PredDollarCatch->cs.p_code.LastClause;
yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,ld);
CELL *env;
choiceptr first_func = NULL, B0 = B;

94
C/grow.c
View File

@ -42,6 +42,9 @@ static Int total_delay_overflow_time = 0;
static int trail_overflows = 0;
static Int total_trail_overflow_time = 0;
static int atom_table_overflows = 0;
static Int total_atom_table_overflow_time = 0;
STATIC_PROTO(Int p_growheap, (void));
STATIC_PROTO(Int p_growstack, (void));
STATIC_PROTO(Int p_inform_trail_overflows, (void));
@ -494,13 +497,21 @@ static_growheap(long size, int fix_code)
{
Int start_growth_time, growth_time;
int gc_verbose;
UInt hole = 0L;
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
Yap_ErrorMessage = NULL;
if (!Yap_ExtendWorkSpace(size)) {
strncat(Yap_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
return(FALSE);
Int min_size = (CELL)Yap_TrailTop-(CELL)Yap_GlobalBase;
if (size < min_size) size = min_size;
hole = size;
size = Yap_ExtendWorkSpaceThroughHole(size);
if (size < 0) {
strncat(Yap_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
return FALSE;
}
}
start_growth_time = Yap_cputime();
gc_verbose = Yap_is_gc_verbose();
@ -531,6 +542,8 @@ static_growheap(long size, int fix_code)
AdjustRegs(MaxTemps);
YAPLeaveCriticalSection();
ASP += 256;
if (hole)
Yap_AllocHole(hole, size);
growth_time = Yap_cputime()-start_growth_time;
total_heap_overflow_time += growth_time;
if (gc_verbose) {
@ -649,8 +662,8 @@ fix_tabling_info(void)
}
#endif /* TABLING */
int
Yap_growheap(int fix_code, UInt in_size)
static int
do_growheap(int fix_code, UInt in_size)
{
unsigned long size = sizeof(CELL) * 16 * 1024L;
int shift_factor = (heap_overflows > 8 ? 8 : heap_overflows);
@ -699,6 +712,12 @@ Yap_growheap(int fix_code, UInt in_size)
return(FALSE);
}
int
Yap_growheap(int fix_code, UInt in_size)
{
return do_growheap(fix_code, in_size);
}
int
Yap_growglobal(CELL **ptr)
{
@ -944,6 +963,59 @@ Yap_growtrail(long size)
return(TRUE);
}
void
Yap_growatomtable(void)
{
AtomHashEntry *ntb;
UInt nsize = 4*AtomHashTableSize-1, i;
Int start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose();
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
/* leave for next time */
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry)))
return;
}
atom_table_overflows++;
if (gc_verbose) {
fprintf(Yap_stderr, "[AO] Atom Table overflow %d\n", atom_table_overflows);
fprintf(Yap_stderr, "[AO] growing the atom table to %ld entries\n", (long int)(nsize));
}
YAPEnterCriticalSection();
for (i = 0; i < nsize; ++i) {
INIT_RWLOCK(ntb[i].AERWLock);
ntb[i].Entry = NIL;
}
for (i = 0; i < AtomHashTableSize; i++) {
Atom catom;
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
while (catom != NIL) {
AtomEntry *ap = RepAtom(catom);
Atom natom;
CELL hash;
hash = HashFunction(ap->StrOfAE) % nsize;
natom = ap->NextOfAE;
ap->NextOfAE = ntb[hash].Entry;
ntb[hash].Entry = catom;
catom = natom;
}
READ_UNLOCK(HashChain[i].AERWLock);
}
Yap_FreeCodeSpace((char *)HashChain);
HashChain = ntb;
AtomHashTableSize = nsize;
YAPLeaveCriticalSection();
growth_time = Yap_cputime()-start_growth_time;
total_atom_table_overflow_time += growth_time;
if (gc_verbose) {
fprintf(Yap_stderr, "[AO] took %g sec\n", (double)growth_time/1000);
fprintf(Yap_stderr, "[AO] Total of %g sec expanding atom table \n", (double)total_atom_table_overflow_time/1000);
}
}
static Int
p_inform_trail_overflows(void)
@ -1026,11 +1098,11 @@ Yap_total_stack_shift_time(void)
void
Yap_InitGrowPreds(void)
{
Yap_InitCPred("$grow_heap", 1, p_growheap, SafePredFlag);
Yap_InitCPred("$grow_stack", 1, p_growstack, SafePredFlag);
Yap_InitCPred("$inform_trail_overflows", 2, p_inform_trail_overflows, SafePredFlag);
Yap_InitCPred("$inform_heap_overflows", 2, p_inform_heap_overflows, SafePredFlag);
Yap_InitCPred("$inform_stack_overflows", 2, p_inform_stack_overflows, SafePredFlag);
Yap_init_gc();
Yap_init_agc();
Yap_InitCPred("$grow_heap", 1, p_growheap, SafePredFlag);
Yap_InitCPred("$grow_stack", 1, p_growstack, SafePredFlag);
Yap_InitCPred("$inform_trail_overflows", 2, p_inform_trail_overflows, SafePredFlag);
Yap_InitCPred("$inform_heap_overflows", 2, p_inform_heap_overflows, SafePredFlag);
Yap_InitCPred("$inform_stack_overflows", 2, p_inform_stack_overflows, SafePredFlag);
Yap_init_gc();
Yap_init_agc();
}

167
C/index.c
View File

@ -407,6 +407,9 @@ has_cut(yamop *pc)
case _try_in:
pc = NEXTOP(pc,l);
break;
case _jump_if_nonvar:
pc = NEXTOP(pc,xl);
break;
/* instructions type EC */
case _alloc_for_logical_pred:
pc = NEXTOP(pc,EC);
@ -483,9 +486,6 @@ has_cut(yamop *pc)
case _p_float_x:
pc = NEXTOP(pc,x);
break;
case _check_var_for_index:
pc = NEXTOP(pc,xxp);
break;
/* instructions type y */
case _save_b_y:
case _write_y_var:
@ -1571,6 +1571,9 @@ add_info(ClauseDef *clause, UInt regno)
case _try_in:
clause->Tag = (CELL)NULL;
return;
case _jump_if_nonvar:
clause->Tag = (CELL)NULL;
return;
/* instructions type e */
case _trust_fail:
case _op_fail:
@ -1590,7 +1593,6 @@ add_info(ClauseDef *clause, UInt regno)
case _p_execute_tail:
case _index_dbref:
case _index_blob:
case _check_var_for_index:
#ifdef YAPOR
case _getwork_first_time:
#endif
@ -2525,11 +2527,6 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, PredEntry *ap, int f
labl = new_label();
Yap_emit(label_op, labl, Zero);
if (argno0 <= ap->ArityOfPE &&
cf - c0 > 3 &&
ap->ModuleOfPred != 2) {
Yap_emit(check_var_op, argno0, (CELL)ap);
}
/*
add expand_node if var_group == TRUE (jump on var) ||
var_group == FALSE (leaf node)
@ -3020,31 +3017,30 @@ do_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt argno, UInt fail_l,
return do_var_clauses(min, max, FALSE, ap, first, clleft, fail_l, ap->ArityOfPE+1);
}
t = Deref(XREGS[argno]);
labl0 = labl = new_label();
while (IsVarTerm(t)) {
if (argno0 == 1) {
/* force indexing on first argument, even if first argument is unbound */
argno = 1;
break;
}
if (argno == ap->ArityOfPE) {
if (max-min==ap->cs.p_code.NOfClauses-1 &&
!(ap->PredFlags & LogUpdatePredFlag)) {
/* we cover every clause */
return (UInt)(ap->cs.p_code.FirstClause);
} else {
return do_var_clauses(min, max, FALSE, ap, first, clleft, fail_l, argno0);
}
}
argno++;
t = Deref(XREGS[argno]);
}
if (ap->PredFlags & LogUpdatePredFlag) {
found_pvar = cls_head_info(min, max, argno);
} else {
found_pvar = cls_info(min, max, argno);
}
ngroups = groups_in(min, max, group);
labl0 = labl = new_label();
while (IsVarTerm(t)) {
if (max - min > 2 &&
ap->ModuleOfPred != 2) {
Yap_emit(jump_nv_op, (CELL)(&(ap->cs.p_code.ExpandCode)), argno);
}
if (argno == ap->ArityOfPE) {
return do_var_clauses(min, max, FALSE, ap, first, clleft, fail_l, argno0);
}
argno++;
t = Deref(XREGS[argno]);
if (ap->PredFlags & LogUpdatePredFlag) {
found_pvar = cls_head_info(min, max, argno);
} else {
found_pvar = cls_info(min, max, argno);
}
ngroups = groups_in(min, max, group);
}
top = (CELL *)(group+ngroups);
if (argno > 1) {
/* don't try being smart for other arguments than the first */
@ -3654,6 +3650,7 @@ expand_index(PredEntry *ap) {
labelno = 1;
stack[0].pos = 0;
/* try to refine the interval using the indexing code */
while (ipc != NULL) {
op_numbers op;
@ -3671,7 +3668,15 @@ expand_index(PredEntry *ap) {
isfirstcl = FALSE;
ipc = NEXTOP(ipc,ld);
break;
/* instructions type l */
case _try_in:
if (ap->PredFlags & LogUpdatePredFlag) {
first = ClauseCodeToLogUpdClause(ipc->u.l.l)->ClNext->ClCode;
} else {
first = NextClause(PREVOP(ipc->u.l.l,ld));
}
isfirstcl = FALSE;
ipc = NEXTOP(ipc,l);
break;
case _retry_me:
case _retry_me1:
case _retry_me2:
@ -3737,6 +3742,19 @@ expand_index(PredEntry *ap) {
ipc = NEXTOP(ipc,l);
}
break;
case _jump_if_nonvar:
argno = arg_from_x(ipc->u.xl.x);
t = Deref(Yap_XREGS[argno]);
i = 0;
/* expand_index expects to find the new argument */
argno--;
if (!IsVarTerm(t)) {
labp = &(ipc->u.xl.l);
ipc = ipc->u.xl.l;
} else {
ipc = NEXTOP(ipc,xl);
}
break;
/* instructions type EC */
/* instructions type e */
case _index_dbref:
@ -3751,15 +3769,6 @@ expand_index(PredEntry *ap) {
s_reg = NULL;
ipc = NEXTOP(ipc,e);
break;
case _check_var_for_index:
ipc = NEXTOP(ipc,xxp);
break;
case _try_in:
if (first) {
ipc = NEXTOP(ipc,ld);
} else {
ipc = ipc->u.ld.d;
}
/* instructions type e */
case _switch_on_type:
t = Deref(ARG1);
@ -3804,7 +3813,7 @@ expand_index(PredEntry *ap) {
case _switch_on_arg_type:
argno = arg_from_x(ipc->u.xllll.x);
i = 0;
t = Deref(XREGS[argno]);
t = Deref(Yap_XREGS[argno]);
if (IsVarTerm(t)) {
labp = &(ipc->u.xllll.l4);
ipc = ipc->u.xllll.l4;
@ -4064,10 +4073,6 @@ ExpandIndex(PredEntry *ap) {
if (Yap_Option['i' - 'a' + 1]) {
Term tmod = ModuleName[ap->ModuleOfPred];
Yap_DebugPutc(Yap_c_error_stream,'>');
{
extern long long int vsc_count;
fprintf(stderr,"%lld",vsc_count);
}
Yap_DebugPutc(Yap_c_error_stream,'\t');
Yap_plwrite(tmod, Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,':');
@ -4785,6 +4790,8 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
}
if (next <= end) {
/* we got space to put something in */
LogUpdClause *tgl = ClauseCodeToLogUpdClause(code);
if (blk->ClCode->opc != Yap_opcode(_stale_lu_index)) {
if (blk->ClFlags & InUseMask) {
blk->ClCode->opc = Yap_opcode(_stale_lu_index);
@ -4792,6 +4799,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
/* we need to rebuild the code */
/* first, shift the last retry down, getting rid of the trust logical pred */
yamop *nlast = PREVOP(last, l);
memmove((void *)nlast, (void *)last, (CELL)NEXTOP((yamop *)NULL,ld));
nlast->opc = Yap_opcode(_retry);
where = NEXTOP(nlast,ld);
@ -4823,6 +4831,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
#endif /* TABLING */
blk->ClCode->u.Ill.l2 = NEXTOP(where,ld);
blk->ClCode->u.Ill.s++;
tgl->ClRefCount++;
return blk->ClCode;
} else {
return replace_lu_block(blk, RECORDZ, ap, code, has_cut(code));
@ -4866,7 +4875,10 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
/* we got space to put something in */
op_numbers sop = Yap_op_from_opcode(next->opc);
if (sop != _retry_killed) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(next->u.ld.d);
next->opc = Yap_opcode(_retry);
tgl->ClRefCount++;
}
blk->ClCode->u.Ill.l1 = here;
blk->ClCode->u.Ill.s++;
@ -5051,6 +5063,10 @@ add_to_index(PredEntry *ap, int first, path_stack_entry *sp, ClauseDef *cls) {
sp = push_path(sp, &(ipc->u.l.l), cls);
ipc = NEXTOP(ipc,l);
break;
case _jump_if_nonvar:
sp = push_path(sp, &(ipc->u.xl.l), cls);
ipc = NEXTOP(ipc,xl);
break;
/* instructions type EC */
case _try_in:
/* we are done */
@ -5299,10 +5315,12 @@ add_to_index(PredEntry *ap, int first, path_stack_entry *sp, ClauseDef *cls) {
ipc = pop_path(&sp, cls, ap);
} else if (newpc == FAILCODE) {
/* oops, nothing there */
if (table_fe_overflow(ipc, f)) {
fe = expand_ftable(ipc, current_block(sp), ap, f);
if (fe->Tag != f) {
if (table_fe_overflow(ipc, f)) {
fe = expand_ftable(ipc, current_block(sp), ap, f);
}
fe->Tag = f;
}
fe->Tag = f;
fe->Label = (UInt)cls->CurrentCode;
ipc = pop_path(&sp, cls, ap);
} else {
@ -5321,9 +5339,6 @@ add_to_index(PredEntry *ap, int first, path_stack_entry *sp, ClauseDef *cls) {
cls->Tag = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
ipc = NEXTOP(ipc,e);
break;
case _check_var_for_index:
ipc = NEXTOP(ipc,xxp);
break;
case _switch_on_cons:
case _if_cons:
case _go_on_cons:
@ -5344,10 +5359,12 @@ add_to_index(PredEntry *ap, int first, path_stack_entry *sp, ClauseDef *cls) {
ipc = pop_path(&sp, cls, ap);
} else if (newpc == FAILCODE) {
/* oops, nothing there */
if (table_ae_overflow(ipc, at)) {
ae = expand_ctable(ipc, current_block(sp), ap, at);
if (ae->Tag != at) {
if (table_ae_overflow(ipc, at)) {
ae = expand_ctable(ipc, current_block(sp), ap, at);
}
ae->Tag = at;
}
ae->Tag = at;
ae->Label = (UInt)cls->CurrentCode;
ipc = pop_path(&sp, cls, ap);
} else {
@ -5505,6 +5522,17 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
ipc = NEXTOP(ipc, p);
break;
case _try_in:
/* I cannot expand a predicate that starts on a variable,
have to expand the index.
*/
if (IN_BETWEEN(bg,ipc->u.l.l,lt)) {
sp = kill_clause(ipc, bg, lt, sp, ap);
ipc = pop_path(&sp, cls, ap);
} else {
/* just go to next instruction */
ipc = NEXTOP(ipc,l);
}
break;
case _try_clause:
case _retry:
/* I cannot expand a predicate that starts on a variable,
@ -5566,6 +5594,10 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
sp = push_path(sp, &(ipc->u.l.l), cls);
ipc = NEXTOP(ipc,l);
break;
case _jump_if_nonvar:
sp = push_path(sp, &(ipc->u.xl.l), cls);
ipc = NEXTOP(ipc,xl);
break;
/* instructions type e */
case _switch_on_type:
sp = push_path(sp, &(ipc->u.llll.l4), cls);
@ -5798,9 +5830,6 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
cls->Tag = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
ipc = NEXTOP(ipc,e);
break;
case _check_var_for_index:
ipc = NEXTOP(ipc,xxp);
break;
case _switch_on_cons:
case _if_cons:
case _go_on_cons:
@ -5894,10 +5923,6 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
}
} else {
{
extern long long int vsc_count;
printf("vsc_count: %llu\n", vsc_count);
}
if (ap->PredFlags & NumberDBPredFlag) {
Int id = ap->src.IndxId;
Yap_plwrite(MkIntegerTerm(id), Yap_DebugPutc, 0);
@ -6139,6 +6164,17 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
}
}
break;
case _jump_if_nonvar:
{
Term t = Deref(Yap_XREGS[arg_from_x(ipc->u.xllll.x)]);
if (!IsVarTerm(t)) {
jlbl = &(ipc->u.xl.l);
ipc = ipc->u.xl.l;
} else {
ipc = NEXTOP(ipc,xl);
}
}
break;
/* instructions type e */
case _switch_on_type:
t = Deref(ARG1);
@ -6249,9 +6285,6 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
t = MkIntTerm(s_reg[0]);
ipc = NEXTOP(ipc,e);
break;
case _check_var_for_index:
ipc = NEXTOP(ipc,xxp);
break;
case _switch_on_cons:
case _if_cons:
case _go_on_cons:
@ -6367,6 +6400,13 @@ find_caller(PredEntry *ap, yamop *code) {
ipc = NEXTOP(ipc,l);
}
break;
case _jump_if_nonvar:
if (!IsVarTerm(Yap_XREGS[arg_from_x(ipc->u.xllll.x)])) {
ipc = ipc->u.xl.l;
} else {
ipc = NEXTOP(ipc,xl);
}
break;
/* instructions type EC */
/* instructions type e */
case _index_dbref:
@ -6381,9 +6421,6 @@ find_caller(PredEntry *ap, yamop *code) {
s_reg = NULL;
ipc = NEXTOP(ipc,e);
break;
case _check_var_for_index:
ipc = NEXTOP(ipc,xxp);
break;
/* instructions type e */
case _switch_on_type:
t = Deref(ARG1);

2
C/init.c
View File

@ -1099,6 +1099,8 @@ Yap_InitStacks(int Heap,
aux_delayed_release_load);
#else /* Yap */
Yap_InitMemory (Trail, Heap, Stack);
AtomHashTableSize = MaxHash;
HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
#endif /* YAPOR || TABLING */
for (i = 0; i < MaxHash; ++i) {
INIT_RWLOCK(HashChain[i].AERWLock);

2
C/parser.c
View File

@ -124,7 +124,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
UInt hv;
p = Yap_VarTable;
hv = HashFunction(vp) % MaxHash;
hv = HashFunction(vp) % AtomHashTableSize;
while (p != NULL) {
CELL hpv = p->hv;
if (hv == hpv) {

4
C/save.c
View File

@ -1136,7 +1136,7 @@ restore_heap(void)
{
AtomHashEntry *HashPtr = HashChain;
register int i;
for (i = 0; i < MaxHash; ++i) {
for (i = 0; i < AtomHashTableSize; ++i) {
Atom atm = HashPtr->Entry;
if (atm) {
AtomEntry *at;
@ -1176,7 +1176,7 @@ ShowAtoms()
{
AtomHashEntry *HashPtr = HashChain;
register int i;
for (i = 0; i < MaxHash; ++i) {
for (i = 0; i < AtomHashTableSize; ++i) {
if (HashPtr->Entry != NIL) {
AtomEntry *at;
at = RepAtom(HashPtr->Entry);

40
C/stdpreds.c
View File

@ -447,7 +447,7 @@ FindAtom(codeToFind, arity)
Atom a;
int i;
for (i = 0; i < MaxHash; ++i) {
for (i = 0; i < AtomHashTableSize; ++i) {
READ_LOCK(HashChain[i].AeRWLock);
a = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AeRWLock);
@ -1601,7 +1601,7 @@ cont_current_atom(void)
if (catom == NIL){
i++;
/* move away from current hash table line */
while (i < MaxHash) {
while (i < AtomHashTableSize) {
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
if (catom != NIL) {
@ -1610,7 +1610,7 @@ cont_current_atom(void)
READ_UNLOCK(HashChain[i].AERWLock);
i++;
}
if (i == MaxHash) {
if (i == AtomHashTableSize) {
cut_fail();
} else {
READ_UNLOCK(HashChain[i].AERWLock);
@ -1620,7 +1620,7 @@ cont_current_atom(void)
if (Yap_unify_constant(ARG1, MkAtomTerm(catom))) {
if (ap->NextOfAE == NIL) {
i++;
while (i < MaxHash) {
while (i < AtomHashTableSize) {
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AERWLock);
@ -1629,7 +1629,7 @@ cont_current_atom(void)
}
i++;
}
if (i == MaxHash) {
if (i == AtomHashTableSize) {
cut_succeed();
} else {
EXTRA_CBACK_ARG(1,1) = MkAtomTerm(catom);
@ -1672,7 +1672,7 @@ cont_current_predicate(void)
{
PredEntry *pp = (PredEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(3,1));
UInt Arity;
Atom name;
Term name;
while (pp != NULL) {
if (pp->PredFlags & HiddenPredFlag)
@ -1685,12 +1685,26 @@ cont_current_predicate(void)
EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)(pp->NextPredOfModule));
if (pp->FunctorOfPred == FunctorModule)
return(FALSE);
Arity = pp->ArityOfPE;
if (Arity)
name = NameOfFunctor(pp->FunctorOfPred);
else
name = (Atom)pp->FunctorOfPred;
return (Yap_unify(ARG2,MkAtomTerm(name)) &&
if (pp->ModuleOfPred != 2) {
Arity = pp->ArityOfPE;
if (Arity)
name = MkAtomTerm(NameOfFunctor(pp->FunctorOfPred));
else
name = MkAtomTerm((Atom)pp->FunctorOfPred);
} else {
if (pp->PredFlags & NumberDBPredFlag) {
name = MkIntegerTerm(pp->src.IndxId);
Arity = 0;
} else if (pp->PredFlags & AtomDBPredFlag) {
name = MkAtomTerm((Atom)pp->FunctorOfPred);
Arity = 0;
} else {
Functor f = pp->FunctorOfPred;
name = MkAtomTerm(NameOfFunctor(f));
Arity = ArityOfFunctor(f);
}
}
return (Yap_unify(ARG2,name) &&
Yap_unify(ARG3, MkIntegerTerm((Int)Arity)));
}
@ -1813,7 +1827,7 @@ cont_current_op(void)
}
i++;
}
if (i == MaxHash)
if (i == AtomHashTableSize)
cut_fail();
EXTRA_CBACK_ARG(3,2) = (CELL) MkIntTerm(i);
}

2
C/tracer.c
View File

@ -114,7 +114,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
vsc_count++;
#ifdef COMMENTED
if (vsc_count < 123536430LL) {
if (vsc_count < 2923351500LL) {
return;
}
if (vsc_count == 123536441LL) vsc_xstop = 1;

9
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.44 2003-08-27 13:37:09 vsc Exp $ *
* version: $Id: Heap.h,v 1.45 2003-10-28 01:16:02 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -341,7 +341,9 @@ typedef struct various_codes {
struct global_data global;
struct local_data remote[MAX_WORKERS];
#endif
AtomHashEntry hash_chain[MaxHash];
UInt n_of_atoms;
UInt atom_hash_table_size;
AtomHashEntry *hash_chain;
} all_heap_codes;
#define heap_regs ((all_heap_codes *)HEAP_INIT_BASE)
@ -388,6 +390,8 @@ typedef struct various_codes {
#define UNDEF_OPCODE heap_regs->undef_op
#define INDEX_OPCODE heap_regs->index_op
#define FAIL_OPCODE heap_regs->fail_op
#define NOfAtoms heap_regs->n_of_atoms
#define AtomHashTableSize heap_regs->atom_hash_table_size
#define HashChain heap_regs->hash_chain
#define INT_KEYS_SIZE heap_regs->int_keys_size
#define INT_KEYS_TIMESTAMP heap_regs->int_keys_timestamp
@ -575,6 +579,7 @@ typedef struct various_codes {
#define DeadClauses heap_regs->dead_clauses
#define SizeOfOverflow heap_regs->size_of_overflow
#define LastWtimePtr heap_regs->last_wtime
#define FreeBlocks heap_regs->free_blocks
#ifdef COROUTINING
#define WakeUpCode heap_regs->wake_up_code
#define WokenGoals heap_regs->woken_goals

10
H/YapOpcodes.h
View File

@ -144,20 +144,20 @@
OPCODE(trust ,ld),
OPCODE(try_in ,l),
OPCODE(jump_if_var ,l),
OPCODE(switch_on_cons ,c),
OPCODE(jump_if_nonvar ,l),
OPCODE(switch_on_cons ,ssl),
OPCODE(switch_on_type ,llll),
OPCODE(switch_list_nl ,ollll),
OPCODE(switch_on_arg_type ,xllll),
OPCODE(switch_on_sub_arg_type ,sllll),
OPCODE(go_on_cons ,cll),
OPCODE(go_on_cons ,sl),
OPCODE(if_cons ,sl),
OPCODE(switch_on_func ,s),
OPCODE(go_on_func ,fll),
OPCODE(switch_on_func ,sl),
OPCODE(go_on_func ,sl),
OPCODE(if_func ,sl),
OPCODE(if_not_then ,cll),
OPCODE(index_dbref ,e),
OPCODE(index_blob ,e),
OPCODE(check_var_for_index ,xxp),
OPCODE(trust_fail ,e),
OPCODE(index_pred ,e),
OPCODE(expand_index ,e),

3
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.38 2003-08-27 13:37:09 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.39 2003-10-28 01:16:02 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -160,6 +160,7 @@ int STD_PROTO(Yap_growheap, (int, UInt));
int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long));
int STD_PROTO(Yap_growglobal, (CELL **));
void STD_PROTO(Yap_growatomtable, (void));
/* heapgc.c */
Int STD_PROTO(Yap_total_gc_time,(void));

8
H/absmi.h
View File

@ -244,6 +244,10 @@ restore_absmi_regs(REGSTORE * old_regs)
#define ENDCACHE_Y_AS_ENV() }
#define saveregs_and_ycache() YREG = E_YREG; saveregs()
#define setregs_and_ycache() E_YREG = YREG; setregs()
#else
#define E_YREG (YREG)
@ -254,6 +258,10 @@ restore_absmi_regs(REGSTORE * old_regs)
#define ENDCACHE_Y_AS_ENV() }
#define saveregs_and_ycache() saveregs()
#define setregs_and_ycache() setregs()
#endif
#if S_IN_MEM

4
H/alloc.h
View File

@ -83,12 +83,12 @@ typedef struct FREEB {
#define BlockTrailer(b) ((YAP_SEG_SIZE *)b)[((BlockHeader *) b)->b_size]
#define FreeBlocks heap_regs->free_blocks
/* Operating system and architecture dependent page size */
extern int Yap_page_size;
void STD_PROTO(Yap_InitHeap, (void *));
UInt STD_PROTO(Yap_ExtendWorkSpaceThroughHole, (UInt));
void STD_PROTO(Yap_AllocHole, (UInt, UInt));
#if USE_MMAP

11
H/amidefs.h
View File

@ -394,16 +394,15 @@ typedef struct yami {
CELL next;
} xf;
struct {
wamreg x;
struct yami *l;
CELL next;
} xl;
struct {
wamreg xl;
wamreg xr;
CELL next;
} xx;
struct {
CELL x;
CELL x1;
struct pred_entry *p;
CELL next;
} xxp;
struct {
wamreg x;
wamreg x1;

3
H/compile.h
View File

@ -89,6 +89,7 @@ typedef enum compiler_op {
trust_op,
try_in_op,
jump_v_op,
jump_nv_op,
cache_arg_op,
cache_sub_arg_op,
switch_on_type_op,
@ -99,7 +100,7 @@ typedef enum compiler_op {
if_not_op,
index_dbref_op,
index_blob_op,
check_var_op,
if_nonvar_op,
save_pair_op,
save_appl_op,
comit_opt_op,

12
H/rheap.h
View File

@ -333,6 +333,8 @@ restore_codes(void)
heap_regs->last_wtime = (void *)PtoHeapCellAdjust((CELL *)(heap_regs->last_wtime));
heap_regs->db_erased_marker =
DBRefAdjust(heap_regs->db_erased_marker);
heap_regs->hash_chain =
(AtomHashEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->hash_chain));
}
@ -683,6 +685,12 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
pc = NEXTOP(pc,l);
break;
/* instructions type EC */
case _jump_if_nonvar:
pc->u.xl.l = PtoOpAdjust(pc->u.xl.l);
pc->u.xl.x = XAdjust(pc->u.xl.x);
pc = NEXTOP(pc,xl);
break;
/* instructions type EC */
case _alloc_for_logical_pred:
pc->u.EC.ClBase = PtoOpAdjust(pc->u.EC.ClBase);
pc = NEXTOP(pc,EC);
@ -787,10 +795,6 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
pc->u.y.y = YAdjust(pc->u.y.y);
pc = NEXTOP(pc,y);
break;
case _check_var_for_index:
pc->u.xxp.p = PtoPredAdjust(pc->u.xxp.p);
pc = NEXTOP(pc,xxp);
break;
/* instructions type sla */
case _p_execute:
goto sla_full;

17
H/yapio.h
View File

@ -323,12 +323,25 @@ extern int Yap_Portray_delays;
#endif
#endif
EXTERN inline UInt STD_PROTO(HashFunction, (char *));
EXTERN inline UInt
HashFunction(char *CHP)
{
UInt OUT=0;
while(*CHP != '\0') OUT += (UInt)(*CHP++);
/* djb2 */
UInt hash = 5381;
UInt c;
while ((c = *CHP++) != '\0') {
/* hash = ((hash << 5) + hash) + c; hash * 33 + c */
hash = hash * 33 ^ c;
}
return hash;
/*
UInt OUT=0, i = 1;
while(*CHP != '\0') { OUT += (UInt)(*CHP++); }
return OUT;
*/
}
#define FAIL_ON_PARSER_ERROR 0

3
pl/errors.yap
View File

@ -310,6 +310,9 @@ print_message(Level, Mss) :-
'$output_error_message'(domain_error(operator_specifier,Op), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid operator specifier ~w ]~n",
[Where,Op]).
'$output_error_message'(domain_error(out_of_range,Value), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: expression ~w is out of range ]~n",
[Where,Value]).
'$output_error_message'(domain_error(close_option,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid close option ~w ]~n",
[Where,Opt]).

7
pl/utils.yap
View File

@ -370,6 +370,13 @@ system_predicate(P) :-
'$current_predicate3'(M,BadSpec) :- % only for the predicate
'$do_error'(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec)).
current_key(A,K) :-
'$current_predicate'(idb,A,Arity),
functor(K,A,Arity).
current_key(A,K) :-
'$current_immediate_key'(A,K).
%%% User interface for statistics
statistics :-