whole lot of fixes:

- memory leak in indexing
  - memory management in WIN32 now supports holes
  - extend Yap interface, more support for SWI-Interface
  - new predicate mktime in system
  - buffer console I/O in WIN32


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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2004-07-23 21:08:44 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-08-11 16:14:51 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.141  2004/07/23 21:08:44  vsc
+* windows fixes
+*
 * Revision 1.140  2004/07/22 21:32:20  vsc
 * debugger fixes
 * initial support for JPL
@@ -1929,6 +1932,7 @@ Yap_absmi(int inp)
 	  B = B->cp_b;
 	}
       trim_trail:
+	HBREG = PROTECT_FROZEN_H(B->cp_b);
         {
 	  tr_fr_ptr pt1, pt0;
 	  pt1 = pt0 = B->cp_tr;
@@ -1984,7 +1988,6 @@ Yap_absmi(int inp)
         abolish_incomplete_subgoals(B);
 #endif /* TABLING */
 	SET_BB(PROTECT_FROZEN_B(B));
-	HBREG = PROTECT_FROZEN_H(B);
       }
       ENDD(d0);
       GONext();

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.55 2004-07-28 22:09:01 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.56 2004-08-11 16:14:51 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -565,27 +565,42 @@ Yap_ExpandPreAllocCodeSpace(UInt sz)
 /* #define MAX_WORKSPACE 0x40000000L */
 #define MAX_WORKSPACE 0x80000000L
 
+#define ALLOC_SIZE (64*1024)
+
 static LPVOID brk;
 
 static int
-ExtendWorkSpace(Int s)
+ExtendWorkSpace(Int s, int fixed_allocation)
 {
   LPVOID b = brk;
   prolog_exec_mode OldPrologMode = Yap_PrologMode;
 
+  s = ((s+ (ALLOC_SIZE-1))/ALLOC_SIZE)*ALLOC_SIZE;
   Yap_PrologMode = ExtendStackMode;
-  b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
+  if (fixed_allocation)
-  if (b) {
+    b = VirtualAlloc(b, s, MEM_RESERVE, PAGE_NOACCESS);
-    brk = (LPVOID) ((Int) brk + s);
+  else {
-    Yap_PrologMode = OldPrologMode;
+    b = VirtualAlloc(NULL, s, MEM_RESERVE, PAGE_NOACCESS);
-    return TRUE;
+    if (b && b < brk) {
+      return ExtendWorkSpace(s, fixed_allocation);
+    }
   }
-  Yap_ErrorMessage = Yap_ErrorSay;
+  if (!b) {
-  snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
+    Yap_PrologMode = OldPrologMode;
-	    "VirtualAlloc could not commit %ld bytes",
+    return FALSE;
-	    (long int)s);
+  }
+  b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
+  if (!b) {
+    Yap_ErrorMessage = Yap_ErrorSay;
+    snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
+	      "VirtualAlloc could not commit %ld bytes",
+	      (long int)s);
+    Yap_PrologMode = OldPrologMode;
+    return FALSE;
+  }
+  brk = (LPVOID) ((Int) brk + s);
   Yap_PrologMode = OldPrologMode;
-  return FALSE;
+  return TRUE;
 }
 
 static MALLOC_T
@@ -597,27 +612,30 @@ InitWorkSpace(Int s)
 
   GetSystemInfo(&si);
   Yap_page_size = si.dwPageSize;
-
+  
+  s = ((s+ (ALLOC_SIZE-1))/ALLOC_SIZE)*ALLOC_SIZE;
   brk = NULL;
-  for (max_mem = MAX_WORKSPACE; max_mem >= s; max_mem = max_mem - (max_mem >> 2)) {
+  b = VirtualAlloc((LPVOID)MMAP_ADDR, s, MEM_RESERVE, PAGE_NOACCESS);
-    b = VirtualAlloc((LPVOID)MMAP_ADDR, max_mem, MEM_RESERVE, PAGE_NOACCESS);
+  if (b == NULL) {
-    if (b == NULL) {
+    b = VirtualAlloc(NULL, max_mem, MEM_RESERVE, PAGE_NOACCESS);
-      b = VirtualAlloc(NULL, max_mem, MEM_RESERVE, PAGE_NOACCESS);
+    if (!b) {
-      if (b != NULL) {
+      fprintf(stderr,"%% Warning: YAP reserving space at variable address %p\n", brk);
-	brk = b;
+      return NULL;
-	fprintf(stderr,"%% Warning: YAP reserving space at variable address %p\n", brk);
+    } 
-	break;
+    b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
-      } 
+    if (b== NULL) {
-    } else {
+      fprintf(stderr,"%% Warning: YAP failed to reserve space at %p\n", brk);
-      brk = BASE_ADDRESS;
+      return NULL;
-      break;
+    }
+  } else {
+    b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE);
+    if (!b) {
+      fprintf(stderr,"%% Warning: YAP failed to reserve space at %p\n", brk);
+      return NULL;
     }
   }
-  if (brk && ExtendWorkSpace(s)) {
+  brk = (LPVOID) ((Int) b + s);
-    return (MALLOC_T)b;
+  return b;
-  }
-  Yap_Error(FATAL_ERROR,TermNil,"VirtualAlloc Failed");
-  return NULL;
 }
 
 int
@@ -1299,11 +1317,18 @@ Yap_InitExStacks(int Trail, int Stack)
 {
 }
 
+#if defined(_WIN32)
+#define WorkSpaceTop brk
+#define MAP_FIXED 1
+#endif
+
 int
 Yap_ExtendWorkSpace(Int s)
 {
 #if USE_MMAP
   return ExtendWorkSpace(s, MAP_FIXED);
+#elif defined(_WIN32)
+  return ExtendWorkSpace(s, MAP_FIXED);
 #else
   return ExtendWorkSpace(s);
 #endif
@@ -1312,9 +1337,27 @@ Yap_ExtendWorkSpace(Int s)
 UInt
 Yap_ExtendWorkSpaceThroughHole(UInt s)
 {
-#if USE_MMAP
+#if USE_MMAP || defined(_WIN32)
   MALLOC_T WorkSpaceTop0 = WorkSpaceTop;
 
+#if SIZEOF_INT_P==4
+  while (WorkSpaceTop < (MALLOC_T)0xc0000000L) {
+    /* progress 1 MB */
+    WorkSpaceTop += 512*1024;
+    if (ExtendWorkSpace(s, MAP_FIXED)) {
+      return WorkSpaceTop-WorkSpaceTop0;
+    }
+#if defined(_WIN32)
+    /* 487 happens when you step over someone else's memory */
+    if (GetLastError() != 487) {
+      /* I could not manage to allocate the memory*/
+      fprintf(stderr,"I am in trouble here\n");
+      break;
+    }
+#endif
+  }
+  WorkSpaceTop = WorkSpaceTop0;
+#endif
   if (ExtendWorkSpace(s, 0))
     return WorkSpaceTop-WorkSpaceTop0;
 #endif
@@ -1324,7 +1367,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s)
 void
 Yap_AllocHole(UInt actual_request, UInt total_size)
 {
-#if USE_MMAP
+#if USE_MMAP || defined(_WIN32)
   /* where we were when the hole was created,
    also where is the hole store */
   ADDR WorkSpaceTop0 = WorkSpaceTop-total_size;

C/c_interface.c

@@ -10,8 +10,11 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2004-07-23 03:37:16 $,$Author: vsc $						 *
+* Last rev:	$Date: 2004-08-11 16:14:51 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.52  2004/07/23 03:37:16  vsc
+* fix heap overflow in YAP_LookupAtom
+*
 * Revision 1.51  2004/07/22 21:32:20  vsc
 * debugger fixes
 * initial support for JPL
@@ -49,6 +52,7 @@
 
 #define Bool int
 #define flt double
+#define YAP_Term Term
 #define C_INTERFACE
 
 #include "Yap.h"
@@ -138,6 +142,7 @@ X_API Term    STD_PROTO(YAP_WriteBuffer, (Term, char *, unsigned int, int));
 X_API char   *STD_PROTO(YAP_CompileClause, (Term));
 X_API void    STD_PROTO(YAP_PutValue, (Atom,Term));
 X_API Term    STD_PROTO(YAP_GetValue, (Atom));
+X_API int     STD_PROTO(YAP_CompareTerms, (Term,Term));
 X_API int     STD_PROTO(YAP_Reset, (void));
 X_API void    STD_PROTO(YAP_Exit, (int));
 X_API void    STD_PROTO(YAP_InitSocks, (char *, long));
@@ -155,12 +160,15 @@ X_API void    STD_PROTO(YAP_Throw,(Term));
 X_API void    STD_PROTO(YAP_Halt,(int));
 X_API Term   *STD_PROTO(YAP_TopOfLocalStack,(void));
 X_API void   *STD_PROTO(YAP_Predicate,(Atom,unsigned long int,int));
-X_API void    STD_PROTO(YAP_PredicateInfo,(void *,Atom *,unsigned long int *,int *));
+X_API void    STD_PROTO(YAP_PredicateInfo,(void *,Atom *,unsigned long int *,Term *));
 X_API void    STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,unsigned long int));
 X_API void    STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,unsigned long int,unsigned int));
 X_API void    STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,unsigned long int,Term));
-X_API Int     STD_PROTO(YAP_CurrentModule,(void));
+X_API Term     STD_PROTO(YAP_CurrentModule,(void));
+X_API Term     STD_PROTO(YAP_CreateModule,(Atom));
 X_API int     STD_PROTO(YAP_ThreadSelf,(void));
+X_API int     STD_PROTO(YAP_GetThreadRefCount,(int));
+X_API void    STD_PROTO(YAP_SetThreadRefCount,(int,int));
 X_API int     STD_PROTO(YAP_ThreadCreateEngine,(thread_attr *));
 X_API int     STD_PROTO(YAP_ThreadAttachEngine,(int));
 X_API int     STD_PROTO(YAP_ThreadDetachEngine,(int));
@@ -1120,6 +1128,12 @@ YAP_GetValue(Atom at)
   return(Yap_GetValue(at));
 }
 
+X_API int
+YAP_CompareTerms(Term t1, Term t2)
+{
+  return Yap_compare_terms(t1, t2);
+} 
+
 X_API int
 YAP_Reset(void)
 {
@@ -1223,7 +1237,7 @@ YAP_Predicate(Atom a, unsigned long int arity, int m)
 } 
 
 X_API void
-YAP_PredicateInfo(void *p, Atom* a, unsigned long int* arity, int* m)
+YAP_PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m)
 {
   PredEntry *pd = (PredEntry *)p;
   if (pd->ArityOfPE) {
@@ -1269,12 +1283,18 @@ YAP_UserCPredicateWithArgs(char *a, CPredicate f, unsigned long int arity, Term
   CurrentModule = cm;
 } 
 
-X_API Int
+X_API Term
 YAP_CurrentModule(void)
 {
   return(CurrentModule);
 } 
 
+X_API Term
+YAP_CreateModule(Atom at)
+{
+  return Yap_Module(MkAtomTerm(at));
+} 
+
 X_API int
 YAP_ThreadSelf(void)
 {

C/dbase.c

@@ -570,7 +570,7 @@ typedef struct {
          }
 
 /* no checking for overflow while building DB terms yet */
-#define  CheckDBOverflow() if (CodeMax+1024 >= (CELL *)visited) {     \
+#define  CheckDBOverflow(X) if (CodeMax+X >= (CELL *)visited-1024) {     \
     goto error;					                      \
    }
     
@@ -717,13 +717,13 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 #else
 	  *StoPoint++ = AbsAppl(CodeMax);
 #endif
-	  CheckDBOverflow();
+	  CheckDBOverflow(3);
 	  CodeMax = copy_long_int(CodeMax, ap2);
 	  ++pt0;
 	  continue;
 #ifdef USE_GMP
 	case (CELL)FunctorBigInt:
-	  CheckDBOverflow();
+	  CheckDBOverflow(3);
 	  /* first thing, store a link to the list before we move on */
 #ifdef IDB_USE_MBIT
 	  *StoPoint++ = AbsAppl(CodeMax)|MBIT;
@@ -738,7 +738,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 	  {
 	    CELL *st = CodeMax;
 
-	    CheckDBOverflow();
+	    CheckDBOverflow(4);
 	    /* first thing, store a link to the list before we move on */
 #ifdef IDB_USE_MBIT
 	    *StoPoint++ = AbsAppl(st)|MBIT;
@@ -779,7 +779,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
       pt0_end = ap2 + d0;
       /* prepare for our new compound term */
       /* first the functor */
-      CheckDBOverflow();
+      CheckDBOverflow(d0);
       *CodeMax++ = (CELL)f;
       /* we'll be working here */
       StoPoint = CodeMax;
@@ -834,7 +834,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
       pt0_end = RepPair(d0) + 1;
       /* reserve space for our new list */
       CodeMax += 2;
-      CheckDBOverflow();
+      CheckDBOverflow(2);
       continue;
     } else if (IsAtomOrIntTerm(d0)) {
       *StoPoint++ = d0;
@@ -869,7 +869,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 	/* store previous value */ 
 	visited --;
 	visited->addr = ptd0;
-	CheckDBOverflow();
+	CheckDBOverflow(1);
 	/* variables need to be offset at read time */
 	*ptd0 = (CELL)StoPoint;
 #if SBA
@@ -947,7 +947,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
     to_visit -= 3;
     pt0 = to_visit[0];
     pt0_end = to_visit[1];
-    CheckDBOverflow();
+    CheckDBOverflow(1);
     StoPoint = to_visit[2];
 #endif
     goto loop;
@@ -965,7 +965,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
     StoPoint = CodeMax;
     *StoPoint++ = RepAppl(ConstraintsTerm)[0];
     ConstraintsTerm = AbsAppl(CodeMax);
-    CheckDBOverflow();
+    CheckDBOverflow(1);
     CodeMax += 5;
     goto loop;
   }

C/errors.c

@@ -297,7 +297,7 @@ dump_stack(void)
     fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global\n");
   } else {
     if (b_ptr != NULL) {
-      fprintf(stderr," [ Goals with alternatives open:\n");
+      fprintf(stderr," [ Goals with open alternatives:\n");
       while (b_ptr != NULL) {
 	cl_position(b_ptr->cp_ap);
 	b_ptr = b_ptr->cp_b;
@@ -355,6 +355,7 @@ Yap_Error (yap_error_number type, Term where, char *format,...)
   char *tp = tmpbuf;
   int psize = YAP_BUF_SIZE;
 
+  
   if (type == INTERRUPT_ERROR) {
     fprintf(stderr,"%% YAP exiting: cannot handle signal %d\n",
 	    (int)IntOfTerm(where));
@@ -367,7 +368,7 @@ Yap_Error (yap_error_number type, Term where, char *format,...)
     /* now build the error string */
     if (format != NULL) {
 #if   HAVE_VSNPRINTF
-      (void) vsnprintf(tmpbuf, 512, format, ap);
+      (void) vsnprintf(tmpbuf, YAP_BUF_SIZE, format, ap);
 #else
       (void) vsprintf(tmpbuf, format, ap);
 #endif

C/exec.c

@@ -1286,11 +1286,13 @@ Yap_RunTopGoal(Term t)
   READ_LOCK(ppe->PRWLock);
   CodeAdr = ppe->CodeOfPred;
   READ_UNLOCK(ppe->PRWLock);
+#if !USE_MALLOC
   if (Yap_TrailTop - HeapTop < 2048) {
     Yap_PrologMode = BootMode;
     Yap_Error(SYSTEM_ERROR,TermNil,
 	  "unable to boot because of too little heap space");
   }
+#endif
   goal_out = do_goal(t, CodeAdr, arity, pt, TRUE);
   return(goal_out);
 }

C/grow.c

@@ -510,7 +510,7 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
 {
   UInt start_growth_time, growth_time;
   int gc_verbose;
-  UInt hole = 0L;
+  UInt minimal_request = 0L;
 
   /* adjust to a multiple of 256) */
   size = AdjustPageSize(size);
@@ -519,7 +519,7 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
     Int min_size = AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+MinHeapGap);
 
     if (size < min_size) size = min_size;
-    hole = size;
+    minimal_request = size;
     size = Yap_ExtendWorkSpaceThroughHole(size);
     if (size < 0) {
       strncat(Yap_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
@@ -557,8 +557,8 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
   AdjustRegs(MaxTemps);
   YAPLeaveCriticalSection();
   ASP += 256;
-  if (hole) 
+  if (minimal_request) 
-    Yap_AllocHole(hole, size);
+    Yap_AllocHole(minimal_request, size);
   growth_time = Yap_cputime()-start_growth_time;
   total_heap_overflow_time += growth_time;
   if (gc_verbose) {
@@ -837,17 +837,33 @@ Yap_growglobal(CELL **ptr)
 
 
 static int
-execute_growstack(long size, int from_trail)
+execute_growstack(long size0, int from_trail)
 {
-  char *MyGlobalBase = Yap_GlobalBase;
+  UInt minimal_request = 0L;
+  long size = size0;
+  ADDR old_Yap_GlobalBase = Yap_GlobalBase;
   
   if (!Yap_ExtendWorkSpace(size)) {
-    strncat(Yap_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
+    /* make sure stacks and trail are contiguous */
-    return(FALSE);
+    Int minimal_request = AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+MinHeapGap+size0);
+
+    size = Yap_ExtendWorkSpaceThroughHole(minimal_request);
+    if (size < 0) {
+      strncat(Yap_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
+      return FALSE;
+    }
+    YAPEnterCriticalSection();
+    GDiff = DelayDiff = size-size0;
+  } else {
+    YAPEnterCriticalSection();
+    if (Yap_GlobalBase != old_Yap_GlobalBase) {
+      GDiff = DelayDiff = Yap_GlobalBase-old_Yap_GlobalBase;
+      Yap_GlobalBase=old_Yap_GlobalBase;
+    } else {
+      GDiff = DelayDiff = 0;
+    }
   }
-  YAPEnterCriticalSection();  
   XDiff = HDiff = 0;
-  GDiff = DelayDiff = Yap_GlobalBase-MyGlobalBase;
 #if USE_SYSTEM_MALLOC
   if (from_trail) {
     TrDiff = LDiff = GDiff;
@@ -857,9 +873,6 @@ execute_growstack(long size, int from_trail)
 #else
   TrDiff = LDiff = size;
 #endif
-  if (GDiff) {
-    Yap_GlobalBase = (char *)MyGlobalBase;
-  }
   ASP -= 256;
   if (GDiff) {
     SetHeapRegs();
@@ -872,9 +885,14 @@ execute_growstack(long size, int from_trail)
   if (LDiff) {
     MoveLocalAndTrail();
   }
-  if (GDiff) 
+  if (GDiff) {
-    AdjustGlobal();
+    MoveGlobal();
-  if (LDiff) {
+    AdjustStacksAndTrail();
+    AdjustRegs(MaxTemps);
+#ifdef TABLING
+    fix_tabling_info();
+#endif /* TABLING */
+  } else if (LDiff) {
     AdjustGrowStack();
     AdjustRegs(MaxTemps);
 #ifdef TABLING
@@ -883,6 +901,8 @@ execute_growstack(long size, int from_trail)
   }
   YAPLeaveCriticalSection();
   ASP += 256;
+  if (minimal_request) 
+    Yap_AllocHole(minimal_request, size);
   return TRUE;
 }
 
@@ -901,7 +921,7 @@ growstack(long size)
   stack_overflows++;
   if (gc_verbose) {
     fprintf(Yap_stderr, "%% Stack Overflow %d\n", stack_overflows);
-    fprintf(Yap_stderr, "%%   Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),Yap_GlobalBase,H);
+    fprintf(Yap_stderr, "%%   Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),Yap_GlobalBase,H);
     fprintf(Yap_stderr, "%%   Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
     fprintf(Yap_stderr, "%%   Trail:%8ld cells (%p-%p)\n",
 	       (unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
@@ -1022,7 +1042,7 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
   stack_overflows++;
   if (gc_verbose) {
     fprintf(Yap_stderr, "%% Stack overflow %d\n", stack_overflows);
-    fprintf(Yap_stderr, "%%   Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),(CELL *)Yap_GlobalBase,H);
+    fprintf(Yap_stderr, "%%   Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),(CELL *)Yap_GlobalBase,H);
     fprintf(Yap_stderr, "%%   Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
     fprintf(Yap_stderr, "%%   Trail:%8ld cells (%p-%p)\n",
 	       (unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
@@ -1078,8 +1098,7 @@ static int do_growtrail(long size)
   execute_growstack(size, TRUE);
 #else
   if (!Yap_ExtendWorkSpace(size)) {
-    strncat(Yap_ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
+    execute_growstack(size, TRUE);
-    return FALSE;
   }
   YAPEnterCriticalSection();
   Yap_TrailTop += size;

C/heapgc.c

@@ -3213,7 +3213,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
   /* expand the stack if effectiveness is less than 20 % */
   if (ASP - H < gc_margin/sizeof(CELL) ||
       effectiveness < 20) {
-    return (Yap_growstack(gc_margin));
+    return Yap_growstack(gc_margin);
   }
   /*
    * debug for(save_total=1; save_total<=N; ++save_total)

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2004-07-29 18:15:18 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-08-11 16:14:52 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.94  2004/07/29 18:15:18  vsc
+* fix severe bug in indexing of floating point numbers
+*
 * Revision 1.93  2004/07/23 19:01:14  vsc
 * fix bad ref count in expand_clauses when copying indexing block
 *
@@ -5280,7 +5283,10 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
     nbegin->u.xl.x = begin->u.xl.x;
     nbegin->u.xl.l = begin->u.xl.l;
     if (nbegin->u.xl.l->opc == Yap_opcode(_expand_clauses)) {
-      nbegin->u.xl.l->u.sp.s3++;
+      if (!(blk->ClFlags & ErasedMask)) {
+	/* we haven't done erase yet */
+	nbegin->u.xl.l->u.sp.s3++;
+      }
     }
     begin = NEXTOP(begin, xl);
     nbegin = NEXTOP(nbegin, xl);

C/iopreds.c

@@ -3540,7 +3540,7 @@ format_putc(int sno, int ch) {
       format_buf_size = new_max_size;
       if (ActiveSignals & YAP_CDOVF_SIGNAL) {
 	if (!Yap_growheap(FALSE, 0, NULL)) {
-	  Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at format");
+	  Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at format");
 	}
       }
     }

C/modules.c

@@ -46,7 +46,7 @@ Yap_Module_Name(PredEntry *ap)
   return TermProlog;
 }
 
-static Term 
+static int 
 LookupModule(Term a)
 {
   unsigned int             i;
@@ -66,6 +66,12 @@ LookupModule(Term a)
   return (i);
 }
 
+Term
+Yap_Module(Term tmod)
+{
+  return ModuleName[LookupModule(tmod)];
+}
+
 struct pred_entry *
 Yap_ModulePred(Term mod)
 {

C/scanner.c

@@ -457,10 +457,11 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
   }
   while (chtype[ch] == NU) {
     Int oval = val;
-    if (ch != '0')
+    if (!(val == 0 && ch == '0')) {
       *sp++ = ch;
+    }
     if (ch - '0' >= base)
-      return (MkIntegerTerm(val));
+      return MkIntegerTerm(val);
     val = val * base + ch - '0';
     if (val/base != oval || val -oval*base != ch-'0') /* overflow */
       has_overflow = (has_overflow || TRUE);

C/sysbits.c

@@ -124,7 +124,7 @@ Yap_WinError(char *yap_error)
 {
   char msg[256];
   /* Error, we could not read time */
-    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+     FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
 		  NULL, GetLastError(), 
 		  MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
 		  NULL);
@@ -1040,7 +1040,7 @@ SearchForTrailFault(void)
     /*    my_signal_info(SIGSEGV, HandleSIGSEGV); */
   } else
 #endif /* OS_HANDLES_TR_OVERFLOW */
-    Yap_Error(FATAL_ERROR, TermNil,
+    Yap_Error(OUT_OF_TRAIL_ERROR, TermNil,
 	  "likely bug in YAP, segmentation violation");
 }
 

C/threads.c

@@ -194,12 +194,16 @@ p_create_thread(void)
 static Int
 p_thread_self(void)
 {
+  if (pthread_getspecific(Yap_yaamregs_key) == NULL)
+    return Yap_unify(MkIntegerTerm(-1), ARG1);
   return Yap_unify(MkIntegerTerm(worker_id), ARG1);
 }
 
 int
 Yap_thread_self(void)
 {
+  if (pthread_getspecific(Yap_yaamregs_key) == NULL)
+    return -1;
   return worker_id;
 }
 
@@ -223,6 +227,11 @@ int
 Yap_thread_attach_engine(int wid)
 {
   pthread_mutex_lock(&(ThreadHandle[wid].tlock));
+  if (ThreadHandle[wid].ref_count &&
+      ThreadHandle[wid].handle != pthread_self()) {
+    pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
+    return FALSE;
+  }
   ThreadHandle[wid].handle = pthread_self();
   ThreadHandle[wid].ref_count++;
   worker_id = wid;
@@ -234,7 +243,8 @@ int
 Yap_thread_detach_engine(int wid)
 {
   pthread_mutex_lock(&(ThreadHandle[wid].tlock));
-  ThreadHandle[wid].handle = 0;
+  if (ThreadHandle[wid].handle == worker_id)
+    ThreadHandle[wid].handle = 0;
   ThreadHandle[wid].ref_count--;
   pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
   return TRUE;
@@ -254,6 +264,7 @@ Yap_thread_destroy_engine(int wid)
   }
 }
 
+
 static Int
 p_thread_join(void)
 {

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.53 2004-07-22 21:32:21 vsc Exp $	 *
+* version:      $Id: Yapproto.h,v 1.54 2004-08-11 16:14:52 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -216,6 +216,7 @@ Term	STD_PROTO(Yap_ReadTimedVar,(Term));
 Term    STD_PROTO(Yap_UpdateTimedVar,(Term, Term));
 
 /* modules.c */
+Term    STD_PROTO(Yap_Module, (Term));
 Term    STD_PROTO(Yap_Module_Name, (struct pred_entry *));
 struct pred_entry *STD_PROTO(Yap_ModulePred, (Term));
 void    STD_PROTO(Yap_NewModulePred, (Term, struct pred_entry *));

H/threads.h

@@ -5,6 +5,8 @@ typedef struct{
 } thread_attr;
 
 Int STD_PROTO(Yap_thread_self,(void));
+int STD_PROTO(Yap_get_thread_ref_count,(int));
+void STD_PROTO(Yap_set_thread_ref_count,(int,int));
 Int STD_PROTO(Yap_thread_create_engine,(thread_attr *));
 Int STD_PROTO(Yap_thread_attach_engine,(int));
 Int STD_PROTO(Yap_thread_detach_engine,(int));

docs/yap.tex

@@ -7987,6 +7987,24 @@ on local time. This function uses the WIN32
 X = datime(2001,5,28,15,29,46) ? 
 @end example
 
+@item mktime(datime(+@var{Year}, +@var{Month}, +@var{DayOfTheMonth},
++@var{Hour}, +@var{Minute}, +@var{Second}), -@var{Seconds})
+@findex  mktime/2
+@snindex mktime/2
+@cnindex mktime/2
+The @code{mktime/1} procedure returns the number of @var{Seconds}
+elapsed since 00:00:00 on January 1, 1970, Coordinated Universal Time
+(UTC).  The user provides information on @var{Year}, @var{Month},
+@var{DayOfTheMonth}, @var{Hour}, @var{Minute}, and @var{Second}. The
+@var{Hour} is returned on local time. This function uses the WIN32
+@code{GetLocalTime} function or the Unix @code{mktime} function.
+
+@example
+   ?- mktime(datime(2001,5,28,15,29,46),X).
+
+X = 991081786 ? ;
+@end example
+
 @item delete_file(+@var{File})
 @findex  delete_file/1
 @syindex delete_file/1

include/YapInterface.h

@@ -337,16 +337,23 @@ extern X_API YAP_Term  *PROTO(YAP_TopOfLocalStack,(void));
 extern X_API void  *PROTO(YAP_Predicate,(YAP_Atom,unsigned long int,int));
 
 /*  int  YAP_Predicate()  */
-extern X_API void  PROTO(YAP_PredicateInfo,(void *,YAP_Atom *,unsigned long int*,int*));
+extern X_API void  PROTO(YAP_PredicateInfo,(void *,YAP_Atom *,unsigned long int*,YAP_Module*));
 
 /*  int  YAP_CurrentModule()  */
-extern X_API int  PROTO(YAP_CurrentModule,(void));
+extern X_API YAP_Module  PROTO(YAP_CurrentModule,(void));
 
-extern X_API int PROTO(YAP_ThreadSelf,(void));
+/*  int  YAP_CurrentModule()  */
-extern X_API int PROTO(YAP_ThreadCreateEngine,(YAP_thread_attr *));
+extern X_API YAP_Module  PROTO(YAP_CreateModule,(YAP_Atom));
-extern X_API int PROTO(YAP_ThreadAttachEngine,(int));
+
-extern X_API int PROTO(YAP_ThreadDetachEngine,(int));
+/* thread stuff */
-extern X_API int PROTO(YAP_ThreadDestroyEngine,(int));
+extern X_API int  PROTO(YAP_ThreadSelf,(void));
+extern X_API int  PROTO(YAP_ThreadCreateEngine,(YAP_thread_attr *));
+extern X_API int  PROTO(YAP_ThreadAttachEngine,(int));
+extern X_API int  PROTO(YAP_ThreadDetachEngine,(int));
+extern X_API int  PROTO(YAP_ThreadDestroyEngine,(int));
+
+/*  term comparison */
+extern X_API int  PROTO(YAP_CompareTerms,(YAP_Term, YAP_Term));
 
 #define YAP_InitCPred(N,A,F)  YAP_UserCPredicate(N,F,A)
 

include/yap_structs.h

@@ -34,6 +34,8 @@ typedef int YAP_Bool;
 
 typedef YAP_CELL YAP_Term;
 
+typedef YAP_Term YAP_Module;
+
 typedef struct FunctorEntry *YAP_Functor;
 
 typedef struct AtomEntry *YAP_Atom;
@@ -101,6 +103,7 @@ typedef struct {
 typedef struct {
   unsigned long int		    ssize;
   unsigned long int		    tsize;
+  YAP_Term		   alias;
   int		   (*cancel)(int);
 } YAP_thread_attr;
 

library/Makefile.in

@@ -39,6 +39,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
 	$(srcdir)/rbtrees.yap \
 	$(srcdir)/regexp.yap \
 	$(srcdir)/splay.yap \
+	$(srcdir)/swi.yap \
 	$(srcdir)/system.yap \
 	$(srcdir)/terms.yap \
 	$(srcdir)/tries.yap \

library/system.yap

@@ -42,7 +42,7 @@
 	system/0,
 	system/1,
 	system/2,
-	time/1,
+	mktime/2,
 	tmpnam/1,
 	wait/2,
 	working_directory/2
@@ -58,6 +58,32 @@ datime(X) :-
 	datime(X, Error),
 	handle_system_error(Error, off, datime(X)).
  
+mktime(V, A) :- var(V), !,
+	throw(error(instantiation_error,mktime(V,A))).
+mktime(In,Out) :-
+	check_mktime_inp(In, mktime(In,Out)),
+	In = datime(Y,Mo,D,H,Mi,S),
+	mktime(Y, Mo, D, H, Mi, S, Out, Error),
+	handle_system_error(Error, off, mktime(In,Out)).
+ 
+check_mktime_inp(V, Inp) :- var(V), !,
+	throw(error(instantiation_error,Inp)).
+check_mktime_inp(datime(Y,Mo,D,H,Mi,S), Inp) :- !,
+	check_int(Y, Inp),
+	check_int(Mo, Inp),
+	check_int(D, Inp),
+	check_int(H, Inp),
+	check_int(Mi, Inp),
+	check_int(S, Inp).
+check_mktime_inp(T, Inp) :-
+	throw(error(domain_error(mktime,T),Inp)).
+	
+check_int(I, _) :- integer(I), !.
+check_int(I, Inp) :- var(I),
+	throw(error(instantiation_error,Inp)).
+check_int(I, Inp) :-
+	throw(error(type_error(integer,I),Inp)).
+
 % file operations
 
 delete_file(File) :-

library/system/sys.c

@@ -8,8 +8,11 @@
 *									 *
 **************************************************************************
 *									 *
-* $Id: sys.c,v 1.20 2004-07-23 19:02:09 vsc Exp $									 *
+* $Id: sys.c,v 1.21 2004-08-11 16:14:54 vsc Exp $									 *
 * mods:		$Log: not supported by cvs2svn $
+* mods:		Revision 1.20  2004/07/23 19:02:09  vsc
+* mods:		misc fixes
+* mods:		
 * mods:		Revision 1.19  2004/07/23 03:37:17  vsc
 * mods:		fix heap overflow in YAP_LookupAtom
 * mods:		
@@ -97,6 +100,66 @@ WinError(void)
 }
 #endif
 
+/* Return time in a structure */
+static int
+sysmktime(void)
+{
+
+#if defined(__MINGW32__) || _MSC_VER
+  SYSTEMTIME stime, stime0;
+  FILETIME ftime, ftime0;
+
+  stime.wYear = YAP_IntOfTerm(YAP_ARG1);
+  stime.wMonth = YAP_IntOfTerm(YAP_ARG2);
+  stime.wDay = YAP_IntOfTerm(YAP_ARG3);
+  stime.wHour = YAP_IntOfTerm(YAP_ARG4);
+  stime.wMinute = YAP_IntOfTerm(YAP_ARG5);
+  stime.wSecond = YAP_IntOfTerm(YAP_ARG6);
+  stime.wMilliseconds = 0;
+  stime0.wYear = 1970;
+  stime0.wMonth = 1;
+  stime0.wDay = 1;
+  stime0.wHour = 12;
+  stime0.wMinute = 0;
+  stime0.wSecond = 0;
+  stime0.wMilliseconds = 0;
+  if (!SystemTimeToFileTime(&stime,&ftime)) {
+    return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
+  }
+  if (!SystemTimeToFileTime(&stime0,&ftime0)) {
+    return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
+  }
+#if __GNUC__
+  {
+    unsigned long long f1 = (((unsigned long long)ftime.dwHighDateTime)<<32)+(unsigned long long)ftime.dwLowDateTime;
+    unsigned long long f0 = (((unsigned long long)ftime0.dwHighDateTime)<<32)+(unsigned long long)ftime0.dwLowDateTime;
+    return YAP_Unify(YAP_ARG8,YAP_MkIntTerm((long int)((f1-f0)/10000000)));
+  }
+#else
+  return FALSE
+#endif
+#else
+#ifdef HAVE_MKTIME
+  struct tm loc;
+  time_t tim;
+   
+  loc.tm_year = YAP_IntOfTerm(YAP_ARG1)-1900;
+  loc.tm_mon = YAP_IntOfTerm(YAP_ARG2)-1;
+  loc.tm_mday = YAP_IntOfTerm(YAP_ARG3);
+  loc.tm_hour = YAP_IntOfTerm(YAP_ARG4);
+  loc.tm_min = YAP_IntOfTerm(YAP_ARG5);
+  loc.tm_sec = YAP_IntOfTerm(YAP_ARG6);
+
+  if ((tim = mktime(&loc)) < 0) {
+    return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
+  }
+  return YAP_Unify(YAP_ARG7,YAP_MkIntTerm(tim));
+#else
+  oops
+#endif /* HAVE_MKTIME */
+#endif /* WINDOWS */
+}
+
 /* Return time in a structure */
 static int
 datime(void)
@@ -878,6 +941,7 @@ void
 init_sys(void)
 {
   YAP_UserCPredicate("datime", datime, 2);
+  YAP_UserCPredicate("mktime", sysmktime, 8);
   YAP_UserCPredicate("list_directory", list_directory, 3);
   YAP_UserCPredicate("file_property", file_property, 7);
   YAP_UserCPredicate("unlink", p_unlink, 2);

library/yap2swi/Makefile.in

@@ -41,7 +41,7 @@ SOBJS=yap2swi@SHLIB_SUFFIX@
 
 all: $(SOBJS) 
 
-yap2swi.o: $(srcdir)/yap2swi.c
+yap2swi.o: $(srcdir)/yap2swi.c $(srcdir)/yap2swi.h
 	$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/yap2swi.c -o yap2swi.o
 
 @DO_SECOND_LD@@DO_SECOND_LD@%@SHLIB_SUFFIX@: %.o

library/yap2swi/yap2swi.c

@@ -46,7 +46,7 @@ PL_agc_hook(PL_agc_hook_t entry)
    YAP: char* AtomName(Atom) */
 X_API char* PL_atom_chars(atom_t a)	 /* SAM check type */
 {
-  return YAP_AtomName(a);
+  return YAP_AtomName((YAP_Atom)a);
 }
 
 
@@ -108,7 +108,7 @@ X_API int PL_get_atom(term_t ts, atom_t *a)
   YAP_Term t = YAP_GetFromSlot(ts);
   if ( !YAP_IsAtomTerm(t))
     return 0;
-  *a = YAP_AtomOfTerm(t);
+  *a = (atom_t)YAP_AtomOfTerm(t);
   return 1;
 }
 
@@ -323,28 +323,34 @@ X_API int PL_get_module(term_t ts, module_t *m)
   YAP_Term t = YAP_GetFromSlot(ts);
   if (!YAP_IsAtomTerm(t) )
     return 0;
-  *m = YAP_LookupModule(t);
+  *m = (module_t)YAP_LookupModule(t);
   return 1;
 }
 
+/* SWI: int PL_new_module(term_t t, module_t *m) */
+X_API module_t PL_new_module(atom_t at)
+{
+  return (module_t)YAP_CreateModule((YAP_Atom)at);
+}
+
 /* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
    YAP: YAP_Atom YAP_AtomOfTerm(Term) */
 X_API int PL_get_name_arity(term_t ts, atom_t *name, int *arity)
 {
   YAP_Term t = YAP_GetFromSlot(ts);
   if (YAP_IsAtomTerm(t)) {
-    *name = YAP_AtomOfTerm(t);
+    *name = (atom_t)YAP_AtomOfTerm(t);
     *arity = 0;
     return 1;
   }
   if (YAP_IsApplTerm(t)) {
     YAP_Functor f = YAP_FunctorOfTerm(t);
-    *name = YAP_NameOfFunctor(f);
+    *name = (atom_t)YAP_NameOfFunctor(f);
     *arity = YAP_ArityOfFunctor(f);
     return 1;
   }
   if (YAP_IsPairTerm(t)) {
-    *name = YAP_LookupAtom(".");
+    *name = (atom_t)YAP_LookupAtom(".");
     *arity = 2;
     return 1;
   }
@@ -410,16 +416,16 @@ X_API int PL_get_tail(term_t ts, term_t tl)
       */
 X_API atom_t PL_new_atom(const char *c)
 {
-  return YAP_LookupAtom((char *)c);
+  return (atom_t)YAP_LookupAtom((char *)c);
 }
 
 X_API functor_t PL_new_functor(atom_t name, int arity)
 {
   functor_t f;
   if (arity == 0) {
-    f = (functor_t)YAP_MkAtomTerm(name);
+    f = (functor_t)YAP_MkAtomTerm((YAP_Atom)name);
   } else {
-    f = (functor_t)YAP_MkFunctor(name,arity);
+    f = (functor_t)YAP_MkFunctor((YAP_Atom)name,arity);
   }
   return f;
 }
@@ -427,9 +433,9 @@ X_API functor_t PL_new_functor(atom_t name, int arity)
 X_API atom_t PL_functor_name(functor_t f)
 {
   if (YAP_IsAtomTerm(f)) {
-    return YAP_AtomOfTerm(f);
+    return (atom_t)YAP_AtomOfTerm(f);
   } else {
-    return YAP_NameOfFunctor((YAP_Functor)f);
+    return (atom_t)YAP_NameOfFunctor((YAP_Functor)f);
   }
 }
 
@@ -494,7 +500,7 @@ X_API void PL_cons_list(term_t d, term_t h, term_t t)
 
 X_API void PL_put_atom(term_t t, atom_t a)
 {
-  YAP_PutInSlot(t,YAP_MkAtomTerm(a));
+  YAP_PutInSlot(t,YAP_MkAtomTerm((YAP_Atom)a));
 }
 
 X_API void PL_put_atom_chars(term_t t, const char *s)
@@ -531,6 +537,11 @@ X_API void PL_put_list(term_t t)
   YAP_PutInSlot(t,YAP_MkNewPairTerm());
 }
 
+X_API void PL_put_list_chars(term_t t, const char *s)
+{
+  YAP_PutInSlot(t,YAP_BufferToString((char *)s));
+}
+
 X_API void PL_put_nil(term_t t)
 {
   YAP_PutInSlot(t,YAP_MkAtomTerm(YAP_LookupAtom("[]")));
@@ -583,7 +594,7 @@ X_API int PL_unify(term_t t1, term_t t2)
    YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_atom(term_t t, atom_t at)
 {
-  YAP_Term cterm = YAP_MkAtomTerm(at);
+  YAP_Term cterm = YAP_MkAtomTerm((YAP_Atom)at);
   return YAP_Unify(YAP_GetFromSlot(t),cterm);
 }
 
@@ -679,7 +690,7 @@ get_term(arg_types **buf)
     t = YAP_MkVarTerm();
     break;
   case PL_ATOM:
-    t = YAP_MkAtomTerm(ptr->arg.a);
+    t = YAP_MkAtomTerm((YAP_Atom)ptr->arg.a);
     break;
   case PL_INTEGER:
     t = YAP_MkIntTerm(ptr->arg.l);
@@ -800,11 +811,38 @@ X_API int PL_unify_term(term_t l,...)
 
 /* end PL_unify_* functions =============================*/
 
+/* SWI: void PL_register_atom(atom_t atom)
+   YAP: NO EQUIVALENT */
+/* SAM TO DO */
+X_API void PL_register_atom(atom_t atom)
+{
+  YAP_Term ti = YAP_GetValue((YAP_Atom)atom);
+  if (ti == YAP_MkAtomTerm(YAP_LookupAtom("[]"))) {
+    YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(1));
+  } else if (YAP_IsIntTerm(ti)) {
+    long int i = YAP_IntOfTerm(ti);
+    YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(i++));
+  }
+}
+
 /* SWI: void PL_unregister_atom(atom_t atom)
    YAP: NO EQUIVALENT */
 /* SAM TO DO */
 X_API void PL_unregister_atom(atom_t atom)
 {
+  YAP_Term ti = YAP_GetValue((YAP_Atom)atom);
+  if (YAP_IsIntTerm(ti)) {
+    long int i = YAP_IntOfTerm(ti);
+    if (i == 1)
+      YAP_PutValue((YAP_Atom)atom, YAP_MkAtomTerm(YAP_LookupAtom("[]")));
+    YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(i--));
+  }
+}
+
+X_API int PL_get_string_chars(term_t t, char **s, int *len)
+{
+  /* there are no such objects in Prolog */
+  return FALSE;
 }
 
 X_API int PL_term_type(term_t t)
@@ -907,11 +945,64 @@ X_API int PL_is_variable(term_t ts)
   return YAP_IsVarTerm(t);
 }
 
+X_API int PL_compare(term_t ts1, term_t ts2)
+{
+  YAP_Term t1 = YAP_GetFromSlot(ts1);
+  YAP_Term t2 = YAP_GetFromSlot(ts2);
+  return YAP_CompareTerms(t1, t2);
+}
+
 X_API void PL_halt(int e)
 {
    YAP_Halt(e);
 }
 
+X_API int PL_action(int action,...)
+{
+  va_list ap;
+
+  va_start (ap, action);
+  switch (action) {
+  case PL_ACTION_TRACE:
+    fprintf(stderr, "PL_ACTION_TRACE not supported\n");
+    break;
+  case PL_ACTION_DEBUG:
+    fprintf(stderr, "PL_ACTION_DEBUG not supported\n");
+    break;
+  case PL_ACTION_BACKTRACE:
+    fprintf(stderr, "PL_ACTION_BACKTRACE not supported\n");
+    break;
+  case PL_ACTION_HALT:
+    {
+      int halt_arg = va_arg(ap, int);
+      YAP_Halt(halt_arg);
+    }
+    break;
+  case PL_ACTION_ABORT:
+    {
+      YAP_Throw(YAP_MkAtomTerm(YAP_LookupAtom("abort")));
+    }
+    break;
+  case PL_ACTION_BREAK:
+    fprintf(stderr, "PL_ACTION_BREAK not supported\n");
+    break;
+  case PL_ACTION_GUIAPP:
+    fprintf(stderr, "PL_ACTION_GUIAPP not supported\n");
+    break;
+  case PL_ACTION_WRITE:
+    fprintf(stderr, "PL_ACTION_WRITE not supported\n");
+    break;
+  case PL_ACTION_FLUSH:
+    fprintf(stderr, "PL_ACTION_WRITE not supported\n");
+    break;
+  case PL_ACTION_ATTACH_CONSOLE:
+    fprintf(stderr, "PL_ACTION_WRITE not supported\n");
+    break;
+  }
+  va_end (ap);
+  return 0;
+}
+
 X_API fid_t
 PL_open_foreign_frame(void)
 {
@@ -944,7 +1035,7 @@ PL_exception(qid_t q)
 }
 
 X_API int
-PL_initialise(int myargc, char **myargv, char **myenviron)
+PL_initialise(int myargc, char **myargv)
 {
   YAP_init_args init_args;
 
@@ -964,13 +1055,19 @@ PL_initialise(int myargc, char **myargv, char **myenviron)
   return YAP_Init(&init_args);
 }
 
+X_API int
+PL_is_initialised(int *argc, char ***argv)
+{
+  return TRUE;
+}
+
 X_API predicate_t PL_pred(functor_t f, module_t m)
 {
   if (YAP_IsAtomTerm(f)) {
-    return YAP_Predicate(YAP_AtomOfTerm(f),0,m);
+    return YAP_Predicate(YAP_AtomOfTerm(f),0,(YAP_Module)m);
   } else {
     YAP_Functor tf = (YAP_Functor)f;
-    return YAP_Predicate(YAP_NameOfFunctor(tf),YAP_ArityOfFunctor(tf),m);
+    return YAP_Predicate(YAP_NameOfFunctor(tf),YAP_ArityOfFunctor(tf),(YAP_Module)m);
   }
 }
 
@@ -988,7 +1085,7 @@ X_API predicate_t PL_predicate(const char *name, int arity, const char *m)
 
 X_API void PL_predicate_info(predicate_t p,atom_t *name, int *arity, module_t *m)
 {
-  YAP_PredicateInfo(p, name, (unsigned long int  *)arity, (int *)m);
+  YAP_PredicateInfo(p, (YAP_Atom *)name, (unsigned long int  *)arity, (YAP_Module *)m);
 }
 
 typedef struct open_query_struct {
@@ -1003,7 +1100,7 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
 {
   atom_t name;
   unsigned long int  arity;
-  int  m;
+  YAP_Module  m;
   YAP_Term t[2];
 
   /* ignore flags  and module for now */
@@ -1012,12 +1109,12 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
   }
   execution.open=1;
   execution.state=0;
-  YAP_PredicateInfo(p, &name, &arity, &m);
+  YAP_PredicateInfo(p, (YAP_Atom *)&name, &arity, &m);
   t[0] = YAP_ModuleName(m);
   if (arity == 0) {
-    t[1] = YAP_MkAtomTerm(name);
+    t[1] = YAP_MkAtomTerm((YAP_Atom)name);
   } else {
-    YAP_Functor f = YAP_MkFunctor(name, arity);
+    YAP_Functor f = YAP_MkFunctor((YAP_Atom)name, arity);
     t[1] = YAP_MkApplTerm(f,arity,YAP_AddressFromSlot(t0));
   }
   execution.g = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom(":"),2),2,t);
@@ -1068,7 +1165,7 @@ X_API int PL_call_predicate(module_t ctx, int flags, predicate_t p, term_t t0)
 X_API int PL_call(term_t tp, module_t m)
 {
   YAP_Term t[2], g;
-  t[0] = YAP_ModuleName(m);
+  t[0] = YAP_ModuleName((YAP_Module)m);
   t[1] = YAP_GetFromSlot(tp);
   g = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom(":"),2),2,t);
   return YAP_RunGoal(g);
@@ -1078,7 +1175,16 @@ X_API void PL_register_extensions(PL_extension *ptr)
 {
   /* ignore flags for now */
   while(ptr->predicate_name != NULL) {
-    YAP_UserCPredicateWithArgs(ptr->predicate_name,ptr->function,ptr->arity,YAP_CurrentModule());
+    YAP_UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
+    ptr++;
+  }
+}
+
+X_API void PL_load_extensions(PL_extension *ptr)
+{
+  /* ignore flags for now */
+  while(ptr->predicate_name != NULL) {
+    YAP_UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
     ptr++;
   }
 }
@@ -1090,10 +1196,95 @@ X_API int PL_thread_self(void)
 
 X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr)
 {
-  /*  YAP_thread_attr yap; */
+  int wid = YAP_ThreadSelf();
-  return YAP_ThreadSelf();
+  
+  if (wid < 0) {
+    /* we do not have an engine */
+    if (attr) {
+      YAP_thread_attr yapt;
+      int wid; 
+
+      yapt.ssize = attr->local_size;
+      yapt.tsize = attr->global_size;
+      yapt.alias = (YAP_Term)attr->alias;
+      yapt.cancel =  attr->cancel;
+      wid = YAP_ThreadCreateEngine(&yapt);
+    } else {
+      wid = YAP_ThreadCreateEngine(NULL);
+    }
+    if (wid < 0)
+      return -1;
+    if (YAP_ThreadAttachEngine(wid)) {
+      return wid;
+    }
+    return -1;
+  } else {
+    /* attach myself again */
+    YAP_ThreadAttachEngine(wid);
+    return wid;
+  }
 }
 
+X_API int PL_thread_destroy_engine(void)
+{
+  int wid = YAP_ThreadSelf();
+
+  if (wid < 0) {
+    /* we do not have an engine */
+    return FALSE;
+  }
+  YAP_ThreadDetachEngine(wid);
+  return YAP_ThreadDestroyEngine(wid);
+}
+
+X_API int
+PL_thread_at_exit(void (*function)(void *), void *closure, int global)
+{
+  /* don't do nothing for now */
+  fprintf(stderr,"%% YAP ERROR: PL_thread_at_exit not implemented yet\n");
+  return TRUE;
+}
+
+
+X_API PL_engine_t
+PL_create_engine(const PL_thread_attr_t *attr)
+{
+  if (attr) {
+    YAP_thread_attr yapt;
+
+    yapt.ssize = attr->local_size;
+    yapt.tsize = attr->global_size;
+    yapt.alias = (YAP_Term)attr->alias;
+    yapt.cancel =  attr->cancel;
+    return (PL_engine_t)YAP_ThreadCreateEngine(&yapt);
+  } else {
+    return (PL_engine_t)YAP_ThreadCreateEngine(NULL);
+  }
+}
+
+
+X_API int
+PL_destroy_engine(PL_engine_t e)
+{
+  return YAP_ThreadDestroyEngine((int)e);
+}
+
+X_API int
+PL_set_engine(PL_engine_t engine, PL_engine_t *old)
+{
+  int cwid = YAP_ThreadSelf();
+  if (*old) *old = (PL_engine_t)cwid;
+  if (engine == PL_ENGINE_CURRENT)
+    return PL_ENGINE_SET;
+  if (engine < 0) /* should really check if engine does not exist */
+    return PL_ENGINE_INVAL;
+  if (!(YAP_ThreadAttachEngine((int)engine))) {
+    return PL_ENGINE_INUSE;
+  }
+  return PL_ENGINE_SET;
+}
+
+
 /* note: fprintf may be called from anywhere, so please don't try
    to be smart and allocate stack from somewhere else */
 X_API int Sprintf(char *format,...)
@@ -1114,6 +1305,33 @@ X_API int Sprintf(char *format,...)
 }
 
 
+/* note: fprintf may be called from anywhere, so please don't try
+   to be smart and allocate stack from somewhere else */
+X_API int Sdprintf(char *format,...)
+{
+  va_list ap;
+  char buf[512];
+
+  va_start(ap,format);
+#ifdef HAVE_VSNPRINTF
+  vsnprintf(buf,512,format,ap);
+#else
+  vsprintf(buf,format,ap);
+#endif
+  va_end(ap);
+
+#if DEBUG
+  fputs(buf, stderr);
+#endif
+  return 1;
+}
+
+int
+swi_install(void)
+{
+  return TRUE;
+}
+
 #ifdef _WIN32
 
 #include <windows.h>

library/yap2swi/yap2swi.h

@@ -21,21 +21,22 @@
 #define X_API
 #endif
 
-typedef	unsigned int    fid_t;
+typedef	unsigned long    fid_t;
-typedef	unsigned int    term_t;
+typedef	unsigned long    term_t;
-typedef	int     module_t;
+typedef	void *module_t;
-typedef YAP_Atom	atom_t;
+typedef unsigned long	atom_t;
 typedef	YAP_Term    *predicate_t;
 typedef struct  open_query_struct *qid_t;
 typedef long    functor_t;
 typedef int     (*PL_agc_hook_t)(atom_t);
+typedef unsigned long	foreign_t;	/* return type of foreign functions */
 
-typedef int (*CPredicate)(void);
+typedef void *function_t;
 
 typedef struct _PL_extension
 { char 		*predicate_name;	/* Name of the predicate */
   short		arity;			/* Arity of the predicate */
-  CPredicate	function;		/* Implementing functions */
+  function_t	function;		/* Implementing functions */
   short		flags;			/* Or of PL_FA_... */
 } PL_extension;
 
@@ -49,6 +50,8 @@ typedef struct
   void *	    reserved[5];	/* reserved for extensions */
 } PL_thread_attr_t;
 
+typedef void *PL_engine_t;
+
 
 #define PL_FA_NOTRACE		(0x01)	/* foreign cannot be traced */
 #define PL_FA_TRANSPARENT	(0x02)	/* foreign is module transparent */
@@ -95,10 +98,27 @@ typedef struct
 #define BUF_RING	0x0100
 #define BUF_MALLOC	0x0200
 
+#define PL_ENGINE_CURRENT   ((PL_engine_t)-1)
+
+#define PL_ENGINE_SET   0               /* engine set successfully */
+#define PL_ENGINE_INVAL 2               /* engine doesn't exist */
+#define PL_ENGINE_INUSE 3               /* engine is in use */
+
+#define	PL_ACTION_TRACE		1	/* switch to trace mode */
+#define PL_ACTION_DEBUG		2	/* switch to debug mode */
+#define PL_ACTION_BACKTRACE	3	/* show a backtrace (stack dump) */
+#define PL_ACTION_BREAK		4	/* create a break environment */
+#define PL_ACTION_HALT		5	/* halt Prolog execution */
+#define PL_ACTION_ABORT		6	/* generate a Prolog abort */
+					/* 7: Obsolete PL_ACTION_SYMBOLFILE */
+#define PL_ACTION_WRITE		8	/* write via Prolog i/o buffer */
+#define PL_ACTION_FLUSH		9	/* Flush Prolog i/o buffer */
+#define PL_ACTION_GUIAPP	10	/* Win32: set when this is a gui */
+#define PL_ACTION_ATTACH_CONSOLE 11	/* MT: Attach a console */
+
 /* end from pl-itf.h */
 
 /* copied from old SICStus/SWI interface */
-typedef int foreign_t;
 typedef void install_t;
 
 extern X_API PL_agc_hook_t PL_agc_hook(PL_agc_hook_t);
@@ -109,7 +129,7 @@ extern X_API term_t PL_new_term_refs(int);
 extern X_API void PL_reset_term_refs(term_t);
 /* begin PL_get_* functions =============================*/
 extern X_API int PL_get_arg(int, term_t, term_t);
-extern X_API int PL_get_atom(term_t, YAP_Atom *);
+extern X_API int PL_get_atom(term_t, atom_t *);
 extern X_API int PL_get_atom_chars(term_t, char **);
 extern X_API int PL_get_chars(term_t, char **, unsigned);
 extern X_API int PL_get_functor(term_t, functor_t *);
@@ -120,6 +140,7 @@ extern X_API int PL_get_list(term_t, term_t, term_t);
 extern X_API int PL_get_long(term_t, long *);
 extern X_API int PL_get_list_chars(term_t, char **, unsigned);
 extern X_API int PL_get_module(term_t, module_t *);
+extern X_API module_t PL_new_module(atom_t);
 extern X_API int PL_get_name_arity(term_t, atom_t *, int *);
 extern X_API int PL_get_nil(term_t);
 extern X_API int PL_get_pointer(term_t, void **);
@@ -142,11 +163,13 @@ extern X_API void PL_put_float(term_t, double);
 extern X_API void PL_put_functor(term_t, functor_t t);
 extern X_API void PL_put_integer(term_t, long);
 extern X_API void PL_put_list(term_t);
+extern X_API void PL_put_list_chars(term_t, const char *);
 extern X_API void PL_put_nil(term_t);
 extern X_API void PL_put_pointer(term_t, void *);
 extern X_API void PL_put_string_chars(term_t, const char *);
 extern X_API void PL_put_term(term_t, term_t);
 extern X_API void PL_put_variable(term_t);
+extern X_API int PL_compare(term_t, term_t);
 /* end PL_put_* functions =============================*/
 /* begin PL_unify_* functions =============================*/
 extern X_API int PL_unify(term_t, term_t);
@@ -175,11 +198,13 @@ extern X_API int PL_is_variable(term_t);
 extern X_API int PL_term_type(term_t);
 /* end PL_is_* functions =============================*/
 extern X_API void PL_halt(int);
-extern X_API int  PL_initialise(int, char **, char **);
+extern X_API int  PL_initialise(int, char **);
+extern X_API int  PL_is_initialised(int *, char ***);
 extern X_API void PL_close_foreign_frame(fid_t);
 extern X_API void PL_discard_foreign_frame(fid_t);
 extern X_API fid_t PL_open_foreign_frame(void);
 extern X_API int PL_raise_exception(term_t);
+extern X_API void PL_register_atom(atom_t);
 extern X_API void PL_unregister_atom(atom_t);
 extern X_API predicate_t PL_pred(functor_t, module_t);
 extern X_API predicate_t PL_predicate(const char *, int, const char *);
@@ -192,11 +217,21 @@ extern X_API term_t PL_exception(qid_t);
 extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
 extern X_API int PL_call(term_t, module_t);
 extern X_API void PL_register_extensions(PL_extension *);
+extern X_API void PL_load_extensions(PL_extension *);
 extern X_API int  PL_thread_self(void);
 extern X_API int PL_thread_attach_engine(const PL_thread_attr_t *);
+extern X_API int PL_thread_destroy_engine(void);
+extern X_API int PL_thread_at_exit(void (*)(void *), void *, int);
+extern X_API PL_engine_t PL_create_engine(const PL_thread_attr_t *);
+extern X_API int PL_destroy_engine(PL_engine_t);
+extern X_API int PL_set_engine(PL_engine_t,PL_engine_t *);
+extern X_API int PL_get_string_chars(term_t, char **, int *);
+extern X_API int PL_action(int,...);
+
 
 
 extern X_API int Sprintf(char *,...);
+extern X_API int Sdprintf(char *,...);
 
 
 

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.62 2004-07-28 22:09:02 vsc Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.63 2004-08-11 16:14:55 vsc Exp $	 *
 *************************************************************************/
 
 #include "config.h"
@@ -263,9 +263,9 @@ extern char     Yap_Option[20];
 #elif __svr4__ || defined(__SVR4)
 #define MMAP_ADDR 0x02000000
 #elif defined(_WIN32)
-#define MMAP_ADDR 0x10040000L
+#define MMAP_ADDR 0x00480000L
 #elif defined(__CYGWIN__)
-#define MMAP_ADDR 0x30000000L
+#define MMAP_ADDR 0x00480000L
 #endif
 #endif /* !IN_SECOND_QUADRANT */
 

misc/yap.def

@@ -84,8 +84,11 @@ YAP_UserCPredicate
 YAP_UserBackCPredicate
 YAP_UserCPredicateWithArgs
 YAP_CurrentModule
+YAP_CreateModule
 YAP_ThreadSelf
 YAP_ThreadCreateEngine
 YAP_ThreadAttachEngine
 YAP_ThreadDetachEngine
 YAP_ThreadDestroyEngine
+YAP_CompareTerms
+

pl/utils.yap

@@ -438,7 +438,7 @@ unknown(V0,V) :-
 '$unknown_warning'(P) :-
 	P=M:F,
 	functor(F,Na,Ar),
-	'$print_message'(existence_error(P,0,procedure,M:F,0), [P,M,Na,Ar]),
+	'$print_message'(error,error(existence_error(procedure,M:Na/Ar), [P])),
 	fail.
 
 %%% Some "dirty" predicates
@@ -487,7 +487,13 @@ atom_concat(X,Y,At) :-
 	'$append'(S1,S2,S),
 	atom_codes(At,S).
 
-
+atomic_concat(X,Y,At) :-
+	atom(At), !,
+	atom_length(At,Len),
+	'$atom_contact_split'(At,0,Len,X,Y).
+/* Let atom_chars do our error handling */
+atomic_concat(X,Y,At) :-
+	atomic_concat([X,Y],At).
 
 '$atom_contact_split'(At,Len,Len,X,Y) :- !,
 	'$atom_split'(At,Len,X,Y).