From 25344fa1d05e17adf560d657a317d511b169f208 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Fri, 11 Apr 2008 05:36:54 -0400
Subject: [PATCH] Added nanosleep as per bug 210678.

---
 scheme/ikarus.posix.ss | 21 ++++++++++++++++++++-
 scheme/last-revision   |  2 +-
 scheme/makefile.ss     |  1 +
 src/ikarus-enter.S     |  6 ++++--
 src/ikarus-runtime.c   | 11 +++++++++++
 5 files changed, 37 insertions(+), 4 deletions(-)

diff --git a/scheme/ikarus.posix.ss b/scheme/ikarus.posix.ss
index 5674047..8569fc1 100644
--- a/scheme/ikarus.posix.ss
+++ b/scheme/ikarus.posix.ss
@@ -16,10 +16,11 @@
 
 (library (ikarus posix)
   (export posix-fork fork waitpid system file-exists? delete-file
-          getenv env environ file-ctime)
+          nanosleep getenv env environ file-ctime)
   (import 
     (rnrs bytevectors)
     (except (ikarus)
+       nanosleep
        posix-fork fork waitpid system file-exists? delete-file
        getenv env environ file-ctime))
 
@@ -165,4 +166,22 @@
                         (substring s (fxadd1 i) n)
                         "")))))
         (foreign-call "ikrt_environ"))))
+
+  (define (nanosleep secs nsecs)
+    (import (ikarus system $fx))
+    (unless (cond
+              [(fixnum? secs) ($fx>= secs 0)]
+              [(bignum? secs) (<= 0 secs (- (expt 2 32) 1))]
+              [else (die 'nanosleep "not an exact integer" secs)])
+      (die 'nanosleep "seconds must be a nonnegative integer <=" secs))
+    (unless (cond
+              [(fixnum? nsecs) ($fx>= nsecs 0)]
+              [(bignum? nsecs) (<= 0 nsecs 999999999)]
+              [else (die 'nanosleep "not an exact integer" nsecs)])
+      (die 'nanosleep "nanoseconds must be an integer \
+                       in the range 0..999999999" nsecs))
+    (let ([rv (foreign-call "ikrt_nanosleep" secs nsecs)])
+      (unless (eq? rv 0)
+        (error 'nanosleep "failed"))))
+
   )
diff --git a/scheme/last-revision b/scheme/last-revision
index 1eb0c5e..5bf2252 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1443
+1444
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index 865a3fd..bb5624f 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -1287,6 +1287,7 @@
     [string-titlecase                            r uc]
     [string-upcase                               r uc]
     [getenv                                      i]
+    [nanosleep                                   i]
     [char-ready?                                 ]
     [interaction-environment                     ]
     [load                                        i]
diff --git a/src/ikarus-enter.S b/src/ikarus-enter.S
index d18f30e..b54827b 100644
--- a/src/ikarus-enter.S
+++ b/src/ikarus-enter.S
@@ -248,8 +248,6 @@ _ik_foreign_call:
   movl 24(%esi), %esp    # (movl (pcb-ref 'system-stack) esp)
   # %esp is the system stack, %eax is the index to the last arg,
   # %esi is the pcb.
-  # Now, the value of %esp is 16-byte aligned
-  # we always push %esi (4 bytes) and do a call (4 bytes),
   # 0 args require 6 (2) pushes => argc=   0 (0000): %esp +=  -8
   # 1 args require 5 (1) pushes => argc=  -4 (1100): %esp +=  -4
   # 2 args require 4 (0) pushes => argc=  -8 (1000): %esp +=   0
@@ -269,7 +267,11 @@ L_two:
 L_one:
   push $0
 L_zero:
+
+  # Now, the value of %esp is 16-byte aligned
+  # we always push %esi (4 bytes) and do a call (4 bytes),
   push %esi             # (pushl pcr)
+
   cmpl $0, %eax          # (cmpl (int 0) eax)
   je L_set               # (je (label Lset))
 L_loop:                  # (label Lloop)
diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c
index bd90c6b..961fa20 100644
--- a/src/ikarus-runtime.c
+++ b/src/ikarus-runtime.c
@@ -981,6 +981,17 @@ ikrt_exit(ikptr status, ikpcb* pcb){
   }
 }
 
+ikptr
+ikrt_nanosleep(ikptr secs, ikptr nsecs, ikpcb* pcb){
+  struct timespec t;
+  t.tv_sec = 
+    is_fixnum(secs) ? unfix(secs) : ref(secs, off_bignum_data);
+  t.tv_nsec = 
+    is_fixnum(nsecs) ? unfix(nsecs) : ref(nsecs, off_bignum_data);
+  return fix(nanosleep(&t, NULL));
+}
+
+
 ikptr
 ikrt_debug(ikptr x){
   fprintf(stderr, "DEBUG 0x%016lx\n", (long int)x);