cleanups in OS interface predicates.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1469 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
a1c99a72a1
commit
681717eecb
12
C/errors.c
12
C/errors.c
@ -961,6 +961,18 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
|
||||
serious = TRUE;
|
||||
}
|
||||
break;
|
||||
case OPERATING_SYSTEM_ERROR:
|
||||
{
|
||||
int i;
|
||||
|
||||
i = strlen(tmpbuf);
|
||||
nt[0] = MkAtomTerm(Yap_LookupAtom("operating_system_error"));
|
||||
tp = tmpbuf+i;
|
||||
psize -= i;
|
||||
fun = Yap_MkFunctor(Yap_LookupAtom("error"),2);
|
||||
serious = TRUE;
|
||||
}
|
||||
break;
|
||||
case OUT_OF_HEAP_ERROR:
|
||||
{
|
||||
int i;
|
||||
|
||||
135
C/sysbits.c
135
C/sysbits.c
@ -128,7 +128,7 @@ Yap_WinError(char *yap_error)
|
||||
NULL, GetLastError(),
|
||||
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
|
||||
NULL);
|
||||
Yap_Error(SYSTEM_ERROR, TermNil, "%s: %s", yap_error, msg);
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "%s at %s", msg, yap_error);
|
||||
}
|
||||
#endif /* _WIN32 */
|
||||
|
||||
@ -1706,20 +1706,29 @@ Yap_TrueFileName (char *source, char *result, int in_lib)
|
||||
static Int
|
||||
p_getcwd(void)
|
||||
{
|
||||
Term t;
|
||||
|
||||
#if __simplescalar__
|
||||
/* does not implement getcwd */
|
||||
strncpy(Yap_FileNameBuf,yap_pwd,YAP_FILENAME_MAX);
|
||||
#elif HAVE_GETCWD
|
||||
if (getcwd (Yap_FileNameBuf, YAP_FILENAME_MAX) == NULL)
|
||||
return FALSE;
|
||||
if (getcwd (Yap_FileNameBuf, YAP_FILENAME_MAX) == NULL) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in getcwd/1", strerror(errno));
|
||||
#else
|
||||
if (getwd (Yap_FileNameBuf) == NULL)
|
||||
return FALSE;
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "in getcwd/1");
|
||||
#endif
|
||||
t = Yap_StringToList(Yap_FileNameBuf);
|
||||
return Yap_unify(ARG1,t);
|
||||
return FALSE;
|
||||
}
|
||||
#else
|
||||
if (getwd (Yap_FileNameBuf) == NULL) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in getcwd/1", strerror(errno));
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "in getcwd/1");
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
#endif
|
||||
return Yap_unify(ARG1,MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)));
|
||||
}
|
||||
|
||||
/* Executes $SHELL under Prolog */
|
||||
@ -1728,27 +1737,23 @@ static Int
|
||||
p_sh (void)
|
||||
{ /* sh */
|
||||
#ifdef HAVE_SYSTEM
|
||||
register char *shell;
|
||||
char *shell;
|
||||
shell = (char *) getenv ("SHELL");
|
||||
if (shell == NULL)
|
||||
shell = "/bin/sh";
|
||||
/* Yap_CloseStreams(TRUE); */
|
||||
if (system (shell) < 0) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(SYSTEM_ERROR, TermNil,
|
||||
"sh: %s", strerror(errno));
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "%s in sh/0", strerror(errno));
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR, TermNil,
|
||||
"sh");
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "in sh/0");
|
||||
#endif
|
||||
return (FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
return (TRUE);
|
||||
return TRUE;
|
||||
#else
|
||||
#ifdef MSH
|
||||
register char *shell;
|
||||
shell = "msh -i";
|
||||
/* Yap_CloseStreams(); */
|
||||
system (shell);
|
||||
return (TRUE);
|
||||
#else
|
||||
@ -1762,17 +1767,14 @@ static Int
|
||||
p_shell (void)
|
||||
{ /* '$shell'(+SystCommand) */
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
return 0;
|
||||
Yap_Error(SYSTEM_ERROR,TermNil,"shell not available in this configuration");
|
||||
return FALSE;
|
||||
#else
|
||||
#if HAVE_SYSTEM
|
||||
char *shell;
|
||||
register int bourne = FALSE;
|
||||
Term t1 = Deref (ARG1);
|
||||
|
||||
if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
|
||||
Yap_Error(SYSTEM_ERROR,t1,"invalid argument to shell/1");
|
||||
return(FALSE);
|
||||
}
|
||||
shell = (char *) getenv ("SHELL");
|
||||
if (!strcmp (shell, "/bin/sh"))
|
||||
bourne = TRUE;
|
||||
@ -1780,14 +1782,13 @@ p_shell (void)
|
||||
bourne = TRUE;
|
||||
/* Yap_CloseStreams(TRUE); */
|
||||
if (bourne)
|
||||
return (system (Yap_FileNameBuf) == 0);
|
||||
else
|
||||
{
|
||||
return (system (RepAtom(AtomOfTerm(t1))->StrOfAE) == 0);
|
||||
else {
|
||||
int status = -1;
|
||||
int child = fork ();
|
||||
if (child == 0)
|
||||
{ /* let the children go */
|
||||
if (!execl (shell, shell, "-c", Yap_FileNameBuf, NIL)) {
|
||||
if (!execl (shell, shell, "-c", RepAtom(AtomOfTerm(t1))->StrOfAE , NULL)) {
|
||||
exit(-1);
|
||||
}
|
||||
exit(TRUE);
|
||||
@ -1804,10 +1805,9 @@ p_shell (void)
|
||||
#endif
|
||||
*/
|
||||
status == 0;
|
||||
return (result);
|
||||
return result;
|
||||
}
|
||||
}
|
||||
#undef command
|
||||
#else /* HAVE_SYSTEM */
|
||||
#ifdef MSH
|
||||
register char *shell;
|
||||
@ -1828,15 +1828,33 @@ p_system (void)
|
||||
{ /* '$system'(+SystCommand) */
|
||||
#ifdef HAVE_SYSTEM
|
||||
Term t1 = Deref (ARG1);
|
||||
if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
|
||||
Yap_Error(SYSTEM_ERROR,t1,"argument to system/1 is not valid");
|
||||
return(FALSE);
|
||||
char *s;
|
||||
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t1,"argument to system/1 unbound");
|
||||
return FALSE;
|
||||
} else if (IsAtomTerm(t1)) {
|
||||
s = RepAtom(AtomOfTerm(t1))->StrOfAE;
|
||||
} else {
|
||||
if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1");
|
||||
return FALSE;
|
||||
}
|
||||
s = Yap_FileNameBuf;
|
||||
}
|
||||
/* Yap_CloseStreams(TRUE); */
|
||||
#if _MSC_VER
|
||||
_flushall();
|
||||
#endif
|
||||
return (system (Yap_FileNameBuf) == 0);
|
||||
if (system (s)) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR,t1,"%s in system(%s)", strerror(errno), s);
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR,t1,"in system(%s)", s);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
return TRUE;
|
||||
#else
|
||||
#ifdef MSH
|
||||
register char *shell;
|
||||
@ -1863,23 +1881,29 @@ p_mv (void)
|
||||
char oldname[YAP_FILENAME_MAX], newname[YAP_FILENAME_MAX];
|
||||
Term t1 = Deref (ARG1);
|
||||
Term t2 = Deref (ARG2);
|
||||
if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
|
||||
Yap_Error(SYSTEM_ERROR,t1,"first argument to rename/2 is not valid");
|
||||
return(FALSE);
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t1, "first argument to rename/2 unbound");
|
||||
} else if (!IsAtomTerm(t1)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t1, "first argument to rename/2 not atom");
|
||||
}
|
||||
TrueFileName (Yap_FileNameBuf, oldname, FALSE);
|
||||
if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t2)) {
|
||||
Yap_Error(SYSTEM_ERROR,t2,"second argument to rename/2 is not valid");
|
||||
return(FALSE);
|
||||
if (IsVarTerm(t2)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "second argument to rename/2 unbound");
|
||||
} else if (!IsAtomTerm(t2)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
|
||||
}
|
||||
TrueFileName (Yap_FileNameBuf, newname, FALSE);
|
||||
TrueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, oldname, FALSE);
|
||||
TrueFileName (RepAtom(AtomOfTerm(t2))->StrOfAE, newname, FALSE);
|
||||
if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
|
||||
unlink (newname);
|
||||
if (r != 0) {
|
||||
Yap_Error(SYSTEM_ERROR,t2,"operating system error in rename/2");
|
||||
return(FALSE);
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR,t2,"%s in rename(%s,%s)", strerror(errno),oldname,newname);
|
||||
#else
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR,t2,"in rename(%s,%s)",oldname,newname);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
return (TRUE);
|
||||
return TRUE;
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR,TermNil,"rename/2 not available in this machine");
|
||||
return (FALSE);
|
||||
@ -1919,6 +1943,7 @@ p_cd (void)
|
||||
Term t1 = Deref (ARG1);
|
||||
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t1,"argument to cd/1 is not valid");
|
||||
return FALSE;
|
||||
} else if (IsAtomTerm(t1)) {
|
||||
TrueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, Yap_FileNameBuf2, FALSE);
|
||||
@ -1926,7 +1951,7 @@ p_cd (void)
|
||||
if (t1 == TermNil)
|
||||
return TRUE;
|
||||
if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
|
||||
Yap_Error(SYSTEM_ERROR,t1,"argument to cd/1 is not valid");
|
||||
Yap_Error(TYPE_ERROR_ATOM,t1,"argument to cd/1 is not valid");
|
||||
return FALSE;
|
||||
}
|
||||
TrueFileName (Yap_FileNameBuf, Yap_FileNameBuf2, FALSE);
|
||||
@ -1937,10 +1962,10 @@ p_cd (void)
|
||||
#endif
|
||||
if (chdir (Yap_FileNameBuf2) < 0) {
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(SYSTEM_ERROR, t1,
|
||||
"cd(%s): %s", Yap_FileNameBuf2, strerror(errno));
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, t1,
|
||||
"%s in cd(%s)", strerror(errno), Yap_FileNameBuf2);
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR,t1,"cd(%s)", Yap_FileNameBuf2);
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR,t1," in cd(%s)", Yap_FileNameBuf2);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
@ -2043,11 +2068,11 @@ static Int p_putenv(void)
|
||||
if (putenv(p0) == 0)
|
||||
return(TRUE);
|
||||
#if HAVE_STRERROR
|
||||
Yap_Error(SYSTEM_ERROR, TermNil,
|
||||
"putenv: %s", strerror(errno));
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil,
|
||||
"in putenv(%s)", strerror(errno), p0);
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR, TermNil,
|
||||
"putenv");
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil,
|
||||
"in putenv(%s)", p0);
|
||||
#endif
|
||||
return (FALSE);
|
||||
#else
|
||||
@ -2433,11 +2458,11 @@ Yap_InitSysPreds(void)
|
||||
Yap_InitCPred ("srandom", 1, p_srandom, SafePredFlag);
|
||||
Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$system", 1, p_system, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$rename", 2, p_mv, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("system", 1, p_system, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("rename", 2, p_mv, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("cd", 1, p_cd, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$yap_home", 1, p_yap_home, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$getcwd", 1, p_getcwd, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("getcwd", 1, p_getcwd, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag|HiddenPredFlag);
|
||||
|
||||
3
H/Yap.h
3
H/Yap.h
@ -10,7 +10,7 @@
|
||||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h,v 1.8 2005-10-18 17:04:43 vsc Exp $ *
|
||||
* version: $Id: Yap.h,v 1.9 2005-11-23 13:24:00 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
@ -453,6 +453,7 @@ typedef enum
|
||||
EXISTENCE_ERROR_STREAM,
|
||||
INSTANTIATION_ERROR,
|
||||
INTERRUPT_ERROR,
|
||||
OPERATING_SYSTEM_ERROR,
|
||||
OUT_OF_HEAP_ERROR,
|
||||
OUT_OF_STACK_ERROR,
|
||||
OUT_OF_TRAIL_ERROR,
|
||||
|
||||
@ -16,6 +16,9 @@
|
||||
|
||||
<h2>Yap-5.1.0:</h2>
|
||||
<ul>
|
||||
<li> FIXED: prolog_load_context(directory). </li>
|
||||
<li> FIXED: some small beautifications for system/1, getcwd/1, sh/1, rename/2. </li>
|
||||
<li> NEW: operating_system_error. </li>
|
||||
<li> FIXED: Restore could not recover DL_MALLOC info and was not recovering
|
||||
DBTerms correctly. </li>
|
||||
<li> FIXED: with locking field, AtomNil and friends might not be
|
||||
|
||||
@ -816,7 +816,7 @@ bootstrap(F) :-
|
||||
'$current_stream'(File,_,Stream),
|
||||
'$start_consult'(consult, File, LC),
|
||||
file_directory_name(File, Dir),
|
||||
'$getcwd'(OldD),
|
||||
getcwd(OldD),
|
||||
cd(Dir),
|
||||
(
|
||||
get_value('$lf_verbose',silent)
|
||||
|
||||
@ -180,7 +180,7 @@ use_module(M,F,Is) :-
|
||||
'$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, Reconsult, UseModule) :-
|
||||
'$record_loaded'(Stream, M),
|
||||
'$current_module'(OldModule,ContextModule),
|
||||
'$getcwd'(OldD),
|
||||
getcwd(OldD),
|
||||
get_value('$consulting_file',OldF),
|
||||
'$set_consulting_file'(Stream),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
@ -304,15 +304,7 @@ use_module(M,F,Is) :-
|
||||
prolog_load_context(_, _) :-
|
||||
get_value('$consulting_file',[]), !, fail.
|
||||
prolog_load_context(directory, DirName) :-
|
||||
get_value('$consulting_file',FileName),
|
||||
(FileName = user_input ->
|
||||
'$getcwd'(S),
|
||||
atom_codes(DirName,S)
|
||||
;
|
||||
atom_codes(FileName,S),
|
||||
'$strip_file_for_scd'(S,Dir,Unsure,Unsure),
|
||||
atom_codes(DirName,Dir)
|
||||
).
|
||||
getcwd(DirName).
|
||||
prolog_load_context(file, FileName) :-
|
||||
get_value('$included_file',IncFileName),
|
||||
( IncFileName = [] ->
|
||||
|
||||
@ -11,8 +11,13 @@
|
||||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2005-11-10 01:27:12 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-11-23 13:24:00 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.71 2005/11/10 01:27:12 vsc
|
||||
* fix debugger message for EOF input
|
||||
* fix fix to setof
|
||||
* fix profiler spewing out hidden atoms.
|
||||
*
|
||||
* Revision 1.70 2005/11/03 18:27:10 vsc
|
||||
* fix quote
|
||||
*
|
||||
@ -633,6 +638,9 @@ print_message(Level, Mss) :-
|
||||
'$output_error_message'(instantiation_error, Where) :-
|
||||
format(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
|
||||
[Where]).
|
||||
'$output_error_message'(operating_system_error, Where) :-
|
||||
format(user_error,'% OPERATING SYSTEM ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_heap_error, Where) :-
|
||||
format(user_error,'% OUT OF DATABASE SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
|
||||
13
pl/utils.yap
13
pl/utils.yap
@ -207,15 +207,6 @@ op(P,T,V) :- '$op2'(P,T,V).
|
||||
|
||||
%%% Operating System utilities
|
||||
|
||||
getcwd(D) :- '$getcwd'(SD), atom_codes(D, SD).
|
||||
|
||||
system(A) :- atom(A), !, atom_codes(A,S), '$system'(S).
|
||||
system(S) :- '$system'(S).
|
||||
|
||||
rename(Old,New) :- atom(Old), atom(New), !,
|
||||
name(Old,SOld), name(New,SNew),
|
||||
'$rename'(SOld,SNew).
|
||||
|
||||
unix(V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,unix(V)).
|
||||
unix(argv(L)) :- '$is_list_of_atoms'(L,L), !, '$argv'(L).
|
||||
@ -231,12 +222,12 @@ unix(environ(X,Y)) :- '$do_environ'(X,Y).
|
||||
unix(getcwd(X)) :- getcwd(X).
|
||||
unix(shell(V)) :- var(V), !,
|
||||
'$do_error'(instantiation_error,unix(shell(V))).
|
||||
unix(shell(A)) :- atomic(A), !, '$shell'(A).
|
||||
unix(shell(A)) :- atom(A), !, '$shell'(A).
|
||||
unix(shell(V)) :-
|
||||
'$do_error'(type_error(atomic,V),unix(shell(V))).
|
||||
unix(system(V)) :- var(V), !,
|
||||
'$do_error'(instantiation_error,unix(system(V))).
|
||||
unix(system(A)) :- atomic(A), !, system(A).
|
||||
unix(system(A)) :- atom(A), !, system(A).
|
||||
unix(system(V)) :-
|
||||
'$do_error'(type_error(atom,V),unix(system(V))).
|
||||
unix(shell) :- sh.
|
||||
|
||||
Reference in New Issue
Block a user