Added several cwd-aligns. with-env usees with-lock. Some corrections

to getenv.

scsh/newports.scm

@@ -227,7 +227,8 @@
   (set-port-limit! port size)
   (set-port-buffer! port new-buffer))
 
-; TODO flush on stdinput is required
+; TODO flush on stdinput is required but probably impossible since current-input-port is a fluid and may change without notice. One possibility would be to override (current-input-port)
+
 ;;; This port can ONLY be flushed with a newline or a close-output
 ;;; flush-output  won't help
 (define (make-line-output-proc size)
@@ -339,12 +340,13 @@
 
 ;;; replace rts/channel-port.scm begin
 (define (open-file fname flags . maybe-mode)
-  (let ((fd (apply open-fdes fname flags maybe-mode))
-	(access (bitwise-and flags open/access-mask)))
-    ((if (or (= access open/read) (= access open/read+write))
-	 make-input-fdport
-	 make-output-fdport)
-     fd 0)))
+  (with-cwd-aligned
+   (let ((fd (apply open-fdes fname flags maybe-mode))
+	 (access (bitwise-and flags open/access-mask)))
+     ((if (or (= access open/read) (= access open/read+write))
+	  make-input-fdport
+	  make-output-fdport)
+      fd 0))))
 
 (define (open-input-file fname . maybe-flags)
   (let ((flags (:optional maybe-flags 0)))
@@ -641,16 +643,17 @@
 
 (define (call-with-mumble-file open close)
   (lambda (string proc)
-    (let ((port #f))
-      (dynamic-wind (lambda ()
-		      (if port
-			  (warn "throwing back into a call-with-...put-file"
-				string)
-			  (set! port (open string))))
-		    (lambda () (proc port))
-		    (lambda ()
-		      (if port
-			  (close port)))))))
+    (with-cwd-aligned
+     (let ((port #f))
+       (dynamic-wind (lambda ()
+		       (if port
+			   (warn "throwing back into a call-with-...put-file"
+				 string)
+			   (set! port (open string))))
+		     (lambda () (proc port))
+		     (lambda ()
+		       (if port
+			   (close port))))))))
 
 ;;; replace rts/channel-port.scm begin
 (define call-with-input-file

scsh/scsh.scm

@@ -130,8 +130,6 @@
   (%free-env (env:c-struct env)))
 
 (define env-lock (make-lock))
-(define (obtain-env-lock) (obtain-lock env-lock))	; Thunks for
-(define (release-env-lock) (release-lock env-lock))	; DYNAMIC-WINDs.
 
 (define current-process-env  #f)
 (define  $current-env #f)
@@ -153,9 +151,10 @@
 	       (set! current-process-env current-env-val)))))
 
 (define (with-env-aligned* thunk)
-  (dynamic-wind obtain-env-lock
-                (lambda () (dynamic-wind align-env! thunk values))
-		release-env-lock))
+  (dynamic-wind (lambda ()
+		  (with-lock env-lock
+			     align-env!)) 
+		thunk values))
 
 (define (with-total-env* alist thunk)
   (let-fluid $current-env (make-threads-env alist) thunk))
@@ -309,12 +308,12 @@
   (process-chdir dir)
   (set-cache:cwd *unix-cwd* (process-cwd)))
 
-;;; Dynamic-wind is not the rigth thing to take care of the lock;
+;;; Dynamic-wind is not the right thing to take care of the lock;
 ;;; it would release the lock on every context switch.
 ;;; With-lock releases the lock on a condition, using call/cc will 
 ;;; skrew things up
 
-;;; Should be moved somewhere else
+;;; Should be moved to somewhere else
 (define (with-lock lock thunk)
   (with-handler (lambda (condition more)
 		  (release-lock lock)

scsh/syscalls.scm

@@ -482,10 +482,11 @@
 						      
 		
 (define (file-info fd/port/fname . maybe-chase?)
-  (let ((chase? (:optional maybe-chase? #t)))
-    (receive (err info) (file-info/errno fd/port/fname chase?)
-      (if err (errno-error err file-info fd/port/fname chase?)
-	  info))))
+  (with-cwd-aligned
+   (let ((chase? (:optional maybe-chase? #t)))
+     (receive (err info) (file-info/errno fd/port/fname chase?)
+	      (if err (errno-error err file-info fd/port/fname chase?)
+		  info)))))
 
 
 (define file-attributes
@@ -885,7 +886,7 @@
 ;;; ENV->ALIST
 
 (define-foreign %load-env (scm_envvec)
-  desc))
+  desc)
 
 (define (env->list)
   (%load-env))
@@ -924,6 +925,9 @@
   (align_env (desc))
   ignore)
 
+(define-foreign %free-env
+  (free_envvec (desc))
+  desc)
 ;;; GETENV, SETENV
 ;;; they all assume an aligned env
 
@@ -941,8 +945,8 @@
  "#define errno_on_nonzero_or_false(x) ((x) ? s48_enter_fixnum(errno) : S48_FALSE)"
  "" "")
 
-(define-foreign envvec-delete-env (delete_env (string var))
-  ignore)
+(define-foreign envvec-delete-env (delete_env (desc var))
+  desc)
 
 
 ;;; Fd-ports

scsh/syscalls1.c

@@ -447,14 +447,28 @@ void align_env(s48_value pointer_to_struct)
     current_env = thread_env; 
 }
 
+s48_value free_envvec (s48_value pointer_to_struct)
+{
+  struct envvec* envv =  (struct envvec*) s48_extract_integer(pointer_to_struct);
+  int i;
+  if (envv->revealed)
+    {
+      envv->gcable = 1;
+      return S48_FALSE;
+    }
+  for (i=0; i<envv->size; i++)
+    Free(envv->env[i]);
+  Free(envv->env);
+  Free(envv);
+  return S48_TRUE;
+}
 
-
-int envvec_setenv(s48_value scheme_name, s48_value entry){
+s48_value envvec_setenv(s48_value scheme_name, s48_value entry){
   char * name = s48_extract_string(scheme_name);
   int namelen = strlen(name);
   char **ptr = environ;
   char ** newenv;
-  int size = current_env->size;	
+  int size;
   int number_of_entries = 0;
   char * newentry = Malloc(char, S48_STRING_LENGTH(entry) + 1);
   if ( !newentry) return  s48_enter_fixnum(errno);
@@ -463,7 +477,7 @@ int envvec_setenv(s48_value scheme_name, s48_value entry){
     fprintf(stderr, "no current_env, giving up" );
     exit (1);
   }
-
+  size = current_env->size;	
   while (*ptr){
     if ( ( strncmp(*ptr, name, namelen) == 0) && (*ptr)[namelen] == '=')
       {
@@ -498,14 +512,6 @@ int envvec_setenv(s48_value scheme_name, s48_value entry){
     }
 }
 
-//char** scm_envvec(int *len)	/* Returns environ c-vector & its length. */
-//{
-// char **ptr=environ;
-// while( *ptr ) ptr++;
-// *len = ptr-environ;
-//  return(environ);
-//}
-
 s48_value scm_envvec(){
   return char_pp_2_string_list(environ);
 }
@@ -559,7 +565,7 @@ int create_env(s48_value vec,  s48_value * envvec_addr)
     
   newenv = Malloc(char*, envsize+1);
   if( !newenv ) return errno;
-  thread_env = Malloc (struct envvec, 4);
+  thread_env = Malloc (struct envvec, 4); // TODO: why 4 ??
    if( !thread_env ) {
     Free (newenv);
     return errno;
@@ -591,17 +597,23 @@ int create_env(s48_value vec,  s48_value * envvec_addr)
 }
   
 /* Delete the env var. */
-void delete_env(const char *var)
+s48_value delete_env(s48_value name)
 {
-  int varlen = strlen(var);
-  char **ptr = environ-1;
+  int varlen = S48_STRING_LENGTH (name);
+  char * var = s48_extract_string (name);
+  char **ptr = environ;
   char **ptr2;
-  do if( !*++ptr ) return;
+  if (!current_env)  {
+    fprintf(stderr, "no current_env, giving up" );
+    exit (1);
+  }
+  do if( !*++ptr ) return S48_FALSE;
   while( strncmp(*ptr, var, varlen) || (*ptr)[varlen] != '=' );
   ptr2 = ptr;
   while (*++ptr2);
   *ptr = *ptr2;
   *ptr2 = NULL;
+  return S48_TRUE; 
 }	
 
 

scsh/syscalls1.h

@@ -45,7 +45,7 @@ s48_value scm_envvec(void);
 
 int install_env(s48_value vec);
 
-void delete_env(const char *var);
+s48_value delete_env(s48_value var);
 
 s48_value scm_gethostname(void);