Menu
▾
▴
yap-commits — Logs of commits to the CVS
You can subscribe to this list here.
| 2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(72) |
Jul
(30) |
Aug
(31) |
Sep
(41) |
Oct
(22) |
Nov
(70) |
Dec
(98) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2002 |
Jan
(194) |
Feb
(127) |
Mar
(47) |
Apr
(83) |
May
(154) |
Jun
(149) |
Jul
(49) |
Aug
(64) |
Sep
(98) |
Oct
(104) |
Nov
(99) |
Dec
(109) |
| 2003 |
Jan
(72) |
Feb
(105) |
Mar
(76) |
Apr
(66) |
May
(20) |
Jun
(51) |
Jul
(67) |
Aug
(16) |
Sep
(24) |
Oct
(52) |
Nov
(43) |
Dec
(92) |
| 2004 |
Jan
(16) |
Feb
(145) |
Mar
(137) |
Apr
(140) |
May
(29) |
Jun
(214) |
Jul
(167) |
Aug
(202) |
Sep
(188) |
Oct
(228) |
Nov
(283) |
Dec
(250) |
| 2005 |
Jan
(107) |
Feb
(162) |
Mar
(100) |
Apr
(110) |
May
(144) |
Jun
(19) |
Jul
(23) |
Aug
(127) |
Sep
(20) |
Oct
(76) |
Nov
(85) |
Dec
(171) |
| 2006 |
Jan
(86) |
Feb
(134) |
Mar
(213) |
Apr
(70) |
May
(81) |
Jun
(25) |
Jul
(6) |
Aug
(36) |
Sep
(20) |
Oct
(21) |
Nov
(368) |
Dec
(164) |
| 2007 |
Jan
(239) |
Feb
(126) |
Mar
(148) |
Apr
(24) |
May
(48) |
Jun
(238) |
Jul
(18) |
Aug
(13) |
Sep
(59) |
Oct
(73) |
Nov
(224) |
Dec
(39) |
| 2008 |
Jan
(53) |
Feb
(92) |
Mar
(134) |
Apr
(81) |
May
(53) |
Jun
(210) |
Jul
(31) |
Aug
(38) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2009 |
Jan
(1) |
Feb
(1) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Fabrizio R. <rz...@us...> - 2009-02-06 14:06:45
|
Update of /cvsroot/yap/cplint In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv29179 Modified Files: lpadsld.pl Log Message: Removed printing of memory information Index: lpadsld.pl =================================================================== RCS file: /cvsroot/yap/cplint/lpadsld.pl,v retrieving revision 1.10 retrieving revision 1.11 diff -u -r1.10 -r1.11 --- lpadsld.pl 9 Jun 2008 17:57:30 -0000 1.10 +++ lpadsld.pl 6 Feb 2009 14:06:32 -0000 1.11 @@ -70,7 +70,7 @@ CPUTime1 is CT1/1000, statistics(walltime,[_,WT1]), WallTime1 is WT1/1000, - print_mem, +% print_mem, build_formula(L,Formula,[],Var,0,Conj), length(L,ND), length(Var,NV), @@ -87,7 +87,7 @@ statistics(walltime,[_,WT2]), WallTime2 is WT2/1000 ; - print_mem, +% print_mem, Prob=0.0, statistics(cputime,[_,CT1]), CPUTime1 is CT1/1000, @@ -96,9 +96,9 @@ CPUTime2 =0.0, statistics(walltime,[_,WT2]), WallTime2 =0.0 - ),!, - format(user_error,"~nMemory after inference~n",[]), - print_mem. + ),!. +% format(user_error,"~nMemory after inference~n",[]), +% print_mem. si(GoalsList,ProbL,ProbU,CPUTime):- statistics(cputime,[_,_]), @@ -239,7 +239,7 @@ (setof(DerivE,find_deriv(Evidence,DerivE),LDupE)-> rem_dup_lists(LDupE,[],LE), (setof(DerivGE,find_deriv_GE(LE,Goals,DerivGE),LDupGE)-> - print_mem, +% print_mem, rem_dup_lists(LDupGE,[],LGE), build_formula(LE,FormulaE,[],VarE), var2numbers(VarE,0,NewVarE), @@ -249,15 +249,15 @@ call_compute_prob(NewVarGE,FormulaGE,ProbGE), Prob is ProbGE/ProbE ; - print_mem, +% print_mem, Prob=0.0 ) ; - print_mem, +% print_mem, Prob=undefined - ), - format(user_error,"~nMemory after inference~n",[]), - print_mem. + ). +% format(user_error,"~nMemory after inference~n",[]), +% print_mem. sci(Goals,Evidence,ProbL,ProbU,CPUTime):- statistics(cputime,[_,_]), |
|
From: Fabrizio R. <rz...@us...> - 2009-01-08 19:28:38
|
Update of /cvsroot/yap/cplint/doc In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv13824 Modified Files: manual.html manual.pdf manual.tex Log Message: Corrected links with tilde Index: manual.html =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.html,v retrieving revision 1.7 retrieving revision 1.8 diff -u -r1.7 -r1.8 --- manual.html 8 Dec 2008 12:59:27 -0000 1.7 +++ manual.html 8 Jan 2009 19:28:27 -0000 1.8 @@ -7,7 +7,7 @@ <meta name="originator" content="TeX4ht (http://www.cse.ohio-state.edu/~gurari/TeX4ht/)"> <!-- html --> <meta name="src" content="manual.tex"> -<meta name="date" content="2008-12-08 13:21:00"> +<meta name="date" content="2009-01-08 20:15:00"> <link rel="stylesheet" type="text/css" href="manual.css"> </head><body > @@ -21,7 +21,7 @@ <br /><span class="cmr-12">fab...@un...</span></div><br /> <div class="date" ><span -class="cmr-12">December 8, 2008</span></div> +class="cmr-12">January 8, 2009</span></div> </div> <h3 class="sectionHead"><span class="titlemark">1 </span> <a id="x1-10001"></a>Introduction</h3> @@ -130,13 +130,13 @@ <!--l. 62--><p class="noindent" ><span class="cmtt-10">cplint </span>is distributed in source code in the CVS version of Yap. It includes Prolog and C files. Download it by following the instruction in <a -href="http://www.ncc.up.pt/\protect \unhbox \voidb@x \penalty \@M \relax \unhbox \voidb@x \special {t4ht@+&{35}x00A0{59}}x{}vsc/Yap/downloads.html" > +href="http://www.ncc.up.pt/~vsc/Yap/downloads.html" > http://www.ncc.up.pt/<span class="cmsy-10">~</span>vsc/Yap/downloads.html </a>. <!--l. 64--><p class="indent" > <span class="cmtt-10">cplint </span>requires glu (a subpackage of vis) and glib-2.0. You can download glu from <a -href="http://vlsi.colorado.edu/\protect \unhbox \voidb@x \penalty \@M \relax \unhbox \voidb@x \special {t4ht@+&{35}x00A0{59}}x{}vis/getting_VIS_2.1.html" > http://vlsi.colorado.edu/<span +href="http://vlsi.colorado.edu/~vis/getting_VIS_2.1.html" > http://vlsi.colorado.edu/<span class="cmsy-10">~</span>vis/getting_VIS_2.1.html </a> You can download glib-2.0 (version <span class="cmsy-10">≥ </span>2<span Index: manual.pdf =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.pdf,v retrieving revision 1.7 retrieving revision 1.8 diff -u -r1.7 -r1.8 Binary files /tmp/cvsxjPHDT and /tmp/cvsaozUFd differ Index: manual.tex =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.tex,v retrieving revision 1.12 retrieving revision 1.13 diff -u -r1.12 -r1.13 --- manual.tex 8 Dec 2008 12:59:27 -0000 1.12 +++ manual.tex 8 Jan 2009 19:28:27 -0000 1.13 @@ -59,10 +59,10 @@ \section{Installation} -\texttt{cplint} is distributed in source code in the CVS version of Yap. It includes Prolog and C files. Download it by following the instruction in \href{http://www.ncc.up.pt/~vsc/Yap/downloads.html}{http://www.ncc.up.pt/$\sim$vsc/Yap/downloads.html}. +\texttt{cplint} is distributed in source code in the CVS version of Yap. It includes Prolog and C files. Download it by following the instruction in \href{http://www.ncc.up.pt/\string~vsc/Yap/downloads.html}{http://www.ncc.up.pt/$\sim$vsc/Yap/downloads.html}. \texttt{cplint} requires glu (a subpackage of vis) and glib-2.0. -You can download glu from \href{http://vlsi.colorado.edu/~vis/getting_VIS_2.1.html}{http://vlsi.colorado.edu/$\sim$vis/getting\_VIS\_2.1.html} +You can download glu from \href{http://vlsi.colorado.edu/\string~vis/getting_VIS_2.1.html}{http://vlsi.colorado.edu/$\sim$vis/getting\_VIS\_2.1.html} You can download glib-2.0 (version $\geq 2.0$) from \href{http://www.gtk.org/}{http://www.gtk.org/}. This is a standard GNU package so it is easy to install it using the package management software of your Linux or Cygwin distribution. |
|
From: Fabrizio R. <rz...@us...> - 2008-12-08 12:59:37
|
Update of /cvsroot/yap/cplint/doc In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv6713/doc Modified Files: manual.bbl manual.css manual.html manual.pdf manual.tex Log Message: Added the algorithm PICL for inference in the Independent Choice Logic Index: manual.bbl =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.bbl,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- manual.bbl 15 Nov 2007 12:18:46 -0000 1.1 +++ manual.bbl 8 Dec 2008 12:59:27 -0000 1.2 @@ -1,4 +1,9 @@ \begin{thebibliography}{10} +\bibitem{DBLP:journals/jlp/Poole00} +D. Poole. +\newblock Abducing through negation as failure: stable models within the + independent choice logic. +\newblock {\em Journal of Logic Programming}, 44(1-3):5--35, 2000. \bibitem{DBLP:journals/ngc/AptB91} K.~R. Apt and M.~Bezem. Index: manual.css =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.css,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- manual.css 19 Jun 2008 21:28:33 -0000 1.2 +++ manual.css 8 Dec 2008 12:59:27 -0000 1.3 @@ -11,6 +11,7 @@ .cmtt-10{font-family: monospace;} .cmti-10{ font-style: italic;} p.noindent { text-indent: 0em } +td p.noindent { text-indent: 0em; margin-top:0em; } p.nopar { text-indent: 0em; } p.indent{ text-indent: 1.5em } @media print {div.crosslinks {visibility:hidden;}} @@ -20,6 +21,9 @@ .Canvas { position:relative; } img.math{vertical-align:middle;} li p.indent { text-indent: 0em } +li p:first-child{ margin-top:0em; } +li p:last-child, li div:last-child { margin-bottom:0.5em; } +li p~ul:last-child, li p~ol:last-child{ margin-bottom:0.5em; } .enumerate1 {list-style-type:decimal;} .enumerate2 {list-style-type:lower-alpha;} .enumerate3 {list-style-type:lower-roman;} @@ -32,11 +36,11 @@ td.displaylines {text-align:center; white-space:nowrap;} .centerline {text-align:center;} .rightline {text-align:right;} -div.verbatim {font-family: monospace; white-space: nowrap; } -table.verbatim {width:100%;} +div.verbatim {font-family: monospace; white-space: nowrap; text-align:left; clear:both; } .fbox {padding-left:3.0pt; padding-right:3.0pt; text-indent:0pt; border:solid black 0.4pt; } +div.fbox {display:table} div.center div.fbox {text-align:center; clear:both; padding-left:3.0pt; padding-right:3.0pt; text-indent:0pt; border:solid black 0.4pt; } -table.minipage{width:100%;} +div.minipage{width:100%;} div.center, div.center div.center {text-align: center; margin-left:1em; margin-right:1em;} div.center div {text-align: left;} div.flushright, div.flushright div.flushright {text-align: right;} @@ -53,6 +57,8 @@ div.tabular, div.center div.tabular {text-align: center; margin-top:0.5em; margin-bottom:0.5em; } table.tabular td p{margin-top:0em;} table.tabular {margin-left: auto; margin-right: auto;} +td p:first-child{ margin-top:0em; } +td p:last-child{ margin-bottom:0em; } div.td00{ margin-left:0pt; margin-right:0pt; } div.td01{ margin-left:0pt; margin-right:5pt; } div.td10{ margin-left:5pt; margin-right:0pt; } @@ -90,6 +96,7 @@ table.pmatrix {width:100%;} img.cdots{vertical-align:middle;} .partToc a, .partToc, .likepartToc a, .likepartToc {line-height: 200%; font-weight:bold; font-size:110%;} +.index-item, .index-subitem, .index-subsubitem {display:block} .caption td.id{font-weight: bold; white-space: nowrap; } table.caption {text-align:center;} h1.partHead{text-align: center} @@ -107,7 +114,7 @@ div.author{white-space: nowrap;} .quotation {margin-bottom:0.25em; margin-top:0.25em; margin-left:1em; } .abstract p {margin-left:5%; margin-right:5%;} -table.abstract {width:100%;} +div.abstract {width:100%;} .figure img.graphics {margin-left:10%;} /* end css.sty */ Index: manual.html =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.html,v retrieving revision 1.6 retrieving revision 1.7 diff -u -r1.6 -r1.7 --- manual.html 19 Jun 2008 21:28:33 -0000 1.6 +++ manual.html 8 Dec 2008 12:59:27 -0000 1.7 @@ -7,7 +7,7 @@ <meta name="originator" content="TeX4ht (http://www.cse.ohio-state.edu/~gurari/TeX4ht/)"> <!-- html --> <meta name="src" content="manual.tex"> -<meta name="date" content="2008-06-19 23:25:00"> +<meta name="date" content="2008-12-08 13:21:00"> <link rel="stylesheet" type="text/css" href="manual.css"> </head><body > @@ -19,41 +19,48 @@ <div class="author" ><span class="cmr-12">Fabrizio Riguzzi</span> [...1097 lines suppressed...] - [12]<span class="bibsp">   </span></span><a + <p class="bibitem" ><span class="biblabel"> + [13]<span class="bibsp">   </span></span><a id="XVenVer04-ICLP04-IC"></a>J. Vennekens, S. Verbaeten, and M. Bruynooghe. Logic programs with annotated disjunctions. In <span class="cmti-10">The 20th International Conference on Logic</span> @@ -1030,10 +981,11 @@ class="cmsy-10">~</span>joost/ </a>. </p> - <p class="bibitem"><span class="biblabel"> - [13]<span class="bibsp">   </span></span><a + <p class="bibitem" ><span class="biblabel"> + [14]<span class="bibsp">   </span></span><a id="XCP-logic-unp"></a>Joost Vennekens, Marc Denecker, and Maurice Bruynooge. Extending the role of causality in + probabilistic modeling. <a href="http://www.cs.kuleuven.ac.be/\protect \unhbox \voidb@x \penalty \@M \relax \unhbox \voidb@x \special {t4ht@+&{35}x00A0{59}}x{}joost/cplogic.pdf" > http://www.cs.kuleuven.ac.be/<span class="cmsy-10">~</span>joost/cplogic.pdf Index: manual.pdf =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.pdf,v retrieving revision 1.6 retrieving revision 1.7 diff -u -r1.6 -r1.7 Binary files /tmp/cvsTq9VKG and /tmp/cvs6A3hRp differ Index: manual.tex =================================================================== RCS file: /cvsroot/yap/cplint/doc/manual.tex,v retrieving revision 1.11 retrieving revision 1.12 diff -u -r1.11 -r1.12 --- manual.tex 19 Jun 2008 21:08:31 -0000 1.11 +++ manual.tex 8 Dec 2008 12:59:27 -0000 1.12 @@ -27,15 +27,16 @@ \section{Introduction} -\texttt{cplint} is a suite of programs for reasoning with LPADs \cite{VenVer03-TR,VenVer04-ICLP04-IC} and CP-logic programs \cite{VenDenBru-JELIA06,CP-logic-unp}. +\texttt{cplint} is a suite of programs for reasoning with ICL \cite{DBLP:journals/jlp/Poole00}, LPADs \cite{VenVer03-TR,VenVer04-ICLP04-IC} and CP-logic programs \cite{VenDenBru-JELIA06,CP-logic-unp}. It consists of three Prolog modules for answering queries using goal-oriented procedures plus - three -Prolog modules for answering queries using the definition of the semantics of LPADs and CP-logic. + four +Prolog modules for answering queries using the definition of the semantics of ICL, LPADs and CP-logic. -The modules for answering queries using using goal-oriented procedures are \texttt{lpadsld.pl}, \texttt{lpad.pl} and +The modules for answering queries using using goal-oriented procedures are \texttt{picl.pl}, \texttt{lpadsld.pl}, \texttt{lpad.pl} and \texttt{cpl.pl}: \begin{itemize} +\item \texttt{picl.pl}: computes the probability of a query using a top-down procedure based on SLDNF resolution and is an adaptation of the interpreter for ProbLog \cite{DBLP:conf/ijcai/RaedtKT07}. \item \texttt{lpadsld.pl}: computes the probability of a query using the top-down procedure described in in \cite{Rig-AIIA07-IC} and \cite{Rig-RCRA07-IC}. It is based on SLDNF resolution and is an adaptation of the interpreter for ProbLog \cite{DBLP:conf/ijcai/RaedtKT07}. @@ -56,6 +57,7 @@ \end{itemize} %For program with function symbols, the semantics of LPADs and CP-logic are not defined. However, the interpreter accepts programs with function symbols and, if it does not go into a loop, it returns an answer. What is the meaning of this answer is subject of current study. + \section{Installation} \texttt{cplint} is distributed in source code in the CVS version of Yap. It includes Prolog and C files. Download it by following the instruction in \href{http://www.ncc.up.pt/~vsc/Yap/downloads.html}{http://www.ncc.up.pt/$\sim$vsc/Yap/downloads.html}. @@ -96,6 +98,11 @@ \section{Syntax} +\subsection{ICL} +We use the syntax of Cilog2 \href{http://www.cs.ubc.ca/spider/poole/aibook/code/cilog/CILog2.html}{http://www.cs.ubc.ca/spider/poole/aibook/code/cilog/CILog2.html}. + +ICL theories must be stored in a text file with extension \texttt{.cil}. +\subsection{LPADs and CP\--logic} Disjunction in the head is represented with a semicolon and atoms in the head are separated from probabilities by a colon. For the rest, the usual syntax of Prolog is used. For example, the CP-logic clause $$h_1:p_1\vee \ldots \vee h_n:p_n\leftarrow b_1,\dots,b_m ,\neg c_1,\ldots,\neg c_l$$ @@ -132,11 +139,15 @@ \end{verbatim} The first clause states that if we toss a coin that is not biased it has equal probability of landing heads and tails. The second states that if the coin is biased it has a slightly higher probability of landing heads. The third states that the coin is fair with probability 0.9 and biased with probability 0.1 and the last clause states that we toss a coin with certainty. - +The LPAD or CP-logic program must be stored in a text file with extension \texttt{.cpl}. +\subsection{Conversion Utilities} +The programs \texttt{cil2cpl.pl} and \texttt{cpl2cil.pl} can be used to convert an ICL theory in a \texttt{.cil} file into an LPAD/CP\--logic program in a \texttt{.cpl} file and vice versa. +To do the conversion, load \texttt{cil2cpl.pl} or \texttt{cpl2cil.pl} and call the command +\texttt{c(filename-without-extensions).} \section{Commands} -All six modules accept the same commands for reading in files and answering queries. -The LPAD or CP-logic program must be stored in a text file with extension \texttt{.cpl}. Suppose you have stored the example above in file \texttt{coin.cpl}. +All seven modules accept the same commands for reading in files and answering queries. + Suppose you have stored the example above in file \texttt{coin.cpl}. In order to answer queries from this program, you have to run Yap, load one of the modules (such as for example \texttt{lpad.pl}) by issuing the command \begin{verbatim} @@ -187,7 +198,7 @@ The available parameters are: \begin{itemize} \item - \verb|epsilon_parsing| (valid for all six modules): if (1 - the sum of the probabilities of all the head atoms) is smaller than + \verb|epsilon_parsing| (valid for all seven modules): if (1 - the sum of the probabilities of all the head atoms) is smaller than \verb|epsilon_parsing| then \texttt{cplint} adds the null events to the head. Default value 0.00001 \item \verb|save_dot| (valid for all goal-oriented modules): if \texttt{true} a graph representing the BDD is saved in the file \texttt{cpl.dot} in the current directory in dot format. |
|
From: Fabrizio R. <rz...@us...> - 2008-12-08 12:59:37
|
Update of /cvsroot/yap/cplint In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv6713 Added Files: cil2cpl.pl cpl2cil.pl picl.pl Log Message: Added the algorithm PICL for inference in the Independent Choice Logic --- NEW FILE: cil2cpl.pl --- :- op(1150, xfx, <- ). % <= is the base-level "if" (it is not used here, but can be used in % programs). :- op(1120, xfx, <= ). % "&" is the conjunction. :- op(950,xfy, &). % "~" is the negation :- op(900,fy,~). :- op(1170,fx,prob). c(File):- atom_concat(File,'.cil',FileCil), atom_concat(File,'.cpl',FileCpl), open(FileCil,read,S), read_clauses(C,S), close(S), open(FileCpl,write,SC), write_clauses(C,SC), close(SC). read_clauses([Cl|Out],S):- read_term(S,Cl,[]), (Cl=end_of_file-> Out=[] ; read_clauses(Out,S) ). write_clauses([end_of_file],_S). write_clauses([(H <- B)|T],S):-!, convert_body(B,B1), numbervars((H,B1),0,_N), write(S,H), write(S,':-'), nl(S), write(S,'\t'), write(S,B1), write(S,'.'), nl(S), write_clauses(T,S). write_clauses([(prob B)|T],S):-!, convert_prob(B,B1), numbervars(B1,0,_N), write(S,(B1)), write(S,'.'), nl(S), write_clauses(T,S). write_clauses([H|T],S):-!, numbervars(H,0,_N), write(S,H), write(S,'.'), nl(S), write_clauses(T,S). convert_body((~ A & B),(\+ A,B1)):-!, convert_body(B,B1). convert_body((A & B),(A,B1)):-!, convert_body(B,B1). convert_body(~ A,\+ A):-!. convert_body(A,A). convert_prob((A,T),(A;T1)):-!, convert_prob(T,T1). convert_prob(A,A). --- NEW FILE: cpl2cil.pl --- :- use_module(library(lists)). :- source. :-dynamic setting/2. :- op(1150, xfx, <- ). % <= is the base-level "if" (it is not used here, but can be used in % programs). :- op(1120, xfx, <= ). % "&" is the conjunction. :- op(950,xfy, &). % "~" is the negation :- op(900,fy,~). :- op(1170,fx,prob). setting(ground_body,true). c(File):- atom_concat(File,'.cil',FileCil), atom_concat(File,'.cpl',FileCpl), open(FileCpl,read,S), read_clauses(S,C), close(S), open(FileCil,write,SC), write_clauses(C,1,SC), close(SC). extract_variables([],[]). extract_variables([_V=X|V],[X|V1]):- extract_variables(V,V1). write_clauses([(end_of_file,_)],_N,_S). write_clauses([((H :- B),V)|T],N,S):- H=(_;_),!, list2or(HL,H), numbervars((H,B),0,_N), convert_body(B1,B), name(N,L), write_set_of_clauses(HL,B1,V,L,1,[],S), N1 is N+1, write_clauses(T,N1,S). write_clauses([((H :- B),V)|T],N,S):- H=(_:_),!, numbervars((H,B),0,_N), convert_body(B1,B), name(N,L), write_set_of_clauses([H],B1,V,L,1,[],S), N1 is N+1, write_clauses(T,N1,S). write_clauses([((H :- B),_V)|T],N,S):-!, convert_body(B1,B), numbervars((H,B1),0,_N), write(S,H), write(S,'<-'), nl(S), write(S,'\t'), write(S,B1), write(S,'.'), nl(S), N1 is N+1, write_clauses(T,N1,S). write_clauses([(H,V)|T],N,S):- H=(_;_),!, list2or(HL,H), numbervars(H,0,_N), name(N,L), write_set_of_facts(HL,V,L,1,[],S), N1 is N+1, write_clauses(T,N1,S). write_clauses([(H,V)|T],N,S):- H=(_:_),!, numbervars(H,0,_N), name(N,L), write_set_of_facts([H],V,L,1,[],S), N1 is N+1, write_clauses(T,N1,S). write_clauses([(H,_V)|T],N,S):- numbervars(H,0,_N), write(S,H), write(S,'.'), nl(S), N1 is N+1, write_clauses(T,N1,S). write_set_of_clauses([],_B1,_V,_L,_N,ChL,S):- write(S,'prob '), write_list(S,ChL), write(S,'.'), nl(S). write_set_of_clauses([H:P|T],B,V,L,N,ChL,S):- write(S,H), write(S,'<-'), nl(S), write(S,'\t'), write(S,B), append("c_",L,ChC1), name(N,NL), append(ChC1,"_",ChC2), append(ChC2,NL,ChC), name(Ch,ChC), ChA=..[Ch|V], append(ChL,[ChA:P],ChL1), write(S,' & '), write(S,ChA), write(S,'.'), nl(S), N1 is N+1, write_set_of_clauses(T,B,V,L,N1,ChL1,S). write_set_of_facts([],_V,_L,_N,ChL,S):- write(S,'prob '), write_list(S,ChL), write(S,'.'), nl(S). write_set_of_facts([H:P|T],V,L,N,ChL,S):- write(S,H), write(S,'<-'), nl(S), write(S,'\t'), append("c_",L,ChC1), name(N,NL), append(ChC1,"_",ChC2), append(ChC2,NL,ChC), name(Ch,ChC), ChA=..[Ch|V], append(ChL,[ChA:P],ChL1), write(S,ChA), write(S,'.'), nl(S), N1 is N+1, write_set_of_facts(T,V,L,N1,ChL1,S). write_list(S,[H]):-!, write(S,H). write_list(S,[H|T]):- write(S,H), write(S,', '), write_list(S,T). convert_body((~ A & B),(\+ A,B1)):-!, convert_body(B,B1). convert_body((A & B),(A,B1)):-!, convert_body(B,B1). convert_body(~ A,\+ A):-!. convert_body(A,A). convert_prob((A,T),(A;T1)):-!, convert_prob(T,T1). convert_prob(A,A). /* predicates for reading in the program clauses */ read_clauses(S,Clauses):- (setting(ground_body,true)-> read_clauses_ground_body(S,Clauses) ; read_clauses_exist_body(S,Clauses) ). read_clauses_ground_body(S,[(Cl,V)|Out]):- read_term(S,Cl,[variable_names(V1)]), extract_variables(V1,V), (Cl=end_of_file-> Out=[] ; read_clauses_ground_body(S,Out) ). read_clauses_exist_body(S,[(Cl,V)|Out]):- read_term(S,Cl,[variable_names(VN)]), extract_vars_cl(Cl,VN,V1), extract_variables(V1,V), (Cl=end_of_file-> Out=[] ; read_clauses_exist_body(S,Out) ). extract_vars_cl(end_of_file,[]). extract_vars_cl(Cl,VN,Couples):- (Cl=(H:-_B)-> true ; H=Cl ), extract_vars(H,[],V), pair(VN,V,Couples). pair(_VN,[],[]). pair([VN= _V|TVN],[V|TV],[VN=V|T]):- pair(TVN,TV,T). extract_vars(Var,V0,V):- var(Var),!, (member_eq(Var,V0)-> V=V0 ; append(V0,[Var],V) ). extract_vars(Term,V0,V):- Term=..[_F|Args], extract_vars_list(Args,V0,V). extract_vars_list([],V,V). extract_vars_list([Term|T],V0,V):- extract_vars(Term,V0,V1), extract_vars_list(T,V1,V). member_eq(A,[H|_T]):- A==H,!. member_eq(A,[_H|T]):- member_eq(A,T). list2or([X],X):- X\=;(_,_),!. list2or([H|T],(H ; Ta)):-!, list2or(T,Ta). /* set(Par,Value) can be used to set the value of a parameter */ set(Parameter,Value):- retract(setting(Parameter,_)), assert(setting(Parameter,Value)). /* end of utility predicates */ --- NEW FILE: picl.pl --- /* LPAD and CP-Logic reasoning suite File lpadsld.pl Goal oriented interpreter for LPADs based on SLDNF Copyright (c) 2007, Fabrizio Riguzzi */ :-dynamic rule/4,def_rule/2,setting/2. :-use_module(library(lists)). :-use_module(library(ugraphs)). :-load_foreign_files(['cplint'],[],init_my_predicates). :- op(1150, xfx, <- ). :- op(950,xfy, &). :- op(900,fy,~). :- op(1170,fx,prob). /* start of list of parameters that can be set by the user with set(Parameter,Value) */ setting(epsilon_parsing,0.00001). setting(save_dot,false). setting(ground_body,false). /* available values: true, false if true, both the head and the body of each clause will be grounded, otherwise only the head is grounded. In the case in which the body contains variables not appearing in the head, the body represents an existential event */ setting(min_error,0.01). setting(depth_bound,4). setting(prob_threshold,0.00001). setting(prob_bound,0.01). /* end of list of parameters */ /* s(GoalsLIst,Prob) compute the probability of a list of goals GoalsLis can have variables, s returns in backtracking all the solutions with their corresponding probability */ s(GoalsList,Prob):- solve(GoalsList,Prob). solve(GoalsList,Prob):- findall(Deriv,find_deriv(GoalsList,Deriv),L), build_formula(L,Formula,[],Var), var2numbers(Var,0,NewVar), (setting(save_dot,true)-> format("Variables: ~p~n",[Var]), compute_prob(NewVar,Formula,Prob,1) ; compute_prob(NewVar,Formula,Prob,0) ). solve(GoalsList,0.0):- \+ find_deriv(GoalsList,_Deriv). /* s(GoalsList,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2) compute the probability of a list of goals GoalsLis can have variables, s returns in backtracking all the solutions with their corresponding probability CPUTime1 is the cpu time for performing resolution CPUTime2 is the cpu time for elaborating the BDD WallTime1 is the wall time for performing resolution WallTime2 is the wall time for elaborating the BDD */ s(GoalsList,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2):- solve(GoalsList,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2). solve(GoalsList,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2):- statistics(cputime,[_,_]), statistics(walltime,[_,_]), findall(Deriv,find_deriv(GoalsList,Deriv),L)-> statistics(cputime,[_,CT1]), CPUTime1 is CT1/1000, statistics(walltime,[_,WT1]), WallTime1 is WT1/1000, %print_mem, build_formula(L,Formula,[],Var,0,Conj), length(L,ND), length(Var,NV), format(user_error,"Disjunctions :~d~nConjunctions: ~d~nVariables ~d~n",[ND,Conj,NV]), var2numbers(Var,0,NewVar), (setting(save_dot,true)-> format("Variables: ~p~n",[Var]), compute_prob(NewVar,Formula,Prob,1) ; compute_prob(NewVar,Formula,Prob,0) ), statistics(cputime,[_,CT2]), CPUTime2 is CT2/1000, statistics(walltime,[_,WT2]), WallTime2 is WT2/1000, format(user_error,"~nMemory after inference~n",[]). %print_mem. print_mem:- statistics(global_stack,[GS,GSF]), statistics(local_stack,[LS,LSF]), statistics(heap,[HP,HPF]), statistics(trail,[TU,TF]), format(user_error,"~nGloabal stack used ~d execution stack free: ~d~n",[GS,GSF]), format(user_error,"Local stack used ~d execution stack free: ~d~n",[LS,LSF]), format(user_error,"Heap used ~d heap free: ~d~n",[HP,HPF]), format(user_error,"Trail used ~d Trail free: ~d~n",[TU,TF]). find_deriv(GoalsList,Deriv):- solve(GoalsList,[],Deriv). % remove_duplicates(DerivDup,Deriv). /* duplicate can appear in the C set because two different unistantiated clauses may become the same clause when instantiated */ /* sc(Goals,Evidence,Prob) compute the conditional probability of the list of goals Goals given the list of goals Evidence Goals and Evidence can have variables, sc returns in backtracking all the solutions with their corresponding probability */ sc(Goals,Evidence,Prob):- solve_cond(Goals,Evidence,Prob). solve_cond(Goals,Evidence,Prob):- findall(DerivE,find_deriv(Evidence,DerivE),LE), findall(DerivGE,find_deriv_GE(LE,Goals,DerivGE),LGE), %print_mem, build_formula(LE,FormulaE,[],VarE), var2numbers(VarE,0,NewVarE), build_formula(LGE,FormulaGE,[],VarGE), var2numbers(VarGE,0,NewVarGE), compute_prob(NewVarE,FormulaE,ProbE,0), call_compute_prob(NewVarGE,FormulaGE,ProbGE), (ProbE>0.0-> Prob is ProbGE/ProbE ; %print_mem, Prob=undefined ), format(user_error,"~nMemory after inference~n",[]). %print_mem. /* sc(Goals,Evidence,Prob,Time1,Time2) compute the conditional probability of the list of goals Goals given the list of goals Evidence Goals and Evidence can have variables, sc returns in backtracking all the solutions with their corresponding probability Time1 is the time for performing resolution Time2 is the time for elaborating the two BDDs */ sc(Goals,Evidence,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2):- solve_cond(Goals,Evidence,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2). solve_cond(Goals,Evidence,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2):- statistics(cputime,[_,_]), statistics(walltime,[_,_]), findall(DerivE,find_deriv(Evidence,DerivE),LE), findall(DerivGE,find_deriv_GE(LE,Goals,DerivGE),LGE), statistics(cputime,[_,CT1]), CPUTime1 is CT1/1000, statistics(walltime,[_,WT1]), WallTime1 is WT1/1000, build_formula(LE,FormulaE,[],VarE), var2numbers(VarE,0,NewVarE), build_formula(LGE,FormulaGE,[],VarGE), var2numbers(VarGE,0,NewVarGE), compute_prob(NewVarE,FormulaE,ProbE,0), call_compute_prob(NewVarGE,FormulaGE,ProbGE), (ProbE>0.0-> Prob is ProbGE/ProbE, statistics(cputime,[_,CT2]), CPUTime2 is CT2/1000, statistics(walltime,[_,WT2]), WallTime2 is WT2/1000 ; Prob=undefined, statistics(cputime,[_,CT2]), CPUTime2 is CT2/1000, statistics(walltime,[_,WT2]), WallTime2 is WT2/1000 ). solve_cond_goals(Goals,LE,0,Time1,0):- statistics(runtime,[_,_]), \+ find_deriv_GE(LE,Goals,_DerivGE), statistics(runtime,[_,T1]), Time1 is T1/1000. call_compute_prob(NewVarGE,FormulaGE,ProbGE):- (setting(save_dot,true)-> format("Variables: ~p~n",[NewVarGE]), compute_prob(NewVarGE,FormulaGE,ProbGE,1) ; compute_prob(NewVarGE,FormulaGE,ProbGE,0) ). find_deriv_GE(LD,GoalsList,Deriv):- member(D,LD), solve(GoalsList,D,DerivDup), remove_duplicates(DerivDup,Deriv). /* solve(GoalsList,CIn,COut) takes a list of goals and an input C set and returns an output C set The C set is a list of triple (N,R,S) where - N is the index of the head atom used, starting from 0 - R is the index of the non ground rule used, starting from 1 - S is the substitution of rule R, in the form of a list whose elements are of the form 'VarName'=value */ solve([],C,C):-!. solve([\+ H|T],CIn,COut):- builtin(H),!, call((\+ H)), solve(T,CIn,COut). solve([\+ H |T],CIn,COut):-!, list2and(HL,H), findall(D,find_deriv(HL,D),L), choose_clauses(CIn,L,C1), solve(T,C1,COut) . solve([H|T],CIn,COut):- builtin(H),!, call(H), solve(T,CIn,COut). solve([H|T],CIn,COut):- def_rule(H,B), append(B,T,NG), solve(NG,CIn,COut). solve([H|T],CIn,COut):- find_rule(H,(R,S,N),CIn), solve_pres(R,S,N,T,CIn,COut). solve_pres(R,S,N,T,CIn,COut):- member_eq((N,R,S),CIn),!, solve(T,CIn,COut). solve_pres(R,S,N,T,CIn,COut):- append(CIn,[(N,R,S)],C1), solve(T,C1,COut). /* find_rule(G,(R,S,N),Body,C) takes a goal G and the current C set and returns the index R of a disjunctive rule resolving with G together with the index N of the resolving head, the substitution S and the Body of the rule */ find_rule(H,(R,S,N),C):- rule(H,_P,N,R,S,_NH,_Head), not_already_present_with_a_different_head(N,R,S,C). not_already_present_with_a_different_head(_N,_R,_S,[]). not_already_present_with_a_different_head(N,R,S,[(N1,R,S1)|T]):- not_different(N,N1,S,S1),!, not_already_present_with_a_different_head(N,R,S,T). not_already_present_with_a_different_head(N,R,S,[(_N1,R1,_S1)|T]):- R\==R1, not_already_present_with_a_different_head(N,R,S,T). not_different(_N,_N1,S,S1):- S\=S1,!. not_different(N,N1,S,S1):- N\=N1,!, S\=S1. not_different(N,N,S,S). /* choose_clauses(CIn,LC,COut) takes as input the current C set and the set of C sets for a negative goal and returns a new C set that excludes all the derivations for the negative goals */ choose_clauses(C,[],C). choose_clauses(CIn,[D|T],COut):- member((N,R,S),D), already_present_with_a_different_head(N,R,S,CIn), choose_clauses(CIn,T,COut). choose_clauses(CIn,[D|T],COut):- member((N,R,S),D), new_head(N,R,S,N1), \+ already_present(N1,R,S,CIn), choose_clauses([(N1,R,S)|CIn],T,COut). /* select a head different from N for rule R with substitution S, return it in N1 */ new_head(N,R,S,N1):- rule_by_num(R,S,Numbers,Head,_Body), Head\=uniform(_,_,_),!, nth0(N, Numbers, _Elem, Rest), member(N1,Rest). already_present_with_a_different_head(N,R,S,[(NH,R,SH)|_T]):- S=SH,NH \= N,!. already_present_with_a_different_head(N,R,S,[_H|T]):- already_present_with_a_different_head(N,R,S,T). /* checks that a rule R with head N and selection S is already present in C (or a generalization of it is in C) */ already_present(N,R,S,[(N,R,SH)|_T]):- S=SH. already_present(N,R,S,[_H|T]):- already_present(N,R,S,T). /* rem_dup_lists removes the C sets that are a superset of another C sets further on in the list of C sets */ /* rem_dup_lists removes the C sets that are a superset of another C sets further on in the list of C sets */ rem_dup_lists([],L,L). rem_dup_lists([H|T],L0,L):- (member_subset(H,T);member_subset(H,L0)),!, rem_dup_lists(T,L0,L). rem_dup_lists([H|T],L0,L):- rem_dup_lists(T,[H|L0],L). member_subset(E,[H|_T]):- subset_my(H,E),!. member_subset(E,[_H|T]):- member_subset(E,T). /* predicates for building the formula to be converted into a BDD */ /* build_formula(LC,Formula,VarIn,VarOut) takes as input a set of C sets LC and a list of Variables VarIn and returns the formula and a new list of variables VarOut Formula is of the form [Term1,...,Termn] Termi is of the form [Factor1,...,Factorm] Factorj is of the form (Var,Value) where Var is the index of the multivalued variable Var and Value is the index of the value */ build_formula([],[],Var,Var,C,C). build_formula([D|TD],[F|TF],VarIn,VarOut,C0,C1):- length(D,NC), C2 is C0+NC, reverse(D,D1), build_term(D1,F,VarIn,Var1), build_formula(TD,TF,Var1,VarOut,C2,C1). build_formula([],[],Var,Var). build_formula([D|TD],[F|TF],VarIn,VarOut):- build_term(D,F,VarIn,Var1), build_formula(TD,TF,Var1,VarOut). build_term([],[],Var,Var). build_term([(_,pruned,_)|TC],TF,VarIn,VarOut):-!, build_term(TC,TF,VarIn,VarOut). build_term([(N,R,S)|TC],[[NVar,N]|TF],VarIn,VarOut):- (nth0_eq(0,NVar,VarIn,(R,S))-> Var1=VarIn ; append(VarIn,[(R,S)],Var1), length(VarIn,NVar) ), build_term(TC,TF,Var1,VarOut). /* nth0_eq(PosIn,PosOut,List,El) takes as input a List, an element El and an initial position PosIn and returns in PosOut the position in the List that contains an element exactly equal to El */ nth0_eq(N,N,[H|_T],El):- H==El,!. nth0_eq(NIn,NOut,[_H|T],El):- N1 is NIn+1, nth0_eq(N1,NOut,T,El). /* var2numbers converts a list of couples (Rule,Substitution) into a list of triples (N,NumberOfHeadsAtoms,ListOfProbabilities), where N is an integer starting from 0 */ var2numbers([],_N,[]). var2numbers([(R,S)|T],N,[[N,ValNumber,Probs]|TNV]):- find_probs(R,S,Probs), length(Probs,ValNumber), N1 is N+1, var2numbers(T,N1,TNV). find_probs(R,S,Probs):- rule_by_num(R,S,_N,Head,_Body), get_probs(Head,Probs). get_probs(uniform(_A:1/Num,_P,_Number),ListP):- Prob is 1/Num, list_el(Num,Prob,ListP). get_probs([],[]). get_probs([_H:P|T],[P1|T1]):- P1 is P, get_probs(T,T1). list_el(0,_P,[]):-!. list_el(N,P,[P|T]):- N1 is N-1, list_el(N1,P,T). /* end of predicates for building the formula to be converted into a BDD */list_el(0,_P,[]):-!. /* start of predicates for parsing an input file containing a program */ /* p(File) parses the file File.cpl. It can be called more than once without exiting yap */ p(File):- parse(File). parse(File):- atom_concat(File,'.cil',FilePl), open(FilePl,read,S), read_clauses(S,C), close(S), retractall(rule_by_num(_,_,_,_,_)), retractall(rule(_,_,_,_,_,_,_)), retractall(def_rule(_,_)), process_clauses(C,1). process_clauses([(end_of_file,[])],_N). process_clauses([((H <- B),_V)|T],N):-!, convert_body(B,BL), assert(def_rule(H,BL)), process_clauses(T,N). process_clauses([((prob H),V)|T],N):-!, list2and(HL1,H), process_head(HL1,HL), length(HL,LH), listN(0,LH,NH), assert_rules(HL,0,HL,[],NH,N,V), assertz(rule_by_num(N,V,NH,HL,[])), N1 is N+1, process_clauses(T,N1). process_clauses([(H,_V)|T],N):- assert(def_rule(H,[])), process_clauses(T,N). assert_rules([],_Pos,_HL,_BL,_Nh,_N,_V1):-!. assert_rules(['':_P],_Pos,_HL,_BL,_Nh,_N,_V1):-!. assert_rules([H:P|T],Pos,HL,BL,NH,N,V1):- assertz(rule(H,P,Pos,N,V1,NH,HL)), Pos1 is Pos+1, assert_rules(T,Pos1,HL,BL,NH,N,V1). /* if the annotation in the head are not ground, the null atom is not added and the eventual formulas are not evaluated */ process_head(HL,NHL):- (ground_prob(HL)-> process_head_ground(HL,0,NHL) ; NHL=HL ). ground_prob([]). ground_prob([_H:PH|T]):- ground(PH), ground_prob(T). process_head_ground([H:PH],P,[H:PH1|Null]):- PH1 is PH, PNull is 1-P-PH1, setting(epsilon_parsing,Eps), EpsNeg is - Eps, PNull > EpsNeg, (PNull>Eps-> Null=['':PNull] ; Null=[] ). process_head_ground([H:PH|T],P,[H:PH1|NT]):- PH1 is PH, P1 is P+PH1, process_head_ground(T,P1,NT). /* predicates for reading in the program clauses */ read_clauses(S,Clauses):- (setting(ground_body,true)-> read_clauses_ground_body(S,Clauses) ; read_clauses_exist_body(S,Clauses) ). read_clauses_ground_body(S,[(Cl,V)|Out]):- read_term(S,Cl,[variable_names(V)]), (Cl=end_of_file-> Out=[] ; read_clauses_ground_body(S,Out) ). read_clauses_exist_body(S,[(Cl,V)|Out]):- read_term(S,Cl,[variable_names(VN)]), extract_vars_cl(Cl,VN,V), (Cl=end_of_file-> Out=[] ; read_clauses_exist_body(S,Out) ). extract_vars_cl(end_of_file,[]). extract_vars_cl(Cl,VN,Couples):- (Cl=(H:-_B)-> true ; H=Cl ), extract_vars(H,[],V), pair(VN,V,Couples). pair(_VN,[],[]). pair([VN= _V|TVN],[V|TV],[VN=V|T]):- pair(TVN,TV,T). extract_vars(Var,V0,V):- var(Var),!, (member_eq(Var,V0)-> V=V0 ; append(V0,[Var],V) ). extract_vars(Term,V0,V):- Term=..[_F|Args], extract_vars_list(Args,V0,V). extract_vars_list([],V,V). extract_vars_list([Term|T],V0,V):- extract_vars(Term,V0,V1), extract_vars_list(T,V1,V). listN(N,N,[]):-!. listN(NIn,N,[NIn|T]):- N1 is NIn+1, listN(N1,N,T). /* end of predicates for parsing an input file containing a program */ /* start of utility predicates */ list2or([X],X):- X\=;(_,_),!. list2or([H|T],(H ; Ta)):-!, list2or(T,Ta). list2and([X],X):- X\=(_,_),!. list2and([H|T],(H,Ta)):-!, list2and(T,Ta). member_eq(A,[H|_T]):- A==H,!. member_eq(A,[_H|T]):- member_eq(A,T). subset_my([],_). subset_my([H|T],L):- member_eq(H,L), subset_my(T,L). remove_duplicates_eq([],[]). remove_duplicates_eq([H|T],T1):- member_eq(H,T),!, remove_duplicates_eq(T,T1). remove_duplicates_eq([H|T],[H|T1]):- remove_duplicates_eq(T,T1). builtin(_A is _B). builtin(_A > _B). builtin(_A < _B). builtin(_A >= _B). builtin(_A =< _B). builtin(_A =:= _B). builtin(_A =\= _B). builtin(true). builtin(false). builtin(_A = _B). builtin(_A==_B). builtin(_A\=_B). builtin(_A\==_B). builtin(length(_L,_N)). builtin(member(_El,_L)). builtin(average(_L,_Av)). builtin(max_list(_L,_Max)). builtin(min_list(_L,_Max)). builtin(nth0(_,_,_)). builtin(nth(_,_,_)). average(L,Av):- sum_list(L,Sum), length(L,N), Av is Sum/N. clique(Graph,Clique):- vertices(Graph,Candidates), extend_cycle(Graph,Candidates,[],[],Clique). extend_cycle(G,[H|T],Not,CS,CSOut):- neighbours(H, G, Neigh), intersection(Neigh,T,NewCand), intersection(Neigh,Not,NewNot), extend(G,NewCand,NewNot,[H|CS],CSOut). extend_cycle(G,[H|T],Not,CS,CSOut):- extend_cycle(G,T,[H|Not],CS,CSOut). extend(_G,[],[],CompSub,CompSub):-!. extend(G,Cand,Not,CS,CSOut):- extend_cycle(G,Cand,Not,CS,CSOut). intersection([],_Y,[]). intersection([H|T],Y,[H|Z]):- member(H,Y),!, intersection(T,Y,Z). intersection([_H|T],Y,Z):- intersection(T,Y,Z). convert_body((~ A & B),[\+ A|B1]):-!, convert_body(B,B1). convert_body((A & B),[A|B1]):-!, convert_body(B,B1). convert_body(~ A,[\+ A]):-!. convert_body(A,[A]). /* set(Par,Value) can be used to set the value of a parameter */ set(Parameter,Value):- retract(setting(Parameter,_)), assert(setting(Parameter,Value)). /* end of utility predicates */ |
|
From: Vitor S. C. <vs...@us...> - 2008-08-13 10:29:40
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21591 Modified Files: configure configure.in Log Message: continue fixing Index: configure.in =================================================================== RCS file: /cvsroot/yap/configure.in,v retrieving revision 1.142 retrieving revision 1.143 diff -u -r1.142 -r1.143 --- configure.in 13 Aug 2008 10:26:55 -0000 1.142 +++ configure.in 13 Aug 2008 10:29:48 -0000 1.143 @@ -882,7 +882,7 @@ ;; esac else - EXTEND_DYNLOADER_PATH="YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)" + EXTEND_DYNLOADER_PATH="YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" DYNYAPLIB=libYap.notused fi |
|
From: Vitor S. C. <vs...@us...> - 2008-08-13 10:26:50
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv20144 Modified Files: configure.in Log Message: patch previous patch for Linux (Keri Harris) |
|
From: Vitor S. C. <vs...@us...> - 2008-08-13 01:16:18
|
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv23329/C Modified Files: absmi.c sysbits.c Log Message: more locking fixes Index: absmi.c =================================================================== RCS file: /cvsroot/yap/C/absmi.c,v retrieving revision 1.246 retrieving revision 1.247 diff -u -r1.246 -r1.247 --- absmi.c 12 Aug 2008 01:27:22 -0000 1.246 +++ absmi.c 13 Aug 2008 01:16:26 -0000 1.247 @@ -12,6 +12,9 @@ * comments: Portable abstract machine interpreter * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.247 2008/08/13 01:16:26 vsc +* more locking fixes +* * Revision 1.246 2008/08/12 01:27:22 vsc * MaxOS fixes * Avoid a thread deadlock @@ -13812,8 +13815,8 @@ if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); LOCK(SignalLock); - UNLOCK(SignalLock); if (ActiveSignals & YAP_CDOVF_SIGNAL) { + UNLOCK(SignalLock); saveregs_and_ycache(); if (!Yap_growheap(FALSE, 0, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); @@ -13824,12 +13827,13 @@ LOCK(SignalLock); ActiveSignals &= ~YAP_CDOVF_SIGNAL; CreepFlag = CalculateStackGap(); - UNLOCK(SignalLock); if (!ActiveSignals) { + UNLOCK(SignalLock); goto execute_after_comma; } } if (ActiveSignals & YAP_TROVF_SIGNAL) { + UNLOCK(SignalLock); #ifdef SHADOW_S S = SREG; #endif @@ -13843,17 +13847,20 @@ LOCK(SignalLock); ActiveSignals &= ~YAP_TROVF_SIGNAL; CreepFlag = CalculateStackGap(); - UNLOCK(SignalLock); if (!ActiveSignals) { + UNLOCK(SignalLock); goto execute_after_comma; } } if (ActiveSignals) { if (ActiveSignals & YAP_CDOVF_SIGNAL) { + UNLOCK(SignalLock); goto noheapleft; } + UNLOCK(SignalLock); goto creep; } + UNLOCK(SignalLock); saveregs(); if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); Index: sysbits.c =================================================================== RCS file: /cvsroot/yap/C/sysbits.c,v retrieving revision 1.109 retrieving revision 1.110 diff -u -r1.109 -r1.110 --- sysbits.c 23 May 2008 10:02:13 -0000 1.109 +++ sysbits.c 13 Aug 2008 01:16:26 -0000 1.110 @@ -2529,36 +2529,57 @@ non-backtrackable variable bad */ if (ActiveSignals & YAP_WAKEUP_SIGNAL) { ActiveSignals &= ~YAP_WAKEUP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_wake_up"))); } if (ActiveSignals & YAP_ITI_SIGNAL) { ActiveSignals &= ~YAP_ITI_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_iti"))); } if (ActiveSignals & YAP_INT_SIGNAL) { ActiveSignals &= ~YAP_INT_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_int"))); } if (ActiveSignals & YAP_USR2_SIGNAL) { ActiveSignals &= ~YAP_USR2_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_usr2"))); } if (ActiveSignals & YAP_USR1_SIGNAL) { ActiveSignals &= ~YAP_USR1_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_usr1"))); } if (ActiveSignals & YAP_PIPE_SIGNAL) { ActiveSignals &= ~YAP_PIPE_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_pipe"))); } if (ActiveSignals & YAP_HUP_SIGNAL) { ActiveSignals &= ~YAP_HUP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_hup"))); } @@ -2569,43 +2590,64 @@ } if (ActiveSignals & YAP_DELAY_CREEP_SIGNAL) { ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_delay_creep"))); } if (ActiveSignals & YAP_CREEP_SIGNAL) { ActiveSignals &= ~YAP_CREEP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_creep"))); } if (ActiveSignals & YAP_TRACE_SIGNAL) { ActiveSignals &= ~YAP_TRACE_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_trace"))); } if (ActiveSignals & YAP_DEBUG_SIGNAL) { ActiveSignals &= ~YAP_DEBUG_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_debug"))); } if (ActiveSignals & YAP_BREAK_SIGNAL) { ActiveSignals &= ~YAP_BREAK_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_break"))); } if (ActiveSignals & YAP_STACK_DUMP_SIGNAL) { ActiveSignals &= ~YAP_STACK_DUMP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_stack_dump"))); } if (ActiveSignals & YAP_STATISTICS_SIGNAL) { ActiveSignals &= ~YAP_STATISTICS_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); +#endif UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_statistics"))); } - UNLOCK(SignalLock); #ifdef THREADS - pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); + pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock)); #endif + UNLOCK(SignalLock); return FALSE; } |
|
From: Vitor S. C. <vs...@us...> - 2008-08-13 01:16:18
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv23329 Modified Files: changes-5.1.html Log Message: more locking fixes |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 22:04:43
|
Update of /cvsroot/yap/LGPL/chr In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv9792/LGPL/chr Modified Files: Makefile.in Log Message: DESTDIR fixes Index: Makefile.in =================================================================== RCS file: /cvsroot/yap/LGPL/chr/Makefile.in,v retrieving revision 1.7 retrieving revision 1.8 diff -u -r1.7 -r1.8 --- Makefile.in 27 Jul 2008 22:31:36 -0000 1.7 +++ Makefile.in 12 Aug 2008 22:04:51 -0000 1.8 @@ -8,18 +8,15 @@ srcdir=@srcdir@ +BINDIR = $(EROOTDIR)/bin +LIBDIR=$(EROOTDIR)/lib +YAPLIBDIR=$(EROOTDIR)/lib/Yap +SHAREDIR=$(ROOTDIR)/share + SHELL=@SHELL@ -PLBASE=@PLBASE@ -PLARCH=@PLARCH@ -PL=LD_LIBRARY_PATH=system YAPSHAREDIR=`pwd`/../../library ../../yap ../../startup -XPCEBASE=$(PLBASE)/xpce -PKGDOC=$(PLBASE)/doc/packages -PCEHOME=../../xpce -LIBDIR=$(PLBASE)/library -SHAREDIR=$(ROOTDIR)/share/Yap +PL=@EXTEND_DYNLOADER_PATH@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup CHRDIR=$(SHAREDIR)/chr EXDIR=$(CHRDIR)/examples/chr -DESTDIR= LN_S=@LN_S@ DOCTOTEX=$(PCEHOME)/bin/doc2tex |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 22:04:43
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv9792 Modified Files: changes-5.1.html configure configure.in Log Message: DESTDIR fixes Index: configure =================================================================== RCS file: /cvsroot/yap/configure,v retrieving revision 1.142 retrieving revision 1.143 diff -u -r1.142 -r1.143 --- configure 19 Jun 2008 21:09:56 -0000 1.142 +++ configure 12 Aug 2008 22:04:49 -0000 1.143 @@ -689,6 +689,7 @@ CPLINT_LDFLAGS CPLINT_SHLIB_LD ENABLE_CPLINT +EXTEND_DYNLOADER_PATH M4 M4GENHDRS INSTALL_DLLS @@ -3097,7 +3098,6 @@ fi - if test "$tabling" = yes -o "$orparallelism" = yes -o "$threads" = yes then cat >>confdefs.h <<\_ACEOF @@ -7124,10 +7124,14 @@ YAP_EXTRAS="$SHLIB_CFLAGS $YAP_EXTRAS" CROSS_SIMULATOR="LD_LIBRARY_PATH=." case "$target_os" in + *cygwin*!*mingw32*) + EXTEND_DYNLOADER_PATH="" + ;; *darwin*) DYNYAPLIB=libYap"$SHLIB_SUFFIX" YAPLIB="$DYNYAPLIB" DYNLIB_LD="gcc -dynamiclib" + EXTEND_DYNLOADER_PATH="DYLD_LIBRARY_PATH=\$DYLD_LIBRARY_PATH:\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" ;; *) case "$target_cpu" in @@ -7141,6 +7145,7 @@ JAVA_TARGET=sparc ;; esac + EXTEND_DYNLOADER_PATH="LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$(DESTDIR)$(LIBDIR): YAPSHAREDIR=$(DESTDIR)$(SHAREDIR)" LDFLAGS="$LDFLAGS -Wl,-R,$prefix/lib -Wl,-R,$JAVA_HOME/jre/lib/$JAVA_TARGET" DYNYAPLIB=libYap"$SHLIB_SUFFIX" YAPLIB="$DYNYAPLIB" @@ -7148,6 +7153,7 @@ ;; esac else + EXTEND_DYNLOADER_PATH="YAPSHAREDIR=$(DESTDIR)$(SHAREDIR)" DYNYAPLIB=libYap.notused fi @@ -7521,6 +7527,7 @@ fi + # LAM OLD_CC=${CC} CC=${LAM_MPI_CC} @@ -16902,6 +16909,7 @@ CPLINT_LDFLAGS!$CPLINT_LDFLAGS$ac_delim CPLINT_SHLIB_LD!$CPLINT_SHLIB_LD$ac_delim ENABLE_CPLINT!$ENABLE_CPLINT$ac_delim +EXTEND_DYNLOADER_PATH!$EXTEND_DYNLOADER_PATH$ac_delim M4!$M4$ac_delim M4GENHDRS!$M4GENHDRS$ac_delim INSTALL_DLLS!$INSTALL_DLLS$ac_delim @@ -16922,7 +16930,6 @@ JAR!$JAR$ac_delim IN_UNIX!$IN_UNIX$ac_delim YAPMPILIB!$YAPMPILIB$ac_delim -LAM_MPI_CC!$LAM_MPI_CC$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then @@ -16964,6 +16971,7 @@ ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF +LAM_MPI_CC!$LAM_MPI_CC$ac_delim MPI_OBJS!$MPI_OBJS$ac_delim MPI_LIBS!$MPI_LIBS$ac_delim INSTALL_COMMAND!$INSTALL_COMMAND$ac_delim @@ -16982,7 +16990,7 @@ LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF - if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 16; then + if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 17; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 Index: configure.in =================================================================== RCS file: /cvsroot/yap/configure.in,v retrieving revision 1.140 retrieving revision 1.141 diff -u -r1.140 -r1.141 --- configure.in 19 Jun 2008 21:09:29 -0000 1.140 +++ configure.in 12 Aug 2008 22:04:50 -0000 1.141 @@ -261,7 +261,6 @@ fi, [yap_cv_max_threads="1024"]) - if test "$tabling" = yes -o "$orparallelism" = yes -o "$threads" = yes then AC_DEFINE(MinHeapSpace, (1000*SIZEOF_INT_P)) @@ -854,10 +853,14 @@ YAP_EXTRAS="$SHLIB_CFLAGS $YAP_EXTRAS" CROSS_SIMULATOR="LD_LIBRARY_PATH=." case "$target_os" in + *cygwin*!*mingw32*) + EXTEND_DYNLOADER_PATH="" + ;; *darwin*) DYNYAPLIB=libYap"$SHLIB_SUFFIX" YAPLIB="$DYNYAPLIB" DYNLIB_LD="gcc -dynamiclib" + EXTEND_DYNLOADER_PATH="DYLD_LIBRARY_PATH=\$DYLD_LIBRARY_PATH:\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" ;; *) case "$target_cpu" in @@ -871,6 +874,7 @@ JAVA_TARGET=sparc ;; esac + EXTEND_DYNLOADER_PATH="LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$(DESTDIR)$(LIBDIR): YAPSHAREDIR=$(DESTDIR)$(SHAREDIR)" LDFLAGS="$LDFLAGS -Wl,-R,$prefix/lib -Wl,-R,$JAVA_HOME/jre/lib/$JAVA_TARGET" DYNYAPLIB=libYap"$SHLIB_SUFFIX" YAPLIB="$DYNYAPLIB" @@ -878,6 +882,7 @@ ;; esac else + EXTEND_DYNLOADER_PATH="YAPSHAREDIR=$(DESTDIR)$(SHAREDIR)" DYNYAPLIB=libYap.notused fi @@ -992,6 +997,7 @@ ENABLE_CPLINT="#" fi AC_SUBST(ENABLE_CPLINT) +AC_SUBST(EXTEND_DYNLOADER_PATH) # LAM OLD_CC=${CC} |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 02:08:54
|
Update of /cvsroot/yap/pl In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21137/pl Modified Files: arith.yap boot.yap utils.yap Log Message: MaxOS fixes Avoid a thread deadlock improvements to SWI predicates. make variables_in_term system builtin. Index: arith.yap =================================================================== RCS file: /cvsroot/yap/pl/arith.yap,v retrieving revision 1.20 retrieving revision 1.21 diff -u -r1.20 -r1.21 --- arith.yap 15 May 2008 13:41:47 -0000 1.20 +++ arith.yap 12 Aug 2008 01:27:23 -0000 1.21 @@ -337,6 +337,7 @@ '$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). Index: boot.yap =================================================================== RCS file: /cvsroot/yap/pl/boot.yap,v retrieving revision 1.192 retrieving revision 1.193 diff -u -r1.192 -r1.193 --- boot.yap 6 Aug 2008 10:15:48 -0000 1.192 +++ boot.yap 12 Aug 2008 01:27:23 -0000 1.193 @@ -312,7 +312,9 @@ '$execute_commands'(C,VL,Con,Source) :- '$execute_command'(C,VL,Con,Source). - % + + + % % % Index: utils.yap =================================================================== RCS file: /cvsroot/yap/pl/utils.yap,v retrieving revision 1.90 retrieving revision 1.91 diff -u -r1.90 -r1.91 --- utils.yap 15 May 2008 13:41:48 -0000 1.90 +++ utils.yap 12 Aug 2008 01:27:23 -0000 1.91 @@ -855,3 +855,9 @@ 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). + |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 02:08:54
|
Update of /cvsroot/yap/library In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21137/library Modified Files: swi.yap terms.yap Log Message: MaxOS fixes Avoid a thread deadlock improvements to SWI predicates. make variables_in_term system builtin. Index: swi.yap =================================================================== RCS file: /cvsroot/yap/library/swi.yap,v retrieving revision 1.31 retrieving revision 1.32 diff -u -r1.31 -r1.32 --- swi.yap 6 Aug 2008 17:34:15 -0000 1.31 +++ swi.yap 12 Aug 2008 01:27:23 -0000 1.32 @@ -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: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_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, '=@='). @@ -400,70 +401,6 @@ 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). - -maplist2([], [], [], [], _). -maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :- - call(Goal, Elem1, Elem2, Elem3, Elem4), - maplist2(Tail1, Tail2, Tail3, Tail4, Goal). - prolog:compile_aux_clauses([]). prolog:compile_aux_clauses([(:- G)|Cls]) :- prolog_load_context(module, M), @@ -474,6 +411,7 @@ assert_static(M:Cl), prolog:compile_aux_clauses(Cls). + % % convert from SWI's goal expansion to YAP/SICStus old style goal % expansion. Index: terms.yap =================================================================== RCS file: /cvsroot/yap/library/terms.yap,v retrieving revision 1.6 retrieving revision 1.7 diff -u -r1.6 -r1.7 --- terms.yap 13 Mar 2008 14:38:01 -0000 1.6 +++ terms.yap 12 Aug 2008 01:27:23 -0000 1.7 @@ -18,8 +18,6 @@ :- module(terms, [ term_hash/2, term_hash/4, - term_variables/2, - term_variables/3, variant/2, unifiable/3, subsumes/2, |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 02:08:53
|
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21137/C Modified Files: absmi.c amasm.c arith1.c threads.c utilpreds.c Log Message: MaxOS fixes Avoid a thread deadlock improvements to SWI predicates. make variables_in_term system builtin. Index: absmi.c =================================================================== RCS file: /cvsroot/yap/C/absmi.c,v retrieving revision 1.245 retrieving revision 1.246 diff -u -r1.245 -r1.246 --- absmi.c 7 Aug 2008 20:51:15 -0000 1.245 +++ absmi.c 12 Aug 2008 01:27:22 -0000 1.246 @@ -12,6 +12,12 @@ * comments: Portable abstract machine interpreter * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.246 2008/08/12 01:27:22 vsc +* MaxOS fixes +* Avoid a thread deadlock +* improvements to SWI predicates. +* make variables_in_term system builtin. +* * Revision 1.245 2008/08/07 20:51:15 vsc * more threadin fixes * @@ -494,6 +500,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)) { Index: amasm.c =================================================================== RCS file: /cvsroot/yap/C/amasm.c,v retrieving revision 1.103 retrieving revision 1.104 diff -u -r1.103 -r1.104 --- amasm.c 7 Aug 2008 20:51:16 -0000 1.103 +++ amasm.c 12 Aug 2008 01:27:22 -0000 1.104 @@ -13,6 +13,12 @@ * * * Last rev: $Date$ * * $Log$ +* Revision 1.104 2008/08/12 01:27:22 vsc +* MaxOS fixes +* Avoid a thread deadlock +* improvements to SWI predicates. +* make variables_in_term system builtin. +* * Revision 1.103 2008/08/07 20:51:16 vsc * more threadin fixes * @@ -3122,7 +3128,8 @@ #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); @@ -3221,7 +3228,8 @@ #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); @@ -3232,7 +3240,8 @@ 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); Index: arith1.c =================================================================== RCS file: /cvsroot/yap/C/arith1.c,v retrieving revision 1.32 retrieving revision 1.33 diff -u -r1.32 -r1.33 --- arith1.c 13 May 2008 10:37:27 -0000 1.32 +++ arith1.c 12 Aug 2008 01:27:22 -0000 1.33 @@ -1966,6 +1966,52 @@ } } +/* + 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 @@ {"float_integer_part", p_fintp}, {"sign", p_sign}, {"lgamma", p_lgamma}, + {"random", p_random}, }; static Int Index: threads.c =================================================================== RCS file: /cvsroot/yap/C/threads.c,v retrieving revision 1.46 retrieving revision 1.47 diff -u -r1.46 -r1.47 --- threads.c 8 Aug 2008 16:05:10 -0000 1.46 +++ threads.c 12 Aug 2008 01:27:22 -0000 1.47 @@ -897,6 +897,11 @@ return Yap_unify(ARG1,MkIntTerm(0)); } +p_thread_stacks(void) +{ /* '$thread_runtime'(+P) */ + return FALSE; +} + static Int p_thread_unlock(void) { /* '$thread_runtime'(+P) */ Index: utilpreds.c =================================================================== RCS file: /cvsroot/yap/C/utilpreds.c,v retrieving revision 1.64 retrieving revision 1.65 diff -u -r1.64 -r1.65 --- utilpreds.c 6 Aug 2008 17:32:20 -0000 1.64 +++ utilpreds.c 12 Aug 2008 01:27:22 -0000 1.65 @@ -172,9 +172,9 @@ 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 @@ 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); |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 02:08:53
|
Update of /cvsroot/yap/docs In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21137/docs Modified Files: yap.tex Log Message: MaxOS fixes Avoid a thread deadlock improvements to SWI predicates. make variables_in_term system builtin. Index: yap.tex =================================================================== RCS file: /cvsroot/yap/docs/yap.tex,v retrieving revision 1.264 retrieving revision 1.265 diff -u -r1.264 -r1.265 --- yap.tex 10 Aug 2008 15:44:12 -0000 1.264 +++ yap.tex 12 Aug 2008 01:27:22 -0000 1.265 @@ -3757,6 +3757,16 @@ @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 |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 01:27:18
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21137 Modified Files: changes-5.1.html Log Message: MaxOS fixes Avoid a thread deadlock improvements to SWI predicates. make variables_in_term system builtin. |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 01:27:17
|
Update of /cvsroot/yap/H In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21137/H Modified Files: Regs.h Log Message: MaxOS fixes Avoid a thread deadlock improvements to SWI predicates. make variables_in_term system builtin. Index: Regs.h =================================================================== RCS file: /cvsroot/yap/H/Regs.h,v retrieving revision 1.41 retrieving revision 1.42 diff -u -r1.41 -r1.42 --- Regs.h 8 Aug 2008 14:05:34 -0000 1.41 +++ Regs.h 12 Aug 2008 01:27:22 -0000 1.42 @@ -157,7 +157,7 @@ /* keep X as a global variable */ -Term Yap_XREGS[MaxTemps]; /* 29 */ +extern Term Yap_XREGS[MaxTemps]; /* 29 */ #define XREGS Yap_XREGS |
|
From: Vitor S. C. <vs...@us...> - 2008-08-12 01:27:17
|
Update of /cvsroot/yap/LGPL/JPL/src In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv21137/LGPL/JPL/src Modified Files: jpl.c Log Message: MaxOS fixes Avoid a thread deadlock improvements to SWI predicates. make variables_in_term system builtin. Index: jpl.c =================================================================== RCS file: /cvsroot/yap/LGPL/JPL/src/jpl.c,v retrieving revision 1.16 retrieving revision 1.17 diff -u -r1.16 -r1.17 --- jpl.c 10 May 2008 23:24:12 -0000 1.16 +++ jpl.c 12 Aug 2008 01:27:22 -0000 1.17 @@ -1798,6 +1798,8 @@ /* 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 @@ ? 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 @@ ? 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) |
|
From: Paulo M. <pm...@us...> - 2008-08-10 16:24:09
|
Update of /cvsroot/yap/pl In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv12341/pl Modified Files: yio.yap Log Message: Added built-in predicate format/1 for compatibility with SWI-Prolog. Index: yio.yap =================================================================== RCS file: /cvsroot/yap/pl/yio.yap,v retrieving revision 1.49 retrieving revision 1.50 diff -u -r1.49 -r1.50 --- yio.yap 26 May 2008 09:16:24 -0000 1.49 +++ yio.yap 10 Aug 2008 15:44:12 -0000 1.50 @@ -592,6 +592,10 @@ print(_,_). +format(T) :- + format(T, []). + + /* interface to user portray */ '$portray'(T) :- \+ '$undefined'(portray(_),user), |
|
From: Paulo M. <pm...@us...> - 2008-08-10 15:45:43
|
Update of /cvsroot/yap/docs In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv12341/docs Modified Files: yap.tex Log Message: Added built-in predicate format/1 for compatibility with SWI-Prolog. Index: yap.tex =================================================================== RCS file: /cvsroot/yap/docs/yap.tex,v retrieving revision 1.263 retrieving revision 1.264 diff -u -r1.263 -r1.264 --- yap.tex 1 Aug 2008 21:44:25 -0000 1.263 +++ yap.tex 10 Aug 2008 15:44:12 -0000 1.264 @@ -4854,6 +4854,14 @@ @code{Hello}. Space is then evenly divided between the right and the left sides. + +@item format(+@var{T}) +@findex format/1 +@saindex format/1 +@cnindex format/1 +Print formatted output to the current output stream. + + @item format(+@var{S},+@var{T},+@var{L}) @findex format/3 @saindex format/3 |
|
From: Vitor S. C. <vs...@us...> - 2008-08-08 16:05:02
|
Update of /cvsroot/yap/pl In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv16305/pl Modified Files: threads.yap Log Message: fix threads/0. Index: threads.yap =================================================================== RCS file: /cvsroot/yap/pl/threads.yap,v retrieving revision 1.78 retrieving revision 1.79 diff -u -r1.78 -r1.79 --- threads.yap 8 Aug 2008 14:05:34 -0000 1.78 +++ threads.yap 8 Aug 2008 16:05:10 -0000 1.79 @@ -807,12 +807,24 @@ thread_property(Id, Prop) :- ( nonvar(Id) -> '$check_thread_or_alias'(Id, thread_property(Id, Prop)) - ; '$thread_stacks'(Id, _, _, _) + ; '$enumerate_threads'(Id) ), '$check_thread_property'(Prop, thread_property(Id, Prop)), '$thread_id_alias'(Id0, Id), '$thread_property'(Id0, Prop). +'$enumerate_threads'(Id) :- + '$max_threads'(Max), + Max1 is Max-1, + '$between'(0,Max1,Id), + '$thread_stacks'(Id, _, _, _). + +'$between'(I,_,I). +'$between'(I0,I,J) :- + I0 < I, + I1 is I0+1, + '$between'(I1,I,J). + '$thread_property'(Id, alias(Alias)) :- recorded('$thread_alias', [Id|Alias], _). '$thread_property'(Id, status(Status)) :- @@ -822,7 +834,7 @@ ; Status = running ). '$thread_property'(Id, detached(Detached)) :- - '$thread_detached'(Detached). + '$thread_detached'(Id,Detached). '$thread_property'(Id, at_exit(M:G)) :- '$thread_run_at_exit'(G,M). '$thread_property'(Id, InfoSize) :- @@ -837,7 +849,7 @@ format(user_error,'------------------------------------------------------------------------~n',[]), format(user_error, '~t~a~48+~n', 'Thread Detached Status'), format(user_error,'------------------------------------------------------------------------~n',[]), - '$thread_property'(Id, detached(Detached)), + thread_property(Id, detached(Detached)), '$thread_property'(Id, status(Status)), '$thread_id_alias'(Id, Alias), format(user_error,'~t~q~30+~33|~w~42|~q~n', [Alias, Detached, Status]), |
|
From: Vitor S. C. <vs...@us...> - 2008-08-08 16:05:01
|
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv16305/C Modified Files: threads.c Log Message: fix threads/0. Index: threads.c =================================================================== RCS file: /cvsroot/yap/C/threads.c,v retrieving revision 1.45 retrieving revision 1.46 diff -u -r1.45 -r1.46 --- threads.c 8 Aug 2008 14:05:34 -0000 1.45 +++ threads.c 8 Aug 2008 16:05:10 -0000 1.46 @@ -479,7 +479,20 @@ static Int p_thread_detached(void) { - return Yap_unify(ARG1,ThreadHandle[worker_id].tdetach); + if (ThreadHandle[worker_id].tdetach) + return Yap_unify(ARG1,ThreadHandle[worker_id].tdetach); + else + return FALSE; +} + +static Int +p_thread_detached2(void) +{ + Int tid = IntegerOfTerm(Deref(ARG1)); + if (ThreadHandle[tid].tdetach) + return Yap_unify(ARG2,ThreadHandle[tid].tdetach); + else + return FALSE; } static Int @@ -820,6 +833,7 @@ Yap_InitCPred("thread_yield", 0, p_thread_yield, 0); Yap_InitCPred("$detach_thread", 1, p_thread_detach, HiddenPredFlag); Yap_InitCPred("$thread_detached", 1, p_thread_detached, HiddenPredFlag); + Yap_InitCPred("$thread_detached", 2, p_thread_detached2, HiddenPredFlag); Yap_InitCPred("$thread_exit", 0, p_thread_exit, HiddenPredFlag); Yap_InitCPred("thread_setconcurrency", 2, p_thread_set_concurrency, 0); Yap_InitCPred("$valid_thread", 1, p_valid_thread, HiddenPredFlag); |
|
From: Vitor S. C. <vs...@us...> - 2008-08-08 14:05:25
|
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv29177/C Modified Files: dbase.c threads.c Log Message: more thread fixes. Index: dbase.c =================================================================== RCS file: /cvsroot/yap/C/dbase.c,v retrieving revision 1.176 retrieving revision 1.177 diff -u -r1.176 -r1.177 --- dbase.c 7 Aug 2008 20:51:21 -0000 1.176 +++ dbase.c 8 Aug 2008 14:05:34 -0000 1.177 @@ -1837,11 +1837,13 @@ #if defined(YAPOR) || defined(THREADS) // INIT_LOCK(cl->ClLock); INIT_CLREF_COUNT(cl); -#endif + ipc->opc = Yap_opcode(_copy_idb_term); +#else if (needs_vars) ipc->opc = Yap_opcode(_copy_idb_term); else ipc->opc = Yap_opcode(_unify_idb_term); +#endif return cl; } @@ -5036,6 +5038,44 @@ return TRUE; } +static Int +p_enqueue_unlocked(void) +{ + Term Father = Deref(ARG1); + Term t; + QueueEntry *x; + db_queue *father_key; + + if (IsVarTerm(Father)) { + Yap_Error(INSTANTIATION_ERROR, Father, "enqueue"); + return FALSE; + } else if (!IsIntegerTerm(Father)) { + Yap_Error(TYPE_ERROR_INTEGER, Father, "enqueue"); + return FALSE; + } else + father_key = (db_queue *)IntegerOfTerm(Father); + while ((x = (QueueEntry *)AllocDBSpace(sizeof(QueueEntry))) == NULL) { + if (!Yap_growheap(FALSE, sizeof(QueueEntry), NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "in findall"); + return FALSE; + } + } + /* Yap_LUClauseSpace += sizeof(QueueEntry); */ + t = Deref(ARG1); + x->DBT = StoreTermInDB(Deref(ARG2), 2); + if (x->DBT == NULL) { + return FALSE; + } + x->next = NULL; + if (father_key->LastInQueue != NULL) + father_key->LastInQueue->next = x; + father_key->LastInQueue = x; + if (father_key->FirstInQueue == NULL) { + father_key->FirstInQueue = x; + } + return TRUE; +} + /* when reading an entry in the data base we are making it accessible from the outside. If the entry was removed, and this was the last pointer, the target entry would be immediately removed, leading to dangling pointers. @@ -5120,6 +5160,108 @@ } } + +static Int +p_dequeue_unlocked(void) +{ + db_queue *father_key; + QueueEntry *cur_instance, *prev_instance; + Term Father = Deref(ARG1); + + if (IsVarTerm(Father)) { + Yap_Error(INSTANTIATION_ERROR, Father, "dequeue"); + return FALSE; + } else if (!IsIntegerTerm(Father)) { + Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue"); + return FALSE; + } else + father_key = (db_queue *)IntegerOfTerm(Father); + prev_instance = NULL; + cur_instance = father_key->FirstInQueue; + while (cur_instance) { + Term TDB; + while ((TDB = GetDBTerm(cur_instance->DBT)) == 0L) { + if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growglobal(NULL)) { + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } else { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(Yap_Error_Size, 2, YENV, P)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } + } + if (Yap_unify(ARG2, TDB)) { + if (prev_instance) { + prev_instance->next = cur_instance->next; + if (father_key->LastInQueue == cur_instance) + father_key->LastInQueue = prev_instance; + } else if (cur_instance == father_key->LastInQueue) + father_key->FirstInQueue = father_key->LastInQueue = NULL; + else + father_key->FirstInQueue = cur_instance->next; + /* release space for cur_instance */ + keepdbrefs(cur_instance->DBT); + ErasePendingRefs(cur_instance->DBT); + FreeDBSpace((char *) cur_instance->DBT); + FreeDBSpace((char *) cur_instance); + return TRUE; + } else { + prev_instance = cur_instance; + cur_instance = cur_instance->next; + } + } + /* an empty queue automatically goes away */ + return FALSE; +} + +static Int +p_peek_queue(void) +{ + db_queue *father_key; + QueueEntry *cur_instance; + Term Father = Deref(ARG1); + + if (IsVarTerm(Father)) { + Yap_Error(INSTANTIATION_ERROR, Father, "dequeue"); + return FALSE; + } else if (!IsIntegerTerm(Father)) { + Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue"); + return FALSE; + } else + father_key = (db_queue *)IntegerOfTerm(Father); + cur_instance = father_key->FirstInQueue; + while (cur_instance) { + Term TDB; + while ((TDB = GetDBTerm(cur_instance->DBT)) == 0L) { + if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growglobal(NULL)) { + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } else { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(Yap_Error_Size, 2, YENV, P)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } + } + if (Yap_unify(ARG2, TDB)) { + return TRUE; + } + cur_instance = cur_instance->next; + } + return FALSE; +} + + + static Int p_clean_queues(void) { @@ -5205,7 +5347,8 @@ ReleaseTermFromDB(DBTerm *ref) { keepdbrefs(ref); - FreeDBSpace((char *)ref); + ErasePendingRefs(ref); + FreeDBSpace((char *) ref); } void @@ -5282,7 +5425,10 @@ Yap_InitCPred("$init_db_queue", 1, p_init_queue, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$db_key", 2, p_db_key, HiddenPredFlag); Yap_InitCPred("$db_enqueue", 2, p_enqueue, SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("$db_enqueue_unlocked", 2, p_enqueue_unlocked, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$db_dequeue", 2, p_dequeue, SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("$db_dequeue_unlocked", 2, p_dequeue_unlocked, SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("$db_peek_queue", 2, p_peek_queue, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$db_clean_queues", 1, p_clean_queues, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$switch_log_upd", 1, p_slu, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$log_upd", 1, p_lu, SafePredFlag|SyncPredFlag|HiddenPredFlag); Index: threads.c =================================================================== RCS file: /cvsroot/yap/C/threads.c,v retrieving revision 1.44 retrieving revision 1.45 diff -u -r1.44 -r1.45 --- threads.c 7 Aug 2008 20:51:22 -0000 1.44 +++ threads.c 8 Aug 2008 14:05:34 -0000 1.45 @@ -136,7 +136,6 @@ static void thread_die(int wid, int always_die) { - if (!always_die) { /* called by thread itself */ ThreadsTotalTime += Yap_cputime(); @@ -200,7 +199,7 @@ } } } while (t == 0); - free(ThreadHandle[myworker_id].tgoal); + Yap_ReleaseTermFromDB(ThreadHandle[myworker_id].tgoal); ThreadHandle[myworker_id].tgoal = NULL; tgs[1] = ThreadHandle[worker_id].tdetach; tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs); @@ -488,6 +487,7 @@ { thread_die(worker_id, FALSE); pthread_exit(NULL); + /* done, just make gcc happy */ return TRUE; } |
|
From: Vitor S. C. <vs...@us...> - 2008-08-08 14:05:25
|
Update of /cvsroot/yap/pl In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv29177/pl Modified Files: threads.yap Log Message: more thread fixes. Index: threads.yap =================================================================== RCS file: /cvsroot/yap/pl/threads.yap,v retrieving revision 1.77 retrieving revision 1.78 diff -u -r1.77 -r1.78 --- threads.yap 7 Aug 2008 20:51:23 -0000 1.77 +++ threads.yap 8 Aug 2008 14:05:34 -0000 1.78 @@ -30,8 +30,6 @@ recorda('$thread_alias', [0|main], _). '$init_thread0' :- recorda('$thread_defaults', [0, 0, 0, false, true], _), - '$new_mutex'(QId), - assert('$global_queue_mutex'(QId)), '$create_thread_mq'(0), '$new_mutex'(Id), assert('$with_mutex_mutex'(Id)). @@ -123,7 +121,8 @@ erase(R), fail. '$erase_thread_info'(Id) :- - message_queue_destroy(Id), + recorded('$queue',q(Id,_,_,_,QKey),_), + '$empty_mqueue'(QKey), fail. '$erase_thread_info'(_). @@ -527,10 +526,7 @@ var(Options), !, '$do_error'(instantiation_error, message_queue_create(Id, Options)). message_queue_create(Id, []) :- !, - '$new_mutex'(Mutex), - '$cond_create'(Cond), - '$mq_new_id'(Id, NId, Key), - recorda('$queue',q(Id,Mutex,Cond,NId,Key), _). + '$do_msg_queue_create'(Id). message_queue_create(Id, [alias(Alias)]) :- var(Alias), !, '$do_error'(instantiation_error, message_queue_create(Id, [alias(Alias)])). @@ -560,7 +556,17 @@ ; '$do_error'(type_error(variable, Id), message_queue_create(Id)) ). +'$do_msg_queue_create'(Id) :- + \+ recorded('$queue',q(Id,_,_,_,_), _), + '$new_mutex'(Mutex), + '$cond_create'(Cond), + '$mq_new_id'(Id, NId, Key), + recorda('$queue',q(Id,Mutex,Cond,NId,Key), _), + fail. +'$do_msg_queue_create'(_). + '$create_thread_mq'(TId) :- + \+ recorded('$queue',q(TId,_,_,_,_), _), '$new_mutex'(Mutex), '$cond_create'(Cond), '$mq_new_id'(TId, TId, Key), @@ -572,13 +578,12 @@ '$mq_new_id'(Id, Id, AtId) :- integer(Id), !, \+ recorded('$queue', q(_,_,_,Id,_), _), - atomic_concat('$queue__',Id,AtId), - !. + '$init_db_queue'(AtId). '$mq_new_id'(_, Id, AtId) :- '$integers'(Id), \+ recorded('$queue', q(_,_,_,Id,_), _), - atomic_concat('$queue__',Id,AtId), - !. + !, + '$init_db_queue'(AtId). '$integers'(-1). '$integers'(I) :- @@ -597,10 +602,10 @@ '$message_queue_destroy'(Queue) :- recorded('$queue',q(Queue,Mutex,Cond,_,QKey),R), !, - erase(R), + '$clean_mqueue'(QKey), '$cond_destroy'(Cond), '$destroy_mutex'(Mutex), - '$clean_mqueue'(QKey). + erase(R). '$message_queue_destroy'(Queue) :- atomic(Queue), !, '$do_error'(existence_error(message_queue,Queue),message_queue_destroy(Queue)). @@ -608,11 +613,14 @@ '$do_error'(type_error(atom,Name),message_queue_destroy(Name)). '$clean_mqueue'(Queue) :- - recorded(Queue,_,R), - erase(R), + '$db_dequeue'(Queue), fail. '$clean_mqueue'(_). +'$empty_mqueue'(Queue) :- + '$db_dequeue_unlocked'(Queue), + fail. +'$empty_mqueue'(_). message_queue_property(Id, Prop) :- ( nonvar(Id) -> @@ -673,7 +681,8 @@ '$do_thread_send_message'(Queue, Term) :- recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !, '$lock_mutex'(Mutex), - recordz(Key,Term,_), + '$db_enqueue_unlocked'(Key, Term), +% write(+Queue:Term),nl, '$cond_signal'(Cond), '$unlock_mutex'(Mutex). '$do_thread_send_message'(Queue, Term) :- @@ -691,14 +700,14 @@ thread_get_message(Queue, Term) :- recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !, '$lock_mutex'(Mutex), +% write(-Queue:Term),nl, '$thread_get_message_loop'(Key, Term, Mutex, Cond). thread_get_message(Queue, Term) :- '$do_error'(existence_error(message_queue,Queue),thread_get_message(Queue,Term)). '$thread_get_message_loop'(Key, Term, Mutex, _) :- - recorded(Key,Term,R), !, - erase(R), + '$db_dequeue_unlocked'(Key, Term), !, '$unlock_mutex'(Mutex). '$thread_get_message_loop'(Key, Term, Mutex, Cond) :- '$cond_wait'(Cond, Mutex), @@ -722,7 +731,7 @@ '$thread_peek_message2'(Key, Term, Mutex) :- - recorded(Key,Term,_), !, + '$db_peek_queue'(Key, Term), !, '$unlock_mutex'(Mutex). '$thread_peek_message2'(_, _, Mutex) :- '$unlock_mutex'(Mutex), |
|
From: Vitor S. C. <vs...@us...> - 2008-08-08 14:05:25
|
Update of /cvsroot/yap/H In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv29177/H Modified Files: Heap.h Regs.h clause.h Log Message: more thread fixes. Index: Heap.h =================================================================== RCS file: /cvsroot/yap/H/Heap.h,v retrieving revision 1.135 retrieving revision 1.136 diff -u -r1.135 -r1.136 --- Heap.h 7 Aug 2008 20:51:23 -0000 1.135 +++ Heap.h 8 Aug 2008 14:05:34 -0000 1.136 @@ -584,7 +584,7 @@ } all_heap_codes; #ifdef USE_SYSTEM_MALLOC -struct various_codes *Yap_heap_regs; +extern struct various_codes *Yap_heap_regs; #else #define Yap_heap_regs ((all_heap_codes *)HEAP_INIT_BASE) #endif Index: Regs.h =================================================================== RCS file: /cvsroot/yap/H/Regs.h,v retrieving revision 1.40 retrieving revision 1.41 diff -u -r1.40 -r1.41 --- Regs.h 25 Mar 2008 22:03:13 -0000 1.40 +++ Regs.h 8 Aug 2008 14:05:34 -0000 1.41 @@ -763,7 +763,7 @@ when we come from a longjmp */ #if PUSH_REGS /* In this case we need to initialise the abstract registers */ -REGSTORE Yap_standard_regs; +extern REGSTORE Yap_standard_regs; #endif /* PUSH_REGS */ /******************* controlling debugging ****************************/ Index: clause.h =================================================================== RCS file: /cvsroot/yap/H/clause.h,v retrieving revision 1.53 retrieving revision 1.54 diff -u -r1.53 -r1.54 --- clause.h 7 Aug 2008 20:51:23 -0000 1.53 +++ clause.h 8 Aug 2008 14:05:34 -0000 1.54 @@ -186,6 +186,7 @@ #define INIT_CLREF_COUNT(X) (X)->ClRefCount = 0 #define INC_CLREF_COUNT(X) (X)->ClRefCount++ #define DEC_CLREF_COUNT(X) (X)->ClRefCount-- + #define CL_IN_USE(X) ((X)->ClRefCount) #else #define INIT_CLREF_COUNT(X) |
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv17793/C Modified Files: absmi.c amasm.c arrays.c c_interface.c dbase.c index.c init.c modules.c threads.c Log Message: more threadin fixes Index: absmi.c =================================================================== RCS file: /cvsroot/yap/C/absmi.c,v retrieving revision 1.244 retrieving revision 1.245 diff -u -r1.244 -r1.245 --- absmi.c 6 Aug 2008 23:05:49 -0000 1.244 +++ absmi.c 7 Aug 2008 20:51:15 -0000 1.245 @@ -12,6 +12,9 @@ * comments: Portable abstract machine interpreter * * Last rev: $Date$,$Author$ * * $Log$ +* 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 * @@ -8269,9 +8272,6 @@ /* actually get rid of the code */ if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) { if (PREG != FAILCODE) { - /* I am the last one using this clause, hence I don't need a lock - to dispose of it - */ if (lcl->ClRefCount == 1) { /* make sure the clause isn't destroyed */ /* always add an extra reference */ Index: amasm.c =================================================================== RCS file: /cvsroot/yap/C/amasm.c,v retrieving revision 1.102 retrieving revision 1.103 diff -u -r1.102 -r1.103 --- amasm.c 11 Jul 2008 17:02:07 -0000 1.102 +++ amasm.c 7 Aug 2008 20:51:16 -0000 1.103 @@ -13,6 +13,9 @@ * * * Last rev: $Date$ * * $Log$ +* 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. @@ -1668,7 +1671,7 @@ ic->ChildIndex = NULL; ic->ClRefCount = 0; ic->ParentIndex = (LogUpdIndex *)cl_u; - INIT_LOCK(ic->ClLock); + // INIT_LOCK(ic->ClLock); cl_u->lui.ChildIndex = ic; cl_u->lui.ClRefCount++; } @@ -2774,7 +2777,7 @@ cl_u->luc.ClExt = NULL; cl_u->luc.ClPrev = cl_u->luc.ClNext = NULL; #if defined(YAPOR) || defined(THREADS) - INIT_LOCK(cl_u->luc.ClLock); + //INIT_LOCK(cl_u->luc.ClLock); INIT_CLREF_COUNT(&(cl_u->luc)); #endif } @@ -2838,7 +2841,7 @@ cl_u->lui.ParentIndex = NULL; cl_u->lui.ClSize = size; cl_u->lui.ClRefCount = 0; - INIT_LOCK(cl_u->lui.ClLock); + // INIT_LOCK(cl_u->lui.ClLock); #if defined(YAPOR) || defined(THREADS) INIT_CLREF_COUNT(&(cl_u->lui)); #endif Index: arrays.c =================================================================== RCS file: /cvsroot/yap/C/arrays.c,v retrieving revision 1.49 retrieving revision 1.50 diff -u -r1.49 -r1.50 --- arrays.c 11 Jun 2008 11:08:24 -0000 1.49 +++ arrays.c 7 Aug 2008 20:51:21 -0000 1.50 @@ -732,15 +732,15 @@ if (ptr->Flags & LogUpdMask) { LogUpdClause *lup = (LogUpdClause *)ptr; - LOCK(lup->ClLock); + // LOCK(lup->ClLock); lup->ClRefCount--; if (lup->ClRefCount == 0 && (lup->ClFlags & ErasedMask) && !(lup->ClFlags & InUseMask)) { - UNLOCK(lup->ClLock); + // UNLOCK(lup->ClLock); Yap_ErLogUpdCl(lup); } else { - UNLOCK(lup->ClLock); + // UNLOCK(lup->ClLock); } } else { ptr->NOfRefsTo--; @@ -1836,15 +1836,15 @@ if (ptr->Flags & LogUpdMask) { LogUpdClause *lup = (LogUpdClause *)ptr; - LOCK(lup->ClLock); + // LOCK(lup->ClLock); lup->ClRefCount--; if (lup->ClRefCount == 0 && (lup->ClFlags & ErasedMask) && !(lup->ClFlags & InUseMask)) { - UNLOCK(lup->ClLock); + // UNLOCK(lup->ClLock); Yap_ErLogUpdCl(lup); } else { - UNLOCK(lup->ClLock); + // UNLOCK(lup->ClLock); } } else { ptr->NOfRefsTo--; @@ -1858,9 +1858,9 @@ if (p->Flags & LogUpdMask) { LogUpdClause *lup = (LogUpdClause *)p; - LOCK(lup->ClLock); + // LOCK(lup->ClLock); lup->ClRefCount++; - UNLOCK(lup->ClLock); + // UNLOCK(lup->ClLock); } else { p->NOfRefsTo++; } Index: c_interface.c =================================================================== RCS file: /cvsroot/yap/C/c_interface.c,v retrieving revision 1.122 retrieving revision 1.123 diff -u -r1.122 -r1.123 --- c_interface.c 1 Aug 2008 21:44:24 -0000 1.122 +++ c_interface.c 7 Aug 2008 20:51:21 -0000 1.123 @@ -12,6 +12,9 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.123 2008/08/07 20:51:21 vsc +* more threadin fixes +* * Revision 1.122 2008/08/01 21:44:24 vsc * swi compatibility support * @@ -2298,36 +2301,10 @@ X_API Term YAP_StripModule(Term t, Term *modp) { - Term tmod; - - tmod = CurrentModule; - restart: - if (IsVarTerm(t)) { - return 0L; - } else if (IsAtomTerm(t)) { - *modp = tmod; - return t; - } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); - if (fun == FunctorModule) { - tmod = ArgOfTerm(1, t); - if (IsVarTerm(tmod) ) { - return 0L; - } - if (!IsAtomTerm(tmod) ) { - return 0L; - } - t = ArgOfTerm(2, t); - goto restart; - } - *modp = tmod; - return t; - } - return 0L; + return Yap_StripModule(t, modp); } - X_API int YAP_ThreadSelf(void) { Index: dbase.c =================================================================== RCS file: /cvsroot/yap/C/dbase.c,v retrieving revision 1.175 retrieving revision 1.176 diff -u -r1.175 -r1.176 --- dbase.c 6 Aug 2008 17:32:19 -0000 1.175 +++ dbase.c 7 Aug 2008 20:51:21 -0000 1.176 @@ -1835,7 +1835,7 @@ } cl->ClTimeEnd = TIMESTAMP_EOT; #if defined(YAPOR) || defined(THREADS) - INIT_LOCK(cl->ClLock); + // INIT_LOCK(cl->ClLock); INIT_CLREF_COUNT(cl); #endif if (needs_vars) Index: index.c =================================================================== RCS file: /cvsroot/yap/C/index.c,v retrieving revision 1.202 retrieving revision 1.203 diff -u -r1.202 -r1.203 --- index.c 11 Jul 2008 17:02:07 -0000 1.202 +++ index.c 7 Aug 2008 20:51:21 -0000 1.203 @@ -13,6 +13,9 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.203 2008/08/07 20:51:21 vsc +* more threadin fixes +* * Revision 1.202 2008/07/11 17:02:07 vsc * fixes by Bart and Tom: mostly libraries but nasty one in indexing * compilation. @@ -6132,7 +6135,7 @@ ncl->ChildIndex = cl->ChildIndex; ncl->ParentIndex = cl->ParentIndex; ncl->ClPred = cl->ClPred; - INIT_LOCK(ncl->ClLock); + // INIT_LOCK(ncl->ClLock); if (c == cl) { parent_block->lui.ChildIndex = ncl; } else { Index: init.c =================================================================== RCS file: /cvsroot/yap/C/init.c,v retrieving revision 1.174 retrieving revision 1.175 diff -u -r1.174 -r1.175 --- init.c 6 Aug 2008 17:32:19 -0000 1.174 +++ init.c 7 Aug 2008 20:51:22 -0000 1.175 @@ -1335,7 +1335,7 @@ Yap_heap_regs->logdb_erased_marker->ClNext = NULL; Yap_heap_regs->logdb_erased_marker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode,e); Yap_heap_regs->logdb_erased_marker->ClCode->opc = Yap_opcode(_op_fail); - INIT_LOCK(Yap_heap_regs->logdb_erased_marker->ClLock); + // INIT_LOCK(Yap_heap_regs->logdb_erased_marker->ClLock); INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker); Yap_heap_regs->yap_streams = NULL; #if DEBUG Index: modules.c =================================================================== RCS file: /cvsroot/yap/C/modules.c,v retrieving revision 1.34 retrieving revision 1.35 diff -u -r1.34 -r1.35 --- modules.c 13 Mar 2008 14:37:58 -0000 1.34 +++ modules.c 7 Aug 2008 20:51:22 -0000 1.35 @@ -264,6 +264,39 @@ return Yap_unify(ARG1, CurrentModule); } +Term +Yap_StripModule(Term t, Term *modp) +{ + Term tmod; + + tmod = CurrentModule; + restart: + if (IsVarTerm(t)) { + return 0L; + } else if (IsAtomTerm(t)) { + *modp = tmod; + return t; + } else if (IsApplTerm(t)) { + Functor fun = FunctorOfTerm(t); + if (fun == FunctorModule) { + tmod = ArgOfTerm(1, t); + if (IsVarTerm(tmod) ) { + return 0L; + } + if (!IsAtomTerm(tmod) ) { + return 0L; + } + t = ArgOfTerm(2, t); + goto restart; + } + *modp = tmod; + return t; + } + return 0L; +} + + + void Yap_InitModulesC(void) { Index: threads.c =================================================================== RCS file: /cvsroot/yap/C/threads.c,v retrieving revision 1.43 retrieving revision 1.44 diff -u -r1.43 -r1.44 --- threads.c 6 Aug 2008 17:32:20 -0000 1.43 +++ threads.c 7 Aug 2008 20:51:22 -0000 1.44 @@ -67,21 +67,24 @@ } static int -store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach) +store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term tgoal, Term tdetach, Term texit) { UInt pm; /* memory to be requested */ + Term tmod; + if (tsize < MinTrailSpace) tsize = MinTrailSpace; if (ssize < MinStackSpace) ssize = MinStackSpace; ThreadHandle[new_worker_id].ssize = ssize; ThreadHandle[new_worker_id].tsize = tsize; + ThreadHandle[new_worker_id].sysize = sysize; pm = (ssize + tsize)*1024; if (!(ThreadHandle[new_worker_id].stack_address = malloc(pm))) { return FALSE; } ThreadHandle[new_worker_id].tgoal = - Yap_StoreTermInDB(tgoal,4); + Yap_StoreTermInDB(tgoal,7); ThreadHandle[new_worker_id].cmod = CurrentModule; if (IsVarTerm(tdetach)){ @@ -91,6 +94,10 @@ ThreadHandle[new_worker_id].tdetach = tdetach; } + tgoal = Yap_StripModule(texit, &tmod); + ThreadHandle[new_worker_id].texit_mod = tmod; + ThreadHandle[new_worker_id].texit = + Yap_StoreTermInDB(tgoal,7); return TRUE; } @@ -114,6 +121,7 @@ ThreadHandle[wid].current_yaam_regs = NULL; free(ThreadHandle[wid].start_of_timesp); free(ThreadHandle[wid].last_timep); + Yap_FreeCodeSpace((ADDR)ThreadHandle[wid].texit); LOCK(ThreadHandlesLock); if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) || always_die) { @@ -213,9 +221,9 @@ } static int -init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach) +init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term tgoal, Term tdetach, Term texit) { - return store_specs(new_worker_id, ssize, tsize, tgoal, tdetach); + return store_specs(new_worker_id, ssize, tsize, sysize, tgoal, tdetach, texit); } static Int @@ -223,11 +231,14 @@ { UInt ssize; UInt tsize; + UInt sysize; Term tgoal = Deref(ARG1); Term tdetach = Deref(ARG5); + Term texit = Deref(ARG6); Term x2 = Deref(ARG2); Term x3 = Deref(ARG3); - int new_worker_id = IntegerOfTerm(Deref(ARG6)); + Term x4 = Deref(ARG4); + int new_worker_id = IntegerOfTerm(Deref(ARG7)); // fprintf(stderr," %d --> %d\n", worker_id, new_worker_id); if (IsBigIntTerm(x2)) @@ -236,13 +247,14 @@ return FALSE; ssize = IntegerOfTerm(x2); tsize = IntegerOfTerm(x3); + sysize = IntegerOfTerm(x4); /* UInt systemsize = IntegerOfTerm(Deref(ARG4)); */ if (new_worker_id == -1) { /* YAP ERROR */ return FALSE; } /* make sure we can proceed */ - if (!init_thread_engine(new_worker_id, ssize, tsize, tgoal, tdetach)) + if (!init_thread_engine(new_worker_id, ssize, tsize, sysize, tgoal, tdetach, texit)) return FALSE; ThreadHandle[new_worker_id].id = new_worker_id; ThreadHandle[new_worker_id].ref_count = 1; @@ -352,7 +364,7 @@ /* YAP ERROR */ return FALSE; } - if (!init_thread_engine(new_id, ops->ssize, ops->tsize, TermNil, TermNil)) + if (!init_thread_engine(new_id, ops->ssize, ops->tsize, ops->sysize, TermNil, TermNil, ops->egoal)) return FALSE; ThreadHandle[new_id].id = new_id; ThreadHandle[new_id].handle = pthread_self(); @@ -658,6 +670,57 @@ return TRUE; } +static Int +p_thread_stacks(void) +{ /* '$thread_signal'(+P) */ + Int tid = IntegerOfTerm(Deref(ARG1)); + Int status= TRUE; + + LOCK(ThreadHandlesLock); + if (!ThreadHandle[tid].in_use && + !ThreadHandle[tid].zombie) { + UNLOCK(ThreadHandlesLock); + return FALSE; + } + status &= Yap_unify(ARG2,MkIntegerTerm(ThreadHandle[tid].ssize)); + status &= Yap_unify(ARG3,MkIntegerTerm(ThreadHandle[tid].tsize)); + status &= Yap_unify(ARG4,MkIntegerTerm(ThreadHandle[tid].sysize)); + UNLOCK(ThreadHandlesLock); + return status; +} + +static Int +p_thread_atexit(void) +{ /* '$thread_signal'(+P) */ + Term t; + + if (ThreadHandle[worker_id].texit->Entry == MkAtomTerm(AtomTrue)) { + return FALSE; + } + do { + t = Yap_FetchTermFromDB(ThreadHandle[worker_id].texit); + if (t == 0) { + if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growglobal(NULL)) { + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + thread_die(worker_id, FALSE); + return FALSE; + } + } else { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growstack(ThreadHandle[worker_id].tgoal->NOfCells*CellSize)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + thread_die(worker_id, FALSE); + return FALSE; + } + } + } + } while (t == 0); + return Yap_unify(ARG1, t) && Yap_unify(ARG2, ThreadHandle[worker_id].texit_mod); +} + + static Int p_thread_signal(void) @@ -747,7 +810,7 @@ Yap_InitCPred("$max_workers", 1, p_max_workers, HiddenPredFlag); Yap_InitCPred("$max_threads", 1, p_max_threads, HiddenPredFlag); Yap_InitCPred("$thread_new_tid", 1, p_thread_new_tid, HiddenPredFlag); - Yap_InitCPred("$create_thread", 6, p_create_thread, HiddenPredFlag); + Yap_InitCPred("$create_thread", 7, p_create_thread, HiddenPredFlag); Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$thread_status_lock", 1, p_thread_status_lock, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$thread_status_unlock", 1, p_thread_status_unlock, SafePredFlag|HiddenPredFlag); @@ -771,12 +834,14 @@ Yap_InitCPred("$cond_signal", 1, p_cond_signal, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$cond_broadcast", 1, p_cond_broadcast, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$cond_wait", 2, p_cond_wait, SafePredFlag|HiddenPredFlag); + Yap_InitCPred("$thread_stacks", 4, p_thread_stacks, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$signal_thread", 1, p_thread_signal, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$nof_threads_created", 1, p_nof_threads_created, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$thread_sleep", 4, p_thread_sleep, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$thread_runtime", 1, p_thread_runtime, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$thread_self_lock", 1, p_thread_self_lock, SafePredFlag); + Yap_InitCPred("$thread_run_at_exit", 2, p_thread_atexit, SafePredFlag); Yap_InitCPred("$thread_unlock", 1, p_thread_unlock, SafePredFlag); } @@ -838,6 +903,7 @@ Yap_InitCPred("$max_threads", 1, p_max_threads, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$nof_threads_created", 1, p_nof_threads_created, SafePredFlag|HiddenPredFlag); + Yap_InitCPred("$thread_stacks", 4, p_thread_stacks, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$thread_runtime", 1, p_thread_runtime, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$thread_unlock", 1, p_thread_unlock, SafePredFlag); } |