small changes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@270 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
91476a8e78
commit
1012146c28
@ -48,7 +48,7 @@ typedef struct PropEntryStruct *Prop;
|
||||
/* atom structure */
|
||||
typedef struct AtomEntryStruct {
|
||||
Atom NextOfAE; /* used to build hash chains */
|
||||
Prop PropOfAE; /* property list for this atom */
|
||||
Prop PropsOfAE; /* property list for this atom */
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
rwlock_t ARWLock;
|
||||
#endif
|
||||
@ -103,6 +103,9 @@ typedef struct FunctorEntryStruct {
|
||||
unsigned int ArityOfFE; /* arity of functor */
|
||||
Atom NameOfFE; /* back pointer to owner atom */
|
||||
Prop PropsOfFE; /* pointer to list of properties for this functor */
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
rwlock_t FRWLock;
|
||||
#endif
|
||||
} FunctorEntry;
|
||||
|
||||
typedef FunctorEntry *Functor;
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
* Last rev: December 90 *
|
||||
* mods: *
|
||||
* comments: Tag Scheme for machines with 24 bits adresses (m68000) *
|
||||
* version: $Id: Tags_24bits.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
|
||||
* version: $Id: Tags_24bits.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* Version for 24 bit addresses (68000)
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
* Last rev: December 90 *
|
||||
* mods: *
|
||||
* comments: Original Tag Scheme for machines with 32 bits adresses *
|
||||
* version: $Id: Tags_32LowTag.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
|
||||
* version: $Id: Tags_32LowTag.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#define TAG_LOW_BITS_32 1
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
* Last rev: December 90 *
|
||||
* mods: *
|
||||
* comments: Original Tag Scheme for machines with 32 bits adresses *
|
||||
* version: $Id: Tags_32Ops.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
|
||||
* version: $Id: Tags_32Ops.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/*
|
||||
@ -78,7 +78,7 @@ are now 1 in compound terms and structures.
|
||||
This allows optimisation of switch_list
|
||||
|
||||
*/
|
||||
#if defined(i386) || defined(sparc) || defined(_POWER)
|
||||
#if defined(i386) || defined(sparc) || defined(_POWER) || defined(__sparc)
|
||||
#define UNIQUE_TAG_FOR_PAIRS 1
|
||||
#endif
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
* Last rev: December 90 *
|
||||
* mods: *
|
||||
* comments: Original Tag Scheme for machines with 32 bits adresses *
|
||||
* version: $Id: Tags_32bits.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
|
||||
* version: $Id: Tags_32bits.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* Original version for 32 bit addresses machines,
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
* Last rev: December 90 *
|
||||
* mods: *
|
||||
* comments: Original Tag Scheme for machines with 32 bits adresses *
|
||||
* version: $Id: Tags_64bits.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
|
||||
* version: $Id: Tags_64bits.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#define TAG_64BITS 1
|
||||
|
||||
@ -17,7 +17,7 @@
|
||||
* File: TermExt.h *
|
||||
* mods: *
|
||||
* comments: Extensions to standard terms for YAP *
|
||||
* version: $Id: TermExt.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
|
||||
* version: $Id: TermExt.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#if USE_OFFSETS
|
||||
@ -85,7 +85,10 @@ typedef struct {
|
||||
in some predefined context */
|
||||
void (*bind_op)(Term *, Term);
|
||||
/* what to do if someone wants to copy our constraint */
|
||||
int (*copy_term_op)(Term, CELL ***);
|
||||
int (*copy_term_op)(CELL *, CELL ***, CELL *);
|
||||
/* copy the constraint into a term and back */
|
||||
Term (*to_term_op)(CELL *);
|
||||
int (*term_to_op)(Term, Term);
|
||||
/* op called to do marking in GC */
|
||||
void (*mark_op)(CELL *);
|
||||
} ext_op;
|
||||
@ -239,10 +242,10 @@ inline EXTERN int IsLongIntTerm(Term t)
|
||||
|
||||
|
||||
MP_INT *STD_PROTO(PreAllocBigNum,(void));
|
||||
void STD_PROTO(ClearAllocBigNum,(void));
|
||||
MP_INT *STD_PROTO(InitBigNum,(Int));
|
||||
Term STD_PROTO(MkBigIntTerm, (MP_INT *));
|
||||
MP_INT *STD_PROTO(BigIntOfTerm, (Term));
|
||||
void STD_PROTO(CleanBigNum,(void));
|
||||
|
||||
|
||||
inline EXTERN int IsBigIntTerm(Term);
|
||||
@ -401,6 +404,7 @@ inline EXTERN Int IsAttachedTerm(Term t)
|
||||
|
||||
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
EXTERN int STD_PROTO(unify_extension,(Functor, CELL, CELL *, CELL));
|
||||
|
||||
@ -17,7 +17,7 @@
|
||||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
|
||||
* version: $Id: Yap.h,v 1.7 2002-01-05 04:04:14 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
@ -247,7 +247,7 @@ extern char Option[20];
|
||||
#elif __APPLE__
|
||||
#define MMAP_ADDR 0x01000000
|
||||
#else
|
||||
#define MMAP_ADDR 0x10000000
|
||||
#define MMAP_ADDR 0x09000000
|
||||
#endif
|
||||
#elif __svr4__
|
||||
#define MMAP_ADDR 0x02000000
|
||||
@ -322,7 +322,7 @@ typedef CELL Term;
|
||||
#ifdef i386
|
||||
#include <x86_locks.h>
|
||||
#endif
|
||||
#ifdef sparc
|
||||
#if defined(sparc) || defined(__sparc)
|
||||
#include <sparc_locks.h>
|
||||
#endif
|
||||
#ifdef mips
|
||||
@ -574,7 +574,7 @@ and RefOfTerm(t) : Term -> DBRef = ...
|
||||
incompatible with the high tag scheme. Linux-ELF also does not like
|
||||
if you place things in the lower addresses (power to the libc people).
|
||||
*/
|
||||
#if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(IN_SECOND_QUADRANT)) && !defined(TABLING)
|
||||
#if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || defined(IN_SECOND_QUADRANT)) && !defined(TABLING)
|
||||
#define USE_LOW32_TAGS 1
|
||||
#endif
|
||||
|
||||
@ -932,15 +932,6 @@ extern int emacs_mode;
|
||||
/************ variable concerned with version number *****************/
|
||||
extern char version_number[];
|
||||
|
||||
/* consult stack management */
|
||||
|
||||
typedef union CONSULT_OBJ {
|
||||
char *filename;
|
||||
int mode;
|
||||
Prop p;
|
||||
union CONSULT_OBJ *c;
|
||||
} consult_obj;
|
||||
|
||||
/********* common instructions codes*************************/
|
||||
|
||||
#define MAX_PROMPT 256
|
||||
@ -972,7 +963,8 @@ typedef enum {
|
||||
UserMode = 2, /* Normal mode */
|
||||
CritMode = 4, /* If we are meddling with the heap */
|
||||
AbortMode = 8, /* expecting to abort */
|
||||
InterruptMode = 16 /* under an interrupt */
|
||||
InterruptMode = 16, /* under an interrupt */
|
||||
InErrorMode = 32 /* under an interrupt */
|
||||
} prolog_exec_mode;
|
||||
|
||||
extern prolog_exec_mode PrologMode;
|
||||
@ -1030,7 +1022,7 @@ extern int yap_argc;
|
||||
} \
|
||||
if (PrologMode & AbortMode) { \
|
||||
PrologMode &= ~AbortMode; \
|
||||
Abort(""); \
|
||||
Error(PURE_ABORT, 0, ""); \
|
||||
} \
|
||||
GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \
|
||||
UNLOCK(GLOBAL_LOCKS_heap_access); \
|
||||
@ -1053,7 +1045,7 @@ extern int yap_argc;
|
||||
} \
|
||||
if (PrologMode & AbortMode) { \
|
||||
PrologMode &= ~AbortMode; \
|
||||
Abort(""); \
|
||||
Error(PURE_ABORT, 0, ""); \
|
||||
} \
|
||||
} \
|
||||
}
|
||||
|
||||
@ -449,6 +449,7 @@ inline EXTERN PropFlags IsValProperty(int flags)
|
||||
CodeOfPred holds the address of the correspondent C-function.
|
||||
*/
|
||||
typedef enum {
|
||||
CutTransparentPredFlag = 0x800000L, /* ! should ! across */
|
||||
SourcePredFlag = 0x400000L, /* static predicate with source declaration */
|
||||
MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */
|
||||
SyncPredFlag = 0x100000L, /* has to synch before it can execute*/
|
||||
@ -486,27 +487,28 @@ typedef struct {
|
||||
was retried */
|
||||
} profile_data;
|
||||
|
||||
typedef struct {
|
||||
Prop NextOfPE; /* used to chain properties */
|
||||
PropFlags KindOfPE; /* kind of property */
|
||||
unsigned int ArityOfPE; /* arity of property */
|
||||
SMALLUNSGN StateOfPred; /* actual state of predicate */
|
||||
CODEADDR CodeOfPred; /* code address */
|
||||
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
|
||||
Functor FunctorOfPred; /* functor for Predicate */
|
||||
CODEADDR FirstClause, LastClause;
|
||||
CELL PredFlags;
|
||||
Atom OwnerFile; /* File where the predicate was defined */
|
||||
typedef struct pred_entry {
|
||||
Prop NextOfPE; /* used to chain properties */
|
||||
PropFlags KindOfPE; /* kind of property */
|
||||
unsigned int ArityOfPE; /* arity of property */
|
||||
int ModuleOfPred; /* module for this definition */
|
||||
CELL PredFlags;
|
||||
CODEADDR CodeOfPred; /* code address */
|
||||
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
|
||||
Functor FunctorOfPred; /* functor for Predicate */
|
||||
CODEADDR FirstClause, LastClause;
|
||||
Atom OwnerFile; /* File where the predicate was defined */
|
||||
struct pred_entry *NextPredOfModule; /* next pred for same module */
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
rwlock_t PRWLock; /* a simple lock to protect this entry */
|
||||
rwlock_t PRWLock; /* a simple lock to protect this entry */
|
||||
#endif
|
||||
#ifdef TABLING
|
||||
tab_ent_ptr TableOfPred;
|
||||
tab_ent_ptr TableOfPred;
|
||||
#endif /* TABLING */
|
||||
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
|
||||
profile_data StatisticsForPred; /* enable profiling for predicate */
|
||||
SMALLUNSGN ModuleOfPred; /* module for this definition */
|
||||
} PredEntry;
|
||||
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
|
||||
profile_data StatisticsForPred; /* enable profiling for predicate */
|
||||
SMALLUNSGN StateOfPred; /* actual state of predicate */
|
||||
} PredEntry;
|
||||
#define PEProp ((PropFlags)(0x0000))
|
||||
|
||||
#if USE_OFFSETS_IN_PROPS
|
||||
@ -612,6 +614,9 @@ typedef struct DB_STRUCT {
|
||||
Int age; /* entry's age, negative if from recorda,
|
||||
positive if it was recordz */
|
||||
#endif /* KEEP_ENTRY_AGE */
|
||||
#ifdef COROUTINING
|
||||
CELL attachments; /* attached terms */
|
||||
#endif
|
||||
CELL Mask; /* parts that should be cleared */
|
||||
CELL Key; /* A mask that can be used to check before
|
||||
you unify */
|
||||
@ -1019,85 +1024,51 @@ CODEADDR STD_PROTO(PredIsIndexable,(PredEntry *));
|
||||
/* init.c */
|
||||
Atom STD_PROTO(GetOp,(OpEntry *,int *,int));
|
||||
|
||||
#ifdef XX_ADTDEFS_C
|
||||
#ifndef inline
|
||||
|
||||
/* look property list of atom a for kind */
|
||||
EXTERN inline Prop GetAProp(a,kind)
|
||||
Atom a;
|
||||
PropFlags kind;
|
||||
{ register PropEntry *pp = RepProp(RepAtom(a)->PropOfAE);
|
||||
while( !EndOfPAEntr(pp) && pp->KindOfPE!=kind) pp=RepProp(pp->NextOfPE);
|
||||
return(AbsProp(pp));
|
||||
}
|
||||
|
||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||
EXTERN inline Prop PredProp(ap,arity)
|
||||
Atom ap;
|
||||
unsigned int arity;
|
||||
{
|
||||
Prop p0;
|
||||
PredEntry *p = RepPredProp(p0=RepAtom(ap)->PropOfAE);
|
||||
while(p0 && (p->KindOfPE != 00 || p->ArityOfPE != arity ||
|
||||
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
|
||||
p = RepPredProp(p0=p->NextOfPE);
|
||||
if(p0) return(p0);
|
||||
YAPEnterCriticalSection();
|
||||
p = (PredEntry *) AllocAtomSpace(sizeof(*p));
|
||||
p->KindOfPE = PEProp;
|
||||
p->ArityOfPE = arity;
|
||||
p->FirstClause = p->LastClause = NIL;
|
||||
p->PredFlags = 0L;
|
||||
p->StateOfPred = 0;
|
||||
p->OwnerFile = AtomNil;
|
||||
p->ModuleOfPred = CurrentModule;
|
||||
p->OpcodeOfPred = opcode(_undef_p);
|
||||
p->StatisticsForPred.NOfEntries = 0;
|
||||
p->StatisticsForPred.NOfHeadSuccesses = 0;
|
||||
p->StatisticsForPred.NOfRetries = 0;
|
||||
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->DefaultCodeOfPred));
|
||||
if (arity==0) p->FunctorOfPred = (Functor) ap;
|
||||
else p->FunctorOfPred = MkFunctor(ap,arity);
|
||||
p->NextOfPE = RepAtom(ap)->PropOfAE;
|
||||
RepAtom(ap)->PropOfAE = p0 = AbsPredProp(p);
|
||||
YAPLeaveCriticalSection();
|
||||
return(p0);
|
||||
}
|
||||
|
||||
EXTERN inline Term GetValue(a)
|
||||
Atom a;
|
||||
{
|
||||
Prop p0 = GetAProp(a,ValProperty);
|
||||
if(p0==0) return(MkAtomTerm(AtomNil));
|
||||
return(RepValProp(p0)->ValueOfVE);
|
||||
}
|
||||
|
||||
|
||||
EXTERN inline void PutValue(a,v)
|
||||
Atom a; Term v;
|
||||
{
|
||||
Prop p0 = GetAProp(a,ValProperty);
|
||||
if(p0) RepValProp(p0)->ValueOfVE = v;
|
||||
else {
|
||||
ValEntry *p;
|
||||
YAPEnterCriticalSection();
|
||||
p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry));
|
||||
p->KindOfPE = ValProperty;
|
||||
p->ValueOfVE = v;
|
||||
p->NextOfPE = RepAtom(a)->PropOfAE;
|
||||
RepAtom(a)->PropOfAE = AbsValProp(p);
|
||||
YAPLeaveCriticalSection();
|
||||
}
|
||||
}
|
||||
|
||||
#endif /* inline */
|
||||
#else
|
||||
/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */
|
||||
Prop STD_PROTO(GetAProp,(Atom,PropFlags));
|
||||
Prop STD_PROTO(LockedGetAProp,(AtomEntry *,PropFlags));
|
||||
Prop STD_PROTO(PredProp,(Atom,unsigned int));
|
||||
#endif /* ADTDEFS_C */
|
||||
Prop STD_PROTO(GetAPropHavingLock,(AtomEntry *,PropFlags));
|
||||
|
||||
EXTERN inline Prop
|
||||
PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
|
||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||
{
|
||||
Prop p0;
|
||||
FunctorEntry *fe = (FunctorEntry *)f;
|
||||
|
||||
WRITE_LOCK(fe->FRWLock);
|
||||
p0 = fe->PropsOfFE;
|
||||
while (p0) {
|
||||
PredEntry *p = RepPredProp(p0);
|
||||
if (/* p->KindOfPE != 0 || only props */
|
||||
(p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) {
|
||||
WRITE_UNLOCK(f->FRWLock);
|
||||
return (p0);
|
||||
}
|
||||
p0 = p->NextOfPE;
|
||||
}
|
||||
return(NewPredPropByFunctor(fe,cur_mod));
|
||||
}
|
||||
|
||||
EXTERN inline Prop
|
||||
PredPropByAtom(Atom at, SMALLUNSGN cur_mod)
|
||||
/* 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) {
|
||||
PredEntry *pe = RepPredProp(p0);
|
||||
if ( pe->KindOfPE == PEProp &&
|
||||
(pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) {
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
return(p0);
|
||||
}
|
||||
p0 = pe->NextOfPE;
|
||||
}
|
||||
return(NewPredPropByAtom(ae,cur_mod));
|
||||
}
|
||||
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
void STD_PROTO(ReleasePreAllocCodeSpace, (ADDR));
|
||||
|
||||
@ -317,11 +317,11 @@ inline EXTERN AtomEntry * AtomEntryAdjust(AtomEntry * at)
|
||||
|
||||
|
||||
|
||||
inline EXTERN consult_obj * ConsultObjAdjust(consult_obj *);
|
||||
inline EXTERN union CONSULT_OBJ * ConsultObjAdjust(union CONSULT_OBJ *);
|
||||
|
||||
inline EXTERN consult_obj * ConsultObjAdjust(consult_obj * co)
|
||||
inline EXTERN union CONSULT_OBJ * ConsultObjAdjust(union CONSULT_OBJ * co)
|
||||
{
|
||||
return (consult_obj *) ((consult_obj *)(CharP(co)+HDiff) );
|
||||
return (union CONSULT_OBJ *) ((union CONSULT_OBJ *)(CharP(co)+HDiff) );
|
||||
}
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user