Implemented waitpid with the new FFI to support 32 bit parameters.

scsh/syscalls.c

@@ -80,26 +80,6 @@ s48_value df_fork(s48_value mv_vec)
     return ret1;
 }
 
-s48_value df_wait_pid(s48_value g1, s48_value g2, s48_value mv_vec)
-{
-    extern s48_value wait_pid(pid_t , int , pid_t *, int *);
-    s48_value ret1;
-    S48_DECLARE_GC_PROTECT(2);
-    s48_value r1;
-    pid_t r2;
-    int r3;
-
-    
-    
-    S48_GC_PROTECT_2(mv_vec,ret1);
-    r1 = wait_pid(s48_extract_fixnum(g1), s48_extract_fixnum(g2), &r2, &r3);
-    ret1 = r1;
-    S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
-    S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
-    S48_GC_UNPROTECT();
-    return ret1;
-}
-
 s48_value df_chdir(s48_value g1)
 {
     extern int chdir(const char *);
@@ -886,10 +866,10 @@ s48_value df_write_fdes_char(s48_value g1, s48_value g2)
 
 s48_value df_read_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec)
 {
-    extern int read_fdes_substring(s48_value , size_t , size_t , int );
+    extern ssize_t read_fdes_substring(s48_value , size_t , size_t , int );
     s48_value ret1;
     S48_DECLARE_GC_PROTECT(2);
-    int r1;
+    ssize_t r1;
 
     
     
@@ -903,10 +883,10 @@ s48_value df_read_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_v
 
 s48_value df_write_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec)
 {
-    extern int write_fdes_substring(s48_value , size_t , size_t , int );
+    extern ssize_t write_fdes_substring(s48_value , size_t , size_t , int );
     s48_value ret1;
     S48_DECLARE_GC_PROTECT(2);
-    int r1;
+    ssize_t r1;
 
     
     
@@ -972,21 +952,18 @@ s48_value df_scm_sort_filevec(s48_value g1, s48_value g2)
     return S48_FALSE;
 }
 
-s48_value df_scm_envvec(s48_value mv_vec)
+s48_value df_scm_envvec(void)
 {
-    extern char** scm_envvec(int *);
+    extern s48_value scm_envvec(void);
     s48_value ret1;
-    S48_DECLARE_GC_PROTECT(2);
+    S48_DECLARE_GC_PROTECT(1);
-    char** r1;
+    s48_value r1;
-    int r2;
 
     
     
-    S48_GC_PROTECT_2(mv_vec,ret1);
+    S48_GC_PROTECT_1(ret1);
-    r1 = scm_envvec(&r2);
+    r1 = scm_envvec();
-    ret1 = S48_VECTOR_REF(mv_vec,0);
+    ret1 = r1;
-    SetAlienVal(ret1,(long) r1);//simple-assign
-    S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r2));
     S48_GC_UNPROTECT();
     return ret1;
 }
@@ -1034,6 +1011,22 @@ s48_value df_align_env(s48_value g1)
     return S48_FALSE;
 }
 
+s48_value df_free_envvec(s48_value g1)
+{
+    extern s48_value free_envvec(s48_value );
+    s48_value ret1;
+    S48_DECLARE_GC_PROTECT(1);
+    s48_value r1;
+
+    
+    
+    S48_GC_PROTECT_1(ret1);
+    r1 = free_envvec(g1);
+    ret1 = r1;
+    S48_GC_UNPROTECT();
+    return ret1;
+}
+
 s48_value df_envvec_setenv(s48_value g1, s48_value g2)
 {
     extern s48_value envvec_setenv(s48_value , s48_value );
@@ -1071,11 +1064,18 @@ s48_value df_getenv(s48_value g1, s48_value mv_vec)
 
 s48_value df_delete_env(s48_value g1)
 {
-    extern void delete_env(const char *);
+    extern s48_value delete_env(s48_value );
+    s48_value ret1;
+    S48_DECLARE_GC_PROTECT(1);
+    s48_value r1;
 
     
-    delete_env(s48_extract_string(g1));
+    
-    return S48_FALSE;
+    S48_GC_PROTECT_1(ret1);
+    r1 = delete_env(g1);
+    ret1 = r1;
+    S48_GC_UNPROTECT();
+    return ret1;
 }
 
 s48_value df_set_cloexec(s48_value g1, s48_value g2)
@@ -1198,7 +1198,7 @@ s48_value s48_init_syscalls(void)
     S48_EXPORT_FUNCTION(df_exit);
     S48_EXPORT_FUNCTION(df__exit);
     S48_EXPORT_FUNCTION(df_fork);
-    S48_EXPORT_FUNCTION(df_wait_pid);
+    S48_EXPORT_FUNCTION(wait_pid);
     S48_EXPORT_FUNCTION(df_chdir);
     S48_EXPORT_FUNCTION(df_scheme_cwd);
     S48_EXPORT_FUNCTION(df_getgid);
@@ -1257,6 +1257,7 @@ s48_value s48_init_syscalls(void)
     S48_EXPORT_FUNCTION(df_install_env);
     S48_EXPORT_FUNCTION(df_create_env);
     S48_EXPORT_FUNCTION(df_align_env);
+    S48_EXPORT_FUNCTION(df_free_envvec);
     S48_EXPORT_FUNCTION(df_envvec_setenv);
     S48_EXPORT_FUNCTION(df_getenv);
     S48_EXPORT_FUNCTION(df_delete_env);

scsh/syscalls.scm

@@ -1,3 +1,4 @@
+
 ;;; POSIX system-call Scheme binding.
 ;;; Copyright (c) 1993 by Olin Shivers.
 
@@ -132,11 +133,11 @@
   pid)
 
 ;;; Posix waitpid(2) call.
-(define-foreign %wait-pid/errno (wait_pid (pid_t pid) (fixnum options))
+(define-stubless-foreign %wait-pid/errno-list (pid options)
-  desc		; errno or #f
+  "wait_pid")
-  pid_t  ; process' id
-  fixnum) ; process' status
 
+(define (%wait-pid/errno pid options)
+  (apply values (%wait-pid/errno-list pid options)))
 
 ;;; Miscellaneous process state
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -619,7 +620,8 @@
    fd)
 
 (define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
-  (%open path flags (:optional maybe-mode #o666)))
+    (with-cwd-aligned
+     (%open path flags (:optional maybe-mode #o666))))
 
 
 (define-foreign pipe-fdes/errno (scheme_pipe)
@@ -821,6 +823,7 @@
   ignore)
 
 (define (directory-files . args)
+  (with-cwd-aligned
    (let-optionals args ((dir       ".")
 			(dotfiles? #f))
     (check-arg string? dir directory-files)
@@ -831,7 +834,7 @@
       (let ((files (vector->list (C-string-vec->Scheme&free cvec numfiles))))
 	(if dotfiles? files
 	    (filter (lambda (f) (not (char=? (string-ref f 0) #\.)))
-		    files))))))
+		    files)))))))
 
 ;;; I do this one in C, I'm not sure why:
 ;;; It is used by MATCH-FILES.

scsh/syscalls1.c

@@ -56,11 +56,20 @@ extern char **environ;
 
 /* Args: pid, flags; returns [retval, status] */
 
-s48_value wait_pid(pid_t pid, int flags, pid_t *result_pid, int *status)
+s48_value wait_pid(s48_value s48_pid, s48_value s48_flags)
 {
-    *result_pid = waitpid(pid, status, flags);
+  int status=0;
-    return (*result_pid == -1) ? s48_enter_fixnum(errno) : S48_FALSE;
+  pid_t pid = (pid_t) s48_extract_integer (s48_pid); 
-    }
+  int flags = s48_extract_integer (s48_flags); 
+  pid_t result_pid;
+
+  result_pid = waitpid(pid, &status, flags);
+  fprintf (stderr, "status was %d \n", status);
+  return s48_cons ((result_pid == -1) ? s48_enter_fixnum(errno) : S48_FALSE, 
+		   s48_cons (s48_enter_integer (result_pid),
+			     s48_cons (s48_enter_integer (status),
+				       S48_NULL)));
+}
 
 
 /* env:  Scheme vector of Scheme strings, e.g., #("TERM=vt100" ...) or #T.

scsh/syscalls1.h

@@ -1,6 +1,6 @@
 /* Exports from syscalls1.c. */
 
-s48_value wait_pid(pid_t pid, int flags, pid_t *result_pid, int *status);
+s48_value wait_pid(s48_value pid, s48_value flags);
 
 int scheme_exec(const char *prog, s48_value argv, s48_value env);