steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Win32 version ported to gcc, eliminate MSVC hacks, add gcc hacks

cvs
Mackenzie Straight 2005-02-08 22:05:08 +00:00
parent d22b17c169
commit 88ba22ff6c
13 changed files with 85 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
Makefile
View File

@ -4,7 +4,15 @@ DEFAULT_LIBS = -lm
STRIP = strip
OBJS = native/arithmetic.o native/array.o native/bignum.o \
obj-$(UNIX) += native/unix/file.o native/unix/io.o native/unix/socket.o \
native/unix/signal.o native/unix/read.o native/unix/write.o \
native/unix/ffi.o native/unix/run.o
obj-$(WIN32) += native/win32/ffi.o native/win32/file.o native/win32/io.o \
native/win32/misc.o native/win32/read.o native/win32/write.o \
native/win32/run.o
obj-y += native/arithmetic.o native/array.o native/bignum.o \
native/s48_bignum.o \
native/complex.o native/cons.o native/error.o \
native/factor.o native/fixnum.o \
@ -17,13 +25,6 @@ OBJS = native/arithmetic.o native/array.o native/bignum.o \
native/string.o native/types.o native/vector.o \
native/word.o native/compiler.o \
native/ffi.o native/boolean.o \
native/unix/file.o \
native/unix/io.o \
native/unix/socket.o \
native/unix/signal.o \
native/unix/read.o \
native/unix/write.o \
native/unix/ffi.o \
native/debug.o \
native/hashtable.o
@ -35,6 +36,7 @@ default:
@echo "linux"
@echo "macosx"
@echo "solaris"
@echo "windows"
@echo ""
@echo "Also, you might want to set the SITE_CFLAGS environment"
@echo "variable to enable some CPU-specific optimizations; this"
@ -45,34 +47,45 @@ default:
bsd:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic -pthread" \
LIBS="$(DEFAULT_LIBS)"
LIBS="$(DEFAULT_LIBS)" \
UNIX=y
bsd-nopthread:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic" \
LIBS="$(DEFAULT_LIBS)"
LIBS="$(DEFAULT_LIBS)" \
UNIX=y
macosx:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS) -DFFI" \
LIBS="$(DEFAULT_LIBS)"
LIBS="$(DEFAULT_LIBS)" \
UNIX=y
linux:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic" \
LIBS="$(DEFAULT_LIBS) -ldl"
LIBS="$(DEFAULT_LIBS) -ldl" \
UNIX=y
solaris:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS)" \
LIBS="$(DEFAULT_LIBS) -lsocket -lnsl -lm"
LIBS="$(DEFAULT_LIBS) -lsocket -lnsl -lm" \
UNIX=y
f: $(OBJS)
$(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)
windows:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS) -DFFI -DWIN32" \
LIBS="$(DEFAULT_LIBS)" \
WIN32=y
f: $(obj-y)
$(CC) $(LIBS) $(CFLAGS) -o $@ $(obj-y)
$(STRIP) $@
clean:
rm -f $(OBJS)
rm -f $(obj-y)
.c.o:
$(CC) -c $(CFLAGS) -o $@ $<

2
library/dlists.factor
View File

@ -32,7 +32,7 @@ C: dlist-node
: (dlist-each) ( quot dnode -- )
[
[ dlist-node-data swap [ call ] keep ] keep
[ dlist-node-data swap call ] 2keep
dlist-node-next (dlist-each)
] [
drop

2
native/factor.c
View File

@ -45,7 +45,7 @@ int main(int argc, char** argv)
userenv[ARGS_ENV] = args;
run();
platform_run();
return 0;
}

27
native/factor.h
View File

@ -31,6 +31,7 @@ DLLEXPORT CELL cs;
#include <fcntl.h>
#include <limits.h>
#include <math.h>
#include <stdbool.h>
#include <setjmp.h>
#include <signal.h>
#include <stdio.h>
@ -57,33 +58,11 @@ DLLEXPORT CELL cs;
#include <netdb.h>
#endif
#if defined(_MSC_VER)
#pragma warning(disable:4312)
#pragma warning(disable:4311)
typedef enum { false, true } _Bool;
typedef enum _Bool bool;
typedef unsigned char uint8_t;
typedef unsigned short uint16_t;
typedef unsigned int uint32_t;
typedef unsigned __int64 uint64_t;
typedef signed char int8_t;
typedef signed short int16_t;
typedef signed int int32_t;
typedef signed __int64 int64_t;
#define snprintf _snprintf
#else
#include <stdbool.h>
#endif
#if defined(FFI) && !defined(WIN32)
#include <dlfcn.h>
#endif /* FFI */
#if defined(_MSC_VER)
#define INLINE static __inline
#else
#define INLINE inline static
#endif
#define INLINE inline static
#define FIXNUM_MAX (LONG_MAX >> TAG_BITS)
#define FIXNUM_MIN (LONG_MIN >> TAG_BITS)
@ -101,7 +80,7 @@ DLLEXPORT CELL cs;
typedef unsigned char BYTE;
/* Memory areas */
#define DEFAULT_ARENA (8 * 1024 * 1024)
#define DEFAULT_ARENA (16 * 1024 * 1024)
#define COMPILE_ZONE_SIZE (8 * 1024 * 1024)
#define STACK_SIZE (2 * 1024 * 1024)

12
native/run.c
View File

@ -21,12 +21,9 @@ void run(void)
/* Error handling. */
#ifdef WIN32
setjmp(toplevel);
__try
{
#else
sigsetjmp(toplevel, 1);
#endif
if(thrown_error != F)
{
if(thrown_keep_stacks)
@ -61,15 +58,6 @@ void run(void)
else
dpush(next);
}
#ifdef WIN32
}
__except (GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ?
EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH)
{
signal_error(SIGSEGV);
}
#endif
}
/* XT of deferred words */

1
native/run.h
View File

@ -92,6 +92,7 @@ INLINE void call(CELL quot)
void clear_environment(void);
void run(void);
void platform_run(void);
void undefined(F_WORD* word);
void docol(F_WORD* word);
void dosym(F_WORD* word);

2
native/signal.h
View File

@ -5,4 +5,4 @@ void call_profiling_step(int signal, siginfo_t* siginfo, void* uap);
void init_signals(void);
#endif
void primitive_call_profiling(void);
void primitive_call_profiling(F_WORD *);

8
native/socket.h
View File

@ -1,9 +1,9 @@
void init_sockaddr(struct sockaddr_in *name,
const char *hostname, uint16_t port);
int make_client_socket(const char* hostname, uint16_t port);
void primitive_client_socket(void);
void primitive_client_socket(F_WORD *);
int make_server_socket(uint16_t port);
void primitive_server_socket(void);
void primitive_add_accept_io_task(void);
void primitive_server_socket(F_WORD *);
void primitive_add_accept_io_task(F_WORD *);
CELL accept_connection(F_PORT* p);
void primitive_accept_fd(void);
void primitive_accept_fd(F_WORD *);

7
native/unix/run.c Normal file
View File

@ -0,0 +1,7 @@
#include "../factor.h"
void platform_run()
{
run();
}

2
native/unix/signal.c
View File

@ -60,7 +60,7 @@ void init_signals(void)
sigaction(SIGQUIT,&dump_sigaction,NULL);
}
void primitive_call_profiling(void)
void primitive_call_profiling(F_WORD *word)
{
CELL d = dpop();
if(d == F)

8
native/unix/socket.c
View File

@ -42,7 +42,7 @@ int make_client_socket(const char* hostname, uint16_t port)
return sock;
}
void primitive_client_socket(void)
void primitive_client_socket(F_WORD *word)
{
uint16_t p = (uint16_t)to_fixnum(dpop());
char* host;
@ -94,14 +94,14 @@ int make_server_socket(uint16_t port)
return sock;
}
void primitive_server_socket(void)
void primitive_server_socket(F_WORD *word)
{
uint16_t p = (uint16_t)to_fixnum(dpop());
maybe_garbage_collection();
dpush(tag_object(port(PORT_SPECIAL,make_server_socket(p))));
}
void primitive_add_accept_io_task(void)
void primitive_add_accept_io_task(F_WORD *word)
{
CELL callback, port;
maybe_garbage_collection();
@ -133,7 +133,7 @@ CELL accept_connection(F_PORT* p)
return true;
}
void primitive_accept_fd(void)
void primitive_accept_fd(F_WORD *word)
{
F_PORT* p;
maybe_garbage_collection();

3
native/win32/misc.c
View File

@ -4,7 +4,7 @@
* Various stubs for functions not currently implemented in the Windows port.
*/
void init_signals(void)
void init_signals()
{
}
@ -32,3 +32,4 @@ void primitive_call_profiling(F_WORD *word)
{
undefined(word);
}

30
native/win32/run.c Normal file
View File

@ -0,0 +1,30 @@
#include "../factor.h"
/* SEH support. Proceed with caution. */
typedef long exception_handler_t(
void *rec, void *frame, void *context, void *dispatch);
typedef struct exception_record {
struct exception_record *next_handler;
void *handler_func;
} exception_record_t;
void seh_call(void (*func)(), exception_handler_t *handler)
{
exception_record_t record;
asm("mov %%fs:0, %0" : "=r" (record.next_handler));
asm("mov %0, %%fs:0" : : "r" (&record));
record.handler_func = handler;
func();
asm("mov %0, %%fs:0" : "=r" (record.next_handler));
}
static long exception_handler(void *rec, void *frame, void *ctx, void *dispatch)
{
signal_error(SIGSEGV);
}
void platform_run ()
{
seh_call(run, exception_handler);
}