small changes

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@270 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

VC/include/Atoms.h

@@ -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;

VC/include/Tags_24bits.h

@@ -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)

VC/include/Tags_32LowTag.h

@@ -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

VC/include/Tags_32Ops.h

@@ -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
 

VC/include/Tags_32bits.h

@@ -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,

VC/include/Tags_64bits.h

@@ -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

VC/include/TermExt.h

@@ -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));

VC/include/Yap.h

@@ -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, "");                            \
             }                                                            \
           }                                                              \
         }

VC/include/Yatom.h

@@ -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 {
+typedef	struct pred_entry {
-    Prop	NextOfPE;	/* used to chain properties	    	*/
+  Prop	NextOfPE;	/* used to chain properties	    	*/
-    PropFlags	KindOfPE;	/* kind of property		    	*/
+  PropFlags	KindOfPE;	/* kind of property		    	*/
-    unsigned int ArityOfPE;	/* arity of property		    	*/
+  unsigned int  ArityOfPE;	/* arity of property		    	*/
-    SMALLUNSGN	StateOfPred;	/* actual state of predicate 		*/
+  int		ModuleOfPred;	/* module for this definition		*/
-    CODEADDR	CodeOfPred;	/* code address		    		*/
+  CELL	        PredFlags;
-    CODEADDR	TrueCodeOfPred;	/* if needing to spy or to lock 	*/
+  CODEADDR	CodeOfPred;	/* code address		    		*/
-    Functor     FunctorOfPred;	/* functor for Predicate        	*/
+  CODEADDR	TrueCodeOfPred;	/* if needing to spy or to lock 	*/
-    CODEADDR	FirstClause, LastClause;
+  Functor       FunctorOfPred;	/* functor for Predicate        	*/
-    CELL	PredFlags;
+  CODEADDR	FirstClause, LastClause;
-    Atom	OwnerFile;	/* File where the predicate was defined */
+  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, ....  */
+  OPCODE        OpcodeOfPred;	/* undefcode, indexcode, spycode, ....  */
-    profile_data StatisticsForPred; /* enable profiling for predicate  */
+  profile_data  StatisticsForPred; /* enable profiling for predicate  */
-    SMALLUNSGN	ModuleOfPred;	/* module for this definition		*/
+  SMALLUNSGN	StateOfPred;	/* actual state of predicate 		*/
-  } PredEntry;
+} 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(GetAPropHavingLock,(AtomEntry *,PropFlags));
-Prop	STD_PROTO(PredProp,(Atom,unsigned int));
-#endif /* ADTDEFS_C */
 
+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));

VC/include/sshift.h

@@ -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) );
 }