fix win32 server socket bug, update makefile
parent
7cde7402a1
commit
d6ba26951f
|
@ -22,7 +22,7 @@ OBJS = $(WIN32_OBJS) native\arithmetic.o native\array.o native\bignum.o \
|
||||||
native\word.o native\compiler.o \
|
native\word.o native\compiler.o \
|
||||||
native\ffi.o native\boolean.o \
|
native\ffi.o native\boolean.o \
|
||||||
native\debug.o \
|
native\debug.o \
|
||||||
native\hashtable.o native\walk.o
|
native\hashtable.o native\scan.o \
|
||||||
|
|
||||||
default:
|
default:
|
||||||
@echo "Run 'make' with one of the following parameters:"
|
@echo "Run 'make' with one of the following parameters:"
|
||||||
|
|
|
@ -156,8 +156,8 @@ global [ <namespace> "c-types" set ] bind
|
||||||
[ alien-2 ] "getter" set
|
[ alien-2 ] "getter" set
|
||||||
[ set-alien-2 ] "setter" set
|
[ set-alien-2 ] "setter" set
|
||||||
2 "width" set
|
2 "width" set
|
||||||
"box_cell" "boxer" set
|
"box_unsigned_2" "boxer" set
|
||||||
"unbox_cell" "unboxer" set
|
"unbox_unsigned_2" "unboxer" set
|
||||||
] "ushort" define-c-type
|
] "ushort" define-c-type
|
||||||
|
|
||||||
[
|
[
|
||||||
|
@ -172,8 +172,8 @@ global [ <namespace> "c-types" set ] bind
|
||||||
[ alien-1 ] "getter" set
|
[ alien-1 ] "getter" set
|
||||||
[ set-alien-1 ] "setter" set
|
[ set-alien-1 ] "setter" set
|
||||||
1 "width" set
|
1 "width" set
|
||||||
"box_cell" "boxer" set
|
"box_unsigned_1" "boxer" set
|
||||||
"unbox_cell" "unboxer" set
|
"unbox_unsigned_1" "unboxer" set
|
||||||
] "uchar" define-c-type
|
] "uchar" define-c-type
|
||||||
|
|
||||||
[
|
[
|
||||||
|
|
|
@ -77,14 +77,18 @@ SYMBOL: socket
|
||||||
: listen-socket ( socket -- )
|
: listen-socket ( socket -- )
|
||||||
20 wsa-listen 0 = [ handle-socket-error ] unless ;
|
20 wsa-listen 0 = [ handle-socket-error ] unless ;
|
||||||
|
|
||||||
C: win32-client-stream ( buf stream -- stream )
|
: sockaddr>string ( sockaddr -- string )
|
||||||
[ set-win32-client-stream-delegate ] keep >r
|
|
||||||
buffer-ptr <alien> 0 32 32
|
|
||||||
<sockaddr-in> dup >r <indirect-pointer> <sockaddr-in> dup >r
|
|
||||||
<indirect-pointer> GetAcceptExSockaddrs r> r> drop
|
|
||||||
dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa
|
dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa
|
||||||
[ , ":" , unparse , ] make-string
|
[ , ":" , unparse , ] make-string ;
|
||||||
r> [ set-win32-client-stream-host ] keep ;
|
|
||||||
|
: extract-remote-host ( buffer -- host )
|
||||||
|
buffer-ptr <alien> 0 32 32 <indirect-pointer> <indirect-pointer>
|
||||||
|
<indirect-pointer> dup >r <indirect-pointer>
|
||||||
|
GetAcceptExSockaddrs r> indirect-pointer-value <alien> sockaddr>string ;
|
||||||
|
|
||||||
|
C: win32-client-stream ( buf stream -- stream )
|
||||||
|
[ set-win32-client-stream-delegate extract-remote-host ] keep
|
||||||
|
[ set-win32-client-stream-host ] keep ;
|
||||||
|
|
||||||
M: win32-client-stream client-stream-host win32-client-stream-host ;
|
M: win32-client-stream client-stream-host win32-client-stream-host ;
|
||||||
|
|
||||||
|
|
|
@ -58,10 +58,10 @@ END-STRUCT
|
||||||
alien-invoke ;
|
alien-invoke ;
|
||||||
|
|
||||||
: htons ( short -- short )
|
: htons ( short -- short )
|
||||||
"short" "winsock" "htons" [ "short" ] alien-invoke ;
|
"ushort" "winsock" "htons" [ "ushort" ] alien-invoke ;
|
||||||
|
|
||||||
: ntohs ( short -- short )
|
: ntohs ( short -- short )
|
||||||
"short" "winsock" "ntohs" [ "short" ] alien-invoke ;
|
"ushort" "winsock" "ntohs" [ "ushort" ] alien-invoke ;
|
||||||
|
|
||||||
: wsa-bind ( socket sockaddr len -- status )
|
: wsa-bind ( socket sockaddr len -- status )
|
||||||
"int" "winsock" "bind" [ "void*" "sockaddr-in*" "int" ] alien-invoke ;
|
"int" "winsock" "bind" [ "void*" "sockaddr-in*" "int" ] alien-invoke ;
|
||||||
|
|
|
@ -203,26 +203,24 @@ void primitive_fixnum_not(void)
|
||||||
drepl(tag_fixnum(~untag_fixnum_fast(dpeek())));
|
drepl(tag_fixnum(~untag_fixnum_fast(dpeek())));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* FFI calls this */
|
#define DEFBOX(name,type) \
|
||||||
void box_signed_1(signed char integer)
|
void name (type integer) \
|
||||||
{
|
{ \
|
||||||
dpush(tag_integer(integer));
|
dpush(tag_integer(integer)); \
|
||||||
}
|
}
|
||||||
|
|
||||||
/* FFI calls this */
|
#define DEFUNBOX(name,type) \
|
||||||
void box_signed_2(signed short integer)
|
type name(void) \
|
||||||
{
|
{ \
|
||||||
dpush(tag_integer(integer));
|
return to_fixnum(dpop()); \
|
||||||
}
|
}
|
||||||
|
|
||||||
/* FFI calls this */
|
DEFBOX(box_signed_1, signed char)
|
||||||
signed char unbox_signed_1(void)
|
DEFBOX(box_signed_2, signed short)
|
||||||
{
|
DEFBOX(box_unsigned_1, unsigned char)
|
||||||
return to_fixnum(dpop());
|
DEFBOX(box_unsigned_2, unsigned short)
|
||||||
}
|
DEFUNBOX(unbox_signed_1, signed char)
|
||||||
|
DEFUNBOX(unbox_signed_2, signed short)
|
||||||
|
DEFUNBOX(unbox_unsigned_1, unsigned char)
|
||||||
|
DEFUNBOX(unbox_unsigned_2, unsigned short)
|
||||||
|
|
||||||
/* FFI calls this */
|
|
||||||
signed short unbox_signed_2(void)
|
|
||||||
{
|
|
||||||
return to_fixnum(dpop());
|
|
||||||
}
|
|
||||||
|
|
|
@ -30,5 +30,9 @@ void primitive_fixnum_greatereq(void);
|
||||||
void primitive_fixnum_not(void);
|
void primitive_fixnum_not(void);
|
||||||
DLLEXPORT void box_signed_1(signed char integer);
|
DLLEXPORT void box_signed_1(signed char integer);
|
||||||
DLLEXPORT void box_signed_2(signed short integer);
|
DLLEXPORT void box_signed_2(signed short integer);
|
||||||
|
DLLEXPORT void box_unsigned_1(unsigned char integer);
|
||||||
|
DLLEXPORT void box_unsigned_2(unsigned short integer);
|
||||||
DLLEXPORT signed char unbox_signed_1(void);
|
DLLEXPORT signed char unbox_signed_1(void);
|
||||||
DLLEXPORT signed short unbox_signed_2(void);
|
DLLEXPORT signed short unbox_signed_2(void);
|
||||||
|
DLLEXPORT unsigned char unbox_unsigned_1(void);
|
||||||
|
DLLEXPORT unsigned short unbox_unsigned_2(void);
|
||||||
|
|
Loading…
Reference in New Issue