diff --git a/bindings/libc.scm b/bindings/libc.scm index 255ae43..1c46880 100644 --- a/bindings/libc.scm +++ b/bindings/libc.scm @@ -67,15 +67,15 @@ ((foreign-procedure "inet_ntop" (int void* (* char) int) - void*) + string) (domain->int af) src dst size)) (define (htons host) - ((foreign-procedure "htons" (short) short) host)) + ((foreign-procedure "htons" (unsigned-16) unsigned-16) host)) (define (ntohs net) - ((foreign-procedure "ntohs" (short) short) net)) + ((foreign-procedure "ntohs" (unsigned-16) unsigned-16) net)) (define (setsockopt sockfd level optname optval optlen) ((foreign-procedure diff --git a/bindings/utils.scm b/bindings/utils.scm new file mode 100644 index 0000000..a6fa9e0 --- /dev/null +++ b/bindings/utils.scm @@ -0,0 +1,22 @@ +; Convert a char* to a Scheme string +; Extracted from this paper: +; http://scheme2011.ucombinator.org/papers/Keep2011.pdf +(define (char*->string fptr) + (let f ([i 0]) + (let ([c (ftype-ref char () fptr i)]) + (if (char=? c #\nul) + (make-string i) + (let ([str (f (fx+ i 1))]) + (string-set! str i c)str))))) + +(define (alloc size fx) + (let ([v (foreign-alloc size)]) + (fx v) + (foreign-free v))) + +(define (check-err ret msg) + (cond + ((< ret 0) + (perror msg) + (raise msg)) + (#t ret))) diff --git a/examples/udp_server.scm b/examples/udp_server.scm index a24c903..91a6014 100644 --- a/examples/udp_server.scm +++ b/examples/udp_server.scm @@ -1,16 +1,5 @@ (load "../bindings/libc.scm") - -(define (check-err ret msg) - (cond - ((< ret 0) - (perror msg) - (raise msg)) - (#t ret))) - -(define (alloc size fx) - (let ([v (foreign-alloc size)]) - (fx v) - (foreign-free v))) +(load "../bindings/utils.scm") (define (udpsock-create fx) (fx @@ -89,4 +78,8 @@ (udpsock-readblock sock (lambda (host port buf size) + (printf "~a~%" size) + (printf "~a~%" port) + (printf "~a~%" host) + (printf "~a~%" (ftype-ref string () buf)) ))))