* Fork, posix-fork, and waitpid are implemented.
This commit is contained in:
parent
eb24d17049
commit
a5618ef877
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -905,3 +905,16 @@ ikrt_bytes_allocated_major(ikpcb* pcb){
|
|||
return fix(pcb->allocation_count_major);
|
||||
}
|
||||
|
||||
|
||||
ikp
|
||||
ikrt_fork(){
|
||||
int pid = fork();
|
||||
return fix(pid);
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_waitpid(ikp pid){
|
||||
int status;
|
||||
pid_t t = waitpid(unfix(pid), &status, 0);
|
||||
return fix(t);
|
||||
}
|
||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -1,16 +1,22 @@
|
|||
|
||||
;;; ($pcb-set! posix-fork
|
||||
;;; (lambda ()
|
||||
;;; (foreign-call "S_fork")))
|
||||
;;;
|
||||
;;; ($pcb-set! fork
|
||||
;;; (lambda (parent-proc child-proc)
|
||||
;;; (let ([pid (posix-fork)])
|
||||
;;; (cond
|
||||
;;; [(fx= pid 0) (child-proc)]
|
||||
;;; [(fx= pid -1)
|
||||
;;; (error 'fork "failed")]
|
||||
;;; [else (parent-proc pid)]))))
|
||||
(primitive-set! 'posix-fork
|
||||
(lambda ()
|
||||
(foreign-call "ikrt_fork")))
|
||||
|
||||
(primitive-set! 'fork
|
||||
(lambda (parent-proc child-proc)
|
||||
(let ([pid (posix-fork)])
|
||||
(cond
|
||||
[(fx= pid 0) (child-proc)]
|
||||
[(fx= pid -1)
|
||||
(error 'fork "failed")]
|
||||
[else (parent-proc pid)]))))
|
||||
|
||||
(primitive-set! 'waitpid
|
||||
(lambda (pid)
|
||||
(unless (fixnum? pid)
|
||||
(error 'waitpid "~s is not a fixnum" pid))
|
||||
(foreign-call "ikrt_waitpid" pid)))
|
||||
|
||||
(primitive-set! 'system
|
||||
(lambda (x)
|
||||
|
|
|
@ -86,6 +86,7 @@
|
|||
make-guardian weak-cons collect
|
||||
interrupt-handler
|
||||
time-it
|
||||
posix-fork fork waitpid
|
||||
))
|
||||
|
||||
(define system-primitives
|
||||
|
|
Loading…
Reference in New Issue