Updated csug socket code to match that in examples folder
original commit: 5bdf715809e5847dfa0807216bcc6d0dac2f10ea
This commit is contained in:
parent
2f355b464e
commit
3c7c397fff
2
LOG
2
LOG
|
@ -958,3 +958,5 @@
|
||||||
x86_64.ss, foreign.ms, foreign4.c
|
x86_64.ss, foreign.ms, foreign4.c
|
||||||
- Avoid an occasional invalid memory violation on Windows in S_call_help
|
- Avoid an occasional invalid memory violation on Windows in S_call_help
|
||||||
schlib.c
|
schlib.c
|
||||||
|
- Updated csug socket code to match that in examples folder
|
||||||
|
csug/foreign.stex, examples/socket.ss
|
||||||
|
|
|
@ -3585,12 +3585,14 @@ transparent input from and output to a subprocess via a Scheme port.
|
||||||
#include <signal.h>
|
#include <signal.h>
|
||||||
#include <sys/ioctl.h>
|
#include <sys/ioctl.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
#include <unistd.h>
|
||||||
|
|
||||||
/* c_write attempts to write the entire buffer, pushing through
|
/* c_write attempts to write the entire buffer, pushing through
|
||||||
interrupts, socket delays, and partial-buffer writes */
|
interrupts, socket delays, and partial-buffer writes */
|
||||||
int c_write(int fd, char *buf, unsigned n) {
|
int c_write(int fd, char *buf, ssize_t start, ssize_t n) {
|
||||||
unsigned i, m;
|
ssize_t i, m;
|
||||||
|
|
||||||
|
buf += start;
|
||||||
m = n;
|
m = n;
|
||||||
while (m > 0) {
|
while (m > 0) {
|
||||||
if ((i = write(fd, buf, 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 */
|
/* 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;
|
int i;
|
||||||
|
|
||||||
|
buf += start;
|
||||||
for (;;) {
|
for (;;) {
|
||||||
i = read(fd, buf, n);
|
i = read(fd, buf, n);
|
||||||
if (i >= 0) return i;
|
if (i >= 0) return i;
|
||||||
|
@ -3641,17 +3644,17 @@ int do_bind(int s, char *name) {
|
||||||
(void) strcpy(sun.sun_path, name);
|
(void) strcpy(sun.sun_path, name);
|
||||||
length = sizeof(sun.sun_family) + sizeof(sun.sun_path);
|
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 */
|
/* do_accept accepts a connection on socket s */
|
||||||
int do_accept(int s) {
|
int do_accept(int s) {
|
||||||
struct sockaddr_un sun;
|
struct sockaddr_un sun;
|
||||||
int length;
|
socklen_t length;
|
||||||
|
|
||||||
length = sizeof(sun.sun_family) + sizeof(sun.sun_path);
|
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 */
|
/* do_connect initiates a socket connection */
|
||||||
|
@ -3663,7 +3666,7 @@ int do_connect(int s, char *name) {
|
||||||
(void) strcpy(sun.sun_path, name);
|
(void) strcpy(sun.sun_path, name);
|
||||||
length = sizeof(sun.sun_family) + sizeof(sun.sun_path);
|
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 */
|
/* get_error returns the operating system's error status */
|
||||||
|
@ -3679,86 +3682,89 @@ char* get_error(void) {
|
||||||
;;; socket.ss
|
;;; socket.ss
|
||||||
|
|
||||||
;;; Requires csocket.so, built from csocket.c.
|
;;; Requires csocket.so, built from csocket.c.
|
||||||
(case (machine-type)
|
;;; Example compilation command line from macOS:
|
||||||
[(i3le ti3le) (load-shared-object "libc.so.6")]
|
;;; cc -c csocket.c -o csocket.o
|
||||||
[(i3osx ti3osx) (load-shared-object "libc.dylib")]
|
;;; cc csocket.o -dynamic -dynamiclib -current_version 1.0 -compatibility_version 1.0 -o csocket.so
|
||||||
[else (load-shared-object "libc.so")])
|
(load-shared-object "./csocket.so")
|
||||||
|
|
||||||
;;; Requires from C library:
|
;;; Requires from C library:
|
||||||
;;; close, dup, execl, fork, kill, listen, tmpnam, unlink
|
;;; 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
|
;;; basic C-library stuff
|
||||||
|
|
||||||
(define close
|
(define close
|
||||||
(foreign-procedure "close" (integer-32)
|
(foreign-procedure "close" (int)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define dup
|
(define dup
|
||||||
(foreign-procedure "dup" (integer-32)
|
(foreign-procedure "dup" (int)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define execl4
|
(define execl4
|
||||||
(let ([execl-help
|
(let ((execl-help
|
||||||
(foreign-procedure "execl"
|
(foreign-procedure "execl"
|
||||||
(string string string string integer-32)
|
(string string string string void*)
|
||||||
integer-32)])
|
int)))
|
||||||
(lambda (s1 s2 s3 s4)
|
(lambda (s1 s2 s3 s4)
|
||||||
(execl-help s1 s2 s3 s4 0))))
|
(execl-help s1 s2 s3 s4 0))))
|
||||||
|
|
||||||
(define fork
|
(define fork
|
||||||
(foreign-procedure "fork" ()
|
(foreign-procedure "fork" ()
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define kill
|
(define kill
|
||||||
(foreign-procedure "kill" (integer-32 integer-32)
|
(foreign-procedure "kill" (int int)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define listen
|
(define listen
|
||||||
(foreign-procedure "listen" (integer-32 integer-32)
|
(foreign-procedure "listen" (int int)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define tmpnam
|
(define tmpnam
|
||||||
(foreign-procedure "tmpnam" (integer-32)
|
(foreign-procedure "tmpnam" (void*)
|
||||||
string))
|
string))
|
||||||
|
|
||||||
(define unlink
|
(define unlink
|
||||||
(foreign-procedure "unlink" (string)
|
(foreign-procedure "unlink" (string)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
;;; routines defined in csocket.c
|
;;; routines defined in csocket.c
|
||||||
|
|
||||||
(define accept
|
(define accept
|
||||||
(foreign-procedure "do_accept" (integer-32)
|
(foreign-procedure "do_accept" (int)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define bytes-ready?
|
(define bytes-ready?
|
||||||
(foreign-procedure "bytes_ready" (integer-32)
|
(foreign-procedure "bytes_ready" (int)
|
||||||
boolean))
|
boolean))
|
||||||
|
|
||||||
(define bind
|
(define bind
|
||||||
(foreign-procedure "do_bind" (integer-32 string)
|
(foreign-procedure "do_bind" (int string)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define c-error
|
(define c-error
|
||||||
(foreign-procedure "get_error" ()
|
(foreign-procedure "get_error" ()
|
||||||
string))
|
string))
|
||||||
|
|
||||||
(define c-read
|
(define c-read
|
||||||
(foreign-procedure "c_read" (integer-32 string integer-32)
|
(foreign-procedure "c_read" (int u8* size_t size_t)
|
||||||
integer-32))
|
ssize_t))
|
||||||
|
|
||||||
(define c-write
|
(define c-write
|
||||||
(foreign-procedure "c_write" (integer-32 string integer-32)
|
(foreign-procedure "c_write" (int u8* size_t ssize_t)
|
||||||
integer-32))
|
ssize_t))
|
||||||
|
|
||||||
(define connect
|
(define connect
|
||||||
(foreign-procedure "do_connect" (integer-32 string)
|
(foreign-procedure "do_connect" (int string)
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
(define socket
|
(define socket
|
||||||
(foreign-procedure "do_socket" ()
|
(foreign-procedure "do_socket" ()
|
||||||
integer-32))
|
int))
|
||||||
|
|
||||||
;;; higher-level routines
|
;;; higher-level routines
|
||||||
|
|
||||||
|
@ -3768,7 +3774,7 @@ char* get_error(void) {
|
||||||
(lambda (old new)
|
(lambda (old new)
|
||||||
(check 'close (close old))
|
(check 'close (close old))
|
||||||
(unless (= (dup new) old)
|
(unless (= (dup new) old)
|
||||||
(errorf 'dodup
|
(error 'dodup
|
||||||
"couldn't set up child process io for fd ~s" old))))
|
"couldn't set up child process io for fd ~s" old))))
|
||||||
|
|
||||||
(define dofork
|
(define dofork
|
||||||
|
@ -3779,7 +3785,7 @@ char* get_error(void) {
|
||||||
(cond
|
(cond
|
||||||
[(= pid 0) (child)]
|
[(= pid 0) (child)]
|
||||||
[(> pid 0) (parent pid)]
|
[(> pid 0) (parent pid)]
|
||||||
[else (errorf 'fork (c-error))]))))
|
[else (error 'fork (c-error))]))))
|
||||||
|
|
||||||
(define setup-server-socket
|
(define setup-server-socket
|
||||||
; create a socket, bind it to name, and listen for connections
|
; create a socket, bind it to name, and listen for connections
|
||||||
|
@ -3803,11 +3809,11 @@ char* get_error(void) {
|
||||||
(check 'accept (accept sock))))
|
(check 'accept (accept sock))))
|
||||||
|
|
||||||
(define check
|
(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
|
; obtain the operating-system's error message
|
||||||
(lambda (who x)
|
(lambda (who x)
|
||||||
(if (< x 0)
|
(if (< x 0)
|
||||||
(errorf who (c-error))
|
(error who (c-error))
|
||||||
x)))
|
x)))
|
||||||
|
|
||||||
(define terminate-process
|
(define terminate-process
|
||||||
|
|
|
@ -16,7 +16,7 @@
|
||||||
;;; Requires from C library:
|
;;; Requires from C library:
|
||||||
;;; close, dup, execl, fork, kill, listen, tmpnam, unlink
|
;;; close, dup, execl, fork, kill, listen, tmpnam, unlink
|
||||||
(case (machine-type)
|
(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")]
|
[(i3osx ti3osx a6osx ta6osx) (load-shared-object "libc.dylib")]
|
||||||
[else (load-shared-object "libc.so")])
|
[else (load-shared-object "libc.so")])
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user