truncate/floor/ceiling words; stop-httpd word fixed; accept did not yield properly
Slava Pestov
parent
11c604d865
commit
356af39cc6
5
Makefile
5
Makefile
|
|
@ -46,11 +46,13 @@ bsd:
|
|||
$(MAKE) f \
|
||||
CFLAGS="$(DEFAULT_CFLAGS) -export-dynamic -pthread" \
|
||||
LIBS="$(DEFAULT_LIBS)"
|
||||
$(STRIP) f
|
||||
|
||||
bsd-nopthread:
|
||||
$(MAKE) f \
|
||||
CFLAGS="$(DEFAULT_CFLAGS) -export-dynamic" \
|
||||
LIBS="$(DEFAULT_LIBS)"
|
||||
$(STRIP) f
|
||||
|
||||
macosx:
|
||||
$(MAKE) f \
|
||||
|
|
@ -61,15 +63,16 @@ linux:
|
|||
$(MAKE) f \
|
||||
CFLAGS="$(DEFAULT_CFLAGS) -export-dynamic" \
|
||||
LIBS="$(DEFAULT_LIBS) -ldl"
|
||||
$(STRIP) f
|
||||
|
||||
linux-ppc:
|
||||
$(MAKE) f \
|
||||
CFLAGS="$(DEFAULT_CFLAGS) -export-dynamic -mregnames" \
|
||||
LIBS="$(DEFAULT_LIBS) -ldl"
|
||||
$(STRIP) f
|
||||
|
||||
f: $(OBJS)
|
||||
$(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)
|
||||
$(STRIP) $@
|
||||
|
||||
clean:
|
||||
rm -f $(OBJS)
|
||||
|
|
|
|||
|
|
@ -1,14 +1,11 @@
|
|||
0.74:
|
||||
|
||||
- trailing newlines in read-line output value
|
||||
- local structs are 4 times larger than they should be
|
||||
- ppc ffi relocation
|
||||
- faster layout
|
||||
- faster repaint
|
||||
- forgotten words not removed from cross-reference
|
||||
- get all-tests to run with -no-compile
|
||||
- freebsd 4 -pthread errno
|
||||
- mac os x ffi
|
||||
- implement fcopy
|
||||
- if external factor is down, don't add tons of random shit to the dictionary
|
||||
- scalar * matrix, vector * matrix, matrix * vector need to work
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: alien
|
||||
USING: assembler errors generic inference kernel lists math
|
||||
namespaces sequences stdio strings words ;
|
||||
namespaces sequences stdio strings unparser words ;
|
||||
|
||||
! ! ! WARNING ! ! !
|
||||
! Reloading this file into a running Factor instance on Win32
|
||||
|
|
@ -25,16 +25,20 @@ namespaces sequences stdio strings words ;
|
|||
|
||||
! FFI code does not run in the interpreter.
|
||||
|
||||
TUPLE: alien-error lib ;
|
||||
TUPLE: alien-error symbol library ;
|
||||
|
||||
C: alien-error ( lib -- ) [ set-alien-error-lib ] keep ;
|
||||
C: alien-error ( lib sym -- )
|
||||
[ set-alien-error-symbol ] keep
|
||||
[ set-alien-error-library ] keep ;
|
||||
|
||||
M: alien-error error. ( error -- )
|
||||
[
|
||||
"C library interface words cannot be interpreted. " ,
|
||||
"Either the compiler is disabled, " ,
|
||||
"or the ``" , alien-error-lib ,
|
||||
"'' library is missing." ,
|
||||
"C library interface words cannot be interpreted. " %
|
||||
"Either the compiler is disabled, " %
|
||||
"or the " % dup alien-error-library unparse %
|
||||
" library does not define the " %
|
||||
alien-error-symbol unparse %
|
||||
" symbol." %
|
||||
] make-string print ;
|
||||
|
||||
: alien-invoke ( ... returns library function parameters -- ... )
|
||||
|
|
@ -42,13 +46,13 @@ M: alien-error error. ( error -- )
|
|||
#! 'returns' is a type spec, and 'parameters' is a list of
|
||||
#! type specs. 'library' is an entry in the "libraries"
|
||||
#! namespace.
|
||||
rot <alien-error> throw ;
|
||||
drop <alien-error> throw ;
|
||||
|
||||
: alien-global ( type library name -- value )
|
||||
#! Fetch the value of C global variable.
|
||||
#! 'type' is a type spec. 'library' is an entry in the
|
||||
#! "libraries" namespace.
|
||||
swap <alien-error> throw ;
|
||||
<alien-error> throw ;
|
||||
|
||||
! Linear IR nodes
|
||||
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ math namespaces parser strings words ;
|
|||
: array-constructor ( width -- )
|
||||
#! Make a word <foo-array> ( n -- byte-array ).
|
||||
"struct-name" get "-array" cat2 constructor-word
|
||||
swap [ * <byte-array> ] cons
|
||||
swap cell / ceiling [ * <byte-array> ] cons
|
||||
define-compound ;
|
||||
|
||||
: define-nth ( width -- )
|
||||
|
|
|
|||
|
|
@ -5,22 +5,26 @@ lists namespaces parser sequences stdio unparser words ;
|
|||
|
||||
"Bootstrap stage 3..." print
|
||||
|
||||
os "freebsd" = [
|
||||
"libc" "libc.so" "cdecl" add-library
|
||||
] when
|
||||
|
||||
unix? [
|
||||
"sdl" "libSDL.so" "cdecl" add-library
|
||||
"sdl-gfx" "libSDL_gfx.so" "cdecl" add-library
|
||||
"sdl-ttf" "libSDL_ttf.so" "cdecl" add-library
|
||||
"sdl" "libSDL.so" "cdecl" add-library
|
||||
"sdl-gfx" "libSDL_gfx.so" "cdecl" add-library
|
||||
"sdl-ttf" "libSDL_ttf.so" "cdecl" add-library
|
||||
] when
|
||||
|
||||
win32? [
|
||||
"kernel32" "kernel32.dll" "stdcall" add-library
|
||||
"user32" "user32.dll" "stdcall" add-library
|
||||
"gdi32" "gdi32.dll" "stdcall" add-library
|
||||
"winsock" "ws2_32.dll" "stdcall" add-library
|
||||
"mswsock" "mswsock.dll" "stdcall" add-library
|
||||
"libc" "msvcrt.dll" "cdecl" add-library
|
||||
"sdl" "SDL.dll" "cdecl" add-library
|
||||
"sdl-gfx" "SDL_gfx.dll" "cdecl" add-library
|
||||
"sdl-ttf" "SDL_ttf.dll" "cdecl" add-library
|
||||
"kernel32" "kernel32.dll" "stdcall" add-library
|
||||
"user32" "user32.dll" "stdcall" add-library
|
||||
"gdi32" "gdi32.dll" "stdcall" add-library
|
||||
"winsock" "ws2_32.dll" "stdcall" add-library
|
||||
"mswsock" "mswsock.dll" "stdcall" add-library
|
||||
"libc" "msvcrt.dll" "cdecl" add-library
|
||||
"sdl" "SDL.dll" "cdecl" add-library
|
||||
"sdl-gfx" "SDL_gfx.dll" "cdecl" add-library
|
||||
"sdl-ttf" "SDL_ttf.dll" "cdecl" add-library
|
||||
] when
|
||||
|
||||
default-cli-args
|
||||
|
|
@ -137,6 +141,10 @@ compile? [
|
|||
os "linux" = [
|
||||
"/library/unix/syscalls-linux.factor"
|
||||
] pull-in
|
||||
|
||||
os "macosx" = [
|
||||
"/library/unix/syscalls-macosx.factor"
|
||||
] pull-in
|
||||
|
||||
unix? [
|
||||
"/library/unix/syscalls.factor"
|
||||
|
|
|
|||
|
|
@ -8,11 +8,12 @@ math memory namespaces words ;
|
|||
uncons load-dll 2dup rel-dlsym-16/16 dlsym compile-call-far
|
||||
] "generator" set-word-prop
|
||||
|
||||
#parameters [
|
||||
dup 0 = [ drop ] [ 16 align 1 1 rot SUBI ] ifte
|
||||
] "generator" set-word-prop
|
||||
: stack-size 8 + 16 align ;
|
||||
: stack@ 3 + cell * ;
|
||||
|
||||
: stack@ cell * cell + ;
|
||||
#parameters [
|
||||
dup 0 = [ drop ] [ stack-size 1 1 rot SUBI ] ifte
|
||||
] "generator" set-word-prop
|
||||
|
||||
#unbox [
|
||||
uncons f 2dup rel-dlsym-16/16 dlsym compile-call-far
|
||||
|
|
@ -28,5 +29,5 @@ math memory namespaces words ;
|
|||
] "generator" set-word-prop
|
||||
|
||||
#cleanup [
|
||||
dup 0 = [ drop ] [ 16 align 1 1 rot ADDI ] ifte
|
||||
dup 0 = [ drop ] [ stack-size 1 1 rot ADDI ] ifte
|
||||
] "generator" set-word-prop
|
||||
|
|
|
|||
|
|
@ -9,18 +9,6 @@ test-responder ;
|
|||
#! responder table.
|
||||
global [ <namespace> "httpd-responders" set ] bind
|
||||
|
||||
! This responder lets anybody shut down your httpd. You should
|
||||
! disable it if you plan on running a production server!
|
||||
<responder> [
|
||||
"quit" "responder" set
|
||||
[ quit-responder ] "get" set
|
||||
] extend add-responder
|
||||
|
||||
<responder> [
|
||||
"posttest" "responder" set
|
||||
[ drop "response" get global [ . ] bind ] "post" set
|
||||
] extend add-responder
|
||||
|
||||
! Runs all unit tests and dumps result to the client. This uses
|
||||
! a lot of server resources, so disable it on a busy server.
|
||||
<responder> [
|
||||
|
|
|
|||
|
|
@ -58,8 +58,8 @@ stdio streams strings threads url-encoding ;
|
|||
: httpd-loop ( -- ) httpd-connection httpd-loop ;
|
||||
|
||||
: httpd ( port -- )
|
||||
[
|
||||
<server> "http-server" set [
|
||||
<server> "http-server" set [
|
||||
[
|
||||
httpd-loop
|
||||
] [
|
||||
"http-server" get stream-close rethrow
|
||||
|
|
|
|||
|
|
@ -1,46 +0,0 @@
|
|||
! :folding=indent:collapseFolds=0:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: quit-responder
|
||||
USE: httpd
|
||||
USE: httpd-responder
|
||||
USE: namespaces
|
||||
USE: kernel
|
||||
USE: stdio
|
||||
USE: streams
|
||||
|
||||
: quit-prohibited ( -- )
|
||||
"404 quit prohibited" httpd-error ;
|
||||
|
||||
: quit-responder ( argument -- )
|
||||
serving-text
|
||||
drop
|
||||
"quit-prohibited" get [
|
||||
quit-prohibited
|
||||
] [
|
||||
stop-httpd
|
||||
] ifte ;
|
||||
|
|
@ -37,4 +37,7 @@ M: object clone ;
|
|||
: cpu ( -- arch ) 7 getenv ;
|
||||
: os ( -- os ) 11 getenv ;
|
||||
: win32? ( -- ? ) os "win32" = ;
|
||||
: unix? ( -- ? ) os "freebsd" = os "linux" = or ;
|
||||
: unix? ( -- ? )
|
||||
os "freebsd" =
|
||||
os "linux" = or
|
||||
os "macosx" = or ;
|
||||
|
|
|
|||
|
|
@ -94,3 +94,7 @@ M: bignum bitxor bignum-bitxor ;
|
|||
M: bignum shift bignum-shift ;
|
||||
|
||||
M: bignum bitnot bignum-bitnot ;
|
||||
|
||||
M: integer truncate ;
|
||||
M: integer floor ;
|
||||
M: integer ceiling ;
|
||||
|
|
|
|||
|
|
@ -29,11 +29,13 @@ M: object number= 2drop f ;
|
|||
|
||||
GENERIC: bitnot ( n -- n )
|
||||
|
||||
: max ( x y -- z )
|
||||
2dup > [ drop ] [ nip ] ifte ;
|
||||
GENERIC: truncate ( n -- n )
|
||||
GENERIC: floor ( n -- n )
|
||||
GENERIC: ceiling ( n -- n )
|
||||
|
||||
: min ( x y -- z )
|
||||
2dup < [ drop ] [ nip ] ifte ;
|
||||
: max ( x y -- z ) [ > ] 2keep ? ;
|
||||
|
||||
: min ( x y -- z ) [ < ] 2keep ? ;
|
||||
|
||||
: between? ( x min max -- ? )
|
||||
#! Push if min <= x <= max. Handles case where min > max
|
||||
|
|
|
|||
|
|
@ -9,11 +9,13 @@ UNION: rational integer ratio ;
|
|||
M: integer numerator ;
|
||||
M: integer denominator drop 1 ;
|
||||
|
||||
: >fraction ( a/b -- a b )
|
||||
dup numerator swap denominator ;
|
||||
|
||||
IN: math-internals
|
||||
|
||||
: 2>fraction ( a/b c/d -- a c b d )
|
||||
[ swap numerator swap numerator ] 2keep
|
||||
swap denominator swap denominator ; inline
|
||||
>r >fraction r> >fraction swapd ;
|
||||
|
||||
M: ratio number= ( a/b c/d -- ? )
|
||||
2>fraction number= [ number= ] [ 2drop f ] ifte ;
|
||||
|
|
@ -35,3 +37,7 @@ M: ratio * ( x y -- x*y ) 2>fraction * >r * r> integer/ ;
|
|||
M: ratio / scale integer/ ;
|
||||
M: ratio /i scale /i ;
|
||||
M: ratio /f scale /f ;
|
||||
|
||||
M: ratio truncate >fraction /i ;
|
||||
M: ratio floor >fraction /mod dup 0 < [ 1 - ] when ;
|
||||
M: ratio ceiling >fraction /mod dup 0 > [ 1 + ] when ;
|
||||
|
|
|
|||
|
|
@ -25,6 +25,13 @@ USE: math
|
|||
"/library/test/io/mac-os-eol.txt" <resource-stream> lines-test
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"This is a line."
|
||||
"This is another line."
|
||||
] [
|
||||
"/library/test/io/unix-eol.txt" <resource-stream> lines-test
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"This is a line.\rThis is another line.\r"
|
||||
] [
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
This is a line.
|
||||
This is another line.
|
||||
|
|
@ -4,6 +4,8 @@ USE: math
|
|||
USE: test
|
||||
USE: unparser
|
||||
|
||||
[ 1 2 ] [ 1/2 >fraction ] unit-test
|
||||
|
||||
[ 1/2 ] [ 1 >bignum 2 >bignum / ] unit-test
|
||||
[ t ] [ 10 3 / ratio? ] unit-test
|
||||
[ f ] [ 10 2 / ratio? ] unit-test
|
||||
|
|
@ -63,3 +65,13 @@ unit-test
|
|||
[ -1 ] [ -12.55 sgn ] unit-test
|
||||
[ 1 ] [ 100000000000000000000000000000000 sgn ] unit-test
|
||||
[ 0 ] [ 0.0 sgn ] unit-test
|
||||
|
||||
[ 5 ] [ 5 floor ] unit-test
|
||||
[ -5 ] [ -5 floor ] unit-test
|
||||
[ 6 ] [ 6 truncate ] unit-test
|
||||
[ 3 ] [ 10/3 floor ] unit-test
|
||||
[ -4 ] [ -10/3 floor ] unit-test
|
||||
[ 4 ] [ 10/3 ceiling ] unit-test
|
||||
[ -3 ] [ -10/3 ceiling ] unit-test
|
||||
[ 3 ] [ 10/3 truncate ] unit-test
|
||||
[ -3 ] [ -10/3 truncate ] unit-test
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ USING: namespaces ;
|
|||
: io-error ( n -- ) 0 < [ errno strerror throw ] when ;
|
||||
|
||||
: init-handle ( fd -- )
|
||||
F_SETFL O_NONBLOCK 1 fcntl io-error ;
|
||||
F_SETFL O_NONBLOCK fcntl io-error ;
|
||||
|
||||
! Common delegate of native stream readers and writers
|
||||
TUPLE: port handle buffer error ;
|
||||
|
|
@ -196,7 +196,7 @@ M: read-line-task do-io-task ( task -- ? )
|
|||
] ifte ;
|
||||
|
||||
M: read-line-task io-task-events ( task -- events )
|
||||
drop read-events ;
|
||||
drop POLLIN ;
|
||||
|
||||
: wait-to-read-line ( port -- )
|
||||
dup can-read-line? [
|
||||
|
|
@ -259,7 +259,7 @@ M: read-task do-io-task ( task -- ? )
|
|||
] ifte ;
|
||||
|
||||
M: read-task io-task-events ( task -- events )
|
||||
drop read-events ;
|
||||
drop POLLIN ;
|
||||
|
||||
: wait-to-read ( count port -- )
|
||||
2dup can-read-count? [
|
||||
|
|
@ -310,7 +310,7 @@ M: write-task do-io-task
|
|||
] ifte ;
|
||||
|
||||
M: write-task io-task-events ( task -- events )
|
||||
drop write-events ;
|
||||
drop POLLOUT ;
|
||||
|
||||
: write-fin ( str writer -- )
|
||||
dup pending-error >buffer ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
! We need to fiddle with the exact search order here, since
|
||||
! unix-internals::accept shadows streams::accept.
|
||||
IN: io-internals
|
||||
USING: namespaces streams unparser ;
|
||||
USING: namespaces streams threads unparser ;
|
||||
USING: alien generic kernel math unix-internals ;
|
||||
|
||||
: init-sockaddr ( port -- sockaddr )
|
||||
|
|
@ -57,10 +57,10 @@ C: accept-task ( port -- task )
|
|||
M: accept-task do-io-task ( task -- ? ) drop t ;
|
||||
|
||||
M: accept-task io-task-events ( task -- events )
|
||||
drop read-events ;
|
||||
drop POLLIN ;
|
||||
|
||||
: wait-to-accept ( server -- )
|
||||
[ swap <accept-task> add-io-task io-multiplex ] callcc0 drop ;
|
||||
[ swap <accept-task> add-io-task stop ] callcc0 drop ;
|
||||
|
||||
: inet-ntoa ( n -- str )
|
||||
ntohl [
|
||||
|
|
|
|||
|
|
@ -21,3 +21,6 @@ IN: unix-internals
|
|||
: SOL_SOCKET HEX: ffff ; ! options for socket level
|
||||
: SO_REUSEADDR HEX: 4 ; ! allow local address reuse
|
||||
: INADDR_ANY 0 ;
|
||||
|
||||
: F_SETFL 4 ; ! set file status flags
|
||||
: O_NONBLOCK 4 ; ! no delay
|
||||
|
|
|
|||
|
|
@ -21,3 +21,6 @@ IN: unix-internals
|
|||
: SOL_SOCKET 1 ;
|
||||
: SO_REUSEADDR 2 ;
|
||||
: INADDR_ANY 0 ;
|
||||
|
||||
: F_SETFL 4 ; ! set file status flags
|
||||
: O_NONBLOCK 4 ; ! no delay
|
||||
|
|
|
|||
|
|
@ -0,0 +1,22 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: unix-internals
|
||||
|
||||
! Mac OS X
|
||||
|
||||
: O_RDONLY HEX: 0000 ;
|
||||
: O_WRONLY HEX: 0001 ;
|
||||
: O_RDWR HEX: 0002 ;
|
||||
: O_CREAT HEX: 0200 ;
|
||||
: O_TRUNC HEX: 0400 ;
|
||||
|
||||
: POLLIN HEX: 0001 ; ! any readable data available
|
||||
: POLLPRI HEX: 0002 ; ! OOB/Urgent readable data
|
||||
: POLLOUT HEX: 0004 ; ! file descriptor is writeable
|
||||
|
||||
: SOL_SOCKET HEX: ffff ; ! options for socket level
|
||||
: SO_REUSEADDR HEX: 4 ; ! allow local address reuse
|
||||
: INADDR_ANY 0 ;
|
||||
|
||||
: F_SETFL 4 ; ! set file status flags
|
||||
: O_NONBLOCK 4 ; ! no delay
|
||||
|
|
@ -25,11 +25,8 @@ ALIAS: uint in_addr_t
|
|||
: close ( fd -- )
|
||||
"void" "libc" "close" [ "int" ] alien-invoke ;
|
||||
|
||||
: F_SETFL 4 ; ! set file status flags
|
||||
: O_NONBLOCK 4 ; ! no delay
|
||||
|
||||
: fcntl ( fd cmd key value -- n )
|
||||
"int" "libc" "fcntl" [ "int" "int" "int" "int" ] alien-invoke ;
|
||||
: fcntl ( fd cmd arg -- n )
|
||||
"int" "libc" "fcntl" [ "int" "int" "int" ] alien-invoke ;
|
||||
|
||||
: read ( fd buf nbytes -- n )
|
||||
"ssize_t" "libc" "read" [ "int" "ulong" "size_t" ] alien-invoke ;
|
||||
|
|
@ -43,9 +40,6 @@ BEGIN-STRUCT: pollfd
|
|||
FIELD: short revents
|
||||
END-STRUCT
|
||||
|
||||
: read-events POLLIN POLLRDNORM bitor POLLRDBAND bitor ;
|
||||
: write-events POLLOUT POLLWRNORM bitor POLLWRBAND bitor ;
|
||||
|
||||
: poll ( pollfds nfds timeout -- n )
|
||||
"int" "libc" "poll" [ "pollfd*" "uint" "int" ] alien-invoke ;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
void init_factor(char* image, CELL ds_size, CELL cs_size,
|
||||
CELL data_size, CELL code_size)
|
||||
{
|
||||
init_ffi();
|
||||
init_arena(data_size);
|
||||
init_compiler(code_size);
|
||||
load_image(image);
|
||||
|
|
@ -26,6 +27,8 @@ void init_factor(char* image, CELL ds_size, CELL cs_size,
|
|||
userenv[OS_ENV] = tag_object(from_c_string("freebsd"));
|
||||
#elif defined(linux)
|
||||
userenv[OS_ENV] = tag_object(from_c_string("linux"));
|
||||
#elif defined(__APPLE__)
|
||||
userenv[OS_ENV] = tag_object(from_c_string("macosx"));
|
||||
#else
|
||||
userenv[OS_ENV] = tag_object(from_c_string("unix"));
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -1,8 +1,15 @@
|
|||
#include "../factor.h"
|
||||
|
||||
void ffi_dlopen(DLL* dll)
|
||||
static void *null_dll;
|
||||
|
||||
void init_ffi(void)
|
||||
{
|
||||
void* dllptr;
|
||||
null_dll = dlopen(NULL,RTLD_LAZY);
|
||||
}
|
||||
|
||||
void ffi_dlopen(DLL *dll)
|
||||
{
|
||||
void *dllptr;
|
||||
|
||||
dllptr = dlopen(to_c_string(untag_string(dll->path)), RTLD_LAZY);
|
||||
|
||||
|
|
@ -17,7 +24,8 @@ void ffi_dlopen(DLL* dll)
|
|||
|
||||
void *ffi_dlsym(DLL *dll, F_STRING *symbol)
|
||||
{
|
||||
void* sym = dlsym(dll ? dll->dll : NULL, to_c_string(symbol));
|
||||
void *handle = (dll == NULL ? null_dll : dll->dll);
|
||||
void *sym = dlsym(handle,to_c_string(symbol));
|
||||
if(sym == NULL)
|
||||
{
|
||||
general_error(ERROR_FFI,tag_object(
|
||||
|
|
|
|||
Loading…
Reference in New Issue