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

fix max modules limitation

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1865 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2007-04-10 22:13:21 +00:00
parent c78a210afc
commit 67738fbbd1
14 changed files with 226 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2007-03-21 18:32:49 $,$Author: vsc $ *
* Last rev: $Date: 2007-04-10 22:13:20 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.220 2007/03/21 18:32:49 vsc
* fix memory expansion bugs.
*
* Revision 1.219 2007/01/24 09:57:25 vsc
* fix glist_void_varx
*
@ -708,38 +711,50 @@ Yap_absmi(int inp)
#endif /* USE_THREADED_CODE */
noheapleft:
saveregs();
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
{
CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
saveregs();
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs();
FAIL();
}
setregs();
FAIL();
CACHE_A1();
SREG = ASP;
SREG[E_CB] = (CELL)(LCL0-cut_b);
}
setregs();
CACHE_A1();
goto reset_absmi;
#if !OS_HANDLES_TR_OVERFLOW
notrailleft:
/* if we are within indexing code, the system may have to
* update a S */
{
CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
#if SHADOW_S
S = SREG;
S = SREG;
#endif
/* YREG =was pointing to where we were going to build the
* next choice-point. The stack shifter will need to know this
* to move the local stack */
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
} else {
ASP = YREG+E_CB;
}
saveregs();
if(!Yap_growtrail (0, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
/* YREG =was pointing to where we were going to build the
* next choice-point. The stack shifter will need to know this
* to move the local stack */
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
} else {
ASP = YREG+E_CB;
}
saveregs();
if(!Yap_growtrail (0, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
setregs();
FAIL();
}
setregs();
FAIL();
SREG = ASP;
SREG[E_CB] = (CELL)(LCL0-cut_b);
}
setregs();
goto reset_absmi;
#endif /* OS_HANDLES_TR_OVERFLOW */

31
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2007-03-26 15:18:43 $,$Author: vsc $ *
* Last rev: $Date: 2007-04-10 22:13:20 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.205 2007/03/26 15:18:43 vsc
* debugging and clause/3 over tabled predicates would kill YAP.
*
* Revision 1.204 2007/01/25 22:11:55 vsc
* all/3 should fail on no solutions.
* get rid of annoying gcc complaints.
@ -3637,23 +3640,21 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
static Int
PredForCode(yamop *codeptr, Atom *pat, UInt *parity, Term *pmodule) {
Int found = 0;
Int i_table;
ModEntry *me = CurrentModules;
/* should we allow the user to see hidden predicates? */
for (i_table = 0; i_table < NoOfModules; i_table++) {
while (me) {
PredEntry *pp;
pp = ModulePred[i_table];
pp = me->PredForME;
while (pp != NULL) {
if ((found = code_in_pred(pp, pat, parity, codeptr)) != 0) {
if (i_table)
*pmodule = ModuleName[i_table];
else
*pmodule = TermProlog;
return(found);
*pmodule = MkAtomTerm(me->AtomOfME);
return found;
}
pp = pp->NextPredOfModule;
}
me = me->NextME;
}
return(0);
}
@ -3669,7 +3670,7 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari
if (p) {
Int out;
if (p->ModuleOfPred == PROLOG_MODULE)
*pmodule = ModuleName[0];
*pmodule = TermProlog;
else
*pmodule = p->ModuleOfPred;
out = find_code_in_clause(p, codeptr, NULL, NULL);
@ -3684,7 +3685,7 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari
}
clause_was_found(p, pat, parity);
if (p->ModuleOfPred == PROLOG_MODULE)
*pmodule = ModuleName[0];
*pmodule = TermProlog;
else
*pmodule = p->ModuleOfPred;
return -1;
@ -5532,10 +5533,11 @@ add_code_in_pred(PredEntry *pp) {
void
Yap_dump_code_area_for_profiler(void) {
Int i_table;
ModEntry *me = CurrentModules;
while (me) {
PredEntry *pp = me->PredForME;
for (i_table = NoOfModules-1; i_table >= 0; --i_table) {
PredEntry *pp = ModulePred[i_table];
while (pp != NULL) {
/* if (pp->ArityOfPE) {
fprintf(stderr,"%s/%d %p\n",
@ -5550,6 +5552,7 @@ Yap_dump_code_area_for_profiler(void) {
add_code_in_pred(pp);
pp = pp->NextPredOfModule;
}
me = me->NextME;
}
Yap_inform_profiler_of_clause(COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma,0)),0);
Yap_inform_profiler_of_clause(FAILCODE, FAILCODE+1, RepPredProp(Yap_GetPredPropByAtom(AtomFail,0)),0);

7
C/gprof.c
View File

@ -11,8 +11,11 @@
* File: gprof.c *
* comments: Interrupt Driven Profiler *
* *
* Last rev: $Date: 2006-08-22 16:12:45 $,$Author: vsc $ *
* Last rev: $Date: 2007-04-10 22:13:20 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.7 2006/08/22 16:12:45 vsc
* global variables
*
* Revision 1.6 2006/08/07 18:51:44 vsc
* fix garbage collector not to try to garbage collect when we ask for large
* chunks of stack in a single go.
@ -1270,7 +1273,7 @@ static Int getpredinfo(void)
if (!pp)
return FALSE;
if (pp->ModuleOfPred == PROLOG_MODULE)
mod = ModuleName[0];
mod = TermProlog;
else
mod = pp->ModuleOfPred;
if (pp->ModuleOfPred == IDB_MODULE) {

6
C/heapgc.c
View File

@ -3728,6 +3728,8 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
static int
is_gc_verbose(void)
{
if (Yap_PrologMode == BootMode)
return FALSE;
#ifdef INSTRUMENT_GC
/* always give info when we are debugging gc */
return(TRUE);
@ -3746,7 +3748,9 @@ Yap_is_gc_verbose(void)
static int
is_gc_very_verbose(void)
{
return(Yap_GetValue(AtomGcVeryVerbose) != TermNil);
if (Yap_PrologMode == BootMode)
return FALSE;
return Yap_GetValue(AtomGcVeryVerbose) != TermNil;
}
Int

2
C/iopreds.c
View File

@ -2312,7 +2312,7 @@ p_open (void)
st->stream_wgetc_for_read = st->stream_wgetc;
t = MkStream (sno);
if (open_mode == AtomWrite ) {
if (!avoid_bom && !write_bom(sno,st))
if (needs_bom && !write_bom(sno,st))
return FALSE;
} else if (open_mode == AtomRead &&
!avoid_bom &&

155
C/modules.c
View File

@ -25,6 +25,60 @@ static char SccsId[] = "%W% %G%";
STATIC_PROTO(Int p_current_module, (void));
STATIC_PROTO(Int p_current_module1, (void));
inline static ModEntry *
FetchModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
AtomEntry *ae = RepAtom(at);
WRITE_LOCK(ae->ARWLock);
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
if ( me->KindOfPE == ModProperty
) {
WRITE_UNLOCK(ae->ARWLock);
return me;
}
p0 = me->NextOfPE;
}
return NULL;
}
inline static ModEntry *
GetModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
AtomEntry *ae = RepAtom(at);
ModEntry *new;
WRITE_LOCK(ae->ARWLock);
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
if ( me->KindOfPE == ModProperty
) {
WRITE_UNLOCK(ae->ARWLock);
return me;
}
p0 = me->NextOfPE;
}
new = (ModEntry *) Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->GRWLock);
new->KindOfPE = ModProperty;
new->NextME = CurrentModules;
CurrentModules = new;
new->AtomOfME = ae;
new->NextOfPE = ae->PropsOfAE;
ae->PropsOfAE = AbsModProp(new);
WRITE_UNLOCK(ae->ARWLock);
return new;
}
#define ByteAdr(X) ((char *) &(X))
Term
Yap_Module_Name(PredEntry *ap)
@ -46,47 +100,44 @@ Yap_Module_Name(PredEntry *ap)
return TermProlog;
}
static int
static ModEntry *
LookupModule(Term a)
{
unsigned int i;
Atom at;
/* prolog module */
if (a == 0)
return 0;
LOCK(ModulesLock);
for (i = 0; i < NoOfModules; ++i) {
if (ModuleName[i] == a) {
UNLOCK(ModulesLock);
return i;
}
}
ModuleName[i = NoOfModules++] = a;
UNLOCK(ModulesLock);
if (NoOfModules == MaxModules) {
Yap_Error(SYSTEM_ERROR,a,"number of modules overflowed");
}
return (i);
return GetModuleEntry(AtomOfTerm(TermProlog));
at = AtomOfTerm(a);
return GetModuleEntry(at);
}
Term
Yap_Module(Term tmod)
{
return ModuleName[LookupModule(tmod)];
LookupModule(tmod);
return tmod;
}
struct pred_entry *
Yap_ModulePred(Term mod)
{
return ModulePred[LookupModule(mod)];
ModEntry *me;
if (!(me = LookupModule(mod)))
return NULL;
return me->PredForME;
}
void
Yap_NewModulePred(Term mod, struct pred_entry *ap)
{
Term imod = LookupModule(mod);
ap->NextPredOfModule = ModulePred[imod];
ModulePred[imod] = ap;
ModEntry *me;
if (!(me = LookupModule(mod)))
return;
/* LOCK THIS */
ap->NextPredOfModule = me->PredForME;
me->PredForME = ap;
}
static Int
@ -133,24 +184,31 @@ p_change_module(void)
static Int
cont_current_module(void)
{
Int imod = IntOfTerm(EXTRA_CBACK_ARG(1,1));
Term t = ModuleName[imod];
ModEntry *imod = (ModEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(1,1)), *next;
Term t = MkAtomTerm(imod->AtomOfME);
next = imod->NextME;
LOCK(ModulesLock);
if (imod == NoOfModules) {
UNLOCK(ModulesLock);
cut_fail();
}
UNLOCK(ModulesLock);
EXTRA_CBACK_ARG(1,1) = MkIntTerm(imod+1);
return(Yap_unify(ARG1,t));
/* ARG1 is unbound */
Yap_unify(ARG1,t);
if (!next)
cut_succeed();
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)next);
return TRUE;
}
static Int
init_current_module(void)
{ /* current_module(?ModuleName) */
EXTRA_CBACK_ARG(1,1) = MkIntTerm(0);
return (cont_current_module());
Term t = Deref(ARG1);
if (!IsVarTerm(t)) {
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM,t,"module name must be an atom");
return FALSE;
}
return (FetchModuleEntry(AtomOfTerm(t)) != NULL);
}
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)CurrentModules);
return cont_current_module();
}
void
@ -167,26 +225,15 @@ Yap_InitModulesC(void)
void
Yap_InitModules(void)
{
ModuleName[PROLOG_MODULE] =
TermProlog;
ModuleName[1] =
USER_MODULE;
ModuleName[2] =
IDB_MODULE;
ModuleName[3] =
ATTRIBUTES_MODULE;
ModuleName[4] =
CHARSIO_MODULE;
ModuleName[5] =
TERMS_MODULE;
ModuleName[6] =
SYSTEM_MODULE;
ModuleName[7] =
READUTIL_MODULE;
ModuleName[8] =
HACKS_MODULE;
ModuleName[9] =
GLOBALS_MODULE;
NoOfModules = 10;
LookupModule(MkAtomTerm(Yap_LookupAtom("prolog")));
LookupModule(USER_MODULE);
LookupModule(IDB_MODULE);
LookupModule(ATTRIBUTES_MODULE);
LookupModule(CHARSIO_MODULE);
LookupModule(TERMS_MODULE);
LookupModule(SYSTEM_MODULE);
LookupModule(READUTIL_MODULE);
LookupModule(HACKS_MODULE);
LookupModule(GLOBALS_MODULE);
CurrentModule = PROLOG_MODULE;
}

13
C/unify.c
View File

@ -621,12 +621,15 @@ InitReverseLookupOpcode(void)
op_numbers i;
/* 2 K should be OK */
int hash_size_mask = OP_HASH_SIZE-1;
UInt sz = OP_HASH_SIZE*sizeof(struct opcode_tab_entry);
if (OP_RTABLE == NULL)
OP_RTABLE = (opentry *)Yap_AllocCodeSpace(OP_HASH_SIZE*sizeof(struct opcode_tab_entry));
if (OP_RTABLE == NULL) {
Yap_Error(INTERNAL_ERROR, TermNil,
"Couldn't obtain space for the reverse translation opcode table");
while (OP_RTABLE == NULL) {
if ((OP_RTABLE = (opentry *)Yap_AllocCodeSpace(sz)) == NULL) {
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(INTERNAL_ERROR, TermNil,
"Couldn't obtain space for the reverse translation opcode table");
}
}
}
opeptr = OP_RTABLE;
/* clear up table */

11
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.114 2007-03-22 11:12:21 vsc Exp $ *
* version: $Id: Heap.h,v 1.115 2007-04-10 22:13:20 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -341,12 +341,9 @@ typedef struct various_codes {
#ifdef LOW_LEVEL_TRACER
lockvar low_level_trace_lock;
#endif
lockvar modules_lock;
#endif
unsigned int size_of_overflow;
Term module_name[MaxModules];
struct pred_entry *module_pred[MaxModules];
SMALLUNSGN no_of_modules;
struct mod_entry *current_modules;
struct operator_entry *op_list;
struct static_clause *dead_static_clauses;
struct static_mega_clause *dead_mega_clauses;
@ -654,9 +651,7 @@ struct various_codes *Yap_heap_regs;
#define INT_BB_KEYS Yap_heap_regs->IntBBKeys
#define CharConversionTable Yap_heap_regs->char_conversion_table
#define CharConversionTable2 Yap_heap_regs->char_conversion_table2
#define ModuleName Yap_heap_regs->module_name
#define ModulePred Yap_heap_regs->module_pred
#define NoOfModules Yap_heap_regs->no_of_modules
#define CurrentModules Yap_heap_regs->current_modules
#define OpList Yap_heap_regs->op_list
#define AtomAbol Yap_heap_regs->atom_abol
#define AtomAlarm Yap_heap_regs->atom_alarm

4
H/Yap.h
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.21 2007-02-26 10:41:40 vsc Exp $ *
* version: $Id: Yap.h,v 1.22 2007-04-10 22:13:20 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -1167,7 +1167,7 @@ extern int Yap_PrologShouldHandleInterrupts;
/******************* number of modules ****************************/
#define MaxModules 256
#define DefaultMaxModules 256
#if YAPOR
#define YAPEnterCriticalSection() \

38
H/Yatom.h
View File

@ -342,11 +342,13 @@ IsWideAtom (Atom at)
/* Module property */
typedef struct
typedef struct mod_entry
{
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
SMALLUNSGN IndexOfMod; /* index in module table */
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
struct pred_entry *PredForME; /* index in module table */
Atom AtomOfME; /* module's name */
struct mod_entry *NextME; /* next module */
} ModEntry;
#if USE_OFFSETS_IN_PROPS
@ -793,20 +795,20 @@ IsPredProperty (int flags)
/* There are several flags for code and data base entries */
typedef enum
{
MegaMask = 0x200000, /* informs this is a mega clause */
FactMask = 0x100000, /* informs this is a fact */
SwitchRootMask = 0x80000, /* informs this is the root for the index tree */
SwitchTableMask = 0x40000, /* informs this is a switch table */
HasBlobsMask = 0x20000, /* informs this has blobs which may be in use */
ProfFoundMask = 0x10000, /* informs this clause is being counted by profiler */
DynamicMask = 0x8000, /* informs this is a dynamic predicate */
InUseMask = 0x4000, /* informs this block is being used */
ErasedMask = 0x2000, /* informs this block has been erased */
IndexMask = 0x1000, /* informs this is indexing code */
DBClMask = 0x0800, /* informs this is a data base structure */
LogUpdRuleMask = 0x0400, /* informs the code is for a log upd rule with env */
LogUpdMask = 0x0200, /* informs this is a logic update index. */
StaticMask = 0x0100, /* dealing with static predicates */
MegaMask = 0x200000, /* mega clause */
FactMask = 0x100000, /* a fact */
SwitchRootMask = 0x80000, /* root for the index tree */
SwitchTableMask = 0x40000, /* switch table */
HasBlobsMask = 0x20000, /* blobs which may be in use */
ProfFoundMask = 0x10000, /* clause is being counted by profiler */
DynamicMask = 0x8000, /* dynamic predicate */
InUseMask = 0x4000, /* this block is being used */
ErasedMask = 0x2000, /* this block has been erased */
IndexMask = 0x1000, /* indexing code */
DBClMask = 0x0800, /* data base structure */
LogUpdRuleMask = 0x0400, /* code is for a log upd rule with env */
LogUpdMask = 0x0200, /* logic update index. */
StaticMask = 0x0100, /* static predicates */
DirtyMask = 0x0080 /* LUIndices */
/* other flags belong to DB */
} dbentry_flags;

34
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h *
* comments: walk through heap code *
* *
* Last rev: $Date: 2007-03-22 11:12:21 $,$Author: vsc $ *
* Last rev: $Date: 2007-04-10 22:13:21 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.74 2007/03/22 11:12:21 vsc
* make sure that YAP_Restart does not restart a failed goal.
*
* Revision 1.73 2007/02/18 00:26:36 vsc
* fix atom garbage collector (although it is still off by default)
* make valgrind feel better
@ -462,6 +465,10 @@ restore_codes(void)
Yap_heap_regs->atprompt =
AtomAdjust(Yap_heap_regs->atprompt);
}
if (Yap_heap_regs->current_modules) {
Yap_heap_regs->current_modules = (struct mod_entry *)
AddrAdjust((ADDR)Yap_heap_regs->current_modules);
}
if (Yap_heap_regs->char_conversion_table) {
Yap_heap_regs->char_conversion_table = (char *)
AddrAdjust((ADDR)Yap_heap_regs->char_conversion_table);
@ -546,17 +553,6 @@ restore_codes(void)
}
}
}
{
/* adjust atoms in atom table */
unsigned int i = 0;
for (i = 0; i < Yap_heap_regs->no_of_modules; i++) {
Yap_heap_regs->module_name[i] = AtomTermAdjust(Yap_heap_regs->module_name[i]);
if (Yap_heap_regs->module_pred[i]) {
Yap_heap_regs->module_pred[i] = PtoPredAdjust(Yap_heap_regs->module_pred[i]);
}
}
}
Yap_heap_regs->atom_abol = AtomAdjust(Yap_heap_regs->atom_abol);
Yap_heap_regs->atom_append = AtomAdjust(Yap_heap_regs->atom_append);
Yap_heap_regs->atom_array = AtomAdjust(Yap_heap_regs->atom_array);
@ -1275,8 +1271,20 @@ RestoreEntries(PropEntry *pp)
opp->OpModule = AtomTermAdjust(opp->OpModule);
}
}
case ExpProperty:
case ModProperty:
{
ModEntry *me = (ModEntry *)pp;
me->NextOfPE =
PropAdjust(me->NextOfPE);
me->PredForME =
PtoPredAdjust(me->PredForME);
me->AtomOfME =
AtomAdjust(me->AtomOfME);
me->NextME = (struct mod_entry *)
AddrAdjust((ADDR)me->NextME);
}
break;
case ExpProperty:
pp->NextOfPE =
PropAdjust(pp->NextOfPE);
break;

2
Makefile.in
View File

@ -27,7 +27,7 @@ INCLUDEDIR=$(ROOTDIR)/include/Yap
#
INFODIR=$(SHAREDIR)/info
#3
#
# Add this flag to YAP_EXTRAS if you need the extension:
# -DRATIONAL_TREES: allow unification and builtins over rational trees
# -DCOROUTINING: implement extra control primitives

4
changes-5.1.html
View File

@ -16,6 +16,10 @@
<h2>Yap-5.1.2:</h2>
<ul>
<li> FIXED: get rid of static structures for modules (obs from Bernd
Gutmann).</li>
<li> FIXED: SREG might be lost on trail/heap overflow, and that would
confuse later pruning.</li>
<li> FIXED: UNICODE16 was broken.</li>
<li> NEW: support for BOM.</li>
<li> FIXED: debugging and clause/3 over tabled predicates would kill YAP.</li>

2
pl/preds.yap
View File

@ -38,6 +38,8 @@ assert(C) :-
'$assert'(V,Mod,_,_,_) :- var(V), !,
'$do_error'(instantiation_error,assert(Mod:V)).
'$assert'(V,Mod,_,_,_) :- var(Mod), !,
'$do_error'(instantiation_error,assert(Mod:V)).
'$assert'(M:C,_,Where,R,P) :- !,
'$assert'(C,M,Where,R,P).
'$assert'((H:-G),M1,Where,R,P) :- !,