Implemented waitpid with the new FFI to support 32 bit parameters.
This commit is contained in:
marting
parent
b39fd47d82
commit
37fc37e78c
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue