diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improve system library.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@113 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2001-06-29 19:30:25 +00:00
parent 54185708f9
commit 3de3c1b7d2
7 changed files with 6375 additions and 2567 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/c_interface.c
View File

@ -112,7 +112,7 @@ YapA(int i)
X_API Bool
YapIsIntTerm(Term t)
{
return (IsIntTerm(t) || IsLongIntTerm(t));
return (IsIntegerTerm(t));
}
X_API Bool

101
C/iopreds.c
View File

@ -106,7 +106,11 @@ typedef struct
Int pos;
} mem_string;
struct {
#if defined(__MINGW32__) || _MSC_VER
HANDLE hdl;
#else
int fd;
#endif
} pipe;
#if USE_SOCKET
struct {
@ -687,7 +691,17 @@ ConsolePipePutc (int sno, int ch)
ch = '\n';
}
#endif
#if _MSC_VER || defined(__MINGW32__)
{
DWORD written;
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &written, NULL) == FALSE) {
PlIOError (SYSTEM_ERROR,TermNil, "write to pipe returned error");
return(EOF);
}
}
#else
write(s->u.pipe.fd, &c, sizeof(c));
#endif
count_output_char(ch,s,sno);
return ((int) ch);
}
@ -703,7 +717,17 @@ PipePutc (int sno, int ch)
ch = '\n';
}
#endif
#if _MSC_VER || defined(__MINGW32__)
{
DWORD written;
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &written, NULL) == FALSE) {
PlIOError (SYSTEM_ERROR,TermNil, "write to pipe returned error");
return(EOF);
}
}
#else
write(s->u.pipe.fd, &c, sizeof(c));
#endif
console_count_output_char(ch,s,sno);
return ((int) ch);
}
@ -1082,9 +1106,18 @@ PipeGetc(int sno)
register StreamDesc *s = &Stream[sno];
register int ch;
char c;
int count;
/* should be able to use a buffer */
#if _MSC_VER || defined(__MINGW32__)
DWORD count;
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) {
PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error");
return(EOF);
}
#else
int count;
count = read(s->u.pipe.fd, &c, sizeof(char));
#endif
printf("reading from pipe %c\n", c);
if (count == 0) {
ch = EOF;
} else if (count > 0) {
@ -1106,7 +1139,11 @@ ConsolePipeGetc(int sno)
register StreamDesc *s = &Stream[sno];
register int ch;
char c;
#if _MSC_VER || defined(__MINGW32__)
DWORD count;
#else
int count;
#endif
/* send the prompt away */
if (newline) {
@ -1118,8 +1155,15 @@ ConsolePipeGetc(int sno)
strncpy(Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT);
newline = FALSE;
}
#if _MSC_VER || defined(__MINGW32__)
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) {
PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error");
return(EOF);
}
#else
/* should be able to use a buffer */
count = read(s->u.pipe.fd, &c, sizeof(char));
#endif
if (count == 0) {
ch = EOF;
} else if (count > 0) {
@ -1323,7 +1367,11 @@ GetStreamFd(int sno)
} else
#endif
if (Stream[sno].status & Pipe_Stream_f) {
#if _MSC_VER || defined(__MINGW32__)
return((int)(Stream[sno].u.pipe.hdl));
#else
return(Stream[sno].u.pipe.fd);
#endif
} else if (Stream[sno].status & InMemory_Stream_f) {
return(-1);
}
@ -1762,16 +1810,25 @@ p_open_pipe_stream (void)
Term t1, t2;
StreamDesc *st;
int sno;
int filedes[2];
#if _MSC_VER || defined(__MINGW32__)
if (_pipe(filedes, 256, O_TEXT) == -1)
#else
if (pipe(filedes) != 0)
#endif
HANDLE ReadPipe, WritePipe;
SECURITY_ATTRIBUTES satt;
satt.nLength = sizeof(satt);
satt.lpSecurityDescriptor = NULL;
satt.bInheritHandle = TRUE;
if (!CreatePipe(&ReadPipe, &WritePipe, &satt, 0))
{
return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
}
#else
int filedes[2];
if (pipe(filedes) != 0)
{
return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
}
#endif
for (sno = 0; sno < MaxStreams; ++sno)
if (Stream[sno].status & Free_Stream_f)
break;
@ -1784,8 +1841,15 @@ p_open_pipe_stream (void)
st->linecount = 1;
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
st->stream_getc_for_read = PipeGetc;
if (CharConversionTable != NULL)
st->stream_getc_for_read = ISOGetc;
else
st->stream_getc_for_read = PipeGetc;
#if _MSC_VER || defined(__MINGW32__)
st->u.pipe.hdl = ReadPipe;
#else
st->u.pipe.fd = filedes[0];
#endif
t1 = MkStream (sno);
for (; sno < MaxStreams; ++sno)
if (Stream[sno].status & Free_Stream_f)
@ -1803,7 +1867,11 @@ p_open_pipe_stream (void)
st->stream_getc_for_read = ISOGetc;
else
st->stream_getc_for_read = st->stream_getc;
#if _MSC_VER || defined(__MINGW32__)
st->u.pipe.hdl = WritePipe;
#else
st->u.pipe.fd = filedes[1];
#endif
t2 = MkStream (sno);
return (unify (ARG1, t1) && unify (ARG2, t2));
}
@ -2234,8 +2302,13 @@ CloseStreams (int loud)
continue;
if ((Stream[sno].status & Popen_Stream_f))
pclose (Stream[sno].u.file.file);
if ((Stream[sno].status & (Pipe_Stream_f|Socket_Stream_f)))
#if _MSC_VER || defined(__MINGW32__)
if (Stream[sno].status & Pipe_Stream_f)
CloseHandle (Stream[sno].u.pipe.hdl);
#else
if (Stream[sno].status & (Pipe_Stream_f|Socket_Stream_f))
close (Stream[sno].u.pipe.fd);
#endif
#if USE_SOCKET
else if (Stream[sno].status & (Socket_Stream_f)) {
CloseSocket(Stream[sno].u.socket.fd,
@ -2274,8 +2347,12 @@ CloseStream(int sno)
Stream[sno].u.socket.domain);
}
#endif
else if (Stream[sno].status & (Pipe_Stream_f)) {
else if (Stream[sno].status & Pipe_Stream_f) {
#if _MSC_VER || defined(__MINGW32__)
CloseHandle (Stream[sno].u.pipe.hdl);
#else
close(Stream[sno].u.pipe.fd);
#endif
}
else if (Stream[sno].status & (InMemory_Stream_f)) {
FreeAtomSpace(Stream[sno].u.mem_string.buf);
@ -4612,7 +4689,11 @@ StreamToFileNo(Term t)
int sno =
CheckStream(t, (Input_Stream_f|Output_Stream_f), "StreamToFileNo");
if (Stream[sno].status & Pipe_Stream_f) {
#if _MSC_VER || defined(__MINGW32__)
return((int)(Stream[sno].u.pipe.hdl));
#else
return(Stream[sno].u.pipe.fd);
#endif
} else if (Stream[sno].status & Socket_Stream_f) {
return(Stream[sno].u.socket.fd);
} else if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f)) {

13
TO_DO
View File

@ -1,16 +1,14 @@
BEFORE 4.4:
- mixed constraints and delays.
- mixed attributes and delays.
- write infinite terms
- constraints in DB.
- fix SBA plus co-routining
- non-void temporaries going to global
- interrupt handling in WIN32
- timestamps on files.
- warnings in documentation file.
- system library
- fix restore when code is moved around.
- library(system) for WIN32
- document system(library)
- document new interface functions.
- ^C can break code.
- add more precision when outputting floats.
@ -26,6 +24,11 @@ TABLING
- make gc work after mutable var changes.
- knap-sack
PARALLELISM
- copying: Fix stack copying after new stack.
- SBA: fix constraint and unification.
- IAP.
AFTER 4.4(?)
- change compilation order for arguments
- fix code for arithmetic
@ -35,6 +38,8 @@ AFTER 4.4(?)
- garbage collector cleans up clauses and logical update DB.
- atom garbage collector.
- lpdoc.
- incremental garbage collector.
- threads.
DONE:
- compilation of bignums.
@ -78,3 +83,5 @@ DONE:
- deterministic trail entries for multi-assignment variables.
- weird going ons with prompt and readline
- check library(random)
- document system(library)
- interrupt handling in WIN32

3
changes4.3.html
View File

@ -16,6 +16,9 @@
<h2>Yap-4.3.19:</h2>
<ul>
<li>FIXED: get_list + unify_local was being compiled into
glval, breaking ENV vars </li>
<li>FIXED: abort was crashing in Alpha machines.</li>
<li>FIXED: make ^c-a work within gc.</li>
<li>FIXED: handle correctly very deep nested terms while gc
marking.</li>

8589
configure vendored
View File

File diff suppressed because it is too large Load Diff

117
library/system.yap
View File

@ -39,6 +39,7 @@ v/*************************************************************************
shell/1,
shell/2,
sleep/1,
system/0,
system/1,
system/2,
time/1,
@ -218,55 +219,84 @@ working_directory(OLD, NEW) :-
%
exec(Command, [StdIn, StdOut, StdErr], PID) :-
G = exec(Command, [StdIn, StdOut, StdErr], PID),
check_command(Command, G),
process_inp_stream_for_exec(StdIn, In, G),
process_out_stream_for_exec(StdOut, Out, G),
process_err_stream_for_exec(StdErr, Err, G),
( exec_command(Command, In, Out, Err, PID, Error) -> true ; true ),
close_temp_streams(StdIn, In, StdOut, Out, StdErr, Err),
check_command_with_default_shell(Command, TrueCommand, G),
process_inp_stream_for_exec(StdIn, In, G, [], L1),
process_out_stream_for_exec(StdOut, Out, G, L1, L2),
process_err_stream_for_exec(StdErr, Err, G, L2, L3),
( exec_command(TrueCommand, In, Out, Err, PID, Error) -> true ; true ),
close_temp_streams(L3),
handle_system_error(Error, off, G).
process_inp_stream_for_exec(Error, _, G) :- var(Error), !,
process_inp_stream_for_exec(Error, _, G, L, L) :- var(Error), !,
throw(error(instantiation_error,G)).
process_inp_stream_for_exec(null, 0, _) :- !.
process_inp_stream_for_exec(std, '$stream'(0), _) :- !.
process_inp_stream_for_exec(pipe(SOut), SInp, _) :- !,
open_pipe_streams(SInp, SOut).
process_inp_stream_for_exec(Stream, Stream, _) :-
process_inp_stream_for_exec(null, null, _, L, L) :- !.
process_inp_stream_for_exec(std, 0, _, L, L) :- !.
process_inp_stream_for_exec(pipe(ForWriting), ForReading, _, L, [ForReading|L]) :- !,
open_pipe_streams(ForReading, ForWriting).
process_inp_stream_for_exec(Stream, Stream, _, L, L) :-
stream_property(Stream, input).
process_out_stream_for_exec(Error, _, G) :- var(Error), !,
process_out_stream_for_exec(Error, _, G, L, L) :- var(Error), !,
throw(error(instantiation_error,G)).
process_out_stream_for_exec(null, 0, _) :- !.
process_out_stream_for_exec(std, '$stream'(1), _) :- !.
process_out_stream_for_exec(pipe(SInp), SOut, _) :- !,
open_pipe_streams(SInp, SOut).
process_out_stream_for_exec(Stream, Stream, _) :-
process_out_stream_for_exec(null, null, _, L, L) :- !.
process_out_stream_for_exec(std, 1, _, L, L) :- !.
process_out_stream_for_exec(pipe(ForReading), ForWriting, _, L, [ForWriting|L]) :- !,
open_pipe_streams(ForReading, ForWriting).
process_out_stream_for_exec(Stream, Stream, _, L, L) :-
stream_property(Stream, output).
process_err_stream_for_exec(Error, _, G) :- var(Error), !,
process_err_stream_for_exec(Error, _, G, L, L) :- var(Error), !,
throw(error(instantiation_error,G)).
process_err_stream_for_exec(null, 0, _) :- !.
process_err_stream_for_exec(std, '$stream'(2), _) :- !.
process_err_stream_for_exec(pipe(SInp), SOut, _) :- !,
open_pipe_streams(SInp, SOut).
process_err_stream_for_exec(Stream, Stream, _) :-
process_err_stream_for_exec(null, null, _, L, L) :- !.
process_err_stream_for_exec(std, 2, _, L, L) :- !.
process_err_stream_for_exec(pipe(ForReading), ForWriting, _, L, [ForWriting|L]) :- !,
open_pipe_streams(ForReading, ForWriting).
process_err_stream_for_exec(Stream, Stream, _, L, L) :-
stream_property(Stream, output).
close_temp_streams(pipe(_), S, _, _, _, _) :- close(S), fail.
close_temp_streams(_, _, pipe(_), S, _, _) :- close(S), fail.
close_temp_streams(_, _, _, _, pipe(_), S) :- close(S), fail.
close_temp_streams(_, _, _, _, _, _).
close_temp_streams([]).
close_temp_streams([S|Ss]) :- close(S),
close_temp_streams(Ss).
popen(Command, Mode, Stream) :-
G = popen(Command, Mode, Stream),
check_command(Command, G),
check_command_with_default_shell(Command, TrueCommand, G),
check_mode(Mode, M, G),
popen(Command, M, Stream, Result),
do_popen(TrueCommand, M, Stream, Result),
handle_system_error(Result, off, G).
do_popen(Command, M, Stream, Result) :- win, !,
win_popen(M, Command, Stream, Result).
do_popen(Command, M, Stream, Result) :-
popen(Command, M, Stream, Result).
win_popen(0, Command, ForReading, Result) :-
open_pipe_streams(ForReading, ForWriting),
exec_command(Command, 0, ForWriting, 2, _, Result),
close(ForWriting).
win_popen(1, Command, ForWriting, Result) :-
open_pipe_streams(Stream, ForWriting),
exec_command(Command, ForReading, 1, 2, _, Result),
close(ForReading).
check_command_with_default_shell(Com, ComF, G) :-
check_command(Com, G),
os_command_postprocess(Com, ComF).
%
% make sure that Windows executes the command from $COMSPEC.
%
os_command_postprocess(Com, ComF) :- win, !,
atom_codes(Com, SC),
append(" /c ", SC, SC1),
getenv('COMSPEC', Shell0),
atom_codes(Shell0, Codes),
append(Codes, SC1, SCF),
atom_codes(ComF, SCF).
os_command_postprocess(Com, Com).
check_command(Com, G) :- var(Com), !,
throw(error(instantiation_error,G)).
check_command(Com, _) :- atom(Com), !.
@ -283,7 +313,7 @@ check_mode(Mode, G) :-
shell :-
G = shell,
get_shell0(FullCommand),
exec_command(FullCommand, '$stream'(0),'$stream'(1), '$stream'(2), PID, Error),
exec_command(FullCommand, 0, 1, 2, PID, Error),
handle_system_error(Error, off, G),
wait(PID, _Status, Error),
handle_system_error(Error, off, G).
@ -295,7 +325,7 @@ shell(Command) :-
atom_codes(Command, SC),
append(Shell, SC, ShellCommand),
atom_codes(FullCommand, ShellCommand),
exec_command(FullCommand, '$stream'(0),'$stream'(1), '$stream'(2), PID, Error),
exec_command(FullCommand, 0, 1, 2, PID, Error),
handle_system_error(Error, off, G),
wait(PID, _Status, Error),
handle_system_error(Error, off, G).
@ -307,7 +337,7 @@ shell(Command, Status) :-
atom_codes(Command, SC),
append(Shell, SC, ShellCommand),
atom_codes(FullCommand, ShellCommand),
exec_command(FullCommand, '$stream'(0),'$stream'(1), '$stream'(2), PID, Error),
exec_command(FullCommand, 0, 1, 2, PID, Error),
handle_system_error(Error, off, G),
wait(PID, Status,Error),
handle_system_error(Error, off, G).
@ -315,23 +345,36 @@ shell(Command, Status) :-
get_shell0(Shell) :-
getenv('SHELL', Shell), !.
get_shell0(Shell) :-
win,
win, !,
getenv('COMSPEC', Shell0).
get_shell0('/bin/sh').
get_shell(Shell) :-
getenv('SHELL', Shell0), !,
atom_codes(Shell0, Codes),
append(Codes," -c ", Shell).
get_shell(Shell) :-
win,
getenv('COMPSEC', Shell0),
win, !,
getenv('COMSPEC', Shell0),
atom_codes(Shell0, Codes),
append(Codes," /c ", Shell).
get_shell("/bin/sh -c").
system :-
default_shell(Command),
do_system(Command, _Status, Error),
handle_system_error(Error, off, system).
default_shell(Shell) :- win, !,
getenv('COMSPEC', Shell).
default_shell('/bin/sh').
system(Command, Status) :-
G = system(Command, Status),
check_command(Command, G),
do_system(Command, Status).
do_system(Command, Status, Error),
handle_system_error(Error, off, G).
sleep(Interval) :- var(Interval), !,
throw(error(instantiation_error,sleep(Interval))).

117
library/system/sys.c
View File

@ -361,34 +361,40 @@ p_environ(void)
}
#if defined(__MINGW32__) || _MSC_VER
static int
get_handle(Term ti, int fd, Term tzero)
static HANDLE
get_handle(Term ti, DWORD fd)
{
if (ti == tzero) {
int new_fd = _dup(fd);
_close(fd);
return(new_fd);
if (IsAtomTerm(ti)) {
HANDLE out;
SECURITY_ATTRIBUTES satt;
satt.nLength = sizeof(satt);
satt.lpSecurityDescriptor = NULL;
satt.bInheritHandle = TRUE;
out = CreateFile("NUL",
GENERIC_READ|GENERIC_WRITE,
FILE_SHARE_READ|FILE_SHARE_WRITE,
&satt,
OPEN_EXISTING,
0,
NULL);
return(out);
} else {
int sd = YapStreamToFileNo(ti), new_fd;
if (sd == fd)
return(-1);
new_fd = _dup(fd);
_close(fd);
_dup2(sd, fd);
return(new_fd);
if (IsIntTerm(ti)) {
return(GetStdHandle(fd));
} else
return((HANDLE)YapStreamToFileNo(ti));
}
}
static void
restore_descriptor(int fd0, int fd, Term t, Term tzero)
close_handle(Term ti, HANDLE h)
{
if (fd != -1) {
if (t != tzero) {
_close(fd0);
}
_dup2(fd, fd0);
if (IsAtomTerm(ti)) {
CloseHandle(h);
}
}
#endif
/* execute a command as a detached process */
@ -396,18 +402,29 @@ static int
execute_command(void)
{
Term ti = ARG2, to = ARG3, te = ARG4;
Term tzero = MkIntTerm(0);
int res;
int inpf, outf, errf;
#if defined(__MINGW32__) || _MSC_VER
HANDLE inpf, outf, errf;
DWORD CreationFlags = 0;
STARTUPINFO StartupInfo;
PROCESS_INFORMATION ProcessInformation;
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 do not keep a curent stream */
inpf = get_handle(ti, STD_INPUT_HANDLE);
if (inpf == INVALID_HANDLE_VALUE) {
return(unify(ARG6, WinError()));
}
outf = get_handle(to, STD_OUTPUT_HANDLE);
if (outf == INVALID_HANDLE_VALUE) {
close_handle(ti, inpf);
return(unify(ARG6, WinError()));
}
errf = get_handle(te, STD_OUTPUT_HANDLE);
if (errf == INVALID_HANDLE_VALUE) {
close_handle(ti, inpf);
close_handle(to, outf);
return(unify(ARG6, WinError()));
}
if (!IsIntTerm(ti) && !IsIntTerm(to) && !IsIntTerm(te)) {
/* we do not keep a current stream */
CreationFlags = DETACHED_PROCESS;
}
StartupInfo.cb = sizeof(STARTUPINFO);
@ -417,9 +434,9 @@ execute_command(void)
StartupInfo.dwFlags = STARTF_USESTDHANDLES;
StartupInfo.cbReserved2 = 0;
StartupInfo.lpReserved2 = NULL;
StartupInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
StartupInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE);
StartupInfo.hStdInput = inpf;
StartupInfo.hStdOutput = outf;
StartupInfo.hStdError = errf;
/* got stdin, stdout and error as I like it */
if (CreateProcess(NULL,
AtomName(AtomOfTerm(ARG1)),
@ -431,19 +448,27 @@ execute_command(void)
NULL,
&StartupInfo,
&ProcessInformation) == FALSE) {
close_handle(ti, inpf);
close_handle(to, outf);
close_handle(te, errf);
return(unify(ARG6, WinError()));
}
restore_descriptor(0, inpf, ti, tzero);
restore_descriptor(1, outf, to, tzero);
restore_descriptor(2, errf, te, tzero);
close_handle(ti, inpf);
close_handle(to, outf);
close_handle(te, errf);
res = ProcessInformation.dwProcessId;
return(unify(ARG5,MkIntTerm(res)));
#else /* UNIX CODE */
int inpf, outf, errf;
/* process input first */
if (ti == tzero) {
if (IsAtomTerm(ti)) {
inpf = open("/dev/null", O_RDONLY);
} else {
int sd = YapStreamToFileNo(ti);
int sd;
if (IsIntTerm(ti))
sd = 0;
else
sd = YapStreamToFileNo(ti);
inpf = dup(sd);
}
if (inpf < 0) {
@ -451,25 +476,36 @@ execute_command(void)
return(unify(ARG6, MkIntTerm(errno)));
}
/* then output stream */
if (to == tzero) {
if (IsAtomTerm(to)) {
outf = open("/dev/zero", O_WRONLY);
} else {
int sd = YapStreamToFileNo(to);
int sd;
if (IsIntTerm(to))
sd = 1;
else
sd = YapStreamToFileNo(to);
outf = dup(sd);
}
if (outf < 0) {
/* return an error number */
close(inpf);
return(unify(ARG6, MkIntTerm(errno)));
}
/* then error stream */
if (te == tzero) {
if (IsAtomTerm(te)) {
errf = open("/dev/zero", O_WRONLY);
} else {
int sd = YapStreamToFileNo(te);
int sd;
if (IsIntTerm(te))
sd = 2;
else
sd = YapStreamToFileNo(te);
errf = dup(sd);
}
if (errf < 0) {
/* return an error number */
close(inpf);
close(outf);
return(unify(ARG6, MkIntTerm(errno)));
}
/* we are now ready to fork */
@ -518,6 +554,9 @@ do_system(void)
char *command = AtomName(AtomOfTerm(ARG1));
int sys = system(command);
#if HAVE_SYSTEM
if (sys < 0) {
return(unify(ARG3,MkIntTerm(errno)));
}
return(unify(ARG2, MkIntTerm(sys)));
#endif
}
@ -730,7 +769,7 @@ init_sys(void)
UserCPredicate("dir_separator", dir_separator, 1);
UserCPredicate("p_environ", p_environ, 2);
UserCPredicate("exec_command", execute_command, 6);
UserCPredicate("do_system", do_system, 2);
UserCPredicate("do_system", do_system, 3);
UserCPredicate("popen", p_popen, 4);
UserCPredicate("wait", p_wait, 3);
UserCPredicate("host_name", host_name, 2);