Added nanosleep as per bug 210678.
This commit is contained in:
parent
191a82e007
commit
25344fa1d0
|
@ -16,10 +16,11 @@
|
||||||
|
|
||||||
(library (ikarus posix)
|
(library (ikarus posix)
|
||||||
(export posix-fork fork waitpid system file-exists? delete-file
|
(export posix-fork fork waitpid system file-exists? delete-file
|
||||||
getenv env environ file-ctime)
|
nanosleep getenv env environ file-ctime)
|
||||||
(import
|
(import
|
||||||
(rnrs bytevectors)
|
(rnrs bytevectors)
|
||||||
(except (ikarus)
|
(except (ikarus)
|
||||||
|
nanosleep
|
||||||
posix-fork fork waitpid system file-exists? delete-file
|
posix-fork fork waitpid system file-exists? delete-file
|
||||||
getenv env environ file-ctime))
|
getenv env environ file-ctime))
|
||||||
|
|
||||||
|
@ -165,4 +166,22 @@
|
||||||
(substring s (fxadd1 i) n)
|
(substring s (fxadd1 i) n)
|
||||||
"")))))
|
"")))))
|
||||||
(foreign-call "ikrt_environ"))))
|
(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"))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1443
|
1444
|
||||||
|
|
|
@ -1287,6 +1287,7 @@
|
||||||
[string-titlecase r uc]
|
[string-titlecase r uc]
|
||||||
[string-upcase r uc]
|
[string-upcase r uc]
|
||||||
[getenv i]
|
[getenv i]
|
||||||
|
[nanosleep i]
|
||||||
[char-ready? ]
|
[char-ready? ]
|
||||||
[interaction-environment ]
|
[interaction-environment ]
|
||||||
[load i]
|
[load i]
|
||||||
|
|
|
@ -248,8 +248,6 @@ _ik_foreign_call:
|
||||||
movl 24(%esi), %esp # (movl (pcb-ref 'system-stack) esp)
|
movl 24(%esi), %esp # (movl (pcb-ref 'system-stack) esp)
|
||||||
# %esp is the system stack, %eax is the index to the last arg,
|
# %esp is the system stack, %eax is the index to the last arg,
|
||||||
# %esi is the pcb.
|
# %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
|
# 0 args require 6 (2) pushes => argc= 0 (0000): %esp += -8
|
||||||
# 1 args require 5 (1) pushes => argc= -4 (1100): %esp += -4
|
# 1 args require 5 (1) pushes => argc= -4 (1100): %esp += -4
|
||||||
# 2 args require 4 (0) pushes => argc= -8 (1000): %esp += 0
|
# 2 args require 4 (0) pushes => argc= -8 (1000): %esp += 0
|
||||||
|
@ -269,7 +267,11 @@ L_two:
|
||||||
L_one:
|
L_one:
|
||||||
push $0
|
push $0
|
||||||
L_zero:
|
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)
|
push %esi # (pushl pcr)
|
||||||
|
|
||||||
cmpl $0, %eax # (cmpl (int 0) eax)
|
cmpl $0, %eax # (cmpl (int 0) eax)
|
||||||
je L_set # (je (label Lset))
|
je L_set # (je (label Lset))
|
||||||
L_loop: # (label Lloop)
|
L_loop: # (label Lloop)
|
||||||
|
|
|
@ -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
|
ikptr
|
||||||
ikrt_debug(ikptr x){
|
ikrt_debug(ikptr x){
|
||||||
fprintf(stderr, "DEBUG 0x%016lx\n", (long int)x);
|
fprintf(stderr, "DEBUG 0x%016lx\n", (long int)x);
|
||||||
|
|
Loading…
Reference in New Issue