From 9b84cdfe5d5b073617df924de789d3a6b3de2d73 Mon Sep 17 00:00:00 2001 From: vsc Date: Thu, 5 Feb 2004 16:57:02 +0000 Subject: [PATCH] improved support for threads and code area allocation using malloc git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@965 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 126 +++++++++++++++++++++++++++++++++++--- C/adtdefs.c | 36 +++++++++++ C/alloc.c | 50 ++++++++------- C/amasm.c | 50 +++++++++++---- C/analyst.c | 6 ++ C/c_interface.c | 6 +- C/cdmgr.c | 45 ++++++++------ C/dbase.c | 116 ++++++++++------------------------- C/errors.c | 6 +- C/exec.c | 1 + C/grow.c | 145 +++++++++++++++++++++++++++++++------------- C/heapgc.c | 9 ++- C/index.c | 151 ++++++++++++++++++++++++++++++++++++++++------ C/init.c | 3 +- C/iopreds.c | 31 +++++++--- C/load_none.c | 1 + C/scanner.c | 48 ++++++++++++++- C/stdpreds.c | 104 +++++++++++++++++++++++-------- C/sysbits.c | 8 ++- C/threads.c | 42 ++++++++++++- C/tracer.c | 4 ++ C/unify.c | 6 +- C/write.c | 2 +- H/Heap.h | 46 +++++++++++--- H/Regs.h | 6 +- H/YapOpcodes.h | 6 +- H/Yapproto.h | 4 +- H/absmi.h | 55 +++++++++++++---- H/clause.h | 1 + H/rheap.h | 11 +++- H/yapio.h | 5 ++ m4/Yap.h.m4 | 27 ++++++++- m4/Yatom.h.m4 | 24 +++++++- pl/boot.yap | 9 ++- pl/consult.yap | 2 +- pl/directives.yap | 16 +++++ pl/errors.yap | 3 + pl/init.yap | 4 +- pl/modules.yap | 1 - pl/preds.yap | 4 +- pl/signals.yap | 6 ++ pl/threads.yap | 50 ++++++++++++++- pl/utils.yap | 14 ----- 43 files changed, 984 insertions(+), 306 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 1c05b9299..5a8fe3771 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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); diff --git a/C/adtdefs.c b/C/adtdefs.c index 3d8f152ac..3f083a211 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -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; diff --git a/C/alloc.c b/C/alloc.c index d1e3bfadf..cc2840811 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -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; - - if (!(ptr = malloc(sz))) + sz = sz + sz0; + + 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); diff --git a/C/amasm.c b/C/amasm.c index b1a71d80e..433c1191c 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -230,8 +230,9 @@ 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 * @@ -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,8 +2194,8 @@ 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; } - *entry_codep = code_p; } while (cip->cpc) { @@ -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 */ diff --git a/C/analyst.c b/C/analyst.c index 5f12fa939..4dd9cfadb 100644 --- a/C/analyst.c +++ b/C/analyst.c @@ -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] + diff --git a/C/c_interface.c b/C/c_interface.c index b1f2ef608..0c573558a 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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 diff --git a/C/cdmgr.c b/C/cdmgr.c index ef235ef7b..0873f2f4c 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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); diff --git a/C/dbase.c b/C/dbase.c index c716303fd..02c03bde6 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -252,15 +252,20 @@ 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)) { \ + if (Unsigned(tofref) == Unsigned(x)) { \ if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { \ goto error_tr_overflow; \ } \ } \ } - #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"); - return(FALSE); + if (!Yap_growtrail(64 * 1024L)) { + Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3"); + return(FALSE); + } + goto recover_record; 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: @@ -1925,14 +1927,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } goto recover_record; default: @@ -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,14 +2031,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } goto recover_record; default: @@ -2086,14 +2070,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } goto recover_record; default: @@ -2140,14 +2118,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } goto recover_record; default: @@ -2193,14 +2165,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } goto recover_record; default: @@ -2241,14 +2207,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } goto recover_record; default: @@ -2290,14 +2250,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } goto recover_record; default: @@ -4674,14 +4628,8 @@ 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); - return FALSE; - } -#ifndef THREADS - break; -#endif + if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) { + return FALSE; } t = Deref(XREGS[nargs+1]); break; diff --git a/C/errors.c b/C/errors.c index 482a80b59..cbc2804c3 100644 --- a/C/errors.c +++ b/C/errors.c @@ -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) { diff --git a/C/exec.c b/C/exec.c index 99863269e..a08bd31b5 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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; diff --git a/C/grow.c b/C/grow.c index 4cf2e6a50..63f79bda8 100644 --- a/C/grow.c +++ b/C/grow.c @@ -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) { - Yap_Error(SYSTEM_ERROR,TermNil,"cannot grow Heap: more than a worker/thread running"); - return FALSE; - } +#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)) diff --git a/C/heapgc.c b/C/heapgc.c index 462f59600..772b8ebf5 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -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(¤t_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) { diff --git a/C/index.c b/C/index.c index d4f9edfdc..e37a2b008 100644 --- a/C/index.c +++ b/C/index.c @@ -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); @@ -4037,7 +4068,7 @@ expand_index(struct intermediates *cint) { /* don't count last clause if you don't have to */ if (alt && max->Code == last) max--; if (max < cls && labp != NULL) { - *labp = FAILCODE; + *labp = FAILCODE; return labp; } cint->freep = (char *)(max+1); @@ -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,7 +4512,9 @@ expand_ctable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Term at) ics->Label = old_ae->Label; } } - replace_index_block(blk, pc->u.sl.l, (yamop *)target, ap); + /* 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; } } + diff --git a/C/init.c b/C/init.c index 690405b61..58ffdd2b3 100644 --- a/C/init.c +++ b/C/init.c @@ -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); diff --git a/C/iopreds.c b/C/iopreds.c index 88455ca37..e6454db92 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -2946,15 +2946,17 @@ do_read(int inp_stream) if (tokstart != NIL && tokstart->Tok != Ord (eot_tok)) { /* we got the end of file from an abort */ if (Yap_ErrorMessage == "Abort") { - TR = old_TR; - return(FALSE); - } + TR = old_TR; + 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; Yap_ErrorMessage = "end of file found before end of term"; } 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); } diff --git a/C/load_none.c b/C/load_none.c index c752861a0..a9ce611ba 100644 --- a/C/load_none.c +++ b/C/load_none.c @@ -14,6 +14,7 @@ #include "Yap.h" #include "Foreign.h" +#include "Yatom.h" #include "Heap.h" #ifdef HAVE_STRING_H #include diff --git a/C/scanner.c b/C/scanner.c index 8070113fa..beb3ef005 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -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,7 +457,8 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted } while (chtype[ch] == NU) { Int oval = val; - *sp++ = ch; + if (ch != '0') + *sp++ = ch; if (ch - '0' >= base) return (MkIntegerTerm(val)); val = val * base + ch - '0'; @@ -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 diff --git a/C/stdpreds.c b/C/stdpreds.c index 9a88d4d25..0e6a53398 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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; } diff --git a/C/sysbits.c b/C/sysbits.c index b2c387349..e2e918eb3 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -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); */ diff --git a/C/threads.c b/C/threads.c index 06ea4427d..f8ad1e430 100644 --- a/C/threads.c +++ b/C/threads.c @@ -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); } diff --git a/C/tracer.c b/C/tracer.c index 5c202bc75..d48856532 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -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 diff --git a/C/unify.c b/C/unify.c index 644c74862..01fea45d7 100644 --- a/C/unify.c +++ b/C/unify.c @@ -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 hash_size_mask) j = 0; } diff --git a/C/write.c b/C/write.c index c161b384f..e658e5062 100644 --- a/C/write.c +++ b/C/write.c @@ -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); } diff --git a/H/Heap.h b/H/Heap.h index 0bec2b076..c9b5b2918 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -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 */ diff --git a/H/Regs.h b/H/Regs.h index 0e770182e..d8cc76e71 100644 --- a/H/Regs.h +++ b/H/Regs.h @@ -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_ diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index c71fbc0e7..d8dd71321 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -165,7 +165,7 @@ OPCODE(index_dbref ,e), OPCODE(index_blob ,e), OPCODE(trust_fail ,e), - OPCODE(index_pred ,e), + OPCODE(index_pred ,e), OPCODE(expand_index ,e), OPCODE(save_b_x ,x), OPCODE(save_b_y ,y), @@ -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 ,), diff --git a/H/Yapproto.h b/H/Yapproto.h index 81f208512..b5de04e74 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.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)); diff --git a/H/absmi.h b/H/absmi.h index b0c3e3608..2ac417a8e 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -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 diff --git a/H/clause.h b/H/clause.h index e315a6718..3cc05c1bb 100644 --- a/H/clause.h +++ b/H/clause.h @@ -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) diff --git a/H/rheap.h b/H/rheap.h index a48369331..7e1e685ae 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -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: diff --git a/H/yapio.h b/H/yapio.h index cb98e9dba..ac18b25c1 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -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)); diff --git a/m4/Yap.h.m4 b/m4/Yap.h.m4 index b12007dc1..3b262c4ae 100644 --- a/m4/Yap.h.m4 +++ b/m4/Yap.h.m4 @@ -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() \ { \ diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4 index 9007faa3e..45f961873 100644 --- a/m4/Yatom.h.m4 +++ b/m4/Yatom.h.m4 @@ -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 { diff --git a/pl/boot.yap b/pl/boot.yap index 0cd14a7a3..f88182ba9 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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', !. diff --git a/pl/consult.yap b/pl/consult.yap index 2c7cf2c1e..54e607a52 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -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) :- diff --git a/pl/directives.yap b/pl/directives.yap index 68169af7f..09d4ca4eb 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -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). + diff --git a/pl/errors.yap b/pl/errors.yap index 509705252..8c95e49c3 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -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]). diff --git a/pl/init.yap b/pl/init.yap index 4a6a2540f..656bda6a8 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -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). diff --git a/pl/modules.yap b/pl/modules.yap index f49451289..3eb065439 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -615,7 +615,6 @@ source_module(Mod) :- ^(+,:), \+ : . - % % if we are asserting something in somewhere else's module, % we need this little bird. diff --git a/pl/preds.yap b/pl/preds.yap index 919c95c5f..4aee8ec6c 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -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), diff --git a/pl/signals.yap b/pl/signals.yap index aa2a11a7a..b1cfde5f6 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -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). diff --git a/pl/threads.yap b/pl/threads.yap index 7970ba5bc..bcdf86c76 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -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). diff --git a/pl/utils.yap b/pl/utils.yap index 08b45a52d..8764cacf9 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -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),