MaxOS fixes

Avoid a thread deadlock
improvements to SWI predicates.
make variables_in_term system builtin.


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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2008-08-07 20:51:15 $,$Author: vsc $						 *
+* Last rev:     $Date: 2008-08-12 01:27:22 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.245  2008/08/07 20:51:15  vsc
+* more threadin  fixes
+*
 * Revision 1.244  2008/08/06 23:05:49  vsc
 * fix debugging info
 *
@@ -491,6 +494,15 @@
 #include "cut_c.h"
 #endif
 
+#ifdef PUSH_X
+#else
+
+/* keep X as a global variable */
+
+Term Yap_XREGS[MaxTemps];	/* 29                                     */
+
+#endif
+
 inline static Functor
 AritFunctorOfTerm(Term t) {
   if (IsVarTerm(t)) {

C/amasm.c

@@ -11,8 +11,11 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2008-08-07 20:51:16 $							 *
+* Last rev:     $Date: 2008-08-12 01:27:22 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.103  2008/08/07 20:51:16  vsc
+* more threadin  fixes
+*
 * Revision 1.102  2008/07/11 17:02:07  vsc
 * fixes by Bart and Tom: mostly libraries but nasty one in indexing
 * compilation.
@@ -3119,7 +3122,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 #if defined(THREADS) || defined(YAPOR)
      else
        if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
-	   !(cip->CurrentPred->PredFlags & ThreadLocalPredFlag))
+	   !(cip->CurrentPred->PredFlags & ThreadLocalPredFlag) &&
+	   !clinfo.alloc_found)
 	 code_p = a_e(_unlock_lu, code_p, pass_no);
 #endif
       code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
@@ -3218,7 +3222,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 #if defined(THREADS) || defined(YAPOR)
      else
        if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
-	   !(cip->CurrentPred->PredFlags & ThreadLocalPredFlag))
+	   !(cip->CurrentPred->PredFlags & ThreadLocalPredFlag) &&
+	  !clinfo.alloc_found)
 	code_p = a_e(_unlock_lu, code_p, pass_no);
 #endif
       code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
@@ -3229,7 +3234,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case execute_op:
 #if defined(THREADS) || defined(YAPOR)
       if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
-	  !(cip->CurrentPred->PredFlags & ThreadLocalPredFlag))
+	  !(cip->CurrentPred->PredFlags & ThreadLocalPredFlag) &&
+	  !clinfo.alloc_found)
 	code_p = a_e(_unlock_lu, code_p, pass_no);
 #endif
       code_p = a_p(_execute, &clinfo, code_p, pass_no, cip);

C/arith1.c

@@ -1966,6 +1966,52 @@ p_sign(Term t E_ARGS)
   }
 }
 
+/*
+  unary negation is \
+*/
+static E_FUNC
+p_random(Term t E_ARGS)
+{
+  Functor f = AritFunctorOfTerm(t);
+  union arith_ret v;
+  blob_type bt;
+
+  switch (BlobOfFunctor(f)) {
+  case long_int_e:
+    RINT(Yap_random()*IntegerOfTerm(t));
+  case double_e:
+    Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
+    P = (yamop *)FAILCODE;
+    RERROR();
+#ifdef USE_GMP
+    Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
+    P = (yamop *)FAILCODE;
+    RERROR();
+#endif
+  default:
+    /* we've got a full term, need to evaluate it first */
+    bt = Yap_Eval(t, &v);
+    /* second case, no need no evaluation */
+    switch (bt) {
+    case long_int_e:
+      RINT(Yap_random()*v.Int);
+    case double_e:
+      Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", v.dbl);
+      P = (yamop *)FAILCODE;
+      RERROR();
+#ifdef USE_GMP
+    case big_int_e:
+      Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
+      P = (yamop *)FAILCODE;
+      RERROR();
+#endif
+    default:
+      /* Yap_Error */
+      RERROR();
+    }
+  }
+}
+
 static InitUnEntry InitUnTab[] = {
   {"+", p_uplus},
   {"-", p_uminus},
@@ -1998,6 +2044,7 @@ static InitUnEntry InitUnTab[] = {
   {"float_integer_part", p_fintp},
   {"sign", p_sign},
   {"lgamma", p_lgamma},
+  {"random", p_random},
 };
 
 static Int 

C/threads.c

@@ -897,6 +897,11 @@ p_thread_self(void)
   return Yap_unify(ARG1,MkIntTerm(0));
 }
 
+p_thread_stacks(void)
+{				/* '$thread_runtime'(+P)	 */
+  return FALSE;
+}
+
 static Int 
 p_thread_unlock(void)
 {				/* '$thread_runtime'(+P)	 */

C/utilpreds.c

@@ -172,9 +172,9 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
 	      UNLOCK(entryref->lock);
 	    }
 	    *ptf++ = d0;  /* you can just copy other extensions. */
-	  }
+	  } else
 #endif
-	  else if (!share) {
+	  if (!share) {
 	    UInt sz;
 
 	    *ptf++ = AbsAppl(H);  /* you can just copy other extensions. */
@@ -2105,9 +2105,9 @@ void Yap_InitUtilCPreds(void)
   Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
   Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, HiddenPredFlag);
   Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag|HiddenPredFlag);
-  CurrentModule = TERMS_MODULE;
   Yap_InitCPred("term_variables", 2, p_term_variables, 0);
   Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
+  CurrentModule = TERMS_MODULE;
   Yap_InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag);
   Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
   Yap_InitCPred("variant", 2, p_variant, 0);

H/Regs.h

@@ -10,7 +10,7 @@
 * File:		Regs.h							 *
 * mods:									 *
 * comments:	YAP abstract machine registers				 *
-* version:      $Id: Regs.h,v 1.41 2008-08-08 14:05:34 vsc Exp $	 *
+* version:      $Id: Regs.h,v 1.42 2008-08-12 01:27:22 vsc Exp $	 *
 *************************************************************************/
 
 
@@ -157,7 +157,7 @@ extern REGSTORE *Yap_regp;
 
 /* keep X as a global variable */
 
-Term Yap_XREGS[MaxTemps];	/* 29                                     */
+extern Term Yap_XREGS[MaxTemps];	/* 29                                     */
 
 #define XREGS Yap_XREGS
 

LGPL/JPL/src/jpl.c

@@ -1,4 +1,4 @@
-/*	$Id: jpl.c,v 1.16 2008-05-10 23:24:12 vsc Exp $
+/*	$Id: jpl.c,v 1.17 2008-08-12 01:27:22 vsc Exp $
 
     Part of JPL -- SWI-Prolog/Java interface
 
@@ -1798,6 +1798,8 @@ jni_create_jvm_c(
  /* opt[optn++].optionString = "-Xcheck:jni";    // extra checking of JNI calls */
 #if __YAP_PROLOG__
     opt[optn++].optionString = "-Xmx1512m";    // give java enough space
+    opt[optn++].optionString = "-Djava.awt.headless=true";    // 
+    //    opt[optn++].optionString = "-XstartOnFirstThread";    // 
 #endif
  /* opt[optn++].optionString = "-Xnoclassgc";    // so method/field IDs remain valid (?) */
  /* opt[optn].optionString = "vfprintf"; */
@@ -1827,7 +1829,7 @@ jni_create_jvm_c(
 	? 2				    /* success (JVM already available) */
 	: ( (r=JNI_CreateJavaVM(&jvm,(void**)&env,&vm_args)) == 0
 	  ? 0				    /* success (JVM created OK) */
-	  : ( jvm=NULL, r)		    /* -ve, i.e. some create error */
+	    : ( jvm=NULL, r)		    /* -ve, i.e. some create error */
 	  )
 	);
     }
@@ -1857,7 +1859,7 @@ jni_create_jvm(
 	? 1				    /* already initialised */
 	: ( (r1=jni_create_jvm_c(cp)) < 0
 	    ? r1				    /* err code from JVM-specific routine */
-	  : ( (r2=jni_init()) < 0
+	    :  ( (r2=jni_init()) < 0
 	    ? r2			    /* err code from jni_init() */
 	    : ( r1 == 0			    /* success code from JVM-specific routine */
 	      ? ( DEBUG(0, Sdprintf("[JPL: Java VM created]\n")), r1)

changes-5.1.html

@@ -17,6 +17,8 @@
 
 <h2>Yap-5.1.4:</h2>
 <ul>
+<li> .</li>
+<li> NEW: X is random(Int) (SWI compatibility).</li>
 <li> NEW: seletchk/3.</li>
 <li> FIXED: do meta-expansion from undefp.</li>
 <li> FIXED: handle correctly flatten([_,[_]],L).</li>

docs/yap.tex

@@ -3757,6 +3757,16 @@ Hyperbolic arc cosine.
 @item atanh(@var{X})
 Hyperbolic arc tangent.
 
+@item lgamma(@var{X}) [ISO]
+gamma function.
+
+@item random(@var{X}) [ISO]
+An integer random number between 0 and @var{X}.
+
+In @code{iso} language mode the argument must be a floating
+point-number, the result is an integer and it the float is equidistant
+it is rounded up, that is, to the least integer greater than @var{X}.
+
 @item integer(@var{X})
 If @var{X} evaluates to a float, the integer between the value of @var{X}
 and 0 closest to the value of @var{X}, else if @var{X} evaluates to an

library/swi.yap

@@ -25,7 +25,8 @@
 
 :- use_module(library(system),
 	      [datime/1,
-	       mktime/2]).
+	       mktime/2,
+	       sleep/1]).
 
 :- use_module(library(arg),
 	      [genarg/3]).
@@ -248,10 +249,10 @@ prolog:read_clause(X,Y) :-
 
 prolog:string(_) :- fail.
 
-prolog:between(I,_,I).
+slp(T) :- sleep(T).
-prolog:between(I0,I,J) :- I0 < I, 
+
-	I1 is I0+1,
+prolog:sleep(T) :-
-	prolog:between(I1,I,J).
+	slp(T).
 
 % SWI has a dynamic attribute scheme
 
@@ -322,13 +323,13 @@ prolog:source_location(File,Line) :-
 	prolog_load_context(term_position, '$stream_position'(_,Line,_)).
 
 % copied from SWI lists library.
-prolog:intersection([], _, []) :- !.
+lists:intersection([], _, []) :- !.
-prolog:intersection([X|T], L, Intersect) :-
+lists:intersection([X|T], L, Intersect) :-
 	memberchk(X, L), !, 
 	Intersect = [X|R], 
-	prolog:intersection(T, L, R).
+	lists:intersection(T, L, R).
-prolog:intersection([_|T], L, R) :-
+lists:intersection([_|T], L, R) :-
-	prolog:intersection(T, L, R).
+	lists:intersection(T, L, R).
 
 
 :- op(700, xfx, '=@=').
@@ -392,70 +393,6 @@ maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
 %	True if Goal  can  succesfully  be   applied  to  all  succesive
 %	quadruples of elements of List1..List4
 
-prolog:maplist(Goal, List1, List2, List3, List4) :-
-	maplist2(List1, List2, List3, List4, Goal).
-
-maplist2([], [], [], [], _).
-maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :-
-	call(Goal, Elem1, Elem2, Elem3, Elem4), 
-	maplist2(Tail1, Tail2, Tail3, Tail4, Goal).
-
-% copied from SWI's boot/apply library
-:- module_transparent
-	prolog:maplist/2, 
-	maplist2/2, 
-	prolog:maplist/3, 
-	maplist2/3, 
-	prolog:maplist/4, 
-	maplist2/4, 
-	prolog:maplist/5, 
-	maplist2/5.
-
-%	maplist(:Goal, +List)
-%
-%	True if Goal can succesfully be applied on all elements of List.
-%	Arguments are reordered to gain performance as well as to make
-%	the predicate deterministic under normal circumstances.
-
-prolog:maplist(Goal, List) :-
-	maplist2(List, Goal).
-
-maplist2([], _).
-maplist2([Elem|Tail], Goal) :-
-	call(Goal, Elem), 
-	maplist2(Tail, Goal).
-
-%	maplist(:Goal, ?List1, ?List2)
-%
-%	True if Goal can succesfully be applied to all succesive pairs
-%	of elements of List1 and List2.
-
-prolog:maplist(Goal, List1, List2) :-
-	maplist2(List1, List2, Goal).
-
-maplist2([], [], _).
-maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
-	call(Goal, Elem1, Elem2), 
-	maplist2(Tail1, Tail2, Goal).
-
-%	maplist(:Goal, ?List1, ?List2, ?List3)
-%
-%	True if Goal can succesfully be applied to all succesive triples
-%	of elements of List1..List3.
-
-prolog:maplist(Goal, List1, List2, List3) :-
-	maplist2(List1, List2, List3, Goal).
-
-maplist2([], [], [], _).
-maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
-	call(Goal, Elem1, Elem2, Elem3), 
-	maplist2(Tail1, Tail2, Tail3, Goal).
-
-%	maplist(:Goal, ?List1, ?List2, ?List3, List4)
-%
-%	True if Goal  can  succesfully  be   applied  to  all  succesive
-%	quadruples of elements of List1..List4
-
 prolog:maplist(Goal, List1, List2, List3, List4) :-
 	maplist2(List1, List2, List3, List4, Goal).
 
@@ -474,6 +411,7 @@ prolog:compile_aux_clauses([Cl|Cls]) :-
 	assert_static(M:Cl),
 	prolog:compile_aux_clauses(Cls).
 
+
 %
 % convert from SWI's goal expansion to YAP/SICStus old style goal
 % expansion.

library/terms.yap

@@ -18,8 +18,6 @@
 :- module(terms, [
 	term_hash/2,
 	term_hash/4,
-	term_variables/2,
-	term_variables/3,
 	variant/2,
 	unifiable/3,
 	subsumes/2,

pl/arith.yap

@@ -337,6 +337,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
 '$unary_op_as_integer'(float_integer_part,28).
 '$unary_op_as_integer'(sign,29).
 '$unary_op_as_integer'(lgamma,30).
+'$unary_op_as_integer'(random,31).
 
 '$binary_op_as_integer'(+,0).
 '$binary_op_as_integer'(-,1).

pl/boot.yap

@@ -312,7 +312,9 @@ true :- true.
  '$execute_commands'(C,VL,Con,Source) :-
 	 '$execute_command'(C,VL,Con,Source).
 
- %
+
+
+				%
  %
  %
 

pl/utils.yap

@@ -855,3 +855,9 @@ nb_current(GlobalVariable, Val) :-
 nb_current(GlobalVariable, Val) :-
 	nb_getval(GlobalVariable, Val).
 
+
+between(I,_,I).
+between(I0,I,J) :- I0 < I, 
+	I1 is I0+1,
+	between(I1,I,J).
+