From 68820cc37011aa59b26c05ee58edecc659612751 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Thu, 7 Jun 2001 17:54:29 +0000
Subject: [PATCH] sys changes

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@60 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 changes4.3.html      |  2 ++
 docs/yap.tex         | 26 +++++++++++++++++++-------
 library/system.yap   | 13 +++++++++----
 library/system/sys.c | 32 +++++++++++++++++++++++---------
 pl/utils.yap         |  5 +----
 5 files changed, 54 insertions(+), 24 deletions(-)

diff --git a/changes4.3.html b/changes4.3.html
index 99437daa2..d05e3490d 100644
--- a/changes4.3.html
+++ b/changes4.3.html
@@ -16,6 +16,8 @@
 
 <h2>Yap-4.3.19:</h2>
 <ul>
+	<li>DELETED: shell/1 is now available through system library.</li>
+	<li>FIXED: ! in meta-call wasn't cutting.</li>
 	<li>FIXED: MkLongIntTerm (from Stasinos Konstantinos).</li>
 	<li>NEW: Logtalk OO library (from Paulo Moura).</li>
 	<li>FIXED: CHR instalation.</li>
diff --git a/docs/yap.tex b/docs/yap.tex
index 46d9f3f88..6fba571a2 100644
--- a/docs/yap.tex
+++ b/docs/yap.tex
@@ -5302,17 +5302,12 @@ Renames file @var{F} to @var{G}.
 @cyindex sh/0
 Creates a new shell interaction.
 
-@item shell(+@var{S})
-@findex shell/1
-@snindex shell/1
-@cnindex shell/1
-Passes command @var{S} to the current shell (on UNIX environments).
-
 @item system(+@var{S})
 @findex system/1
 @snindex system/1
 @cyindex system/1
-Passes command @var{S} to the Bourne shell (on UNIX environments).
+Passes command @var{S} to the Bourne shell (on UNIX environments) or the
+current command interpreter in WIN32 environments.
 
 @item unix(+@var{S})
 @findex unix/1
@@ -7450,6 +7445,23 @@ for the command is returned in @var{Status}.
 Fetch the current directory at @var{CurDir}. If @var{NextDir} is bound
 to an atom, make its value the current working directory.
 
+@item sleep(+@var{Time})
+@findex  sleep/1
+@syindex sleep/1
+@cnindex sleep/1
+Block the current process for @var{Time} seconds. The number of seconds
+must be a positive number, and it may an integer or a float. The Unix
+implementation uses @code{usleep} if the number of seconds is below one,
+and @code{sleep} if it is over a second. The WIN32 implementation uses
+@code{Sleep} for both cases.
+
+@item wait(+@var{PID},-@var{Status})
+@findex  wait/2
+@syindex wait/2
+@cnindex wait/2
+Wait until process @var{PID} terminates, and return its exits @var{Status}.
+
+@comment exec(ls,[std,pipe(X),std], P), repeat, get0(X,C), write(C), nl, C = -1, !.
 @end table
 
 
diff --git a/library/system.yap b/library/system.yap
index 6b532c9fb..46562080c 100644
--- a/library/system.yap
+++ b/library/system.yap
@@ -1,4 +1,4 @@
-/*************************************************************************
+v/*************************************************************************
 *									 *
 *	 YAP Prolog 							 *
 *									 *
@@ -35,6 +35,7 @@
 	make_directory/1,
 	popen/3,
 	rename_file/2,
+	shell/0,
 	shell/1,
 	shell/2,
 	sleep/1,
@@ -46,6 +47,8 @@
 	working_directory/2
           ]).
 
+:- use_module(library(lists), [append/3]).
+
 :- load_foreign_files([sys], [], init_sys).
 
 % time builtins
@@ -126,6 +129,8 @@ directory_files(File, FileList, Ignore) :-
        handle_system_error(Error, Ignore, directory_files(File, FileList)).
 
 handle_system_error(Error, _Ignore, _G) :- var(Error), !.
+handle_system_error(Error, off, G) :- atom(Error), !,
+	throw(error(system_error(Error),G)).
 handle_system_error(Error, off, G) :-
 	error_message(Error, Message),
 	throw(error(system_error(Message),G)).
@@ -279,7 +284,7 @@ shell :-
 	G = shell,
 	get_shell(Shell),
 	atom_codes(FullCommand, Shell),
-	exec_command(FullCommand, '$stream'(0),'$stream'(0), '$stream'(1), PID, Error),
+	exec_command(FullCommand, '$stream'(0),'$stream'(1), '$stream'(2), PID, Error),
 	handle_system_error(Error, off, G),
 	wait(PID, _Status, Error),
 	handle_system_error(Error, off, G).
@@ -291,7 +296,7 @@ shell(Command) :-
 	atom_codes(Command, SC),
 	append(Shell, SC, ShellCommand),
 	atom_codes(FullCommand, ShellCommand),
-	exec_command(FullCommand, '$stream'(0),'$stream'(0), '$stream'(1), PID, Error),
+	exec_command(FullCommand, '$stream'(0),'$stream'(1), '$stream'(2), PID, Error),
 	handle_system_error(Error, off, G),
 	wait(PID, _Status, Error),
 	handle_system_error(Error, off, G).
@@ -303,7 +308,7 @@ shell(Command, Status) :-
 	atom_codes(Command, SC),
 	append(Shell, SC, ShellCommand),
 	atom_codes(FullCommand, ShellCommand),
-	exec_command(FullCommand, '$stream'(0),'$stream'(0), '$stream'(1), PID, Error),
+	exec_command(FullCommand, '$stream'(0),'$stream'(1), '$stream'(2), PID, Error),
 	handle_system_error(Error, off, G),
 	wait(PID, Status,Error),
 	handle_system_error(Error, off, G).
diff --git a/library/system/sys.c b/library/system/sys.c
index fb01c4606..915a3e17c 100644
--- a/library/system/sys.c
+++ b/library/system/sys.c
@@ -69,6 +69,20 @@
 
 void PROTO(init_sys, (void));
 
+#if defined(__MINGW32__) || _MSC_VER
+static Term
+WinError(void)
+{
+  char msg[256];
+  /* Error, we could not read time */
+    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+		  NULL, GetLastError(), 
+		  MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
+		  NULL);
+    return(MkAtomTerm(LookupAtom(msg)));
+}
+#endif
+
 /* Return time in a structure */
 static int
 datime(void)
@@ -392,8 +406,8 @@ execute_command(void)
   inpf = get_handle(ti, 0, tzero);
   outf = get_handle(to, 1, tzero);
   errf = get_handle(te, 2, tzero);
-  if (inpf != -1 || outf != -1 || errf != -1) {
-    /* we are keeping the curent streams */
+  if (inpf == -1 && outf == -1 && errf == -1) {
+    /* we do not keep a curent stream */
     CreationFlags = DETACHED_PROCESS;
   }
   StartupInfo.cb = sizeof(STARTUPINFO);
@@ -417,7 +431,7 @@ execute_command(void)
 		    NULL,
 		    &StartupInfo,
 		    &ProcessInformation) == FALSE) {
-    return(unify(ARG6, MkIntTerm(GetLastError())));
+    return(unify(ARG6, WinError()));
   }
   restore_descriptor(0, inpf, ti, tzero);
   restore_descriptor(1, outf, to, tzero);
@@ -517,13 +531,13 @@ p_wait(void)
   HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE, FALSE, pid);
   DWORD ExitCode;
   if (proc == NULL) {
-    return(unify(ARG3, MkIntTerm(GetLastError())));
+    return(unify(ARG3, WinError()));
   }
   if (WaitForSingleObject(proc, INFINITE) == WAIT_FAILED) {
-    return(unify(ARG3, MkIntTerm(GetLastError())));
+    return(unify(ARG3, WinError()));
   }
   if (GetExitCodeProcess(proc, &ExitCode) == 0) {
-    return(unify(ARG3, MkIntTerm(GetLastError())));
+    return(unify(ARG3, WinError()));
   }
   CloseHandle(proc);
   return(unify(ARG2, MkIntTerm(ExitCode)));
@@ -624,7 +638,7 @@ host_name(void)
   char name[MAX_COMPUTERNAME_LENGTH+1];
   DWORD nSize = MAX_COMPUTERNAME_LENGTH+1;
   if (GetComputerName(name, &nSize) == 0) {
-    return(unify(ARG2, MkIntTerm(GetLastError())));
+    return(unify(ARG2, WinError()));
   }
 #else
 #if HAVE_GETHOSTNAME
@@ -667,10 +681,10 @@ p_kill(void)
      always kill it */
   HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, IntOfTerm(ARG1));
   if (proc == NULL) {
-    return(unify(ARG3, MkIntTerm(GetLastError())));
+    return(unify(ARG3, WinError()));
   }
   if (TerminateProcess(proc, -1) == 0) {
-    return(unify(ARG3, MkIntTerm(GetLastError())));
+    return(unify(ARG3, WinError()));
   }
   CloseHandle(proc);
 #else
diff --git a/pl/utils.yap b/pl/utils.yap
index 90594dd94..aaf7f8d9a 100644
--- a/pl/utils.yap
+++ b/pl/utils.yap
@@ -242,9 +242,6 @@ getcwd(D) :- '$getcwd'(SD), atom_codes(D, SD).
 system(A) :- atom(A), !, atom_codes(A,S), '$system'(S).
 system(S) :- '$system'(S).
 
-shell(A) :- atom(A), !, atom_codes(A,S), '$shell'(S).
-shell(S) :- '$shell'(S).
-
 rename(Old,New) :- atom(Old), atom(New), !,
 	name(Old,SOld), name(New,SNew),
 	'$rename'(SOld,SNew).
@@ -264,7 +261,7 @@ unix(environ(X,Y)) :- do_environ(X,Y).
 unix(getcwd(X)) :- getcwd(X).
 unix(shell(V)) :- var(V), !,
 	throw(error(instantiation_error,unix(shell(V)))).
-unix(shell(A)) :- atomic(A), !, shell(A).
+unix(shell(A)) :- atomic(A), !, '$shell'(A).
 unix(shell(V)) :-
 	throw(error(type_error(atomic,V),unix(shell(V)))).
 unix(system(V)) :- var(V), !,