From 4414acbdf90e66283478c5465f3a51aa6ee5404d Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Mon, 14 Jan 2002 22:26:53 +0000
Subject: [PATCH] fix unix environ

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@293 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/absmi.c            |  2 +-
 C/c_interface.c      |  4 +++-
 C/exec.c             | 23 +++++++++--------------
 C/tracer.c           |  7 ++++++-
 H/Regs.h             |  6 +++++-
 docs/yap.tex         |  4 ++--
 library/system.yap   |  3 +++
 library/system/sys.c |  6 +++---
 pl/boot.yap          |  8 ++++----
 pl/utils.yap         | 14 ++++++++++++--
 10 files changed, 48 insertions(+), 29 deletions(-)

diff --git a/C/absmi.c b/C/absmi.c
index 1eafdece3..01b691dfc 100644
--- a/C/absmi.c
+++ b/C/absmi.c
@@ -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];
diff --git a/C/c_interface.c b/C/c_interface.c
index 726472a4e..77dc8d459 100644
--- a/C/c_interface.c
+++ b/C/c_interface.c
@@ -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);
diff --git a/C/exec.c b/C/exec.c
index 203f3eb33..2ad29b7d7 100644
--- a/C/exec.c
+++ b/C/exec.c
@@ -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);
 }
diff --git a/C/tracer.c b/C/tracer.c
index 2f65b7f3e..b9b74799a 100644
--- a/C/tracer.c
+++ b/C/tracer.c
@@ -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;
diff --git a/H/Regs.h b/H/Regs.h
index 084eaba42..5e17c077b 100644
--- a/H/Regs.h
+++ b/H/Regs.h
@@ -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_;
 }
 
diff --git a/docs/yap.tex b/docs/yap.tex
index 285ab7bf5..129f9a9dd 100644
--- a/docs/yap.tex
+++ b/docs/yap.tex
@@ -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
diff --git a/library/system.yap b/library/system.yap
index 256363fe6..829d62e11 100644
--- a/library/system.yap
+++ b/library/system.yap
@@ -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) :- !.
diff --git a/library/system/sys.c b/library/system/sys.c
index 76a0061ff..66e370f23 100644
--- a/library/system/sys.c
+++ b/library/system/sys.c
@@ -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";
diff --git a/pl/boot.yap b/pl/boot.yap
index 49c6b58a1..6f38ff6c9 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -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)) :-
diff --git a/pl/utils.yap b/pl/utils.yap
index ba6b4d534..74e33442c 100644
--- a/pl/utils.yap
+++ b/pl/utils.yap
@@ -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).