diff --git a/scsh/syscalls.c b/scsh/syscalls.c index 55f1f36..9c5f864 100644 --- a/scsh/syscalls.c +++ b/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); - char** r1; - int r2; + S48_DECLARE_GC_PROTECT(1); + s48_value r1; - S48_GC_PROTECT_2(mv_vec,ret1); - r1 = scm_envvec(&r2); - ret1 = S48_VECTOR_REF(mv_vec,0); - SetAlienVal(ret1,(long) r1);//simple-assign - S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r2)); + S48_GC_PROTECT_1(ret1); + r1 = scm_envvec(); + ret1 = r1; 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); diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index 33a6312..4ebe5b2 100644 --- a/scsh/syscalls.scm +++ b/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)) - desc ; errno or #f - pid_t ; process' id - fixnum) ; process' status +(define-stubless-foreign %wait-pid/errno-list (pid options) + "wait_pid") +(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,8 +823,9 @@ ignore) (define (directory-files . args) - (let-optionals args ((dir ".") - (dotfiles? #f)) + (with-cwd-aligned + (let-optionals args ((dir ".") + (dotfiles? #f)) (check-arg string? dir directory-files) (receive (err cvec numfiles) (%open-dir (ensure-file-name-is-nondirectory dir)) @@ -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. diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index b4e940e..f053c38 100644 --- a/scsh/syscalls1.c +++ b/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); - return (*result_pid == -1) ? s48_enter_fixnum(errno) : S48_FALSE; - } + int status=0; + 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. diff --git a/scsh/syscalls1.h b/scsh/syscalls1.h index 650d4fb..f036f89 100644 --- a/scsh/syscalls1.h +++ b/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);