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

fix unix environ

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@293 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-01-14 22:26:53 +00:00
parent 095e851b00
commit 4414acbdf9
10 changed files with 48 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/absmi.c
View File

@ -2173,7 +2173,7 @@ absmi(int inp)
JMPNext();
BOp(procceed, e);
PREG = (yamop *) CPREG;
PREG = CPREG;
Y = ENV;
#ifdef DEPTH_LIMIT
DEPTH = Y[E_DEPTH];

4
C/c_interface.c
View File

@ -335,7 +335,8 @@ Yapcut_fail(void)
{
BACKUP_B();
B = B->cp_b; /* cut_fail */
B = B->cp_b; /* cut_fail */
HB = B->cp_h; /* cut_fail */
RECOVER_B();
return(FALSE);
@ -347,6 +348,7 @@ Yapcut_succeed(void)
BACKUP_B();
B = B->cp_b;
HB = B->cp_h;
RECOVER_B();
return(TRUE);

23
C/exec.c
View File

@ -1254,30 +1254,25 @@ p_clean_ifcp(void) {
static Int
p_jump_env(void) {
CELL *env = LCL0-IntegerOfTerm(Deref(ARG1)), *prev = NULL, *cur = ENV;
choiceptr old, cptr, ocptr;
while (cur != env) {
prev = cur;
cur = (CELL *)cur[E_E];
}
if (prev != NULL) {
CP = (yamop *)(prev[E_CP]);
if (prev == NULL) {
return(FALSE);
}
ENV = env;
CP = (yamop *)(prev[E_CP]);
YENV = ENV = env;
/* force trail reset */
old = (choiceptr)(env[E_CB]);
cptr = ocptr = B;
while (ocptr->cp_b < old) {
ocptr = ocptr->cp_b;
while (B->cp_b < (choiceptr)env) {
B = B->cp_b;
}
while (cptr != ocptr) {
cptr->cp_tr = ocptr->cp_tr;
cptr = cptr->cp_b;
}
/* I could do this, but it is easier to leave the undwindig to the emulator */
B->cp_env = env;
B->cp_cp = CP;
B->cp_ap = CP;
B->cp_env = env;
B->cp_h = H;
/* I could do this, but it is easier to leave the unwinding to the emulator */
env[CP->u.yx.y] = ARG2;
return(FALSE);
}

7
C/tracer.c
View File

@ -121,7 +121,12 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* if (vsc_count < 49036000) return; */
/* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/
YP_fprintf(YP_stderr,"%lu (%x) ", vsc_count, CreepFlag);
#if defined(__GNUC__)
{
choiceptr myB=B;
YP_fprintf(YP_stderr,"%llu (%p, %p, %p) ", vsc_count, TR, ENV, myB);
}
#endif
/* check_trail_consistency(); */
if (pred == NULL) {
return;

6
H/Regs.h
View File

@ -10,7 +10,7 @@
* File: Regs.h *
* mods: *
* comments: YAP abstract machine registers *
* version: $Id: Regs.h,v 1.10 2002-01-03 16:28:17 vsc Exp $ *
* version: $Id: Regs.h,v 1.11 2002-01-14 22:26:51 vsc Exp $ *
*************************************************************************/
@ -269,7 +269,9 @@ EXTERN inline void save_machine_regs(void) {
REGS.HB_ = HB;
REGS.B_ = B;
REGS.CP_ = CP;
#ifndef DEBUG
REGS.CreepFlag_ = CreepFlag;
#endif
REGS.TR_ = TR;
}
@ -278,7 +280,9 @@ EXTERN inline void restore_machine_regs(void) {
HB = REGS.HB_;
B = REGS.B_;
CP = REGS.CP_;
#ifndef DEBUG
CreepFlag = REGS.CreepFlag_;
#endif
TR = REGS.TR_;
}

4
docs/yap.tex
View File

@ -5345,8 +5345,8 @@ Change to home directory.
Change to given directory. Acceptable directory names are strings or
atoms.
@item environ/2
Unify the first argument with an
environment variable, and the second with its value.
If the first argument is an atom, unify the second argument with the
value of the corresponding environment variable.
@item getcwd/1
Unify the first argument with an atom representing the current directory.
@item putenv/2

3
library/system.yap
View File

@ -240,6 +240,7 @@ exec(Command, [StdIn, StdOut, StdErr], PID) :-
handle_system_error(Error, off, G).
process_inp_stream_for_exec(Error, _, G, L, L) :- var(Error), !,
close_temp_streams(L),
throw(error(instantiation_error,G)).
process_inp_stream_for_exec(null, null, _, L, L) :- !.
process_inp_stream_for_exec(std, 0, _, L, L) :- !.
@ -252,6 +253,7 @@ process_inp_stream_for_exec(Stream, Stream, _, L, L) :-
process_out_stream_for_exec(Error, _, G, L, L) :- var(Error), !,
close_temp_streams(L),
throw(error(instantiation_error,G)).
process_out_stream_for_exec(null, null, _, L, L) :- !.
process_out_stream_for_exec(std, 1, _, L, L) :- !.
@ -263,6 +265,7 @@ process_out_stream_for_exec(Stream, Stream, _, L, L) :-
stream_property(Stream, input).
process_err_stream_for_exec(Error, _, G, L, L) :- var(Error), !,
close_temp_streams(L),
throw(error(instantiation_error,G)).
process_err_stream_for_exec(null, null, _, L, L) :- !.
process_err_stream_for_exec(std, 2, _, L, L) :- !.

6
library/system/sys.c
View File

@ -524,12 +524,12 @@ execute_command(void)
YapCloseAllOpenStreams();
close(0);
dup(inpf);
close(inpf);
close(1);
dup(outf);
close(2);
dup(outf);
close(inpf);
close(outf);
close(2);
dup(errf);
close(errf);
argv[0] = "sh";
argv[1] = "-c";

8
pl/boot.yap
View File

@ -1166,10 +1166,6 @@ catch(G, C, A) :-
!, '$handle_throw'(C, A, Ball)
).
% just create a choice-point
'$mark_tr'(_).
'$mark_tr'(_) :- fail.
%
% system_catch is like catch, but it avoids the overhead of a full
% meta-call by calling '$execute0' instead of $execute.
@ -1195,6 +1191,10 @@ catch(G, C, A) :-
!, '$handle_throw'(C, A, Ball)
).
% just create a choice-point
'$mark_tr'(_).
'$mark_tr'(_) :- fail.
'$force_to_1st'(_).
'$handle_throw'(C, A, '$ball'(Ball)) :-

14
pl/utils.yap
View File

@ -203,7 +203,7 @@ unix(cd(V)) :- var(V), !,
unix(cd(A)) :- atomic(A), !, cd(A).
unix(cd(V)) :-
throw(error(type_error(atomic,V),unix(cd(V)))).
unix(environ(X,Y)) :- do_environ(X,Y).
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)))).
@ -214,10 +214,20 @@ unix(system(V)) :- var(V), !,
throw(error(instantiation_error,unix(system(V)))).
unix(system(A)) :- atomic(A), !, system(A).
unix(system(V)) :-
throw(error(type_error(atomic,V),unix(system(V)))).
throw(error(type_error(atom,V),unix(system(V)))).
unix(shell) :- sh.
unix(putenv(X,Y)) :- '$putenv'(X,Y).
'$do_environ'(X, Y) :-
var(X), !,
throw(error(instantiation_error,unix(environ(X,Y)))).
'$do_environ'(X, Y) :- atom(X), !,
'$getenv'(X,Y).
'$do_environ'(X, Y) :-
throw(error(type_error(atom,X),unix(environ(X,Y)))).
putenv(Na,Val) :-
'$putenv'(Na,Val).