75 lines
2.3 KiB
Scheme
75 lines
2.3 KiB
Scheme
|
|
(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)
|
|
(unless (string? x)
|
|
(error 'system "~s is not a string" x))
|
|
(let ([rv (foreign-call "ik_system" x)])
|
|
(if (fx= rv -1)
|
|
(error 'system "failed")
|
|
rv))))
|
|
|
|
(primitive-set! 'file-exists?
|
|
(lambda (x)
|
|
(unless (string? x)
|
|
(error 'file-exists? "filename ~s is not a string" x))
|
|
(let ([v (foreign-call "ikrt_file_exists" x)])
|
|
(cond
|
|
[(boolean? v) v]
|
|
[else
|
|
(error 'file-exists?
|
|
(case v
|
|
[(1) "the path ~s contains a non-directory"]
|
|
[(2) "the path ~s is too long"]
|
|
[(3) "the path ~s is not accessible"]
|
|
[(4) "the path ~s contains too many symbolic links"]
|
|
[(5) "internal access error while accessing ~s"]
|
|
[(6) "IO error encountered while accessing ~s"]
|
|
[else "Unknown error in ~s"])
|
|
x)]))))
|
|
|
|
(primitive-set! 'delete-file
|
|
(lambda (x)
|
|
(unless (string? x)
|
|
(error 'delete-file "filename ~s is not a string" x))
|
|
(let ([v (foreign-call "ikrt_delete_file" x)])
|
|
(case v
|
|
[(0) (void)]
|
|
[else
|
|
(error 'delete-file
|
|
(case v
|
|
[(1) "the path ~s contains a non-directory"]
|
|
[(2) "the path ~s is too long"]
|
|
[(3) "the file ~s does not exist"]
|
|
[(4) "the path ~s is not accessible"]
|
|
[(5) "the path ~s contains too many symbolic links"]
|
|
[(6) "you do not have permissions to delete ~s"]
|
|
[(7) "device ~s is busy"]
|
|
[(8) "IO error encountered while deleting ~s"]
|
|
[(9) "~s is in a read-only file system"]
|
|
[(10) "internal access error while deleting ~s"]
|
|
[else "Unknown error while deleting ~s"])
|
|
x)]))))
|
|
|
|
|
|
|
|
|