allow copying a chunk of floats to a list in a single operation. Also

improve performance of sum out operation on arrays.

C/c_interface.c

@@ -441,6 +441,7 @@ X_API void   *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
 X_API void    STD_PROTO(YAP_FreeSpaceFromYap,(void *));
 X_API int     STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
 X_API Term    STD_PROTO(YAP_ReadBuffer, (char *,Term *));
+X_API Term    STD_PROTO(YAP_FloatsToList, (double *, size_t));
 X_API Term    STD_PROTO(YAP_BufferToString, (char *));
 X_API Term    STD_PROTO(YAP_NBufferToString, (char *, size_t));
 X_API Term    STD_PROTO(YAP_WideBufferToString, (wchar_t *));
@@ -966,7 +967,7 @@ YAP_MkPairTerm(Term t1, Term t2)
   Term t; 
   BACKUP_H();
 
-  if (H > ASP-1024) {
+  while (H > ASP-1024) {
     Int sl1 = Yap_InitSlot(t1 PASS_REGS);
     Int sl2 = Yap_InitSlot(t2 PASS_REGS);
     RECOVER_H();
@@ -3538,6 +3539,41 @@ YAP_cwd(void)
   return buf;
 }
 
+X_API Term
+YAP_FloatsToList(double *dblp, size_t sz)
+{
+  CACHE_REGS
+  Term t;
+  CELL *oldH;
+  BACKUP_H();
+
+  if (!sz)
+    return TermNil;
+  while (ASP-1024 < H + sz*(2+2+SIZEOF_DOUBLE/SIZEOF_LONG_INT)) {
+    if (dblp > H0 && dblp < H) {
+      /* we are in trouble */
+      LOCAL_OpenArray =  dblp;
+    }
+    if (!dogc( PASS_REGS1 )) {
+      RECOVER_H();
+      return 0L;
+    }
+    dblp = LOCAL_OpenArray;
+    LOCAL_OpenArray = NULL;
+  }
+  t = AbsPair(H);
+  while (sz) {
+    oldH = H;
+    H +=2;
+    oldH[0] = MkFloatTerm(*dblp++);
+    oldH[1] = AbsPair(H);
+    sz--;
+  }
+  oldH[1] = TermNil;
+  RECOVER_H();
+  return t;
+}
+
 X_API Term
 YAP_OpenList(int n)
 {
@@ -3545,7 +3581,7 @@ YAP_OpenList(int n)
   Term t;
   BACKUP_H();
 
-  if (H+2*n > ASP-1024) {
+  while (H+2*n > ASP-1024) {
     if (!dogc( PASS_REGS1 )) {
       RECOVER_H();
       return FALSE;

C/compiler.c

@@ -2759,7 +2759,7 @@ c_layout(compiler_struct *cglobs)
 {
   PInstr *savepc = cglobs->BodyStart->nextInst;
   register Ventry *v = cglobs->vtable;
-  Int *up = cglobs->Uses, Arity;
+  Int *up = cglobs->Uses;
   CELL *cop = cglobs->Contents;
   /* tell put_values used in bip optimisation */
   int rn_kills = 0;
@@ -3024,11 +3024,13 @@ c_layout(compiler_struct *cglobs)
       checktemp(arg, rn, ic, cglobs);
       break;
     case safe_call_op:
-      Arity = RepPredProp((Prop) arg)->ArityOfPE;
       /*
 	vsc: The variables will be in use after this!!!!
-	for (rn = 1; rn <= Arity; ++rn)
+	{ 
-	--cglobs->Uses[rn];
+	  UInt Arity = RepPredProp((Prop) arg)->ArityOfPE;
+	  for (rn = 1; rn <= Arity; ++rn)
+	  --cglobs->Uses[rn];
+	}
       */
       break;
     case call_op:

C/grow.c

@@ -158,6 +158,8 @@ SetHeapRegs(int copying_threads USES_REGS)
 #endif
   if (HB)
     HB = PtoGloAdjust(HB);
+  if (LOCAL_OpenArray)
+    LOCAL_OpenArray = PtoGloAdjust(LOCAL_OpenArray);
   if (B)
     B = ChoicePtrAdjust(B);
 #ifdef TABLING

C/heapgc.c

@@ -3432,6 +3432,16 @@ compact_heap( USES_REGS1 )
 	  *dest++ = *current++;
 	}
 	*old_dest = *current;
+	/* if we have are calling from the C-interface, 
+	   we may have an open array when we start the gc */
+	if (LOCAL_OpenArray) {
+	  CELL *start = current + (dest-old_dest);
+	  if (LOCAL_OpenArray < current &&
+	      LOCAL_OpenArray > start) {
+	    UInt off = LOCAL_OpenArray-start;
+	    LOCAL_OpenArray = old_dest+off;
+	  }
+	}
 	*dest++ = EndSpecials;
 #ifdef DEBUG
 	found_marked += (dest-old_dest);

H/dlocals.h

@@ -136,6 +136,8 @@
 #define REMOTE_LastGcTime(wid) REMOTE(wid)->LastGcTime_
 #define LOCAL_LastSSTime LOCAL->LastSSTime_
 #define REMOTE_LastSSTime(wid) REMOTE(wid)->LastSSTime_
+#define LOCAL_OpenArray LOCAL->OpenArray_
+#define REMOTE_OpenArray(wid) REMOTE(wid)->OpenArray_
 
 #define LOCAL_total_marked LOCAL->total_marked_
 #define REMOTE_total_marked(wid) REMOTE(wid)->total_marked_

H/hlocals.h

@@ -76,6 +76,7 @@ typedef struct worker_local {
   YAP_ULONG_LONG  TotGcRecovered_;
   Int  LastGcTime_;
   Int  LastSSTime_;
+  CELL*  OpenArray_;
 
   Int  total_marked_;
   Int  total_oldies_;

H/ilocals.h

@@ -76,6 +76,7 @@ static void InitWorker(int wid) {
   REMOTE_TotGcRecovered(wid) = 0L;
   REMOTE_LastGcTime(wid) = 0L;
   REMOTE_LastSSTime(wid) = 0L;
+  REMOTE_OpenArray(wid) = NULL;
 
   REMOTE_total_marked(wid) = 0L;
   REMOTE_total_oldies(wid) = 0L;

H/rlocals.h

@@ -83,6 +83,7 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
+
 #if defined(GC_NO_TAGS)
 
 #endif

docs/yap.tex

@@ -16493,6 +16493,14 @@ The user-provided string must include a terminating null
 character. Syntax errors will cause returning @code{FALSE} and binding
 @var{error} to a Prolog term.
 
+@findex YAP_FloatsToList (C-Interface function)
+These C-interface functions are useful when converting chunks of data to Prolog:
+@example
+      YAP_Term YAP_FloatsToList(double *@var{buf},size_t @var{sz})
+@end example
+@noindent
+Notice that they are unsafe, and may call the garbage collector.
+
 @node Memory Allocation, Controlling Streams, Manipulating Strings, C-Interface
 @section Memory Allocation
 

include/YapInterface.h

@@ -356,6 +356,8 @@ extern X_API void PROTO(YAP_PutValue,(YAP_Atom, YAP_Term));
 /*  YAP_Term YAP_GetValue(YAP_Atom) */
 extern X_API YAP_Term PROTO(YAP_GetValue,(YAP_Atom));
 
+extern X_API YAP_Term PROTO(YAP_FloatsToList,(YAP_Float *, size_t));
+
 /*  int StringToBuffer(YAP_Term,char *,unsigned int) */
 extern X_API int PROTO(YAP_StringToBuffer,(YAP_Term,char *,unsigned int));
 

library/matrix/matrix.c

@@ -386,17 +386,8 @@ new_floats_matrix_set(void)
 static YAP_Term
 float_matrix_to_list(int *mat) {
   double *data = matrix_double_data(mat, mat[MAT_NDIMS]);
-  int i = 0;
-  YAP_Term tf = YAP_TermNil(), tnil = tf;
 
-  for (i = mat[MAT_SIZE]-1; i>= 0; i--) {
+  return YAP_FloatsToList(data, mat[MAT_SIZE]);
-    tf = YAP_MkPairTerm(YAP_MkFloatTerm(data[i]),tf);
-    if (tf == tnil) {
-      /* error */
-      return tnil;
-    }
-  }
-  return tf;
 }
 
 static YAP_Term
@@ -2259,8 +2250,8 @@ matrix_transpose(void)
 static int
 matrix_select(void)
 {
-  int ndims, i, j, *dims, newdims, prdim, leftarg;
+  int ndims, i, j, newdims, prdim, leftarg, *dims, indx[MAX_DIMS];
-  int indx[MAX_DIMS], nindx[MAX_DIMS];
+  int nindx[MAX_DIMS];
   YAP_Term tpdim, tdimarg, tf;
   int *mat = (int *)YAP_BlobOfTerm(YAP_ARG1), *nmat;
   if (!mat) {
@@ -2282,7 +2273,7 @@ matrix_select(void)
   leftarg = YAP_IntOfTerm(tdimarg);
   for (i=0, j=0; i< ndims; i++) {
     if (i != prdim) {
-      nindx[j]= (mat+MAT_DIMS)[i];
+      nindx[j]= dims[i];
       j++;
     }
   }
@@ -2631,12 +2622,13 @@ matrix_sum_out_logs(void)
   newdims = ndims-1;
   for (i=0, j=0; i< ndims; i++) {
     if (i != prdim) {
-      nindx[j]= (mat+MAT_DIMS)[i];
+      nindx[j]= dims[i];
       j++;
     }
   }
   if (mat[MAT_TYPE] == INT_MATRIX) {
     long int *data, *ndata;
+    int d = 1, j = 0, dd = 1;
 
     /* create a new matrix with the same size */
     tf = new_int_matrix(newdims,nindx,NULL);
@@ -2647,28 +2639,25 @@ matrix_sum_out_logs(void)
     nmat = (int *)YAP_BlobOfTerm(tf);  
     data = matrix_long_data(mat,ndims);
     ndata = matrix_long_data(nmat,newdims);
-    /* create a new matrix with smaller size */
+    while (j < prdim) {
-    for (i=0;i<nmat[MAT_SIZE];i++) 
+      d = d*dims[j];
-      ndata[i] = 0;
+      j++;
-    for (i=0; i< mat[MAT_SIZE]; i++) {
+    }
-      int j, k;
+    dd = d*dims[prdim];
-      /*
+    for (i=0;i<nmat[MAT_SIZE];i++) {
-	not very efficient, we could try to take advantage of the fact
+      int j = i % d + (i/dd)*d;
-	that we usually only change an index at a time
+      ndata[j] = exp(data[i]);
-      */
+    }
-      matrix_get_index(mat, i, indx);
+    for (; i< mat[MAT_SIZE]; i++) {
-      for (j = 0, k=0; j < ndims; j++)  {
+      int j = i % d + (i/dd)*d;
-	if (j != prdim) {
+      ndata[j] += exp(data[i]);
-	  nindx[k++]= indx[j];
-	}
-      }
-      ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
     }
     for (i=0; i< nmat[MAT_SIZE]; i++) {
       ndata[i] = log(ndata[i]);
     }
   } else {
     double *data, *ndata;
+    int d = 1, j = 0, dd = 1;
 
     /* create a new matrix with the same size */
     tf = new_float_matrix(newdims,nindx,NULL);
@@ -2679,22 +2668,18 @@ matrix_sum_out_logs(void)
     nmat = (int *)YAP_BlobOfTerm(tf);  
     data = matrix_double_data(mat,ndims);
     ndata = matrix_double_data(nmat,newdims);
-    /* create a new matrix with smaller size */
+    while (j < prdim) {
-    for (i=0;i<nmat[MAT_SIZE];i++) 
+      d = d*dims[j];
-      ndata[i] = 0.0;
+      j++;
-    for (i=0; i< mat[MAT_SIZE]; i++) {
+    }
-      int j, k;
+    dd = d*dims[prdim];
-      /*
+    for (i=0;i<nmat[MAT_SIZE];i++) {
-	not very efficient, we could try to take advantage of the fact
+      int j = i % d + (i/dd)*d;
-	that we usually only change an index at a time
+      ndata[j] = exp(data[i]);
-      */
+    }
-      matrix_get_index(mat, i, indx);
+    for (; i< mat[MAT_SIZE]; i++) {
-      for (j = 0, k=0; j < ndims; j++)  {
+      int j = i % d + (i/dd)*d;
-	if (j != prdim) {
+      ndata[j] += exp(data[i]);
-	  nindx[k++]= indx[j];
-	}
-      }
-      ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
     }
     for (i=0; i< nmat[MAT_SIZE]; i++) {
       ndata[i] = log(ndata[i]);
@@ -2799,7 +2784,7 @@ matrix_sum_out_logs_several(void)
   return YAP_Unify(YAP_ARG3, tf);
 }
 
-/* given a matrix M and a set of dims, build contract a matrix to follow
+/* given a matrix M and a set of dims, build a matrix to follow
    the new order
 */ 
 static int

misc/LOCALS

@@ -79,6 +79,7 @@ Int				TotGcTime				=0L
 YAP_ULONG_LONG			TotGcRecovered				=0L
 Int				LastGcTime				=0L
 Int				LastSSTime				=0L
+CELL*				OpenArray				=NULL
 
 /* in a single gc */
 Int				total_marked				=0L