From 3c7c397fff2c8600b37c5825fdb349f14d8d12a2 Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Mon, 18 Jun 2018 09:28:53 -0400 Subject: [PATCH] Updated csug socket code to match that in examples folder original commit: 5bdf715809e5847dfa0807216bcc6d0dac2f10ea --- LOG | 2 ++ csug/foreign.stex | 90 ++++++++++++++++++++++++---------------------- examples/socket.ss | 2 +- 3 files changed, 51 insertions(+), 43 deletions(-) diff --git a/LOG b/LOG index 68ae20332c..a16538db4a 100644 --- a/LOG +++ b/LOG @@ -958,3 +958,5 @@ x86_64.ss, foreign.ms, foreign4.c - Avoid an occasional invalid memory violation on Windows in S_call_help schlib.c +- Updated csug socket code to match that in examples folder + csug/foreign.stex, examples/socket.ss diff --git a/csug/foreign.stex b/csug/foreign.stex index 62d95e8004..348f05d96f 100644 --- a/csug/foreign.stex +++ b/csug/foreign.stex @@ -3585,12 +3585,14 @@ transparent input from and output to a subprocess via a Scheme port. #include #include #include +#include /* c_write attempts to write the entire buffer, pushing through interrupts, socket delays, and partial-buffer writes */ -int c_write(int fd, char *buf, unsigned n) { - unsigned i, m; +int c_write(int fd, char *buf, ssize_t start, ssize_t n) { + ssize_t i, m; + buf += start; m = n; while (m > 0) { if ((i = write(fd, buf, m)) < 0) { @@ -3605,9 +3607,10 @@ int c_write(int fd, char *buf, unsigned n) { } /* c_read pushes through interrupts and socket delays */ -int c_read(int fd, char *buf, unsigned n) { +int c_read(int fd, char *buf, size_t start, size_t n) { int i; + buf += start; for (;;) { i = read(fd, buf, n); if (i >= 0) return i; @@ -3641,17 +3644,17 @@ int do_bind(int s, char *name) { (void) strcpy(sun.sun_path, name); length = sizeof(sun.sun_family) + sizeof(sun.sun_path); - return bind(s, &sun, length); + return bind(s, (struct sockaddr*)(&sun), length); } /* do_accept accepts a connection on socket s */ int do_accept(int s) { struct sockaddr_un sun; - int length; + socklen_t length; length = sizeof(sun.sun_family) + sizeof(sun.sun_path); - return accept(s, &sun, &length); + return accept(s, (struct sockaddr*)(&sun), &length); } /* do_connect initiates a socket connection */ @@ -3663,7 +3666,7 @@ int do_connect(int s, char *name) { (void) strcpy(sun.sun_path, name); length = sizeof(sun.sun_family) + sizeof(sun.sun_path); - return connect(s, &sun, length); + return connect(s, (struct sockaddr*)(&sun), length); } /* get_error returns the operating system's error status */ @@ -3679,86 +3682,89 @@ char* get_error(void) { ;;; socket.ss ;;; Requires csocket.so, built from csocket.c. -(case (machine-type) - [(i3le ti3le) (load-shared-object "libc.so.6")] - [(i3osx ti3osx) (load-shared-object "libc.dylib")] - [else (load-shared-object "libc.so")]) +;;; Example compilation command line from macOS: +;;; cc -c csocket.c -o csocket.o +;;; cc csocket.o -dynamic -dynamiclib -current_version 1.0 -compatibility_version 1.0 -o csocket.so +(load-shared-object "./csocket.so") ;;; Requires from C library: ;;; close, dup, execl, fork, kill, listen, tmpnam, unlink -(load-shared-object "libc.so") +(case (machine-type) + [(i3le ti3le a6le ta6le) (load-shared-object "libc.so.6")] + [(i3osx ti3osx a6osx ta6osx) (load-shared-object "libc.dylib")] + [else (load-shared-object "libc.so")]) ;;; basic C-library stuff (define close - (foreign-procedure "close" (integer-32) - integer-32)) + (foreign-procedure "close" (int) + int)) (define dup - (foreign-procedure "dup" (integer-32) - integer-32)) + (foreign-procedure "dup" (int) + int)) (define execl4 - (let ([execl-help + (let ((execl-help (foreign-procedure "execl" - (string string string string integer-32) - integer-32)]) + (string string string string void*) + int))) (lambda (s1 s2 s3 s4) (execl-help s1 s2 s3 s4 0)))) (define fork (foreign-procedure "fork" () - integer-32)) + int)) (define kill - (foreign-procedure "kill" (integer-32 integer-32) - integer-32)) + (foreign-procedure "kill" (int int) + int)) (define listen - (foreign-procedure "listen" (integer-32 integer-32) - integer-32)) + (foreign-procedure "listen" (int int) + int)) (define tmpnam - (foreign-procedure "tmpnam" (integer-32) + (foreign-procedure "tmpnam" (void*) string)) (define unlink (foreign-procedure "unlink" (string) - integer-32)) + int)) ;;; routines defined in csocket.c (define accept - (foreign-procedure "do_accept" (integer-32) - integer-32)) + (foreign-procedure "do_accept" (int) + int)) (define bytes-ready? - (foreign-procedure "bytes_ready" (integer-32) + (foreign-procedure "bytes_ready" (int) boolean)) (define bind - (foreign-procedure "do_bind" (integer-32 string) - integer-32)) + (foreign-procedure "do_bind" (int string) + int)) (define c-error (foreign-procedure "get_error" () string)) (define c-read - (foreign-procedure "c_read" (integer-32 string integer-32) - integer-32)) + (foreign-procedure "c_read" (int u8* size_t size_t) + ssize_t)) (define c-write - (foreign-procedure "c_write" (integer-32 string integer-32) - integer-32)) + (foreign-procedure "c_write" (int u8* size_t ssize_t) + ssize_t)) (define connect - (foreign-procedure "do_connect" (integer-32 string) - integer-32)) + (foreign-procedure "do_connect" (int string) + int)) (define socket (foreign-procedure "do_socket" () - integer-32)) + int)) ;;; higher-level routines @@ -3768,7 +3774,7 @@ char* get_error(void) { (lambda (old new) (check 'close (close old)) (unless (= (dup new) old) - (errorf 'dodup + (error 'dodup "couldn't set up child process io for fd ~s" old)))) (define dofork @@ -3779,7 +3785,7 @@ char* get_error(void) { (cond [(= pid 0) (child)] [(> pid 0) (parent pid)] - [else (errorf 'fork (c-error))])))) + [else (error 'fork (c-error))])))) (define setup-server-socket ; create a socket, bind it to name, and listen for connections @@ -3803,11 +3809,11 @@ char* get_error(void) { (check 'accept (accept sock)))) (define check - ; raise an exception if status x is negative, using c-error to + ; signal an error if status x is negative, using c-error to ; obtain the operating-system's error message (lambda (who x) (if (< x 0) - (errorf who (c-error)) + (error who (c-error)) x))) (define terminate-process diff --git a/examples/socket.ss b/examples/socket.ss index 7bab5b644b..6f3e7c04b9 100644 --- a/examples/socket.ss +++ b/examples/socket.ss @@ -16,7 +16,7 @@ ;;; Requires from C library: ;;; close, dup, execl, fork, kill, listen, tmpnam, unlink (case (machine-type) - [(i3le ti3le) (load-shared-object "libc.so.6")] + [(i3le ti3le a6le ta6le) (load-shared-object "libc.so.6")] [(i3osx ti3osx a6osx ta6osx) (load-shared-object "libc.dylib")] [else (load-shared-object "libc.so")])