[Xsb-commits] CVS: XSB/emu biassert.c, 1.163, 1.164 builtin.c, 1.314, 1.315 cinterf.h, 1.46, 1.47 error_xsb.c, 1.75, 1.76 loader_xsb.c, 1.72, 1.73

[Terrance S. <ts...@us...>]

Update of /cvsroot/xsb/XSB/emu
In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv442

Modified Files:
	biassert.c builtin.c cinterf.h error_xsb.c loader_xsb.c 
Log Message:

A few minor changes for error handling:

Improved error reporting for predicates that call the new C
convert_to_dyna()

Introduced iso_ptoc_callable_arg(), (for now, used only in convert_to_dyna())



Index: biassert.c
===================================================================
RCS file: /cvsroot/xsb/XSB/emu/biassert.c,v
retrieving revision 1.163
retrieving revision 1.164
diff -u -r1.163 -r1.164
--- biassert.c	16 Mar 2008 22:11:55 -0000	1.163
+++ biassert.c	27 Mar 2008 19:55:15 -0000	1.164
@@ -3916,7 +3916,8 @@
     Cell addr;
     byte termType;
 
-    addr = iso_ptoc_callable(CTXTc 2,"assert");
+    //    addr = iso_ptoc_callable_arg(CTXTc 2, ptoc_string(CTXTc 4),ptoc_int(CTXTc 5));
+    addr = iso_ptoc_callable_arg(CTXTc 2, 4,5);
     psc = term_psc(addr);
     termType = get_type(psc);
     //    printf("here %d %d %d\n",addr,psc,termType);
@@ -3931,9 +3932,9 @@
     }
     else if (termType == T_PRED) 
       xsb_permission_error(CTXTc "modufy","static",ptoc_tag(CTXTc 2),
-			   ptoc_string(CTXTc 3),ptoc_int(CTXTc 4));
+			   ptoc_string(CTXTc 4),ptoc_int(CTXTc 5));
     else 
-      xsb_type_error(CTXTc "callable",ptoc_tag(CTXTc 2),ptoc_string(CTXTc 3),ptoc_int(CTXTc 4));
+      xsb_type_error(CTXTc "callable",ptoc_tag(CTXTc 2),ptoc_string(CTXTc 4),ptoc_int(CTXTc 5));
   }
     break;
 

Index: builtin.c
===================================================================
RCS file: /cvsroot/xsb/XSB/emu/builtin.c,v
retrieving revision 1.314
retrieving revision 1.315
diff -u -r1.314 -r1.315
--- builtin.c	19 Mar 2008 22:58:09 -0000	1.314
+++ builtin.c	27 Mar 2008 19:55:16 -0000	1.315
@@ -325,6 +325,29 @@
   return FALSE;
 }
 
+/* TLS: this one is designed to pass through Prolog register offsets
+   in PredString and arg -- that way ptocs for them need only be done
+   if theres an error */
+inline Cell iso_ptoc_callable_arg(CTXTdeclc int regnum,int PredString,int arg)
+{
+  /* reg is global array in register.h in the single-threaded engine
+   * and is defined as a thread-specific macro in context.h in the
+   * multi-threaded engine
+   */  
+  register Cell addr = cell(reg+regnum);
+
+  /* XSB_Deref and then check the type */
+  XSB_Deref(addr);
+
+  if ((isconstr(addr) && !isboxed(addr)) || isstring(addr) || islist(addr))
+    return addr;
+  else if (isref(addr))  xsb_instantiation_error(CTXTc ptoc_string(CTXTc PredString),
+						 ptoc_int(CTXTc arg));
+  else xsb_type_error(CTXTc "callable",addr,ptoc_string(CTXTc PredString),
+		      ptoc_int(CTXTc arg));
+  return FALSE;
+}
+
 inline void iso_check_var(CTXTdeclc int regnum,const char * PredString) {
   register Cell addr = cell(reg+regnum);
 

Index: cinterf.h
===================================================================
RCS file: /cvsroot/xsb/XSB/emu/cinterf.h,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- cinterf.h	9 Oct 2007 17:15:04 -0000	1.46
+++ cinterf.h	27 Mar 2008 19:55:16 -0000	1.47
@@ -213,6 +213,9 @@
 DllExport extern char* call_conv ptoc_abs(reg_num);
 DllExport extern Cell iso_ptoc_callable(CTXTdeclc int reg_num,const char *PredString);
 						/* defined in builtin.c */
+DllExport extern Cell iso_ptoc_callable_arg(CTXTdeclc int reg_num,
+					    const int PredString, const int arg);
+						/* defined in builtin.c */
 DllExport extern prolog_float call_conv ptoc_float(CTXTdeclc reg_num);
 						/* defined in builtin.c */
 DllExport extern prolog_int call_conv ptoc_int(CTXTdeclc reg_num);	

Index: error_xsb.c
===================================================================
RCS file: /cvsroot/xsb/XSB/emu/error_xsb.c,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -r1.75 -r1.76
--- error_xsb.c	22 Mar 2008 19:17:34 -0000	1.75
+++ error_xsb.c	27 Mar 2008 19:55:16 -0000	1.76
@@ -425,7 +425,15 @@
 }
 
 /*****************/
-/* Operation/Object_type/Culprit */
+/* Operation/Object_type/Culprit 
+
+   When using permission error from the loader, and perhaps elsewhere,
+   there may not be a convenient cell for culprit.  In that case,
+   setting culprit to 0 in the call gives a different error message
+   that does not refer to culprit.  In this case, if desired the
+   culprit can be put in the object string.  This isn't perfect, but
+   it works.
+ */
 void call_conv xsb_permission_error(CTXTdeclc
 				    char *operation,char *object,Cell culprit, 
 				    const char *predicate,int arity) 
@@ -456,7 +464,8 @@
   tptr++;
   bld_string(tptr,string_find(object,1));
   tptr++;
-  if (culprit == (Cell)NULL) bld_int(tptr,0); 
+  //  if (culprit == (Cell)NULL) bld_int(tptr,0); 
+  if (culprit == (Cell)NULL) bld_string(tptr,string_find("",1)); 
   else bld_ref(tptr,culprit);
 
   xsb_throw_internal(CTXTc ball_to_throw,ball_len);

Index: loader_xsb.c
===================================================================
RCS file: /cvsroot/xsb/XSB/emu/loader_xsb.c,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -r1.72 -r1.73
--- loader_xsb.c	18 Feb 2008 20:16:04 -0000	1.72
+++ loader_xsb.c	27 Mar 2008 19:55:17 -0000	1.73
@@ -921,11 +921,17 @@
       /* set data to point to module's psc */
       set_data(ptr->psc_ptr, cur_mod);
       break;
-    case T_DYNA:
+    case T_DYNA: {
+      char culprit[255];
+
       unload_seg(seg_first_inst);
-      xsb_abort("[LOADER] Trying to compile a dynamic predicate, %s/%d",
-		name, arity);
+
+      sprintf(culprit,"dynamic predicate %s/%d",name,arity);
+      xsb_permission_error(CTXTc "compile",culprit,0,"consult",1);
+	//      xsb_abort("[LOADER] Trying to compile a dynamic predicate, %s/%d",
+	//		name, arity);
       return NULL;
+    }
     default:
       unload_seg(seg_first_inst);
       xsb_abort("[LOADER] The predicate %s/%d cannot be loaded", name, arity);