~ chicken-core (chicken-5) f84051ca4b85b7a8ab7bfc6ec68efa2219c02a9a

commit f84051ca4b85b7a8ab7bfc6ec68efa2219c02a9a
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Oct 14 09:43:13 2011 +0200
Commit:     Christian Kellermann <ck@emlix.com>
CommitDate: Fri Oct 14 10:06:06 2011 +0200

    moved some posix functions into posix-common, corrected entry for process-wait in types.db
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/posix-common.scm b/posix-common.scm
index 8c953546..89e87d34 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -487,3 +487,18 @@ EOF
                 (##sys#substring str 0 (fx- (##sys#size str) 1))
                 (##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
 
+
+;;; Processes
+
+(define current-process-id (foreign-lambda int "C_getpid"))
+
+(define process-wait
+  (lambda args
+    (let-optionals* args ([pid #f] [nohang #f])
+      (let ([pid (or pid -1)])
+        (##sys#check-exact pid 'process-wait)
+        (receive [epid enorm ecode] (##sys#process-wait pid nohang)
+          (if (fx= epid -1)
+              (posix-error #:process-error 'process-wait "waiting for child process failed" pid)
+              (values epid enorm ecode) ) ) ) ) ) )
+
diff --git a/posixunix.scm b/posixunix.scm
index ee173252..ec3df0f7 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1837,17 +1837,6 @@ EOF
               (##core#inline "C_WTERMSIG" _wait-status)]
             [else (##core#inline "C_WSTOPSIG" _wait-status)] ) ) ) )
 
-(define process-wait
-  (lambda args
-    (let-optionals* args ([pid #f] [nohang #f])
-      (let ([pid (or pid -1)])
-        (##sys#check-exact pid 'process-wait)
-        (receive [epid enorm ecode] (##sys#process-wait pid nohang)
-          (if (fx= epid -1)
-              (posix-error #:process-error 'process-wait "waiting for child process failed" pid)
-              (values epid enorm ecode) ) ) ) ) ) )
-
-(define current-process-id (foreign-lambda int "C_getpid"))
 (define parent-process-id (foreign-lambda int "C_getppid"))
 
 (define sleep (foreign-lambda int "C_sleep" int))
diff --git a/posixwin.scm b/posixwin.scm
index 64c544ea..2dd5a30b 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -223,7 +223,6 @@ readdir(DIR * dir)
 #define open_text_output_pipe(a, n, name)    open_binary_output_pipe(a, n, name)
 #define close_pipe(p)			     C_fix(_pclose(C_port_file(p)))
 
-#define C_getpid	    getpid
 #define C_chmod(fn, m)	    C_fix(chmod(C_data_pointer(fn), C_unfix(m)))
 #define C_setvbuf(p, m, s)  C_fix(setvbuf(C_port_file(p), NULL, C_unfix(m), C_unfix(s)))
 #define C_test_access(fn, m)	    C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
@@ -1569,8 +1568,6 @@ EOF
     ($exec-teardown 'process-spawn "cannot spawn process" filename
       (if envlst (##core#inline "C_spawnvpe" mode prg) (##core#inline "C_spawnvp" mode prg))) ) )
 
-(define current-process-id (foreign-lambda int "C_getpid"))
-
 (define-foreign-variable _shlcmd c-string "C_shlcmd")
 
 (define (##sys#shell-command)
@@ -1670,21 +1667,7 @@ EOF
     (values pid #t _exstatus)
     (values -1 #f #f) ) )
 
-(define process-wait
-  (lambda (pid . args)
-    (let-optionals* args ([nohang #f])
-      (##sys#check-exact pid 'process-wait)
-      (receive [epid enorm ecode] (##sys#process-wait pid nohang)
-	(if (fx= epid -1)
-	  (begin
-	    (##sys#update-errno)
-	    (##sys#signal-hook #:process-error 'process-wait "waiting for child process failed" pid) )
-	  (values epid enorm ecode) ) ) ) ) )
-
-(define sleep
-  (lambda (t)
-    (##core#inline "C_sleep" t)
-    0) )
+(define sleep (foreign-lambda int "C_sleep" int))
 
 (define-foreign-variable _hostname c-string "C_hostname")
 (define-foreign-variable _osver c-string "C_osver")
diff --git a/profiler.scm b/profiler.scm
index 4ba7cb93..3ddb5259 100644
--- a/profiler.scm
+++ b/profiler.scm
@@ -38,7 +38,7 @@ EOF
 
 (include "common-declarations.scm")
 
-(define-foreign-variable profile-id int "getpid()")
+(define-foreign-variable profile-id int "C_getpid()")
 
 (define-constant profile-info-entry-size 5)
 
diff --git a/types.db b/types.db
index d5778066..1676962e 100644
--- a/types.db
+++ b/types.db
@@ -1691,7 +1691,7 @@
 (process-group-id (#(procedure #:clean #:enforce) process-group-id () fixnum))
 (process-run (#(procedure #:clean #:enforce) process-run (string #!optional (list-of string)) fixnum))
 (process-signal (#(procedure #:clean #:enforce) process-signal (fixnum #!optional fixnum) undefined))
-(process-wait (#(procedure #:clean #:enforce) process-wait (fixnum #!optional *) fixnum fixnum fixnum))
+(process-wait (#(procedure #:clean #:enforce) process-wait (#!optional fixnum *) fixnum fixnum fixnum))
 (prot/exec fixnum)
 (prot/none fixnum)
 (prot/read fixnum)