[Chicken-hackers] [PATCH] fix types.db entry for process-wait

[Felix]

Attached a patch that fixes a small error in types.db for "process-wait".
Also, some posix functions have been factored out into posix-common.scm.


cheers,
felix

>From be44f53283970f3a90f13d266d8567291132b2d2 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 14 Oct 2011 09:43:13 +0200
Subject: [PATCH] moved some posix functions into posix-common, corrected
 entry for process-wait in types.db

---
 posix-common.scm |   15 +++++++++++++++
 posixunix.scm    |   11 -----------
 posixwin.scm     |   19 +------------------
 profiler.scm     |    2 +-
 types.db         |    2 +-
 5 files changed, 18 insertions(+), 31 deletions(-)

diff --git a/posix-common.scm b/posix-common.scm
index 8c95354..89e87d3 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 ee17325..ec3df0f 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 64c544e..2dd5a30 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 4ba7cb9..3ddb525 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 d577806..1676962 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)
-- 
1.7.6.msysgit.0