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);