Merge branch 'master' of ssh://yap.git.sf.net/gitroot/yap/yap-6.3

C/bignum.c

@@ -59,6 +59,28 @@ Yap_MkBigIntTerm(MP_INT *big)
   return AbsAppl(ret);
 }
 
+Term
+Yap_AllocExternalDataInStack(size_t bytes)
+{
+  CACHE_REGS
+  Int nlimbs;
+  MP_INT *dst = (MP_INT *)(H+2);
+  CELL *ret = H;
+
+  nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
+  if (nlimbs > (ASP-ret)-1024) {
+    return TermNil;
+  }
+  H[0] = (CELL)FunctorBigInt;
+  H[1] = EXTERNAL_BLOB;
+  dst->_mp_size = 0;
+  dst->_mp_alloc = nlimbs;
+  H = (CELL *)(dst+1)+nlimbs;
+  H[0] = EndSpecials;
+  H++;
+  return AbsAppl(ret);
+}
+
 MP_INT *
 Yap_BigIntOfTerm(Term t)
 {

C/c_interface.c

@@ -390,6 +390,7 @@ X_API Bool    STD_PROTO(YAP_IsDbRefTerm,(Term));
 X_API Bool    STD_PROTO(YAP_IsAtomTerm,(Term));
 X_API Bool    STD_PROTO(YAP_IsPairTerm,(Term));
 X_API Bool    STD_PROTO(YAP_IsApplTerm,(Term));
+X_API Bool    STD_PROTO(YAP_IsExternalDataInStackTerm,(Term));
 X_API Term    STD_PROTO(YAP_MkIntTerm,(Int));
 X_API Term    STD_PROTO(YAP_MkBigNumTerm,(void *));
 X_API Term    STD_PROTO(YAP_MkRationalTerm,(void *));
@@ -536,6 +537,8 @@ X_API Term     STD_PROTO(YAP_ModuleUser,(void));
 X_API Int      STD_PROTO(YAP_NumberOfClausesForPredicate,(PredEntry *));
 X_API int      STD_PROTO(YAP_MaxOpPriority,(Atom, Term));
 X_API int      STD_PROTO(YAP_OpInfo,(Atom, Term, int, int *, int *));
+X_API Term     STD_PROTO(YAP_AllocExternalDataInStack,(size_t));
+X_API void    *STD_PROTO(YAP_ExternalDataInStackFromTerm,(Term));
 
 static int (*do_putcf)(wchar_t);
 
@@ -2314,6 +2317,27 @@ YAP_RunGoal(Term t)
   return(out);
 }
 
+X_API Term
+YAP_AllocExternalDataInStack(size_t bytes)
+{
+  Term t = Yap_AllocExternalDataInStack(bytes);
+  if (t == TermNil)
+    return 0L;
+  return t;
+}
+
+X_API Bool
+YAP_IsExternalDataInStackTerm(Term t)
+{
+  return IsExternalBlobTerm(t);
+}
+
+X_API void *
+YAP_ExternalDataInStackFromTerm(Term t)
+{
+  return ExternalBlobFromTerm (t);
+}
+
 X_API Term
 YAP_RunGoalOnce(Term t)
 {

C/heapgc.c

@@ -1325,7 +1325,7 @@ mark_variable(CELL_PTR current USES_REGS)
 	  sz++;
 #if DEBUG
 	  if (next[sz] != EndSpecials)  {
-	    fprintf(stderr,"[ Error: could not find EndSpecials at blob %p type %lx ]\n", next, next[1]);
+	    fprintf(stderr,"[ Error: could not find EndSpecials at blob %p type " UInt_FORMAT " ]\n", next, next[1]);
 	}
 #endif
 	  MARK(next+sz);
@@ -1904,11 +1904,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose
       PredEntry *pe = Yap_PredForChoicePt(gc_B);
 #if defined(ANALYST) || defined(DEBUG)
       if (pe == NULL) {
-	fprintf(GLOBAL_stderr,"%%       marked %ld (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]);
+	fprintf(GLOBAL_stderr,"%%       marked  " UInt_FORMAT " (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]);
       } else if (pe->ArityOfPE) {
-	fprintf(GLOBAL_stderr,"%%       %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, Yap_op_names[opnum]);
+	fprintf(GLOBAL_stderr,"%%       %s/%d marked  " UInt_FORMAT " (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, Yap_op_names[opnum]);
       } else {
-	fprintf(GLOBAL_stderr,"%%       %s marked %ld (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, Yap_op_names[opnum]);
+	fprintf(GLOBAL_stderr,"%%       %s marked  " UInt_FORMAT " (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, Yap_op_names[opnum]);
       }
 #else
       if (pe == NULL) {

H/TermExt.h

@@ -86,7 +86,7 @@ typedef enum
     CLAUSE_LIST =  0x40,
     BLOB_STRING =  0x80, /* SWI style strings */
     BLOB_WIDE_STRING =  0x81, /* SWI style strings */
-    EXTERNAL_BLOB =  0x100 /* for SWI emulation */
+    EXTERNAL_BLOB =  0x100 /* generic data */
   } 
 big_blob_type;
 
@@ -438,6 +438,25 @@ IsLargeNumTerm (Term t)
 		    && (FunctorOfTerm (t) >= FunctorLongInt)));
 }
 
+inline EXTERN int IsExternalBlobTerm (Term);
+
+inline EXTERN int
+IsExternalBlobTerm (Term t)
+{
+  return (int) (IsApplTerm (t) &&
+		FunctorOfTerm (t) == FunctorBigInt &&
+		RepAppl(t)[1] == EXTERNAL_BLOB);
+}
+
+inline EXTERN void *ExternalBlobFromTerm (Term);
+
+inline EXTERN void *
+ExternalBlobFromTerm (Term t)
+{
+  MP_INT *base = (MP_INT *)(RepAppl(t)+2);
+  return (void *) (base+1);
+}
+
 
 
 

H/Yapproto.h

@@ -120,6 +120,7 @@ int    STD_PROTO(Yap_IsStringTerm, (Term));
 int    STD_PROTO(Yap_IsWideStringTerm, (Term));
 Term   STD_PROTO(Yap_RatTermToApplTerm, (Term));
 void   STD_PROTO(Yap_InitBigNums, (void));
+Term   STD_PROTO(Yap_AllocExternalDataInStack, (size_t));
 
 /* c_interface.c */
 Int    STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));

MYDDAS/myddas_odbc.c

@@ -154,18 +154,6 @@ static int SQLBINDCOL(SQLHSTMT       sthandle,
   return TRUE;
 }
 
-static int SQLFREESTMT(SQLHSTMT       sthandle,
-		       SQLUSMALLINT   opt,
-		       char *         print)
-{                                                                 
-  SQLRETURN retcode;                                              
-  retcode = SQLFreeStmt(sthandle,opt);
-
-  if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) 
-    return odbc_error(SQL_HANDLE_STMT, sthandle, "SQLFreeStmt", print);
-  return TRUE;
-}
-
 static int SQLNUMRESULTCOLS(SQLHSTMT        sthandle,
 			    SQLSMALLINT *   ncols,
 			    char *          print)
@@ -421,8 +409,9 @@ c_db_odbc_query( USES_REGS1 ) {
 	/* +1 because of '\0' */
 	bind_space = malloc(sizeof(char)*(ColumnSizePtr+1));
 	data_info = malloc(sizeof(SQLINTEGER));
-	if (!SQLBINDCOL(hstmt,i,SQL_C_CHAR,bind_space,(ColumnSizePtr+1),data_info,"db_query"))
+	if (!SQLBINDCOL(hstmt,i,SQL_C_CHAR,bind_space,(ColumnSizePtr+1),data_info,"db_query")) {
 	  return FALSE;
+	}
 	
 	properties[0] = MkIntegerTerm((Int)bind_space);
 	properties[2] = MkIntegerTerm((Int)data_info);
@@ -444,7 +433,7 @@ c_db_odbc_query( USES_REGS1 ) {
     {
       if (!SQLCLOSECURSOR(hstmt,"db_query"))
 	return FALSE;
-      if (!SQLFREESTMT(hstmt,SQL_CLOSE,"db_query"))
+      if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_query"))
 	return FALSE;
       return FALSE;
     }
@@ -466,7 +455,7 @@ c_db_odbc_number_of_fields( USES_REGS1 ) {
   char sql[256];
   SQLSMALLINT number_fields;
 
-  sprintf(sql,"DESCRIBE %s",relation);
+  sprintf(sql,"SELECT column_name from INFORMATION_SCHEMA.COLUMNS where table_name = \'%s\'",relation);
   
   if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_number_of_fields"))
     return FALSE;
@@ -482,7 +471,7 @@ c_db_odbc_number_of_fields( USES_REGS1 ) {
   
   if (!SQLCLOSECURSOR(hstmt,"db_number_of_fields"))
     return FALSE;
-  if (!SQLFREESTMT(hstmt,SQL_CLOSE,"db_number_of_fields"))
+  if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_number_of_fields"))
     return FALSE;
   
   if (!Yap_unify(arg_fields, MkIntegerTerm(number_fields)))
@@ -506,7 +495,7 @@ c_db_odbc_get_attributes_types( USES_REGS1 ) {
   Term head, list;
   list = arg_types_list;
 
-  sprintf(sql,"DESCRIBE %s",relation);
+  sprintf(sql,"SELECT column_name,data_type FROM INFORMATION_SCHEMA.COLUMNS where table_name = \'%s\'",relation);
 
   if (!SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_get_attributes_types"))
     return FALSE;
@@ -547,7 +536,7 @@ c_db_odbc_get_attributes_types( USES_REGS1 ) {
   
   if (!SQLCLOSECURSOR(hstmt,"db_get_attributes_types"))
     return FALSE;
-  if (!SQLFREESTMT(hstmt,SQL_CLOSE, "db_get_attributes_types"))
+  if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_get_attributes_types"))
     return FALSE;
   return TRUE;
 }
@@ -585,12 +574,31 @@ c_db_odbc_row_cut( USES_REGS1 ) {
   
   if (!SQLCLOSECURSOR(hstmt,"db_row_cut"))
     return FALSE; 
-  if (!SQLFREESTMT(hstmt,SQL_CLOSE,"db_row_cut"))
+  if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_row_cut"))
     return FALSE; 
    
   return TRUE;
 }
 
+static int
+release_list_args(Term arg_list_args, Term arg_bind_list, const char *error_msg)
+{
+  Term list = arg_list_args;
+  Term list_bind = arg_bind_list;
+  
+  while (IsPairTerm(list_bind))
+    {
+      Term head_bind = HeadOfTerm(list_bind);
+
+      list = TailOfTerm(list);
+      list_bind = TailOfTerm(list_bind);
+      
+      free((char *)IntegerOfTerm(ArgOfTerm(1,head_bind)));
+      free((SQLINTEGER *)IntegerOfTerm(ArgOfTerm(3,head_bind)));
+    }
+  return TRUE;
+}
+
 /* db_row: ResultSet x BindList x ListOfArgs -> */
 static Int
 c_db_odbc_row( USES_REGS1 ) {
@@ -611,8 +619,11 @@ c_db_odbc_row( USES_REGS1 ) {
     {
       if (!SQLCLOSECURSOR(hstmt,"db_row"))
 	return FALSE; 
-      if (!SQLFREESTMT(hstmt,SQL_CLOSE,"db_row"))
+      if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_row"))
 	return FALSE; 
+      if (!release_list_args(arg_list_args, arg_bind_list, "db_row")) {
+	return FALSE;
+      }
  
       cut_fail(); 
       return FALSE;
@@ -699,7 +710,7 @@ c_db_odbc_number_of_fields_in_query( USES_REGS1 ) {
   if (!Yap_unify(arg_fields, MkIntegerTerm(number_cols))){
     if (!SQLCLOSECURSOR(hstmt,"db_number_of_fields_in_query"))
       return FALSE;
-    if (!SQLFREESTMT(hstmt,SQL_CLOSE, "db_number_of_fields_in_query"))
+    if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_number_of_fields_in_query"))
       return FALSE;
  
     return FALSE;
@@ -707,7 +718,7 @@ c_db_odbc_number_of_fields_in_query( USES_REGS1 ) {
   
   if (!SQLCLOSECURSOR(hstmt,"db_number_of_fields_in_query"))
     return FALSE;
-  if (!SQLFREESTMT(hstmt,SQL_CLOSE, "db_number_of_fields_in_query"))
+  if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt, "db_number_of_fields_in_query"))
     return FALSE;
  
   return TRUE;
@@ -775,7 +786,7 @@ c_db_odbc_get_fields_properties( USES_REGS1 ) {
 
   if (!SQLCLOSECURSOR(hstmt2,"db_get_fields_properties"))
     return FALSE;
-  if (!SQLFREESTMT(hstmt2,SQL_CLOSE,"db_get_fields_properties"))
+  if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt2, "db_get_fields_properties"))
     return FALSE;
   
   for (i=1;i<=num_fields;i++)
@@ -816,9 +827,8 @@ c_db_odbc_get_fields_properties( USES_REGS1 ) {
   
   if (!SQLCLOSECURSOR(hstmt,"db_get_fields_properties"))
     return FALSE;
-  if (!SQLFREESTMT(hstmt,SQL_CLOSE,"db_get_fields_properties"))
+  if (!SQLFREEHANDLE(SQL_HANDLE_STMT, hstmt2, "db_get_fields_properties"))
     return FALSE;
-    
   return TRUE;
 }
 

docs/yap.tex

@@ -16811,13 +16811,29 @@ only two boolean flags are accepted: @code{YAPC_ENABLE_GC} and
 @code{YAPC_ENABLE_AGC}.  The first enables/disables the standard garbage
 collector, the second does the same for the atom garbage collector.`
 
+@item  @code{YAP_TERM} YAP_AllocExternalDataInStack(@code{size_t bytes})
+@item  @code{void *} YAP_ExternalDataInStackFromTerm(@code{YAP_Term t})
+@item  @code{YAP_Bool} YAP_IsExternalDataInStackTerm(@code{YAP_Term t})
+@findex YAP_AllocExternalDataInStack (C-Interface function)
+
+The next routines allow one to store external data in the Prolog
+execution stack. The first routine reserves space for @var{sz} bytes
+and returns an opaque handle. The second routines receives the handle
+and returns a pointer to the data.  The last routine checks if a term
+is an opaque handle.
+
+Data will be automatically reclaimed during
+backtracking. Also, this storage is opaque to the Prolog garbage compiler,
+so it should not be used to store Prolog terms. On the other hand, it
+may be useful to store arrays in a compact way, or pointers to external objects.
+
 @item  @code{int} YAP_HaltRegisterHook(@code{YAP_halt_hook f, void *closure})
 @findex YAP_HaltRegisterHook (C-Interface function)
 
 Register the function @var{f} to be called if YAP is halted. The
-function is called with two arguments: the exit code of the process (@code{0}
+function is called with two arguments: the exit code of the process
-if this cannot be determined on your operating system) and the closure
+(@code{0} if this cannot be determined on your operating system) and
-argument @var{closure}. 
+the closure argument @var{closure}.
 @c See also @code{at_halt/1}.
 
 @end table
@@ -16850,6 +16866,7 @@ implementing the predicate and @var{arity} is its arity.
 @findex YAP_UserBackCutCPredicate (C-Interface function)
 @findex YAP_PRESERVE_DATA (C-Interface function)
 @findex YAP_PRESERVED_DATA (C-Interface function)
+@findex YAP_PRESERVED_DATA_CUT (C-Interface function)
 @findex YAP_cutsucceed (C-Interface function)
 @findex YAP_cutfail (C-Interface function)
 For the second kind of predicates we need three C functions. The first one
@@ -16915,11 +16932,15 @@ static int start_n100(void)
 @end example
 
 The routine starts by getting the dereference value of the argument.
-The call to @code{YAP_PRESERVE_DATA} is used to initialize the memory which will
+The call to @code{YAP_PRESERVE_DATA} is used to initialize the memory
-hold the information to be preserved across backtracking. The first
+which will hold the information to be preserved across
-argument is the variable we shall use, and the second its type. Note
+backtracking. The first argument is the variable we shall use, and the
-that we can only use @code{YAP_PRESERVE_DATA} once, so often we will
+second its type. Note that we can only use @code{YAP_PRESERVE_DATA}
-want the variable to be a structure.
+once, so often we will want the variable to be a structure. This data
+is visible to the garbage collector, so it should consist of Prolog
+terms, as in the example. It is also correct to store pointers to
+objects external to YAP stacks, as the garbage collector will ignore
+such references.
 
 If the argument of the predicate is a variable, the routine initializes the 
 structure to be preserved across backtracking with the information
@@ -16988,6 +17009,34 @@ when pruning the execution of the predicate, @var{arity} is the
 predicate arity, and @var{sizeof} is the size of the data to be
 preserved in the stack. In this example, we would have something like
 
+@example
+void
+init_n100(void)
+@{
+  YAP_UserBackCutCPredicate("n100", start_n100, continue_n100, cut_n100, 1, 1);
+@}
+@end example
+The argument before last is the predicate's arity. Notice again the
+last argument to the call. function argument gives the extra space we
+want to use for @code{PRESERVED_DATA}. Space is given in cells, where
+a cell is the same size as a pointer. The garbage collector has access
+to this space, hence users should use it either to store terms or to
+store pointers to objects outside the stacks.
+
+The code for @code{cut_n100} could be:
+@example
+static int cut_n100(void)
+@{
+  YAP_PRESERVED_DATA_CUT(n100_data,n100_data_type*);
+
+  fprintf("n100 cut with counter %ld\n", YAP_IntOfTerm(n100_data->next_solution));
+  return TRUE;
+@}
+@end example
+Notice that we have to use @code{YAP_PRESERVED_DATA_CUT}: this is
+because the Prolog engine is at a different state during cut.
+
+If no work is required at cut, we can use:
 @example
 void
 init_n100(void)
@@ -16995,8 +17044,7 @@ init_n100(void)
   YAP_UserBackCutCPredicate("n100", start_n100, continue_n100, NULL, 1, 1);
 @}
 @end example
-Notice that we do not actually need to do anything on receiving a cut in
+in this case no code is executed at cut time.
-this case.
 
 @node Loading Objects, Save&Rest, Writing C, C-Interface
 @section Loading Object Files

include/YapInterface.h

@@ -245,9 +245,9 @@ extern X_API YAP_Bool PROTO(YAP_CallProlog,(YAP_Term t));
 /*  void cut_fail(void) */
 extern X_API void PROTO(YAP_cut_up,(void));
 
-#define YAP_cut_succeed() { YAP_cut_up(); return TRUE; }
+#define YAP_cut_succeed() do { YAP_cut_up(); return TRUE; } while(0)
 
-#define YAP_cut_fail() { YAP_cut_up(); return FALSE; }
+#define YAP_cut_fail() do { YAP_cut_up(); return FALSE; } while(0)
 
 /*  void *AllocSpaceFromYAP_(int) */
 extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));
@@ -555,6 +555,15 @@ extern X_API int PROTO(YAP_MaxOpPriority,(YAP_Atom, YAP_Term));
 /*    int  YAP_OpInfo(Atom, Term, int, int *, int *)  */
 extern X_API int  PROTO(YAP_OpInfo,(YAP_Atom, YAP_Term, int, int *, int *));
 
+/*    YAP_Bool  YAP_IsExternalDataInStackTerm(YAP_Term)  */
+extern X_API YAP_Bool PROTO(YAP_IsExternalDataInStackTerm,(YAP_Term));
+
+/*    Term  YAP_AllocExternalDataInStack(size_t)  */
+extern X_API YAP_Term PROTO(YAP_AllocExternalDataInStack,(size_t));
+
+/*    void  *YAP_ExternalDataInStackFromTerm(YAP_Term)  */
+extern X_API void *PROTO(YAP_ExternalDataInStackFromTerm,(YAP_Term));
+
 #define YAP_InitCPred(N,A,F)  YAP_UserCPredicate(N,F,A)
 
 __END_DECLS

library/MYDDAS/myddas_prolog2sql.ypp

@@ -241,6 +241,8 @@ tokenize_arguments([FirstArg|RestArgs],[TokFirstArg|TokRestArgs]):-
 %
 % --------------------------------------------------------------------------------------
 
+:- dynamic attribute/4.
+
 query_generation([],_,[]).
 
 query_generation([Conjunction|Conjunctions],ProjectionTerm,[Query|Queries]):-
@@ -1157,9 +1159,9 @@ column_atom(att(RangeVar,Attribute),QueryList,Diff):-
    column_atom(Attribute,X2,Diff).
 
 column_atom(rel(Relation,RangeVar),QueryList,Diff):-
-	column_atom('`',QueryList,X0),
+	column_atom('',QueryList,X0),
 	column_atom(Relation,X0,X1),
-	column_atom('` ',X1,X2),
+	column_atom(' ',X1,X2),
 	column_atom(RangeVar,X2,Diff).
 
 column_atom('$const$'(String),QueryList,Diff):-