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

improved support for threads and code area allocation using malloc

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@965 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-02-05 16:57:02 +00:00
parent cacc407677
commit 9b84cdfe5d
43 changed files with 984 additions and 306 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
C/absmi.c
View File

@ -213,6 +213,7 @@ Yap_absmi(int inp)
/* the registers are all set up, let's swap */
#ifdef THREADS
pthread_setspecific(yaamregs_key, (const void *)&absmi_regs);
ThreadHandle[worker_id].current_yaam_regs = &absmi_regs;
#else
Yap_regp = &absmi_regs;
#endif
@ -318,7 +319,7 @@ Yap_absmi(int inp)
}
saveregs();
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(SYSTEM_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
setregs();
FAIL();
}
@ -1074,22 +1075,45 @@ Yap_absmi(int inp)
* enter a logical semantics dynamic predicate *
*****************************************************************/
/* only meaningful with THREADS on! */
/* lock logical updates predicate. */
Op(lock_lu, p);
#if defined(YAPOR) || defined(THREADS)
PP = PREG->u.p.p;
READ_LOCK(PP->PRWLock);
#endif
PREG = NEXTOP(PREG, p);
GONext();
ENDOp();
/* enter logical pred */
BOp(stale_lu_index, Ill);
saveregs();
{
yamop *ipc;
#if defined(YAPOR) || defined(THREADS)
PredEntry *ap = PP;
#endif
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
#if defined(YAPOR) || defined(THREADS)
READ_UNLOCK(ap->PRWLock);
PP = NULL;
#endif
ipc = Yap_CleanUpIndex(PREG->u.Ill.I);
/* restart index */
setregs();
PREG = ipc;
CACHED_A1() = ARG1;
#if defined(YAPOR) || defined(THREADS)
PP = ap;
READ_LOCK(ap->PRWLock);
#endif
JMPNext();
}
ENDBOp();
@ -1114,6 +1138,10 @@ Yap_absmi(int inp)
}
#endif
UNLOCK(cl->ClLock);
#if defined(YAPOR) || defined(THREADS)
READ_UNLOCK(PP->PRWLock);
PP = NULL;
#endif
}
GONext();
ENDBOp();
@ -1169,6 +1197,10 @@ Yap_absmi(int inp)
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
}
#else
{
@ -1216,6 +1248,10 @@ Yap_absmi(int inp)
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
#else
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
@ -1260,6 +1296,10 @@ Yap_absmi(int inp)
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
#else
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
@ -1444,6 +1484,12 @@ Yap_absmi(int inp)
fail:
{
register tr_fr_ptr pt0 = TR;
#if defined(YAPOR) || defined(THREADS)
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
#endif
PREG = B->cp_ap;
CACHE_TR(B->cp_tr);
PREFETCH_OP(PREG);
@ -2500,6 +2546,12 @@ Yap_absmi(int inp)
E_YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = E_YREG[E_DEPTH];
#endif
#if defined(YAPOR) || defined(THREADS)
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
#endif
WRITEBACK_Y_AS_ENV();
JMPNext();
@ -6269,6 +6321,17 @@ Yap_absmi(int inp)
JMPNext();
ENDBOp();
#if THREADS
BOp(thread_local, e);
{
PredEntry *ap = PredFromDefCode(PREG);
ap = Yap_GetThreadPred(ap);
PREG = ap->CodeOfPred;
}
JMPNext();
ENDBOp();
#endif
BOp(expand_index, e);
{
PredEntry *pe = PredFromExpandCode(PREG);
@ -6280,11 +6343,29 @@ Yap_absmi(int inp)
ASP = (CELL *) B;
}
saveregs();
WRITE_LOCK(pe->PRWLock);
#if defined(YAPOR) || defined(THREADS)
if (PP != pe) {
READ_LOCK(pe->PRWLock);
}
LOCK(pe->PELock);
if (*PREG_ADDR != (yamop *)&(pe->cs.p_code.ExpandCode)) {
pt0 = *PREG_ADDR;
UNLOCK(pe->PELock);
if (PP != pe) {
READ_UNLOCK(pe->PRWLock);
}
JMPNext();
}
#endif
pt0 = Yap_ExpandIndex(pe);
WRITE_UNLOCK(pe->PRWLock);
/* restart index */
setregs();
UNLOCK(pe->PELock);
#if defined(YAPOR) || defined(THREADS)
if (PP != pe) {
READ_UNLOCK(pe->PRWLock);
}
#endif
PREG = pt0;
JMPNext();
}
@ -6570,17 +6651,20 @@ Yap_absmi(int inp)
if (IsPairTerm(d0)) {
/* pair */
SREG = RepPair(d0);
copy_jmp_address(PREG->u.llll.l1);
PREG = PREG->u.llll.l1;
JMPNext();
}
else if (!IsApplTerm(d0)) {
/* constant */
copy_jmp_address(PREG->u.llll.l2);
PREG = PREG->u.llll.l2;
I_R = d0;
JMPNext();
}
else {
/* appl */
copy_jmp_address(PREG->u.llll.l3);
PREG = PREG->u.llll.l3;
SREG = RepAppl(d0);
JMPNext();
@ -6589,6 +6673,7 @@ Yap_absmi(int inp)
BEGP(pt0);
deref_body(d0, pt0, swt_unk, swt_nvar);
/* variable */
copy_jmp_address(PREG->u.llll.l4);
PREG = PREG->u.llll.l4;
JMPNext();
ENDP(pt0);
@ -6617,6 +6702,7 @@ Yap_absmi(int inp)
if (IsPairTerm(d0)) {
/* pair */
#endif
copy_jmp_address(PREG->u.ollll.l1);
PREG = PREG->u.ollll.l1;
SREG = RepPair(d0);
ALWAYS_GONext();
@ -6632,12 +6718,14 @@ Yap_absmi(int inp)
else {
/* appl or constant */
if (IsApplTerm(d0)) {
SREG = RepAppl(d0);
copy_jmp_address(PREG->u.ollll.l3);
PREG = PREG->u.ollll.l3;
SREG = RepAppl(d0);
JMPNext();
} else {
I_R = d0;
copy_jmp_address(PREG->u.ollll.l3);
PREG = PREG->u.ollll.l3;
I_R = d0;
JMPNext();
}
}
@ -6651,6 +6739,7 @@ Yap_absmi(int inp)
#endif
ENDP(pt0);
/* variable */
copy_jmp_address(PREG->u.ollll.l4);
PREG = PREG->u.ollll.l4;
JMPNext();
ENDD(d0);
@ -6665,18 +6754,21 @@ Yap_absmi(int inp)
arg_swt_nvar:
if (IsPairTerm(d0)) {
/* pair */
SREG = RepPair(d0);
copy_jmp_address(PREG->u.xllll.l1);
PREG = PREG->u.xllll.l1;
SREG = RepPair(d0);
JMPNext();
}
else if (!IsApplTerm(d0)) {
/* constant */
copy_jmp_address(PREG->u.xllll.l2);
PREG = PREG->u.xllll.l2;
I_R = d0;
JMPNext();
}
else {
/* appl */
copy_jmp_address(PREG->u.xllll.l3);
PREG = PREG->u.xllll.l3;
SREG = RepAppl(d0);
JMPNext();
@ -6685,6 +6777,7 @@ Yap_absmi(int inp)
BEGP(pt0);
deref_body(d0, pt0, arg_swt_unk, arg_swt_nvar);
/* variable */
copy_jmp_address(PREG->u.xllll.l4);
PREG = PREG->u.xllll.l4;
JMPNext();
ENDP(pt0);
@ -6699,18 +6792,21 @@ Yap_absmi(int inp)
sub_arg_swt_nvar:
if (IsPairTerm(d0)) {
/* pair */
SREG = RepPair(d0);
copy_jmp_address(PREG->u.sllll.l1);
PREG = PREG->u.sllll.l1;
SREG = RepPair(d0);
JMPNext();
}
else if (!IsApplTerm(d0)) {
/* constant */
copy_jmp_address(PREG->u.sllll.l2);
PREG = PREG->u.sllll.l2;
I_R = d0;
JMPNext();
}
else {
/* appl */
copy_jmp_address(PREG->u.sllll.l3);
PREG = PREG->u.sllll.l3;
SREG = RepAppl(d0);
JMPNext();
@ -6719,6 +6815,7 @@ Yap_absmi(int inp)
BEGP(pt0);
deref_body(d0, pt0, sub_arg_swt_unk, sub_arg_swt_nvar);
/* variable */
copy_jmp_address(PREG->u.sllll.l4);
PREG = PREG->u.sllll.l4;
JMPNext();
ENDP(pt0);
@ -6737,6 +6834,7 @@ Yap_absmi(int inp)
BEGP(pt0);
deref_body(d0, pt0, jump_if_unk, jump0_if_nonvar);
/* variable */
copy_jmp_address(PREG->u.l.l);
PREG = PREG->u.l.l;
ENDP(pt0);
JMPNext();
@ -6749,6 +6847,7 @@ Yap_absmi(int inp)
deref_head(d0, jump2_if_unk);
/* non var */
jump2_if_nonvar:
copy_jmp_address(PREG->u.xl.l);
PREG = PREG->u.xl.l;
JMPNext();
@ -6769,12 +6868,14 @@ Yap_absmi(int inp)
/* not variable */
if (d0 == PREG->u.clll.c) {
/* equal to test value */
copy_jmp_address(PREG->u.clll.l2);
PREG = PREG->u.clll.l2;
JMPNext();
}
else {
/* different from test value */
/* the case to optimise */
copy_jmp_address(PREG->u.clll.l1);
PREG = PREG->u.clll.l1;
JMPNext();
}
@ -6783,6 +6884,7 @@ Yap_absmi(int inp)
deref_body(d0, pt0, if_n_unk, if_n_nvar);
ENDP(pt0);
/* variable */
copy_jmp_address(PREG->u.clll.l3);
PREG = PREG->u.clll.l3;
JMPNext();
ENDD(d0);
@ -6815,6 +6917,7 @@ Yap_absmi(int inp)
/* a match happens either if we found the value, or if we
* found an empty slot */
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
}
@ -6827,6 +6930,7 @@ Yap_absmi(int inp)
pt0 = (CELL *) (PREG) + hash;
d0 = pt0[0];
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) pt0[1];
JMPNext();
}
@ -6859,6 +6963,7 @@ Yap_absmi(int inp)
/* a match happens either if we found the value, or if we
* found an empty slot */
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
}
@ -6871,6 +6976,7 @@ Yap_absmi(int inp)
pt0 = (CELL *) (PREG) + hash;
d0 = pt0[0];
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) pt0[1];
JMPNext();
}
@ -6889,9 +6995,11 @@ Yap_absmi(int inp)
d0 = *SREG++;
if (d0 == pt[0]) {
copy_jmp_addressa(pt+1);
PREG = (yamop *) pt[1];
JMPNext();
} else {
copy_jmp_addressa(pt+3);
PREG = (yamop *) pt[3];
JMPNext();
}
@ -6906,9 +7014,11 @@ Yap_absmi(int inp)
d0 = I_R;
if (d0 == pt[0]) {
copy_jmp_addressa(pt+1);
PREG = (yamop *) pt[1];
JMPNext();
} else {
copy_jmp_addressa(pt+3);
PREG = (yamop *) pt[3];
JMPNext();
}
@ -6924,6 +7034,7 @@ Yap_absmi(int inp)
while (pt0[0] != d1 && pt0[0] != (CELL)NULL ) {
pt0 += 2;
}
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
ENDP(pt0);
@ -6938,6 +7049,7 @@ Yap_absmi(int inp)
while (pt0[0] != d1 && pt0[0] != 0L ) {
pt0 += 2;
}
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
ENDP(pt0);

36
C/adtdefs.c
View File

@ -478,6 +478,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
INIT_RWLOCK(p->PRWLock);
INIT_LOCK(p->PELock);
p->KindOfPE = PEProp;
p->ArityOfPE = fe->ArityOfFE;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
@ -505,6 +506,40 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
return (p0);
}
#if THREADS
Prop
Yap_NewThreadPred(PredEntry *ap)
{
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
INIT_RWLOCK(p->PRWLock);
INIT_LOCK(p->PELock);
p->KindOfPE = PEProp;
p->ArityOfPE = ap->ArityOfPE;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L;
p->src.OwnerFile = ap->src.OwnerFile;
p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
p->ModuleOfPred = ap->ModuleOfPred;
p->NextPredOfModule = NULL;
INIT_LOCK(p->StatisticsForPred.lock);
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0;
#ifdef TABLING
p->TableOfPred = NULL;
#endif /* TABLING */
/* careful that they don't cross MkFunctor */
p->NextOfPE = AbsPredProp(ThreadHandle[worker_id].local_preds);
ThreadHandle[worker_id].local_preds = p;
p->FunctorOfPred = ap->FunctorOfPred;
return AbsPredProp(p);
}
#endif
Prop
Yap_NewPredPropByAtom(AtomEntry *ae, SMALLUNSGN cur_mod)
{
@ -514,6 +549,7 @@ Yap_NewPredPropByAtom(AtomEntry *ae, SMALLUNSGN cur_mod)
/* Printf("entering %s:%s/0\n", RepAtom(AtomOfTerm(ModuleName[cur_mod]))->StrOfAE, ae->StrOfAE); */
INIT_RWLOCK(p->PRWLock);
INIT_LOCK(p->PELock);
p->KindOfPE = PEProp;
p->ArityOfPE = 0;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;

48
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.43 2004-01-23 02:20:59 vsc Exp $ *
* version:$Id: alloc.c,v 1.44 2004-02-05 16:56:58 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -54,10 +54,6 @@ static char SccsId[] = "%W% %G%";
/************************************************************************/
/* Yap workspace management */
#if THREADS
#define USE_SYSTEM_MALLOC 1
#endif
#if USE_SYSTEM_MALLOC
int
@ -99,7 +95,7 @@ Yap_FreeAtomSpace(char *p)
/* If you need to dinamically allocate space from the heap, this is
* the macro you should use */
ADDR
Yap_PreAllocCodeSpace(void)
Yap_InitPreAllocCodeSpace(void)
{
char *ptr;
UInt sz = ScratchPad.msz;
@ -118,28 +114,22 @@ Yap_PreAllocCodeSpace(void)
}
ADDR
Yap_ExpandPreAllocCodeSpace(void)
Yap_ExpandPreAllocCodeSpace(UInt sz0)
{
char *ptr;
UInt sz = ScratchPad.msz;
if (sz0 < SCRATCH_INC_SIZE)
sz0 = SCRATCH_INC_SIZE;
ScratchPad.msz =
ScratchPad.sz =
sz = sz + SCRATCH_INC_SIZE;
sz = sz + sz0;
if (!(ptr = malloc(sz)))
if (!(ptr = realloc(ScratchPad.ptr, sz)))
return NULL;
ScratchPad.ptr = ptr;
AuxSp = (CELL *)(AuxTop = ptr+sz);
return ptr;
}
/* Grabbing the HeapTop is an excellent idea for a sequential system,
but does work as well in parallel systems. Anyway, this will do for now */
void
Yap_ReleasePreAllocCodeSpace(ADDR ptr)
{
}
struct various_codes *heap_regs;
static void
@ -181,8 +171,8 @@ InitExStacks(int Trail, int Stack)
Yap_HeapBase, Yap_GlobalBase, Yap_LocalBase, Yap_TrailTop);
ta = Trail*K; /* trail area size */
fprintf(stderr, "Heap+Aux: %ld\tLocal+Global: %uld\tTrail: %uld\n",
(long int)(pm - sa - ta), (unsigned long int)sa, (unsigned long int)ta);
fprintf(stderr, "Heap+Aux: %lu\tLocal+Global: %lu\tTrail: %lu\n",
(long unsigned)(pm - sa - ta), (long unsigned)sa, (long unsigned)ta);
}
#endif /* DEBUG */
}
@ -206,13 +196,18 @@ void
Yap_InitMemory(int Trail, int Heap, int Stack)
{
InitHeap();
InitExStacks(Trail, Stack);
}
int
Yap_ExtendWorkSpace(Int s)
{
return -1;
void *bp = (void *)Yap_GlobalBase, *nbp;
UInt s0 = (char *)Yap_TrailTop-(char *)Yap_GlobalBase;
nbp = realloc(bp, s+s0);
Yap_GlobalBase = (char *)nbp;
if (nbp == NULL)
return FALSE;
return TRUE;
}
UInt
@ -540,6 +535,16 @@ Yap_AllocCodeSpace(unsigned int size)
return AllocCodeSpace(size);
}
ADDR
Yap_ExpandPreAllocCodeSpace(UInt sz)
{
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return NULL;
}
return Addr(HeapTop) + sizeof(CELL);
}
/************************************************************************/
/* Workspace allocation */
@ -574,7 +579,6 @@ ExtendWorkSpace(Int s)
prolog_exec_mode OldPrologMode = Yap_PrologMode;
Yap_PrologMode = ExtendStackMode;
s = ((s-1)/Yap_page_size+1)*Yap_page_size;
b = VirtualAlloc(brk, s, MEM_COMMIT, PAGE_READWRITE);
if (b) {
brk = (LPVOID) ((Int) brk + s);

50
C/amasm.c
View File

@ -230,9 +230,10 @@ emit_ilabel(register CELL addr, struct intermediates *cip)
{
if (addr & 1)
return (emit_a(Unsigned(cip->code_addr) + cip->label_offset[addr]));
else
else {
return (emit_a(addr));
}
}
inline static CELL *
emit_bmlabel(register CELL addr, struct intermediates *cip)
@ -547,8 +548,10 @@ inline static void
a_pair(CELL *seq_ptr, int pass_no, struct intermediates *cip)
{
if (pass_no) {
CELL lab, lab0 = seq_ptr[1];
lab = (CELL) emit_ilabel(lab0, cip);
seq_ptr[0] = (CELL) emit_a(seq_ptr[0]);
seq_ptr[1] = (CELL) emit_ilabel(seq_ptr[1], cip);
seq_ptr[1] = lab;
}
}
@ -1226,11 +1229,14 @@ a_if(op_numbers opcode, union clause_obj *cl_u, int log_update, yamop *code_p, i
}
GONEXT(sl);
if (pass_no) {
CELL lab, lab0;
for (i = 0; i < imax; i++) {
a_pair(seq_ptr, pass_no, cip);
seq_ptr += 2;
}
seq_ptr[1] = (CELL) emit_ilabel(seq_ptr[1], cip);
lab0 = seq_ptr[1];
lab = (CELL) emit_ilabel(lab0, cip);
seq_ptr[1] = lab;
}
return code_p;
}
@ -1238,12 +1244,13 @@ a_if(op_numbers opcode, union clause_obj *cl_u, int log_update, yamop *code_p, i
static yamop *
a_ifnot(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
{
CELL *seq_ptr = cip->cpc->arnds;
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.clll.c = cip->cpc->arnds[0]; /* tag */
code_p->u.clll.l1 = emit_ilabel(cip->cpc->arnds[1], cip); /* success point */
code_p->u.clll.l2 = emit_ilabel(cip->cpc->arnds[2], cip); /* fail point */
code_p->u.clll.l3 = emit_ilabel(cip->cpc->arnds[3], cip); /* delay point */
code_p->u.clll.c = seq_ptr[0]; /* tag */
code_p->u.clll.l1 = emit_ilabel(seq_ptr[1], cip); /* success point */
code_p->u.clll.l2 = emit_ilabel(seq_ptr[2], cip); /* fail point */
code_p->u.clll.l3 = emit_ilabel(seq_ptr[3], cip); /* delay point */
}
GONEXT(clll);
return code_p;
@ -2102,7 +2109,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
#ifdef TABLING
tabled = cip->CurrentPred->PredFlags & TabledPredFlag;
#endif
if (assembling != ASSEMBLING_INDEX) {
if (assembling == ASSEMBLING_CLAUSE) {
if (log_update) {
if (pass_no) {
cl_u->luc.Id = FunctorDBRef;
@ -2169,6 +2176,17 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
#endif
}
code_p = cl_u->lui.ClCode;
*entry_codep = code_p;
#if defined(YAPOR) || defined(THREADS)
if (assembling == ASSEMBLING_INDEX &&
!(cip->CurrentPred->PredFlags & ThreadLocalPredFlag)) {
if (pass_no) {
code_p->opc = opcode(_lock_lu);
code_p->u.p.p = cip->CurrentPred;
}
GONEXT(p);
}
#endif
} else {
if (pass_no) {
cl_u->si.ClFlags = IndexMask;
@ -2176,9 +2194,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cl_u->si.SiblingIndex = NULL;
}
code_p = cl_u->si.ClCode;
}
*entry_codep = code_p;
}
}
while (cip->cpc) {
switch ((int) cip->cpc->op) {
@ -2441,7 +2459,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = TRYCODE(_retry_me, _retry_me0);
break;
case trustme_op:
if (log_update && assembling == ASSEMBLING_INDEX) {
if (log_update &&
(assembling == ASSEMBLING_INDEX ||
assembling == ASSEMBLING_EINDEX)) {
code_p = a_cl(_trust_logical_pred, code_p, pass_no, cip);
}
#ifdef TABLING
@ -2777,8 +2797,16 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
save_machine_regs();
longjmp(cip->CompilerBotch,3);
case OUT_OF_TRAIL_ERROR:
Yap_growtrail(64 * 1024L);
/* don't just return NULL */
H = h0;
ARG1 = t;
if (!Yap_growtrail(64 * 1024L)) {
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;
t = ARG1;
h0 = H;
H = (CELL *)cip->freep;
break;
case OUT_OF_HEAP_ERROR:
/* don't just return NULL */

6
C/analyst.c
View File

@ -284,6 +284,9 @@ p_show_op_counters()
print_instruction(_pop_n);
print_instruction(_trust_fail);
print_instruction(_index_pred);
#if THREADS
print_instruction(_thread_local);
#endif
print_instruction(_save_b_x);
print_instruction(_save_b_y);
print_instruction(_save_pair_x);
@ -656,6 +659,9 @@ p_show_ops_by_group(void)
Yap_opcount[_Ystop] +
Yap_opcount[_Nstop] +
Yap_opcount[_index_pred] +
#if THREADS
Yap_opcount[_thread_local] +
#endif
Yap_opcount[_save_b_x] +
Yap_opcount[_save_b_y] +
Yap_opcount[_undef_p] +

6
C/c_interface.c
View File

@ -793,6 +793,7 @@ YAP_Read(int (*mygetc)(void))
Term t;
tr_fr_ptr old_TR;
int sno;
TokEntry *tokstart;
BACKUP_MACHINE_REGS();
@ -806,7 +807,7 @@ YAP_Read(int (*mygetc)(void))
return TermNil;
}
Stream[sno].stream_getc_for_read = Stream[sno].stream_getc = do_yap_getc;
Yap_tokptr = Yap_toktide = Yap_tokenizer(sno);
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno);
Stream[sno].status = Free_Stream_f;
if (Yap_ErrorMessage)
{
@ -815,6 +816,7 @@ YAP_Read(int (*mygetc)(void))
return(0);
}
t = Yap_Parse();
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
TR = old_TR;
RECOVER_MACHINE_REGS();
@ -894,7 +896,7 @@ YAP_Init(YAP_init_args *yap_init)
yap_init->SchedulerLoop,
yap_init->DelayedReleaseLoad
);
Yap_InitExStacks (Stack, Trail);
Yap_InitExStacks (Trail, Stack);
Yap_InitYaamRegs();
#if HAVE_MPI

45
C/cdmgr.c
View File

@ -272,6 +272,10 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
case _index_blob:
ipc = NEXTOP(ipc,e);
break;
case _lock_lu:
/* just skip for now, but should worry about locking */
ipc = NEXTOP(ipc,p);
break;
case _retry_profiled:
case _count_retry:
ipc = NEXTOP(ipc,p);
@ -344,6 +348,9 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
default:
Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Indexing Code: opcode %d", op);
}
#if defined(YAPOR) || defined(THREADS)
ipc = (yamop *)((CELL)ipc & ~1);
#endif
}
}
@ -1718,13 +1725,15 @@ p_number_of_clauses(void)
mod = Yap_LookupModule(t2);
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
pe = Yap_GetPredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
pe = PredPropByFunc(f, mod);
pe = Yap_GetPredPropByFunc(f, mod);
} else {
return (FALSE);
}
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(RepPredProp(pe)->PRWLock);
ncl = RepPredProp(pe)->cs.p_code.NOfClauses;
READ_UNLOCK(RepPredProp(pe)->PRWLock);
@ -1747,11 +1756,13 @@ p_in_use(void)
mod = Yap_LookupModule(t2);
if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(PredPropByFunc(fun, mod));
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return FALSE;
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(pe->PRWLock);
out = static_in_use(pe,TRUE);
@ -1813,9 +1824,9 @@ p_is_multifile(void)
return (FALSE);
mod = Yap_LookupModule(t2);
if (IsAtomTerm(t)) {
pe = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod));
pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), mod));
} else if (IsApplTerm(t)) {
pe = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod));
pe = RepPredProp(Yap_GetPredPropByFunc(FunctorOfTerm(t), mod));
} else
return(FALSE);
if (EndOfPAEntr(pe))
@ -1839,13 +1850,13 @@ p_is_log_updatable(void)
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(PredPropByFunc(fun, mod));
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return (FALSE);
if (pe == NIL)
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(pe->PRWLock);
out = (pe->PredFlags & LogUpdatePredFlag);
@ -1866,13 +1877,13 @@ p_is_source(void)
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(PredPropByFunc(fun, mod));
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return (FALSE);
if (pe == NIL)
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(pe->PRWLock);
out = (pe->PredFlags & SourcePredFlag);
@ -1899,7 +1910,7 @@ p_is_dynamic(void)
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return (FALSE);
if (pe == NIL)
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(pe->PRWLock);
out = (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag));
@ -1926,7 +1937,7 @@ p_pred_exists(void)
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return (FALSE);
if (pe == NIL)
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(pe->PRWLock);
if (pe->PredFlags & HiddenPredFlag)
@ -2023,10 +2034,10 @@ p_undefined(void)
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else {
return (FALSE);
return TRUE;
}
if (pe == RepPredProp(NIL))
return (TRUE);
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(pe->PRWLock);
if (pe->PredFlags & (CPredFlag|UserCPredFlag|TestPredFlag|AsmPredFlag|DynamicPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);

96
C/dbase.c
View File

@ -252,6 +252,12 @@ STATIC_PROTO(DBProp find_int_key, (Int));
#if OS_HANDLES_TR_OVERFLOW
#define db_check_trail(x)
#elif USE_SYSTEM_MALLOC
#define db_check_trail(x) { \
if (Unsigned(tofref) == Unsigned(x)) { \
goto error_tr_overflow; \
} \
}
#else
#define db_check_trail(x) { \
if (Unsigned(tofref) == Unsigned(x)) { \
@ -260,7 +266,6 @@ STATIC_PROTO(DBProp find_int_key, (Int));
} \
} \
}
#endif
@ -1877,17 +1882,14 @@ p_rcda(void)
}
goto recover_record;
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
if (!Yap_growtrail(64 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
#ifndef THREADS
break;
#endif
goto recover_record;
case OUT_OF_HEAP_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
goto recover_record;
default:
@ -1925,15 +1927,9 @@ p_rcdap(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
@ -1979,14 +1975,8 @@ p_rcda_at(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
#ifndef THREADS
break;
#endif
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
goto recover_record;
default:
@ -2041,15 +2031,9 @@ p_rcdz(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
@ -2086,15 +2070,9 @@ p_rcdzp(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
@ -2140,15 +2118,9 @@ p_rcdz_at(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recordz_at/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
@ -2193,15 +2165,9 @@ p_rcdstatp(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in record_stat_source/3");
return FALSE;
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
@ -2241,15 +2207,9 @@ p_drcdap(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
@ -2290,15 +2250,9 @@ p_drcdzp(void)
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OUT_OF_HEAP_ERROR:
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
goto recover_record;
default:
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
@ -4674,15 +4628,9 @@ StoreTermInDB(Term t, int nargs)
return(FALSE);
case OUT_OF_HEAP_ERROR:
XREGS[nargs+1] = t;
while (!Yap_ExpandPreAllocCodeSpace()) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
return FALSE;
}
#ifndef THREADS
break;
#endif
}
t = Deref(XREGS[nargs+1]);
break;
default:

6
C/errors.c
View File

@ -379,7 +379,11 @@ Yap_Error (yap_error_number type, Term where, char *format,...)
exit(1);
}
/* must do this here */
if (type == FATAL_ERROR || Yap_HeapBase == NULL) {
if (type == FATAL_ERROR
#if !USE_SYSTEM_MALLOC
|| Yap_HeapBase == NULL
#endif
) {
va_start (ap, format);
/* now build the error string */
if (format != NULL) {

1
C/exec.c
View File

@ -1542,6 +1542,7 @@ Yap_InitYaamRegs(void)
#ifdef THREADS
int myworker_id = worker_id;
pthread_setspecific(yaamregs_key, (const void *)ThreadHandle[myworker_id].default_yaam_regs);
ThreadHandle[myworker_id].current_yaam_regs = ThreadHandle[myworker_id].default_yaam_regs;
worker_id = myworker_id;
#else
Yap_regp = &Yap_standard_regs;

141
C/grow.c
View File

@ -187,11 +187,19 @@ static void
MoveLocalAndTrail(void)
{
/* cpcellsd(To,From,NOfCells) - copy the cells downwards */
#if USE_SYSTEM_MALLOC
#if HAVE_MEMMOVE
cpcellsd(ASP, (CELL *)((char *)OldASP+GDiff), (CELL *)OldTR - OldASP);
#else
cpcellsd((CELL *)TR, (CELL *)((char *)OldTR+Gdiff), (CELL *)OldTR - OldASP);
#endif
#else
#if HAVE_MEMMOVE
cpcellsd(ASP, OldASP, (CELL *)OldTR - OldASP);
#else
cpcellsd((CELL *)TR, (CELL *)OldTR, (CELL *)OldTR - OldASP);
#endif
#endif
}
static void
@ -669,11 +677,9 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip)
if (sz < in_size) {
sz = in_size;
}
#if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) {
#if YAPOR
Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow Heap: more than a worker/thread running");
return FALSE;
}
#endif
if (SizeOfOverflow > sz)
sz = AdjustPageSize(SizeOfOverflow);
@ -709,7 +715,7 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip)
return TRUE;
}
/* failed */
return(FALSE);
return FALSE;
}
int
@ -723,7 +729,7 @@ Yap_growglobal(CELL **ptr)
{
unsigned long sz = sizeof(CELL) * 16 * 1024L;
#if defined(YAPOR) || defined(THREADS)
#if YAPOR
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow Global: more than a worker/thread running");
return(FALSE);
@ -738,6 +744,56 @@ Yap_growglobal(CELL **ptr)
}
static int
execute_growstack(long size, int from_trail)
{
char *MyGlobalBase = Yap_GlobalBase;
if (!Yap_ExtendWorkSpace(size)) {
strncat(Yap_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
XDiff = HDiff = 0;
GDiff = DelayDiff = Yap_GlobalBase-MyGlobalBase;
#if USE_SYSTEM_MALLOC
if (from_trail) {
TrDiff = LDiff = GDiff;
} else {
TrDiff = LDiff = size+GDiff;
}
#else
TrDiff = LDiff = size;
#endif
if (GDiff) {
Yap_GlobalBase = (char *)MyGlobalBase;
}
ASP -= 256;
YAPEnterCriticalSection();
if (GDiff) {
SetHeapRegs();
} else {
SetStackRegs();
}
if (from_trail) {
Yap_TrailTop += size;
}
if (LDiff) {
MoveLocalAndTrail();
}
if (GDiff)
AdjustGlobal();
if (LDiff) {
AdjustGrowStack();
AdjustRegs(MaxTemps);
#ifdef TABLING
fix_tabling_info();
#endif /* TABLING */
}
YAPLeaveCriticalSection();
ASP += 256;
return TRUE;
}
/* Used by do_goal() when we're short of stack space */
static int
growstack(long size)
@ -745,19 +801,9 @@ growstack(long size)
Int start_growth_time, growth_time;
int gc_verbose;
#if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow Local: more than a worker/thread running");
return(FALSE);
}
#endif
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
Yap_ErrorMessage = NULL;
if (!Yap_ExtendWorkSpace(size)) {
strncat(Yap_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = Yap_cputime();
gc_verbose = Yap_is_gc_verbose();
stack_overflows++;
@ -769,20 +815,8 @@ growstack(long size)
(unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
fprintf(Yap_stderr, "[SO] growing the stacks %ld bytes\n", size);
}
TrDiff = LDiff = size;
XDiff = HDiff = GDiff = DelayDiff = 0;
ASP -= 256;
YAPEnterCriticalSection();
SetStackRegs();
MoveLocalAndTrail();
AdjustGrowStack();
AdjustRegs(MaxTemps);
#ifdef TABLING
fix_tabling_info();
#endif /* TABLING */
YAPLeaveCriticalSection();
CreepFlag = CalculateStackGap();
ASP += 256;
if (!execute_growstack(size, FALSE))
return FALSE;
growth_time = Yap_cputime()-start_growth_time;
total_stack_overflow_time += growth_time;
if (gc_verbose) {
@ -873,7 +907,7 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
int gc_verbose;
long size = sizeof(CELL)*(LCL0-(CELL *)Yap_GlobalBase);
#if defined(YAPOR) || defined(THREADS)
#if YAPOR
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow Parser Stack: more than a worker/thread running");
return(FALSE);
@ -914,7 +948,6 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
}
AdjustRegs(MaxTemps);
YAPLeaveCriticalSection();
CreepFlag = CalculateStackGap();
ASP += 256;
growth_time = Yap_cputime()-start_growth_time;
total_stack_overflow_time += growth_time;
@ -930,20 +963,23 @@ static int do_growtrail(long size)
Int start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose();
#if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow trail: more than a worker/thread running");
return(FALSE);
}
#endif
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
trail_overflows++;
if (gc_verbose) {
fprintf(Yap_stderr, "[TO] Trail overflow %d\n", trail_overflows);
#if USE_SYSTEM_MALLOC
fprintf(Yap_stderr, "[TO] Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),(CELL *)Yap_GlobalBase,H);
fprintf(Yap_stderr, "[TO] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(Yap_stderr, "[TO] Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
#endif
fprintf(Yap_stderr, "[TO] growing the trail %ld bytes\n", size);
}
Yap_ErrorMessage = NULL;
#if USE_SYSTEM_MALLOC
execute_growstack(size, TRUE);
#else
if (!Yap_ExtendWorkSpace(size)) {
strncat(Yap_ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
return FALSE;
@ -951,12 +987,17 @@ static int do_growtrail(long size)
YAPEnterCriticalSection();
Yap_TrailTop += size;
YAPLeaveCriticalSection();
#endif
growth_time = Yap_cputime()-start_growth_time;
total_trail_overflow_time += growth_time;
if (gc_verbose) {
fprintf(Yap_stderr, "[TO] took %g sec\n", (double)growth_time/1000);
fprintf(Yap_stderr, "[TO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
fprintf(Yap_stderr, "[TO] Total of %g sec expanding trail \n", (double)total_trail_overflow_time/1000);
}
if (ActiveSignals == YAP_TROVF_SIGNAL) {
CreepFlag = CalculateStackGap();
}
ActiveSignals &= ~YAP_TROVF_SIGNAL;
return TRUE;
}
@ -969,8 +1010,25 @@ Yap_growtrail(long size)
}
CELL **
Yap_shift_visit(CELL **to_visit)
Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
{
#if USE_SYSTEM_MALLOC
CELL **to_visit_max = *to_visit_maxp;
Int sz1 = (CELL)to_visit_max-(CELL)to_visit;
Int sz0 = AuxTop - (ADDR)to_visit_maxp, sz, dsz;
char *newb = Yap_ExpandPreAllocCodeSpace(0);
/* check new size */
sz = AuxTop-newb;
/* how much we grew */
dsz = sz-sz0;
/* copy whole block to end */
cpcellsd((CELL *)newb, (CELL *)(newb+dsz), sz0/sizeof(CELL));
/* base pointer is block start */
*to_visit_maxp = (CELL **)newb;
/* current top is originall diff + diff size */
return (CELL **)((char *)newb+(sz1+dsz));
#else
CELL **old_top = (CELL **)Yap_TrailTop;
if (do_growtrail(64 * 1024L)) {
CELL **dest = (CELL **)((char *)to_visit+64 * 1024L);
@ -980,6 +1038,7 @@ Yap_shift_visit(CELL **to_visit)
Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow temporary stack for unification (%p)", Yap_TrailTop);
return to_visit;
}
#endif
}
void
@ -990,6 +1049,10 @@ Yap_growatomtable(void)
Int start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose();
if (ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap();
}
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
/* leave for next time */
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry), NULL))

9
C/heapgc.c
View File

@ -20,6 +20,7 @@ static char SccsId[] = "%W% %G%";
#include "absmi.h"
#include "yapio.h"
#include "alloc.h"
#define EARLY_RESET 1
@ -3033,11 +3034,14 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
Int effectiveness = 0;
int gc_trace = FALSE;
#if USE_SYSTEM_MALLOC
return 0;
#endif
#if COROUTINING
if (H0 - max < 1024+(2*NUM_OF_ATTS)) {
if (!Yap_growglobal(&current_env)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
return 0;
}
}
#endif
@ -3075,7 +3079,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
}
return(0);
}
gc_calls++;
if (gc_trace) {
fprintf(Yap_stderr, "[gc]\n");
} else if (gc_verbose) {
@ -3226,9 +3229,11 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
gc_margin <<= 8;
gc_margin *= gc_calls;
}
gc_margin *= Yap_page_size;
}
if (gc_margin < gc_lim)
gc_margin = gc_lim;
gc_calls++;
if (gc_on) {
effectiveness = do_gc(predarity, current_env, nextop);
if (effectiveness > 90) {

145
C/index.c
View File

@ -243,17 +243,23 @@ copy_back(ClauseDef *dest, CELL *pt, int max) {
/* sort a group of clauses by using their tags */
static void
sort_group(GroupDef *grp, CELL *top)
sort_group(GroupDef *grp, CELL *top, struct intermediates *cint)
{
int max = (grp->LastClause-grp->FirstClause)+1, i;
CELL *pt = top;
while (top+2*max > (CELL *)Yap_TrailTop) {
#if USE_SYSTEM_MALLOC
Yap_Error_Size = 2*max*sizeof(CELL);
/* grow stack */
longjmp(cint->CompilerBotch,4);
#else
if (!Yap_growtrail(2*max*CellSize)) {
Yap_Error(SYSTEM_ERROR,TermNil,"YAP failed to reserve %ld in growtrail",
2*max*CellSize);
return;
}
#endif
}
/* initialise vector */
for (i=0; i < max; i++) {
@ -428,6 +434,9 @@ has_cut(yamop *pc)
#endif
case _pop:
case _index_pred:
#if THREADS
case _thread_local:
#endif
case _expand_index:
case _undef_p:
case _spy_pred:
@ -1572,6 +1581,7 @@ add_info(ClauseDef *clause, UInt regno)
case _skip:
case _jump_if_var:
case _try_in:
case _lock_lu:
clause->Tag = (CELL)NULL;
return;
case _jump_if_nonvar:
@ -1586,6 +1596,9 @@ add_info(ClauseDef *clause, UInt regno)
#endif
case _pop:
case _index_pred:
#if THREADS
case _thread_local:
#endif
case _expand_index:
case _undef_p:
case _spy_pred:
@ -2961,7 +2974,7 @@ do_nonvar_group(GroupDef *grp, Term t, int compound_term, CELL *sreg, UInt arity
type_sw = emit_type_switch(switch_on_type_op, cint);
type_sw->VarEntry = do_var_entries(grp, t, cint, argno, first, clleft, nxtlbl);
grp->LastClause = cls_move(grp->FirstClause, ap, grp->LastClause, compound_term, argno, last_arg);
sort_group(grp,top);
sort_group(grp,top,cint);
type_sw->ConstEntry =
type_sw->FuncEntry =
type_sw->PairEntry =
@ -3164,9 +3177,15 @@ copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top, struct intermediates *
{
UInt sz = ((max0+1)-min0)*sizeof(ClauseDef);
while ((char *)top + sz > Yap_TrailTop) {
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
#if USE_SYSTEM_MALLOC
Yap_Error_Size = sz;
/* grow stack */
longjmp(cint->CompilerBotch,4);
#else
if(!Yap_growtrail (sz)) {
longjmp(cint->CompilerBotch,3);
}
#endif
}
memcpy((void *)top, (void *)min0, sz);
return (ClauseDef *)top;
@ -3264,7 +3283,7 @@ do_dbref_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cin
Yap_emit(label_op, labl, Zero, cint);
Yap_emit(index_dbref_op, Zero, Zero, cint);
sort_group(group,(CELL *)(group+1));
sort_group(group,(CELL *)(group+1),cint);
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)group+1);
return labl;
}
@ -3296,7 +3315,7 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint
Yap_emit(label_op, labl, Zero, cint);
Yap_emit(index_blob_op, Zero, Zero, cint);
sort_group(group,(CELL *)(group+1));
sort_group(group,(CELL *)(group+1),cint);
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)group+1);
return labl;
}
@ -3378,7 +3397,13 @@ Yap_PredIsIndexable(PredEntry *ap)
} else if (setjres == 2) {
restore_machine_regs();
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FAILCODE;
}
} else if (setjres == 4) {
restore_machine_regs();
if (!Yap_growtrail(Yap_Error_Size)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage);
return FAILCODE;
}
} else if (setjres != 0) {
@ -3684,12 +3709,12 @@ static yamop **
expand_index(struct intermediates *cint) {
/* first clause */
PredEntry *ap = cint->CurrentPred;
yamop *first = ap->cs.p_code.FirstClause, *last = NULL, *alt = NULL;
yamop *first, *last = NULL, *alt = NULL;
istack_entry *stack, *sp;
ClauseDef *cls = (ClauseDef *)H, *max;
int NClauses = ap->cs.p_code.NOfClauses;
int NClauses;
/* last clause to experiment with */
yamop *ipc = ap->cs.p_code.TrueCodeOfPred;
yamop *ipc;
/* labp should point at the beginning of the sequence */
yamop **labp = NULL;
Term t = TermNil, *s_reg = NULL;
@ -3701,6 +3726,9 @@ expand_index(struct intermediates *cint) {
UInt arity = 0;
UInt lab, fail_l, clleft, i = 0;
ipc = ap->cs.p_code.TrueCodeOfPred;
first = ap->cs.p_code.FirstClause;
NClauses = ap->cs.p_code.NOfClauses;
sp = stack = (istack_entry *)top;
labelno = 1;
stack[0].pos = 0;
@ -3791,6 +3819,9 @@ expand_index(struct intermediates *cint) {
/* just skip for now, but should worry about memory management */
ipc = ipc->u.l.l;
break;
case _lock_lu:
ipc = NEXTOP(ipc,p);
break;
case _jump_if_var:
if (IsVarTerm(Deref(ARG1))) {
labp = &(ipc->u.l.l);
@ -4123,6 +4154,21 @@ ExpandIndex(PredEntry *ap) {
}
return NULL;
}
} else if (cb == 4) {
restore_machine_regs();
if (!Yap_growtrail(Yap_Error_Size)) {
save_machine_regs();
if (ap->PredFlags & LogUpdatePredFlag) {
Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap);
} else {
StaticIndex *cl;
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
}
UNLOCK(ap->PELock);
return NULL;
}
}
restart_index:
cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL;
@ -4163,9 +4209,11 @@ ExpandIndex(PredEntry *ap) {
}
#endif
if ((labp = expand_index(&cint)) == NULL) {
UNLOCK(ap->PELock);
return NULL;
}
if (*labp == FAILCODE) {
UNLOCK(ap->PELock);
return FAILCODE;
}
#ifdef DEBUG
@ -4176,20 +4224,24 @@ ExpandIndex(PredEntry *ap) {
/* globals for assembler */
IPredArity = ap->ArityOfPE;
if (cint.CodeStart) {
if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE, &cint)) == NULL) {
if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint)) == NULL) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
UNLOCK(ap->PELock);
return NULL;
}
goto restart_index;
}
} else {
/* single case */
UNLOCK(ap->PELock);
return *labp;
}
if (ProfilerOn) {
Yap_inform_profiler_of_clause(indx_out, ProfEnd, ap);
}
if (indx_out == NULL) {
UNLOCK(ap->PELock);
return FAILCODE;
}
*labp = indx_out;
@ -4211,6 +4263,7 @@ ExpandIndex(PredEntry *ap) {
nic->SiblingIndex = ic->ChildIndex;
ic->ChildIndex = nic;
}
UNLOCK(ap->PELock);
return indx_out;
}
@ -4459,6 +4512,8 @@ expand_ctable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Term at)
ics->Label = old_ae->Label;
}
}
/* support for threads */
if (blk)
replace_index_block(blk, pc->u.sl.l, (yamop *)target, ap);
pc->u.sl.l = (yamop *)target;
return fetch_centry(target, at, n-1, n);
@ -5473,6 +5528,9 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
case _expand_index:
ipc = pop_path(&sp, cls, ap);
break;
case _lock_lu:
ipc = NEXTOP(ipc,p);
break;
default:
sp = kill_unsafe_block(sp, op, ap);
ipc = pop_path(&sp, cls, ap);
@ -5512,6 +5570,20 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
}
return;
}
} else if (cb == 4) {
restore_machine_regs();
if (!Yap_growtrail(Yap_Error_Size)) {
save_machine_regs();
if (ap->PredFlags & LogUpdatePredFlag) {
Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap);
} else {
StaticIndex *cl;
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
}
return;
}
Yap_Error_Size = 0;
}
Yap_ErrorMessage = NULL;
@ -5949,6 +6021,7 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
ipc = pop_path(&sp, cls, ap);
} else {
yamop *newpc = (yamop *)(ae->Label);
sp = fetch_new_block(sp, &(ipc->u.sl.l), ap);
sp = cross_block(sp, (yamop **)&(ae->Label), ap);
ipc = newpc;
@ -5958,6 +6031,9 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
case _expand_index:
ipc = pop_path(&sp, cls, ap);
break;
case _lock_lu:
ipc = NEXTOP(ipc,p);
break;
default:
if (IN_BETWEEN(bg,ipc,lt)) {
sp = kill_unsafe_block(sp, op, ap);
@ -5996,6 +6072,21 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
return;
}
Yap_Error_Size = 0;
} else if (cb == 4) {
restore_machine_regs();
if (!Yap_growtrail(Yap_Error_Size)) {
save_machine_regs();
if (ap->PredFlags & LogUpdatePredFlag) {
Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap);
} else {
StaticIndex *cl;
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
}
return;
}
Yap_Error_Size = 0;
}
Yap_ErrorMessage = NULL;
#ifdef DEBUG
@ -6449,6 +6540,13 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
*/
case _undef_p:
return NULL;
case _lock_lu:
ipc = NEXTOP(ipc,p);
break;
#if THREADS
case _thread_local:
break;
#endif
case _index_pred:
case _spy_pred:
Yap_IPred(ap);
@ -6483,6 +6581,12 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
abolish_incomplete_subgoals(B);
#endif /* TABLING */
}
#if defined(YAPOR) || defined(THREADS)
if (PP == ap) {
PP = NULL;
READ_UNLOCK(ap->PRWLock);
}
#endif
return NULL;
}
@ -6589,6 +6693,9 @@ Yap_NthClause(PredEntry *ap, Int ncls)
case _enter_lu_pred:
ipc = ipc->u.Ill.l1;
break;
case _lock_lu:
ipc = NEXTOP(ipc,p);
break;
case _jump:
jlbl = &(ipc->u.l.l);
ipc = ipc->u.l.l;
@ -6627,14 +6734,19 @@ Yap_NthClause(PredEntry *ap, Int ncls)
case _op_fail:
ipc = alt;
break;
case _undef_p:
return NULL;
case _index_pred:
case _spy_pred:
Yap_IPred(ap);
ipc = ap->cs.p_code.TrueCodeOfPred;
break;
case _undef_p:
default:
#if defined(YAPOR) || defined(THREADS)
if (PP == ap) {
PP = NULL;
READ_UNLOCK(ap->PRWLock);
}
#endif
return NULL;
}
}
@ -6839,6 +6951,7 @@ find_caller(PredEntry *ap, yamop *code) {
case _go_on_cons:
{
AtomSwiEntry *ae;
yamop *newpc;
if (op == _switch_on_cons) {
ae = lookup_c_hash(t,ipc->u.sl.l,ipc->u.sl.s);
@ -6846,15 +6959,16 @@ find_caller(PredEntry *ap, yamop *code) {
ae = lookup_c(t,ipc->u.sl.l,ipc->u.sl.s);
}
if (ae->Label == (CELL)code) {
newpc = (yamop *)(ae->Label);
if (newpc == code) {
/* we found it */
return (yamop **)(&(ae->Label));
ipc = NULL;
} else if (ae->Label == (UInt)FAILCODE) {
} else if (newpc == FAILCODE) {
/* oops, things went wrong */
ipc = alt;
} else {
ipc = (yamop *)(ae->Label);
ipc = newpc;
}
}
break;
@ -6909,3 +7023,4 @@ Yap_CleanUpIndex(LogUpdIndex *blk)
return start;
}
}

3
C/init.c
View File

@ -769,6 +769,7 @@ InitCodes(void)
int i;
for (i=0; i < MAX_WORKERS; i++) {
heap_regs->thread_handle[i].in_use = FALSE;
heap_regs->thread_handle[i].local_preds = NULL;
}
}
heap_regs->thread_handle[0].id = 0;
@ -778,7 +779,7 @@ InitCodes(void)
heap_regs->thread_handle[0].handle = pthread_self();
#endif
#if defined(YAPOR) || defined(THREADS)
INIT_RWLOCK(heap_regs->bgl);
INIT_LOCK(heap_regs->bgl);
INIT_LOCK(heap_regs->free_blocks_lock);
INIT_LOCK(heap_regs->heap_used_lock);
INIT_LOCK(heap_regs->heap_top_lock);

27
C/iopreds.c
View File

@ -2947,7 +2947,8 @@ do_read(int inp_stream)
/* we got the end of file from an abort */
if (Yap_ErrorMessage == "Abort") {
TR = old_TR;
return(FALSE);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
}
/* we need to force the next reading to also give end of file.*/
Stream[inp_stream].status |= Push_Eof_Stream_f;
@ -2955,6 +2956,7 @@ do_read(int inp_stream)
} else {
/* restore TR */
TR = old_TR;
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return (Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG4) &&
Yap_unify_constant (ARG2, MkAtomTerm (AtomEof)));
@ -2978,7 +2980,8 @@ do_read(int inp_stream)
TR = old_TR;
if (ParserErrorStyle == QUIET_ON_PARSER_ERROR) {
/* just fail */
return(FALSE);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
} else if (ParserErrorStyle == CONTINUE_ON_PARSER_ERROR) {
Yap_ErrorMessage = NULL;
TR = TR_before_parse;
@ -2990,13 +2993,16 @@ do_read(int inp_stream)
Yap_ErrorMessage = "SYNTAX ERROR";
if (ParserErrorStyle == EXCEPTION_ON_PARSER_ERROR) {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
Yap_Error(SYNTAX_ERROR,terr,Yap_ErrorMessage);
return(FALSE);
return FALSE;
} else /* FAIL ON PARSER ERROR */ {
Term t[2];
Term t[2], t1;
t[0] = terr;
t[1] = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
return(Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4) &&
t1 = MkIntegerTerm(StartLine = tokstart->TokPos);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return(Yap_unify(t1,ARG4) &&
Yap_unify(ARG5,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t)));
}
}
@ -3025,10 +3031,12 @@ do_read(int inp_stream)
old_H = H;
}
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return(Yap_unify(t, ARG2) && Yap_unify (v, ARG3) &&
Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4));
} else {
TR = old_TR;
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return(Yap_unify(t, ARG2) && Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4));
}
}
@ -4500,7 +4508,11 @@ format(Term tail, Term args, int sno)
static Int
p_format(void)
{ /* '$format'(Control,Args) */
return(format(Deref(ARG1),Deref(ARG2), Yap_c_output_stream));
Int res;
LOCK(BGL);
res = format(Deref(ARG1),Deref(ARG2), Yap_c_output_stream);
UNLOCK(BGL);
return res;
}
@ -4510,14 +4522,17 @@ p_format2(void)
int old_c_stream = Yap_c_output_stream;
Int out;
LOCK(BGL);
/* needs to change Yap_c_output_stream for write */
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3");
if (Yap_c_output_stream == -1) {
Yap_c_output_stream = old_c_stream;
UNLOCK(BGL);
return(FALSE);
}
out = format(Deref(ARG2),Deref(ARG3),Yap_c_output_stream);
Yap_c_output_stream = old_c_stream;
UNLOCK(BGL);
return(out);
}

1
C/load_none.c
View File

@ -14,6 +14,7 @@
#include "Yap.h"
#include "Foreign.h"
#include "Yatom.h"
#include "Heap.h"
#ifdef HAVE_STRING_H
#include <string.h>

46
C/scanner.c
View File

@ -125,6 +125,9 @@ char *Yap_chtype = chtype0+1;
static char *
AllocScannerMemory(unsigned int size)
{
#if USE_SYSTEM_MALLOC
return malloc(AdjustSize(size));
#else
char *AuxSpScan;
AuxSpScan = (char *)TR;
@ -138,6 +141,7 @@ AllocScannerMemory(unsigned int size)
}
#endif
return (AuxSpScan);
#endif
}
char *
@ -453,6 +457,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
}
while (chtype[ch] == NU) {
Int oval = val;
if (ch != '0')
*sp++ = ch;
if (ch - '0' >= base)
return (MkIntegerTerm(val));
@ -665,6 +670,8 @@ Yap_tokenizer(int inp_stream)
p->TokInfo = eot_tok;
/* serious error now */
return(l);
} else {
e->TokNext = NULL;
}
t->TokNext = e;
t = e;
@ -690,6 +697,8 @@ Yap_tokenizer(int inp_stream)
p->TokInfo = eot_tok;
/* serious error now */
return(l);
} else {
e2->TokNext = NULL;
}
t->TokNext = e2;
t = e2;
@ -717,6 +726,8 @@ Yap_tokenizer(int inp_stream)
p->TokInfo = eot_tok;
/* serious error now */
return(l);
} else {
e2->TokNext = NULL;
}
t->TokNext = e2;
t = e2;
@ -896,10 +907,43 @@ Yap_tokenizer(int inp_stream)
e->Tok = Error_tok;
e->TokInfo = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
e->TokPos = GetCurInpPos(inp_stream);
e->TokNext = NIL;
e->TokNext = NULL;
Yap_ErrorMessage = NULL;
p = e;
}
} while (kind != eot_tok);
return (l);
}
#if USE_SYSTEM_MALLOC
static
void clean_vtable(VarEntry *vt)
{
if (vt == NULL)
return;
clean_vtable(vt->VarLeft);
clean_vtable(vt->VarRight);
free(vt);
}
static
void clean_tokens(TokEntry *tk)
{
while (tk != NULL) {
TokEntry *ntk = tk->TokNext;
if (tk->Tok == Ord(String_tok)) {
free((void *)(tk->TokInfo));
}
free(tk);
tk = ntk;
}
}
void
Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartable)
{
clean_vtable(vartable);
clean_vtable(anonvartable);
clean_tokens(tokstart);
}
#endif

104
C/stdpreds.c
View File

@ -702,7 +702,7 @@ p_char_code(void)
static Int
p_name(void)
{ /* name(?Atomic,?String) */
char *String = (char *)TR, *s; /* alloc temp space on trail */
char *String, *s; /* alloc temp space on trail */
Term t, NewT, AtomNameT = Deref(ARG1);
ARG2 = Deref(ARG2);
@ -717,6 +717,7 @@ p_name(void)
}
return (Yap_unify(NewT, ARG2));
} else if (IsIntTerm(AtomNameT)) {
char *String = Yap_PreAllocCodeSpace();
#if SHORT_INTS
sprintf(String, "%ld", IntOfTerm(AtomNameT));
#else
@ -729,6 +730,8 @@ p_name(void)
}
return (Yap_unify(NewT, ARG2));
} else if (IsFloatTerm(AtomNameT)) {
char *String = Yap_PreAllocCodeSpace();
sprintf(String, "%f", FloatOfTerm(AtomNameT));
NewT = Yap_StringToList(String);
if (!IsVarTerm(ARG2) && !IsPairTerm(ARG2)) {
@ -737,6 +740,8 @@ p_name(void)
}
return (Yap_unify(NewT, ARG2));
} else if (IsLongIntTerm(AtomNameT)) {
char *String = Yap_PreAllocCodeSpace();
#if SHORT_INTS
sprintf(String, "%ld", LongIntOfTerm(AtomNameT));
#else
@ -754,7 +759,7 @@ p_name(void)
}
}
t = ARG2;
s = String;
s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
if (!IsVarTerm(t) && t == MkAtomTerm(AtomNil)) {
return (Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom(""))));
}
@ -776,8 +781,14 @@ p_name(void)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,Head,"name/2");
return(FALSE);
}
if (Unsigned(Yap_TrailTop) - Unsigned(s) < MinTrailGap) {
Yap_growtrail(sizeof(CELL) * 16 * 1024L);
if (s+1 == (char *)AuxSp) {
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
}
*s++ = i;
t = TailOfTerm(t);
@ -816,7 +827,7 @@ p_atom_chars(void)
return (Yap_unify(NewT, ARG2));
} else {
/* ARG1 unbound */
char *String = (char *)TR; /* alloc temp space on trail */
char *String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; /* alloc temp space on trail */
register Term t = Deref(ARG2);
register char *s = String;
@ -848,8 +859,14 @@ p_atom_chars(void)
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"atom_chars/2");
return(FALSE);
}
if (Unsigned(Yap_TrailTop) - Unsigned(s) < MinTrailGap) {
Yap_growtrail(sizeof(CELL) * 16 * 1024L);
if (s+1 == (char *)AuxSp) {
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
}
*s++ = i;
t = TailOfTerm(t);
@ -880,8 +897,14 @@ p_atom_chars(void)
Yap_Error(TYPE_ERROR_CHARACTER,Head,"atom_chars/2");
return(FALSE);
}
if (Unsigned(Yap_TrailTop) - Unsigned(s) < MinTrailGap) {
Yap_growtrail(sizeof(CELL) * 16 * 1024L);
if (s+1 == (char *)AuxSp) {
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
}
*s++ = is[0];
t = TailOfTerm(t);
@ -974,7 +997,7 @@ p_atom_codes(void)
return (Yap_unify(NewT, ARG2));
} else {
/* ARG1 unbound */
char *String = (char *)TR; /* alloc temp space on trail */
char *String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
register Term t = Deref(ARG2);
register char *s = String;
@ -1005,8 +1028,14 @@ p_atom_codes(void)
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"atom_codes/2");
return(FALSE);
}
if (Unsigned(Yap_TrailTop) - Unsigned(s) < MinTrailGap) {
Yap_growtrail(sizeof(CELL) * 16 * 1024L);
if (s+1 == (char *)AuxSp) {
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
}
*s++ = i;
t = TailOfTerm(t);
@ -1116,11 +1145,12 @@ gen_syntax_error(char *s)
static Int
p_number_chars(void)
{
char *String = (char *)TR; /* alloc temp space on Trail */
char *String; /* alloc temp space on Trail */
register Term t = Deref(ARG2), t1 = Deref(ARG1);
Term NewT;
register char *s = String;
register char *s;
String = Yap_PreAllocCodeSpace();
if (IsNonVarTerm(t1)) {
Term NewT;
if (!IsNumTerm(t1)) {
@ -1178,6 +1208,7 @@ p_number_chars(void)
Yap_Error(TYPE_ERROR_LIST, t, "number_chars/2");
return(FALSE);
}
s = String;
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
while (t != TermNil) {
register Term Head;
@ -1195,8 +1226,14 @@ p_number_chars(void)
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"number_chars/2");
return(FALSE);
}
if (Unsigned(Yap_TrailTop) - Unsigned(s) < MinTrailGap) {
Yap_growtrail(sizeof(CELL) * 16 * 1024L);
if (s+1 == (char *)AuxSp) {
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0);
t = *--H;
s = nString+(s-String);
String = nString;
}
*s++ = i;
t = TailOfTerm(t);
@ -1227,8 +1264,14 @@ p_number_chars(void)
Yap_Error(TYPE_ERROR_CHARACTER,Head,"number_chars/2");
return(FALSE);
}
if (Unsigned(Yap_TrailTop) - Unsigned(s) < MinTrailGap) {
Yap_growtrail(sizeof(CELL) * 16 * 1024L);
if (s+1 == (char *)AuxSp) {
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0);
t = *--H;
s = nString+(s-String);
String = nString;
}
*s++ = is[0];
t = TailOfTerm(t);
@ -1252,11 +1295,12 @@ p_number_chars(void)
static Int
p_number_atom(void)
{
char *String = (char *)TR; /* alloc temp space on Trail */
char *String; /* alloc temp space on Trail */
register Term t = Deref(ARG2), t1 = Deref(ARG1);
Term NewT;
register char *s = String;
register char *s;
s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
if (IsNonVarTerm(t1)) {
if (IsIntTerm(t1)) {
Term NewT;
@ -1312,11 +1356,12 @@ p_number_atom(void)
static Int
p_number_codes(void)
{
char *String = (char *)TR; /* alloc temp space on Trail */
char *String; /* alloc temp space on Trail */
register Term t = Deref(ARG2), t1 = Deref(ARG1);
Term NewT;
register char *s = String;
register char *s;
String = Yap_PreAllocCodeSpace();
if (IsNonVarTerm(t1)) {
if (IsIntTerm(t1)) {
#if SHORT_INTS
@ -1356,6 +1401,7 @@ p_number_codes(void)
Yap_Error(TYPE_ERROR_LIST, t, "number_codes/2");
return(FALSE);
}
s = String; /* alloc temp space on Trail */
while (t != TermNil) {
register Term Head;
register Int i;
@ -1373,8 +1419,14 @@ p_number_codes(void)
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"number_codes/2");
return(FALSE);
}
if (Unsigned(Yap_TrailTop) - Unsigned(s) < MinTrailGap) {
Yap_growtrail(sizeof(CELL) * 16 * 1024L);
if (s+1 == (char *)AuxSp) {
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0);
t = *--H;
s = nString+(s-String);
String = nString;
}
*s++ = i;
t = TailOfTerm(t);
@ -2480,14 +2532,14 @@ p_set_yap_flags(void)
static Int
p_lock_system(void)
{
WRITE_LOCK(BGL);
LOCK(BGL);
return TRUE;
}
static Int
p_unlock_system(void)
{
WRITE_UNLOCK(BGL);
UNLOCK(BGL);
return TRUE;
}

8
C/sysbits.c
View File

@ -868,10 +868,12 @@ STATIC_PROTO (void my_signal, (int, void (*)(int, siginfo_t *, ucontext_t *)));
static void
HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap)
{
if (sip->si_code != SI_NOINFO &&
sip->si_code == SEGV_MAPERR &&
(void *)(sip->si_addr) > (void *)(Yap_HeapBase) &&
(void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L) ) {
(void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L) &&
! USE_SYSTEM_MALLOC) {
Yap_growtrail(64 * 1024L);
}
else {
@ -1014,7 +1016,7 @@ SearchForTrailFault(void)
#ifdef DEBUG
/* fprintf(stderr,"Catching a sigsegv at %p with %p\n", TR, TrailTop); */
#endif
#if OS_HANDLES_TR_OVERFLOW
#if OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC
if ((TR > (tr_fr_ptr)Yap_TrailTop-1024 &&
TR < (tr_fr_ptr)Yap_TrailTop+(64*1024))|| Yap_DBTrailOverflow()) {
long trsize = 64*2014L;
@ -1022,7 +1024,7 @@ SearchForTrailFault(void)
trsize += 64*2014L;
}
if (!Yap_growtrail(trsize)) {
Yap_Error(SYSTEM_ERROR, TermNil, "YAP failed to reserve %ld bytes in growtrail", 64*1024L);
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP failed to reserve %ld bytes in growtrail", 64*1024L);
}
/* just in case, make sure the OS keeps the signal handler. */
/* my_signal_info(SIGSEGV, HandleSIGSEGV); */

42
C/threads.c
View File

@ -282,7 +282,7 @@ p_cond_create(void)
{
pthread_cond_t* condp;
condp = (SWIMutex *)Yap_AllocCodeSpace(sizeof(pthread_cond_t));
condp = (pthread_cond_t *)Yap_AllocCodeSpace(sizeof(pthread_cond_t));
if (condp == NULL) {
return FALSE;
}
@ -332,6 +332,45 @@ p_cond_wait(void)
return TRUE;
}
static Int
p_install_thread_local(void)
{ /* '$is_dynamic'(+P) */
PredEntry *pe;
Term t = Deref(ARG1);
Term t2 = Deref(ARG2);
SMALLUNSGN mod = Yap_LookupModule(t2);
if (IsVarTerm(t)) {
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(PredPropByFunc(fun, mod));
} else
return FALSE;
WRITE_LOCK(pe->PRWLock);
if (pe->PredFlags & (UserCPredFlag|HiddenPredFlag|CArgsPredFlag|SourcePredFlag|SyncPredFlag|TestPredFlag|AsmPredFlag|StandardPredFlag|DynamicPredFlag|CPredFlag|SafePredFlag|IndexedPredFlag|BinaryTestPredFlag|SpiedPredFlag)) {
return FALSE;
}
pe->PredFlags |= ThreadLocalPredFlag;
pe->OpcodeOfPred = Yap_opcode(_thread_local);
pe->CodeOfPred = (yamop *)&pe->OpcodeOfPred;
WRITE_UNLOCK(pe->PRWLock);
return TRUE;
}
static Int
p_thread_signal(void)
{ /* '$thread_signal'(+P) */
Int wid = IntegerOfTerm(Deref(ARG1));
LOCK(heap_regs->wl[wid].signal_lock);
ThreadHandle[wid].current_yaam_regs->CreepFlag_ = Unsigned(LCL0);
heap_regs->wl[wid].active_signals |= YAP_ITI_SIGNAL;
UNLOCK(heap_regs->wl[wid].signal_lock);
}
void Yap_InitThreadPreds(void)
{
Yap_InitCPred("$create_thread", 5, p_create_thread, 0);
@ -353,6 +392,7 @@ void Yap_InitThreadPreds(void)
Yap_InitCPred("$cond_signal", 1, p_cond_signal, SafePredFlag);
Yap_InitCPred("$cond_broadcast", 1, p_cond_broadcast, SafePredFlag);
Yap_InitCPred("$cond_wait", 2, p_cond_wait, SafePredFlag);
Yap_InitCPred("$install_thread_local", 2, p_install_thread_local, SafePredFlag);
}

4
C/tracer.c
View File

@ -115,6 +115,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */
vsc_count++;
if (vsc_count == 71808) vsc_xstop = 1;
if (vsc_count < 71000)
return;
#ifdef COMMENTED
if (port != enter_pred ||
!pred ||
@ -153,6 +156,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
}
if (gc_calls < 1) return;
#endif
fprintf(Yap_stderr,"%lld ", vsc_count);
#if defined(THREADS) || defined(YAPOR)
fprintf(Yap_stderr,"(%d)", worker_id);
#endif

6
C/unify.c
View File

@ -588,8 +588,8 @@ InitReverseLookupOpcode(void)
/* clear up table */
{
int j;
for (j=0; j<=OP_HASH_SIZE; j++) {
opeptr[j].opc = NIL;
for (j=0; j<OP_HASH_SIZE; j++) {
opeptr[j].opc = 0;
opeptr[j].opnum = _Ystop;
}
}
@ -601,7 +601,7 @@ InitReverseLookupOpcode(void)
OPCODE opc = Yap_opcode(i);
int j = rtable_hash_op(opc,hash_size_mask);
while (opeptr[j].opc != NIL) {
while (opeptr[j].opc) {
if (++j > hash_size_mask)
j = 0;
}

2
C/write.c
View File

@ -468,7 +468,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
{
char *s = (char *)TR;
while (s+2+mpz_sizeinbase(Yap_BigIntOfTerm(t), 10) > (char *)Yap_TrailTop)
Yap_growtrail(64*1024);
Yap_growtrail(2+mpz_sizeinbase(Yap_BigIntOfTerm(t), 10));
mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
wrputs(s,wglb->writech);
}

46
H/Heap.h
View File

@ -10,11 +10,14 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.51 2004-01-29 13:37:09 vsc Exp $ *
* version: $Id: Heap.h,v 1.52 2004-02-05 16:57:00 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
#ifndef HEAP_H
#define HEAP_H 1
#ifndef INT_KEYS_DEFAULT_SIZE
#define INT_KEYS_DEFAULT_SIZE 256
#endif
@ -66,6 +69,8 @@ typedef struct thandle {
int id;
int ret;
REGSTORE *default_yaam_regs;
REGSTORE *current_yaam_regs;
struct pred_entry *local_preds;
pthread_t handle;
} yap_thandle;
#endif
@ -80,7 +85,7 @@ typedef struct various_codes {
ADDR heap_lim;
struct FREEB *free_blocks;
#if defined(YAPOR) || defined(THREADS)
rwlock_t bgl; /* protect long critical regions */
lockvar bgl; /* protect long critical regions */
lockvar free_blocks_lock; /* protect the list of free blocks */
worker_local wl[MAX_WORKERS];
#else
@ -689,17 +694,44 @@ struct various_codes *heap_regs;
#endif
ADDR STD_PROTO(Yap_ExpandPreAllocCodeSpace, (UInt));
#define Yap_ReleasePreAllocCodeSpace(x)
#if defined(YAPOR) || defined(THREADS)
ADDR STD_PROTO(Yap_PreAllocCodeSpace, (void));
ADDR STD_PROTO(Yap_ExpandPreAllocCodeSpace, (void));
void STD_PROTO(Yap_ReleasePreAllocCodeSpace, (ADDR));
ADDR STD_PROTO(Yap_InitPreAllocCodeSpace, (void));
EXTERN inline ADDR
Yap_PreAllocCodeSpace(void)
{
ADDR ptr = ScratchPad.ptr;
if (ptr) return ptr;
return Yap_InitPreAllocCodeSpace();
}
#else
EXTERN inline ADDR
Yap_PreAllocCodeSpace(void)
{
return Addr(HeapTop) + sizeof(CELL);
}
#define Yap_ExpandPreAllocCodeSpace() NULL
#define Yap_ReleasePreAllocCodeSpace(x)
#endif
#if THREADS
Prop STD_PROTO(Yap_NewThreadPred, (PredEntry *));
Prop STD_PROTO(Yap_NewPredPropByFunctor, (Functor, SMALLUNSGN));
EXTERN inline PredEntry *
Yap_GetThreadPred(PredEntry *ap)
{
Functor f = ap->FunctorOfPred;
SMALLUNSGN mod = ap->ModuleOfPred;
Prop p0 = AbsPredProp(heap_regs->thread_handle[worker_id].local_preds);
while(p0) {
PredEntry *ap = RepPredProp(p0);
if (ap->FunctorOfPred == f &&
ap->ModuleOfPred == mod) return ap;
p0 = ap->NextOfPE;
}
return RepPredProp(Yap_NewThreadPred(ap));
}
#endif
#endif /* HEAP_H */

6
H/Regs.h
View File

@ -10,7 +10,7 @@
* File: Regs.h *
* mods: *
* comments: YAP abstract machine registers *
* version: $Id: Regs.h,v 1.22 2004-01-23 02:22:20 vsc Exp $ *
* version: $Id: Regs.h,v 1.23 2004-02-05 16:57:01 vsc Exp $ *
*************************************************************************/
@ -107,6 +107,8 @@ typedef struct
tr_fr_ptr TR_FZ_;
#endif /* SBA || TABLING */
#if defined(YAPOR) || defined(THREADS)
struct pred_entry *PP_;
yamop **PREG_ADDR_;
unsigned int worker_id_;
#ifdef SBA
choiceptr BSEG_;
@ -657,6 +659,8 @@ EXTERN inline void restore_B(void) {
#endif /* SBA || TABLING */
#if defined(YAPOR) || defined(THREADS)
#define worker_id (Yap_REGS.worker_id_)
#define PP (Yap_REGS.PP_)
#define PREG_ADDR (Yap_REGS.PREG_ADDR_)
#ifdef SBA
#define BSEG Yap_REGS.BSEG_
#define binding_array Yap_REGS.binding_array_

4
H/YapOpcodes.h
View File

@ -255,6 +255,7 @@
OPCODE(count_retry_me ,ld),
OPCODE(count_trust_me ,ld),
OPCODE(count_retry_and_mark ,ld),
OPCODE(lock_lu ,p),
OPCODE(enter_lu_pred ,Ill),
OPCODE(stale_lu_index ,Ill),
OPCODE(trust_logical_pred ,l),
@ -263,6 +264,9 @@
OPCODE(copy_idb_term ,e),
OPCODE(retry_killed ,ld),
OPCODE(trust_killed ,ld),
#if THREADS
OPCODE(thread_local ,e),
#endif
#ifdef SFUNC
OPCODE(get_s_f ,),
OPCODE(put_s_f ,),

4
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.42 2004-01-23 02:22:23 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.43 2004-02-05 16:57:01 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -162,7 +162,7 @@ int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long));
int STD_PROTO(Yap_growglobal, (CELL **));
void STD_PROTO(Yap_growatomtable, (void));
CELL **STD_PROTO(Yap_shift_visit, (CELL **));
CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***));
/* heapgc.c */
Int STD_PROTO(Yap_total_gc_time,(void));

55
H/absmi.h
View File

@ -131,6 +131,9 @@ register void* P1REG asm ("bp"); /* can't use yamop before Yap.h */
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#if USE_SYSTEM_MALLOC
#include "Heap.h"
#endif
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
@ -177,6 +180,7 @@ restore_absmi_regs(REGSTORE * old_regs)
memcpy(old_regs, Yap_regp, sizeof(REGSTORE));
#ifdef THREADS
pthread_setspecific(yaamregs_key, (void *)old_regs);
ThreadHandle[worker_id].current_yaam_regs = old_regs;
#else
Yap_regp = old_regs;
#endif
@ -1148,7 +1152,11 @@ static int
IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
#if SHADOW_REGS
#if THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
@ -1160,7 +1168,16 @@ IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
#if USE_SYSTEM_MALLOC
CELL **to_visit_max = (CELL **)Yap_PreAllocCodeSpace(), **to_visit = (CELL **)AuxSp;
#define address_to_visit_max (&to_visit_max)
#define to_visit_base ((CELL **)AuxSp)
#else
CELL **to_visit = (CELL **)Yap_TrailTop;
#define to_visit_max ((CELL **)TR)
#define address_to_visit_max NULL
#define to_visit_base ((CELL **)Yap_TrailTop)
#endif
loop:
while (pt0 < pt0_end) {
@ -1184,13 +1201,13 @@ loop:
if (!IsPairTerm(d1)) {
goto cufail;
}
if ((CELL *)to_visit-(CELL *)TR < 1024) {
to_visit = Yap_shift_visit(to_visit);
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 4;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
@ -1200,6 +1217,9 @@ loop:
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
@ -1229,13 +1249,13 @@ loop:
continue;
goto cufail;
}
if ((CELL *)to_visit-(CELL *)TR < 1024) {
to_visit = Yap_shift_visit(to_visit);
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 4;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
@ -1245,6 +1265,9 @@ loop:
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
@ -1283,7 +1306,7 @@ loop:
}
}
/* Do we still have compound terms to visit */
if (to_visit < (CELL **) Yap_TrailTop) {
if (to_visit < to_visit_base) {
#ifdef RATIONAL_TREES
pt0 = to_visit[0];
pt0_end = to_visit[1];
@ -1303,7 +1326,7 @@ loop:
cufail:
#ifdef RATIONAL_TREES
/* failure */
while (to_visit < (CELL **) Yap_TrailTop) {
while (to_visit < to_visit_base) {
CELL *pt0;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[3];
@ -1311,7 +1334,10 @@ cufail:
}
#endif
return (FALSE);
#if SHADOW_REGS
#if THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
@ -1332,7 +1358,6 @@ iequ_complex(register CELL *pt0, register CELL *pt0_end,
#ifdef RATIONAL_TREES
register CELL *visited = AuxSp;
#endif
loop:
@ -1541,3 +1566,11 @@ Yap_regtoregno(wamreg reg)
#else
#define check_depth(DEPTH, ap)
#endif
#if defined(THREADS) || defined(YAPOR)
#define copy_jmp_address(X) (PREG_ADDR = &(X))
#define copy_jmp_addressa(X) (PREG_ADDR = (yamop **)(X))
#else
#define copy_jmp_address(X)
#define copy_jmp_addressa(X)
#endif

1
H/clause.h
View File

@ -31,6 +31,7 @@ typedef union CONSULT_OBJ {
#define ASSEMBLING_CLAUSE 0
#define ASSEMBLING_INDEX 1
#define ASSEMBLING_EINDEX 2
#define NextDynamicClause(X) (((yamop *)X)->u.ld.d)

11
H/rheap.h
View File

@ -673,11 +673,15 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
break;
/* instructions type l */
case _enter_profiling:
case _count_call:
case _retry_profiled:
case _lock_lu:
case _count_call:
case _count_retry:
case _trust_logical_pred:
case _execute:
pc->u.p.p = PtoPredAdjust(pc->u.p.p);
pc = NEXTOP(pc,p);
break;
case _trust_logical_pred:
case _dexecute:
case _jump:
case _move_back:
@ -717,6 +721,9 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
#endif
case _pop:
case _index_pred:
#if THREADS
case _thread_local:
#endif
case _expand_index:
case _undef_p:
case _spy_pred:

5
H/yapio.h
View File

@ -255,6 +255,11 @@ Term STD_PROTO(Yap_VarNames,(VarEntry *,Term));
/* routines in scanner.c */
TokEntry STD_PROTO(*Yap_tokenizer,(int));
#if USE_SYSTEM_MALLOC
void STD_PROTO(Yap_clean_tokenizer,(TokEntry *, VarEntry *, VarEntry *));
#else
#define Yap_clean_tokenizer(T,V,A)
#endif
Term STD_PROTO(Yap_scan_num,(int (*)(int)));
char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));

27
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.50 2004-01-23 02:23:15 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.51 2004-02-05 16:57:01 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -77,6 +77,10 @@
#endif
#endif
#if SUPPORT_THREADS || SUPPORT_CONDOR
#define USE_SYSTEM_MALLOC 1
#endif
#if defined(TABLING) || defined(SBA)
#define FROZEN_STACKS 1
#endif /* TABLING || SBA */
@ -884,7 +888,7 @@ extern int Yap_argc;
#define MaxModules 256
#ifdef YAPOR
#if YAPOR
#define YAPEnterCriticalSection() \
{ \
if (worker_id != GLOBAL_LOCKS_who_locked_heap) { \
@ -911,6 +915,25 @@ extern int Yap_argc;
UNLOCK(GLOBAL_LOCKS_heap_access); \
} \
}
#elif THREADS
#define YAPEnterCriticalSection() \
{ \
LOCK(BGL); \
Yap_PrologMode |= CritMode; \
}
#define YAPLeaveCriticalSection() \
{ \
Yap_PrologMode &= ~CritMode; \
if (Yap_PrologMode & InterruptMode) { \
Yap_PrologMode &= ~InterruptMode; \
Yap_ProcessSIGINT(); \
} \
if (Yap_PrologMode & AbortMode) { \
Yap_PrologMode &= ~AbortMode; \
Yap_Error(PURE_ABORT, 0, ""); \
} \
UNLOCK(BGL); \
}
#else
#define YAPEnterCriticalSection() \
{ \

24
m4/Yatom.h.m4
View File

@ -162,6 +162,7 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
CodeOfPred holds the address of the correspondent C-function.
*/
typedef enum {
ThreadLocalPredFlag=0x40000000L, /* local to a thread */
MultiFileFlag = 0x20000000L, /* is multi-file */
UserCPredFlag = 0x10000000L, /* CPred defined by the user */
LogUpdatePredFlag= 0x08000000L, /* dynamic predicate with log. upd. sem.*/
@ -231,6 +232,7 @@ typedef struct pred_entry {
} src;
#if defined(YAPOR) || defined(THREADS)
rwlock_t PRWLock; /* a simple lock to protect this entry */
lockvar PELock; /* a simple lock to protect expansion */
#endif
#ifdef TABLING
tab_ent_ptr TableOfPred;
@ -501,6 +503,10 @@ Atom STD_PROTO(Yap_GetOp,(OpEntry *,int *,int));
Prop STD_PROTO(Yap_GetAProp,(Atom,PropFlags));
Prop STD_PROTO(Yap_GetAPropHavingLock,(AtomEntry *,PropFlags));
#if THREADS
EXTERN inline PredEntry *STD_PROTO(Yap_GetThreadPred, (PredEntry *));
#endif
EXTERN inline Prop
PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
/* get predicate entry for ap/arity; create it if neccessary. */
@ -514,12 +520,19 @@ PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
PredEntry *p = RepPredProp(p0);
if (/* p->KindOfPE != 0 || only props */
(p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) {
#if THREADS
/* Thread Local Predicates */
if (p->PredFlags & ThreadLocalPredFlag) {
WRITE_UNLOCK(fe->FRWLock);
return AbsPredProp(Yap_GetThreadPred(p));
}
#endif
WRITE_UNLOCK(fe->FRWLock);
return (p0);
}
p0 = p->NextOfPE;
}
return(Yap_NewPredPropByFunctor(fe,cur_mod));
return Yap_NewPredPropByFunctor(fe,cur_mod);
}
EXTERN inline Prop
@ -535,12 +548,19 @@ PredPropByAtom(Atom at, SMALLUNSGN cur_mod)
PredEntry *pe = RepPredProp(p0);
if ( pe->KindOfPE == PEProp &&
(pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) {
#if THREADS
/* Thread Local Predicates */
if (pe->PredFlags & ThreadLocalPredFlag) {
WRITE_UNLOCK(ae->ARWLock);
return AbsPredProp(Yap_GetThreadPred(pe));
}
#endif
WRITE_UNLOCK(ae->ARWLock);
return(p0);
}
p0 = pe->NextOfPE;
}
return(Yap_NewPredPropByAtom(ae,cur_mod));
return Yap_NewPredPropByAtom(ae,cur_mod);
}
typedef enum {

9
pl/boot.yap
View File

@ -344,10 +344,9 @@ repeat :- '$repeat'.
'$$compile'(G, G0, L, Mod) :-
'$head_and_body'(G,H,_),
'$flags'(H, Mod, Fl, Fl),
( Fl /\ 0x08000000 =\= 0 -> '$compile'(G,L,G0,Mod)
;
Fl /\ 0x00002000 =\= 0 -> '$assertz_dynamic'(L,G,G0,Mod) ;
'$$compile_stat'(G,G0,L,H, Mod) ).
is(NFl, /\, Fl, 0x00002000),
( NFl \= 0 -> '$assertz_dynamic'(L,G,G0,Mod) ;
'$compile'(G, L, G0, Mod) ).
% process a clause for a static predicate
'$$compile_stat'(G,G0,L,H, Mod) :-
@ -891,7 +890,6 @@ break :- get_value('$break',BL), NBL is BL+1,
set_value('$consulting_file',OldF),
'$cd'(OldD),
( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialisation_goals',
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
( '$undefined'('$print_message'(_,_),prolog) ->
( get_value('$verbose',on) ->
@ -902,6 +900,7 @@ break :- get_value('$break',BL), NBL is BL+1,
;
'$print_message'(informational, loaded(consulted, File, Mod, T, H))
),
'$exec_initialisation_goals',
!.

2
pl/consult.yap
View File

@ -120,11 +120,11 @@ reconsult(Fs) :-
set_value('$consulting',Old),
set_value('$consulting_file',OldF),
'$cd'(OldD),
'$exec_initialisation_goals',
'$current_module'(Mod,OldModule),
( LC == 0 -> prompt(_,' |: ') ; true),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$print_message'(informational, loaded(reconsulted, File, Mod, T, H)),
'$exec_initialisation_goals',
!.
'$start_reconsulting'(F) :-

16
pl/directives.yap
View File

@ -40,6 +40,7 @@
'$directive'(use_module(_,_)).
'$directive'(use_module(_,_,_)).
'$directive'(uncutable(_)).
'$directive'(thread_local(_)).
'$exec_directive'(multifile(D), _, M) :-
'$system_catch'('$multifile'(D, M), M,
@ -67,6 +68,8 @@
'$meta_predicate'(P, M).
'$exec_directive'(dynamic(P), _, M) :-
'$dynamic'(P, M).
'$exec_directive'(thread_local(P), _, M) :-
'$thread_local'(P, M).
'$exec_directive'(op(P,OPSEC,OP), _, _) :-
op(P,OPSEC,OP).
'$exec_directive'(set_prolog_flag(F,V), _, _) :-
@ -704,3 +707,16 @@ source_mode(Old,New) :-
source :- '$set_yap_flags'(11,1).
no_source :- '$set_yap_flags'(11,0).
%
% allow users to define their own directives.
%
user_defined_directive(Dir,_) :-
'$directive'(Dir), !.
user_defined_directive(Dir,Action) :-
functor(Dir,Na,Ar),
functor(NDir,Na,Ar),
'$current_module'(M, prolog),
assert_static('$directive'(NDir)),
assert_static(('$exec_directive'(Dir, _, _) :- Action)),
'$current_module'(_, M).

3
pl/errors.yap
View File

@ -486,6 +486,9 @@ print_message(Level, Mss) :-
'$output_error_message'(permission_error(modify,operator,W), _) :-
'$format'(user_error,"[ PERMISSION ERROR- T cannot declare ~w an operator ]~n",
[W]).
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: modifying a dynamic procedure ]~n",
[Where]).
'$output_error_message'(permission_error(modify,static_procedure,_), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: modifying a static procedure ]~n",
[Where]).

4
pl/init.yap
View File

@ -129,12 +129,10 @@ system_mode(verbose,off) :- set_value('$verbose',off).
% :- yap_flag(gc_trace,verbose).
:- system_mode(verbose,on).
:- initialization(system_mode(verbose,on)).
:- module(user).
:- current_module(X), write(X).
:- multifile goal_expansion/3.
:- dynamic_predicate(goal_expansion/3, logical).

1
pl/modules.yap
View File

@ -615,7 +615,6 @@ source_module(Mod) :-
^(+,:),
\+ : .
%
% if we are asserting something in somewhere else's module,
% we need this little bird.

4
pl/preds.yap
View File

@ -219,8 +219,8 @@ assertz_static(C) :-
true
).
'$assert1'(last,C,C0,Mod,H) :- '$$compile_stat'(C,C0,0,H,Mod).
'$assert1'(first,C,C0,Mod,H) :- '$$compile_stat'(C,C0,2,H,Mod).
'$assert1'(last,C,C0,Mod,H) :- '$compile'(C,0,C0,Mod).
'$assert1'(first,C,C0,Mod,H) :- '$compile'(C,2,C0,Mod).
'$assertz_dynamic'(X, C, C0, Mod) :- (X/\4)=:=0, !,
'$head_and_body'(C,H,B),

6
pl/signals.yap
View File

@ -33,6 +33,12 @@
'$wake_up_goal'(G, LG).
'$do_signal'(sig_creep, G) :-
'$start_creep'(G).
'$do_signal'(sig_iti, G) :-
'$thread_gfetch'(Goal),
% if more signals alive, set creep flag
'$continue_signals',
'$current_module'(M0),
'$execute0'((Goal,M:G),M0).
% Unix signals
'$do_signal'(sig_alarm, G) :-
'$signal_handler'(sig_alarm, G).

50
pl/threads.yap
View File

@ -15,7 +15,10 @@
* *
*************************************************************************/
:- meta_predicate thread_create(:,-,+), thread_at_exit(:).
:- meta_predicate
thread_create(:,-,+),
thread_at_exit(:),
thread_signal(+,:).
'$top_thread_goal'(G) :-
'$current_module'(Module),
@ -338,3 +341,48 @@ thread_peek_message(Queue, Term) :-
'$thread_get_message_loop'(Queue, Term, Mutex) :-
mutex_unlock(Mutex),
fail.
'$thread_local'(X,M) :- var(X), !,
'$do_error'(instantiation_error,thread_local(M:X)).
'$thread_local'(Mod:Spec,_) :- !,
'$thread_local'(Spec,Mod).
'$thread_local'([], _) :- !.
'$thread_local'([H|L], M) :- !, '$thread_local'(H, M), '$thread_local'(L, M).
'$thread_local'((A,B),M) :- !, '$thread_local'(A,M), '$thread_local'(B,M).
'$thread_local'(X,M) :- !,
'$thread_local2'(X,M).
'$thread_local2'(A/N, Mod) :- integer(N), atom(A), !,
functor(T,A,N),
'$flags'(T,Mod,F,F),
( '$undefined'(T,Mod) -> '$install_thread_local'(T,Mod);
F /\ 0x08002000 =\= 0 -> '$do_error'(permission_error(modify,dynamic_procedure,A/N),thread_local(Mod:A/N)) ;
'$do_error'(permission_error(modify,static_procedure,A/N),thread_local(Mod:A/N))
).
'$thread_local2'(X,Mod) :-
'$do_error'(type_error(callable,X),thread_local(Mod:X)).
thread_signal(Thread, Goal) :-
var(Thread), !,
'$do_error'(instantiation_error,thread_signal(Thread, Goal)).
thread_signal(Thread, Goal) :-
recorded('$thread_alias',[Thread|Id],_),
'$thread_signal'(Id, Goal).
thread_signal(Thread, Goal) :-
integer(Thread), !,
'$thread_signal'(Thread, Goal).
thread_signal(Thread, Goal) :-
'$do_error'(type_error(integer,Thread),thread_signal(Thread, Goal)).
'$thread_signal'(Thread, Goal) :-
mutex_lock(Thread),
( recorded('$thread_signal',[Thread|_],R), erase(R), fail ; true ),
recorda('$thread_signal',[Thread|Goal],_),
'$signal_thread'(Thread).
mutex_unlock(Thread).
'$thread_gfetch'(G) :-
'$thread_self'(Id),
recorded('$thread_signal',[Id,G],R),
erase(R).

14
pl/utils.yap
View File

@ -781,20 +781,6 @@ term_hash(X,Y) :-
term_hash(X,-1,16'1000000,Y).
%
% allow users to define their own directives.
%
user_defined_directive(Dir,_) :-
'$directive'(Dir), !.
user_defined_directive(Dir,Action) :-
functor(Dir,Na,Ar),
functor(NDir,Na,Ar),
'$current_module'(M, prolog),
assert_static('$directive'(NDir)),
assert_static(('$exec_directive'(Dir, _, _) :- Action)),
'$current_module'(_, M).
'$set_toplevel_hook'(_) :-
recorded('$toplevel_hooks',_,R),
erase(R),