Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | new posix funcs. dup fork, improved wait-for-pid |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
00d95738806619529d3df573d4013706 |
| User & Date: | aldo 2016-12-11 13:55:00 |
Context
|
2016-12-11
| ||
| 13:55 | bind/inet now sets SO_REUSEADDR check-in: 15fd017f95 user: aldo tags: trunk | |
| 13:55 | new posix funcs. dup fork, improved wait-for-pid check-in: 00d9573880 user: aldo tags: trunk | |
|
2016-12-10
| ||
| 19:00 | moved sockaddr_in inside the meta-cond check-in: 0776ca44d8 user: aldo tags: trunk | |
Changes
Changes to posix.sls.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
(library (posix) (export strerror errno EAGAIN EINTR mktemp mkstemp with-mktemp close wtermsig wifexited wifsignaled wexitstatus wait-for-pid file-write file-read bytes-ready) (import (chezscheme) (only (thunder-utils) bytevector-copy*)) ;;; POSIX STUFF (define init (load-shared-object "libc.so.6")) (define strerror (case-lambda [() (strerror (errno))] [(n) ................................................................................ (define (wifsignaled x) (> (logand #xff (bitwise-arithmetic-shift-right (+ 1 (wtermsig x)) 1)) 0)) (define (wexitstatus x) (bitwise-arithmetic-shift-right (logand x #xff00) 8)) (define (wait-for-pid pid) (define waitpid* (foreign-procedure "waitpid" (int u8* int) int)) (define status* (make-bytevector (foreign-sizeof 'int))) (let loop () (let ([r (waitpid* pid status* 0)]) (when (< r 0) (errorf 'wait-for-pid "waitpid failed: ~d" (strerror))) (let ([status (bytevector-sint-ref status* 0 (native-endianness) (foreign-sizeof 'int))]) (cond [(wifexited status) (wexitstatus status)] [(wifsignaled status) #f] [(loop)]))))) ;; these shouldn't be needed.. use just open-fd-input-port, ;; open-fd-output-port or open-fd-input/output-port and then use the scheme ;; functions... (define (file-write fd data) (define write* (foreign-procedure "write" (int u8* size_t) ssize_t)) (define n (bytevector-length data)) |
>
|
|
>
>
>
>
>
>
>
|
>
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
(library (posix) (export strerror errno EAGAIN EINTR mktemp mkstemp with-mktemp close wtermsig wifexited wifsignaled wexitstatus wait-flag wait-for-pid fork dup file-write file-read bytes-ready) (import (chezscheme) (only (thunder-utils) bytevector-copy*) (ffi-utils)) ;;; POSIX STUFF (define init (load-shared-object "libc.so.6")) (define strerror (case-lambda [() (strerror (errno))] [(n) ................................................................................ (define (wifsignaled x) (> (logand #xff (bitwise-arithmetic-shift-right (+ 1 (wtermsig x)) 1)) 0)) (define (wexitstatus x) (bitwise-arithmetic-shift-right (logand x #xff00) 8)) (meta-cond [(memq (machine-type) '(a6le ta6le i3le ti3le)) (define-flags wait-flag (nohang 1) (untraced 2) (stopped 2) (exited 4) (continued 8) (nowait #x01000000) (nothread #x20000000) (all #x40000000) (clone #x80000000))]) (define wait-for-pid (case-lambda [(pid) (wait-for-pid pid '())] [(pid options) (define waitpid* (foreign-procedure "waitpid" (int u8* int) int)) (define status* (make-bytevector (foreign-sizeof 'int))) (let loop () (let ([r (waitpid* pid status* (apply wait-flag options))]) (when (< r 0) (errorf 'wait-for-pid "waitpid failed: ~d" (strerror))) (let ([status (bytevector-sint-ref status* 0 (native-endianness) (foreign-sizeof 'int))]) (cond [(wifexited status) (wexitstatus status)] [(wifsignaled status) #f] [(loop)]))))])) (define (fork) (define fork* (foreign-procedure "fork" () integer-32)) (let ([r (fork*)]) (if (< r 0) (errorf 'dup2 "failed: ~d" (strerror)) r))) (define dup (case-lambda [(filedes filedes2) (define dup2* (foreign-procedure "dup2" (int int) int)) (let ([r (dup2* filedes filedes2)]) (if (< r 0) (errorf 'dup2 "failed: ~d" (strerror)) r))] [(filedes) (define dup* (foreign-procedure "dup" (int) int)) (let ([r (dup* filedes)]) (if (< r 0) (errorf 'dup "failed: ~d" (strerror)) r))])) ;; these shouldn't be needed.. use just open-fd-input-port, ;; open-fd-output-port or open-fd-input/output-port and then use the scheme ;; functions... (define (file-write fd data) (define write* (foreign-procedure "write" (int u8* size_t) ssize_t)) (define n (bytevector-length data)) |