From a70fb915928c6d150addccfe2fa567e55cfdbc74 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Thu, 22 May 2008 23:25:21 +0000
Subject: [PATCH] add tmp_file/2

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2241 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 changes-5.1.html     |  1 +
 docs/yap.tex         | 14 ++++++++++++--
 library/swi.yap      |  1 +
 library/system.yap   | 28 ++++++++++++++++++++++++++-
 library/system/sys.c | 46 ++++++++++++++++++++++++++++++++++++++++----
 5 files changed, 83 insertions(+), 7 deletions(-)

diff --git a/changes-5.1.html b/changes-5.1.html
index bc7c84e9d..2c9461765 100644
--- a/changes-5.1.html
+++ b/changes-5.1.html
@@ -17,6 +17,7 @@ xb
 
 <h2>Yap-5.1.3:</h2>
 <ul>
+<li> NEW: tmp_file/2 (request from Nicos Angelopoulos).</li>
 <li> FIXED: too much pruning on predicate_property/2 (obs from Nicos
 Angelopoulos).</li>
 <li> FIXED: make sure we return to system mode on failing yesno.</li>
diff --git a/docs/yap.tex b/docs/yap.tex
index e7907f8ab..89e34557b 100644
--- a/docs/yap.tex
+++ b/docs/yap.tex
@@ -10395,8 +10395,18 @@ process. An interface to the @t{getpid} function.
 @syindex tmpnam/1
 @cnindex tmpnam/1
 
-Interface with @var{tmpnam}: create an unique file and unify its name
-with @var{File}.
+Interface with @var{tmpnam}: obtain a new, unique file name @var{File}.
+
+@item tmp_file(-@var{File})
+@findex  tmp_file/2
+@snindex tmp_file/2
+@cnindex tmp_file/2
+
+Create a name for a temporary file. @var{Base} is an user provided
+identifier for the category of file. The @var{TmpName} is guaranteed to
+be unique. If the system halts, it will automatically remove all created
+temporary files.
+
 
 @item exec(+@var{Command},[+@var{InputStream},+@var{OutputStream},+@var{ErrorStream}],-@var{PID})
 @findex  exec/3
diff --git a/library/swi.yap b/library/swi.yap
index c4823e6e4..794aec678 100644
--- a/library/swi.yap
+++ b/library/swi.yap
@@ -75,6 +75,7 @@ swi_predicate_table(_,term_variables(X,Y,Z),terms,term_variables(X,Y,Z)).
 swi_predicate_table(_,subsumes(X,Y),terms,subsumes(X,Y)).
 swi_predicate_table(_,unifiable(X,Y,Z),terms,unifiable(X,Y,Z)).
 swi_predicate_table(_,genarg(X,Y,Z),arg,genarg(X,Y,Z)).
+swi_predicate_table(_,tmp_file(X,Y),system,tmp_file(X,Y)).
 
 :- dynamic
    prolog:message/3.
diff --git a/library/system.yap b/library/system.yap
index 851c91ed6..eb7b8f5b1 100644
--- a/library/system.yap
+++ b/library/system.yap
@@ -43,6 +43,7 @@
 	system/2,
 	mktime/2,
 	tmpnam/1,
+	tmp_file/2,
 	wait/2,
 	working_directory/2
           ]).
@@ -51,6 +52,8 @@
 
 :- load_foreign_files([sys], [], init_sys).
 
+:- dynamic tmp_file_sequence_counter/1.
+
 % time builtins
 
 datime(X) :-
@@ -398,7 +401,7 @@ shell(Command, Status) :-
 	do_shell(Shell, Opt, Command, Status, Error),
 	handle_system_error(Error, off, G).
 
-protect_command([], [0'"]).
+protect_command([], [0'"]). % "
 protect_command([H|L], [H|NL]) :-
 	protect_command(L, NL).
 
@@ -493,3 +496,26 @@ mktemp(X,Y) :-
 tmpnam(X) :-
 	tmpnam(X, Error),
 	handle_system_error(Error, off, tmpnam(X)).
+
+tmp_file(Base,X) :-
+	var(Base), !,
+	throw(error(instantiation_error,tmp_file(Base,X))).	
+tmp_file(Base,X) :-
+	atom(Base), !,
+	tmpdir(Dir, Error),
+	handle_system_error(Error, off, tmp_file(Base,Error)),
+	pid(PID, Error),
+	handle_system_error(Error, off, tmp_file(Base,Error)),
+	tmp_file_sequence(I),
+	dir_separator(D),
+	atomic_concat([Dir,D,yap_,Base,'_',PID,'_',I],X).
+tmp_file(Base,X) :-
+	throw(error(type_error(atom,Base),tmp_file(Base,X))).	
+
+tmp_file_sequence(X) :-
+	retract(tmp_file_sequence_counter(X)),
+	X1 is X+1,
+	assert(tmp_file_sequence_counter(X1)).
+tmp_file_sequence(0) :-
+	assert(tmp_file_sequence_counter(1)).
+
diff --git a/library/system/sys.c b/library/system/sys.c
index bfeced18d..8ffe4d414 100644
--- a/library/system/sys.c
+++ b/library/system/sys.c
@@ -8,8 +8,11 @@
 *									 *
 **************************************************************************
 *									 *
-* $Id: sys.c,v 1.33 2007-10-05 18:24:30 vsc Exp $									 *
+* $Id: sys.c,v 1.34 2008-05-22 23:25:21 vsc Exp $									 *
 * mods:		$Log: not supported by cvs2svn $
+* mods:		Revision 1.33  2007/10/05 18:24:30  vsc
+* mods:		fix garbage collector and fix LeaveGoal
+* mods:		
 * mods:		Revision 1.32  2007/05/07 12:11:39  vsc
 * mods:		fix mktime fix
 * mods:		
@@ -483,15 +486,49 @@ p_mktemp(void)
 }
 
 static int
-p_tpmnam(void)
+p_tmpnam(void)
 {
 #if HAVE_TMPNAM
-  return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(tmpnam(NULL)))));
+  char buf[L_tmpnam], *s;
+  if (!(s = tmpnam(buf)))
+    return FALSE;
+  return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s)));
 #else
   return FALSE;
 #endif
 }
 
+static int
+p_tmpdir(void)
+{
+  char *s;
+#if defined(__MINGW32__) || _MSC_VER
+  char buf[512];
+  DWORD out = GetTempPath(512, buf);
+  if (!out) {
+    return(YAP_Unify(YAP_ARG2, WinError()));
+  }
+  if (out > 511) {
+    nbuf = malloc(out+1);
+    if (!nbuf)
+      return YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("no malloc memory")));
+    out = GetTempPath(512, nbuf);
+    if (!out) {
+      return(YAP_Unify(YAP_ARG2, WinError()));
+    }
+    return  YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(nbuf)));
+  }
+  return  YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(buf)));
+#else
+  if ((s = getenv("TMPDIR")))
+    return  YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s)));
+#ifdef P_tmpdir
+  return  YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(P_tmpdir)));
+#endif
+  return  YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/tmp")));
+#endif
+}
+
 /* return YAP's environment */
 static int
 p_environ(void)
@@ -1021,7 +1058,8 @@ init_sys(void)
   YAP_UserCPredicate("pid", pid, 2);
   YAP_UserCPredicate("kill", p_kill, 3);
   YAP_UserCPredicate("mktemp", p_mktemp, 3);
-  YAP_UserCPredicate("tmpnam", p_tpmnam, 2);
+  YAP_UserCPredicate("tmpnam", p_tmpnam, 2);
+  YAP_UserCPredicate("tmpdir", p_tmpdir, 2);
   YAP_UserCPredicate("rename_file", rename_file, 3);
   YAP_UserCPredicate("sleep", p_sleep, 2);
   YAP_UserCPredicate("error_message", error_message, 2);