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
This commit is contained in:
vsc 2008-08-12 01:27:23 +00:00
parent ad67cd43af
commit d170b34624
14 changed files with 119 additions and 90 deletions

View File

@ -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)) {

View File

@ -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);

View File

@ -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

View File

@ -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) */

View File

@ -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);

View File

@ -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

View File

@ -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)

View File

@ -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>

View File

@ -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

View File

@ -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).
prolog:between(I0,I,J) :- I0 < I,
I1 is I0+1,
prolog:between(I1,I,J).
slp(T) :- sleep(T).
prolog:sleep(T) :-
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([], _, []) :- !.
prolog:intersection([X|T], L, Intersect) :-
lists:intersection([], _, []) :- !.
lists:intersection([X|T], L, Intersect) :-
memberchk(X, L), !,
Intersect = [X|R],
prolog:intersection(T, L, R).
prolog:intersection([_|T], L, R) :-
prolog:intersection(T, L, R).
lists:intersection(T, L, R).
lists: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.

View File

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

View File

@ -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).

View File

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

View File

@ -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).