fix unix environ

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@293 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

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];

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);

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) {
+  if (prev == NULL) {
-    CP = (yamop *)(prev[E_CP]);
+    return(FALSE);
   }
-  ENV = env;
+  CP = (yamop *)(prev[E_CP]);
+  YENV = ENV = env;
   /* force trail reset */
-  old = (choiceptr)(env[E_CB]);
+  while (B->cp_b < (choiceptr)env) {
-  cptr = ocptr = B;
+    B = B->cp_b;
-  while (ocptr->cp_b < old) {
-    ocptr = ocptr->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);
 }

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;

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_;
 }
 

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
+If the first argument is an atom, unify the second argument with the
-environment variable, and the second with its value.
+value of the corresponding environment variable.
 @item getcwd/1
 Unify the first argument with an atom representing the current directory.
 @item putenv/2

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) :- !.

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";

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)) :-

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).