diff --git a/core/compiler/test/intrinsics.factor b/core/compiler/test/intrinsics.factor index 23e94a7974..d80b172c31 100644 --- a/core/compiler/test/intrinsics.factor +++ b/core/compiler/test/intrinsics.factor @@ -360,20 +360,25 @@ cell 8 = [ [ 3 ] [ B{ 1 2 3 4 5 } 2 [ { simple-c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test [ ] [ B{ 1 2 3 4 5 } malloc-byte-array "b" set ] unit-test +[ t ] [ "b" get >boolean ] unit-test -[ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-1 ] unit-test -[ 3 ] [ "b" get [ { simple-alien } declare 2 alien-unsigned-1 ] compile-1 ] unit-test -[ 3 ] [ "b" get 2 [ { simple-alien fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test -[ 3 ] [ "b" get 2 [ { simple-c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test +"b" get [ + [ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-1 ] unit-test + [ 3 ] [ "b" get [ { simple-alien } declare 2 alien-unsigned-1 ] compile-1 ] unit-test + [ 3 ] [ "b" get 2 [ { simple-alien fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test + [ 3 ] [ "b" get 2 [ { simple-c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test -[ ] [ "b" get free ] unit-test + [ ] [ "b" get free ] unit-test +] when -[ ] [ "hello world" malloc-char-string "s" set ] unit-test +[ t ] [ "hello world" malloc-char-string "s" set ] unit-test -[ "hello world" ] [ "s" get [ { byte-array } declare *void* ] compile-1 alien>char-string ] unit-test -[ "hello world" ] [ "s" get [ { simple-c-ptr } declare *void* ] compile-1 alien>char-string ] unit-test +"s" get [ + [ "hello world" ] [ "s" get [ { byte-array } declare *void* ] compile-1 alien>char-string ] unit-test + [ "hello world" ] [ "s" get [ { simple-c-ptr } declare *void* ] compile-1 alien>char-string ] unit-test -[ ] [ "s" get free ] unit-test + [ ] [ "s" get free ] unit-test +] when [ ALIEN: 1234 ] [ ALIEN: 1234 [ { simple-alien } declare ] compile-1 *void* ] unit-test [ ALIEN: 1234 ] [ ALIEN: 1234 [ { simple-c-ptr } declare ] compile-1 *void* ] unit-test diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 98d241c8f6..f012f8d736 100644 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -1,6 +1,7 @@ USING: alien alien.c-types destructors io.windows libc io.nonblocking io.streams.duplex windows.types math -windows.kernel32 windows namespaces io.launcher kernel ; +windows.kernel32 windows namespaces io.launcher kernel +io.windows.nt.backend ; IN: io.windows.launcher ! From MSDN: "Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed." diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 06d508e757..5eac9d6751 100644 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -1,9 +1,36 @@ USING: alien alien.c-types arrays assocs combinators continuations -destructors io io.backend io.nonblocking io.windows io.windows.nt libc +destructors io io.backend io.nonblocking io.windows libc kernel math namespaces sequences threads tuples.lib windows -windows.errors windows.kernel32 prettyprint ; +windows.errors windows.kernel32 prettyprint strings splitting +io.files windows.winsock ; IN: io.windows.nt.backend +: unicode-prefix ( -- seq ) + "\\\\?\\" ; inline + +M: windows-nt-io normalize-pathname ( string -- string ) + dup string? [ "pathname must be a string" throw ] unless + "/" split "\\" join + { + ! empty + { [ dup empty? ] [ "empty path" throw ] } + ! .\\foo + { [ dup ".\\" head? ] [ + >r unicode-prefix cwd r> 1 tail 3append + ] } + ! c:\\ + { [ dup 1 tail ":" head? ] [ >r unicode-prefix r> append ] } + ! \\\\?\\c:\\foo + { [ dup unicode-prefix head? ] [ ] } + ! foo.txt ..\\foo.txt + { [ t ] [ + [ + unicode-prefix % cwd % + dup first CHAR: \\ = [ CHAR: \\ , ] unless % + ] "" make + ] } + } cond [ "/\\." member? ] rtrim ; + SYMBOL: io-hash TUPLE: io-callback port continuation ; @@ -63,9 +90,9 @@ C: GetQueuedCompletionStatusParams GetQueuedCompletionStatus ] keep swap ; -: lookup-callback ( GetQueuedCompletion-args -- callback ? ) +: lookup-callback ( GetQueuedCompletion-args -- callback ) GetQueuedCompletionStatusParams-lpOverlapped* *void* - \ io-hash get-global delete-at* ; + \ io-hash get-global delete-at drop ; : wait-for-io ( timeout -- continuation/f ) wait-for-overlapped @@ -73,15 +100,18 @@ C: GetQueuedCompletionStatusParams GetLastError dup (expected-io-error?) [ 2drop f ] [ - (win32-error-string) swap lookup-callback [ + dup ERROR_HANDLE_EOF = [ + drop lookup-callback [ + io-callback-port t swap set-port-eof? + ] keep io-callback-continuation + ] [ + (win32-error-string) swap lookup-callback [ io-callback-port set-port-error ] keep io-callback-continuation - ] [ - drop "No callback found" 2array throw ] if ] if ] [ - lookup-callback [ io-callback-continuation ] when + lookup-callback io-callback-continuation ] if ; : maybe-expire ( io-callbck -- ) @@ -99,3 +129,12 @@ M: windows-nt-io io-multiplex ( ms -- ) cancel-timedout [ wait-for-io ] [ global [ "error: " write . flush ] bind drop f ] recover [ schedule-thread ] when* ; + +M: windows-nt-io init-io ( -- ) + #! Should only be called on startup. Calling this at any + #! other time can have unintended consequences. + global [ + master-completion-port \ master-completion-port set + H{ } clone \ io-hash set + init-winsock + ] bind ; diff --git a/extra/io/windows/nt/nt.factor b/extra/io/windows/nt/nt.factor index 5370580f10..7469410238 100644 --- a/extra/io/windows/nt/nt.factor +++ b/extra/io/windows/nt/nt.factor @@ -1,51 +1,10 @@ ! Copyright (C) 2004, 2007 Mackenzie Straight, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types assocs byte-arrays combinators -io.backend io.files io.nonblocking io.windows -kernel libc math namespaces qualified sequences -splitting strings threads windows windows.errors windows.winsock -windows.kernel32 ; -QUALIFIED: windows.winsock -IN: io.windows.nt - -: unicode-prefix ( -- seq ) - "\\\\?\\" ; inline - -M: windows-nt-io normalize-pathname ( string -- string ) - dup string? [ "pathname must be a string" throw ] unless - "/" split "\\" join - { - ! empty - { [ dup empty? ] [ "empty path" throw ] } - ! .\\foo - { [ dup ".\\" head? ] [ - >r unicode-prefix cwd r> 1 tail 3append - ] } - ! c:\\ - { [ dup 1 tail ":" head? ] [ >r unicode-prefix r> append ] } - ! \\\\?\\c:\\foo - { [ dup unicode-prefix head? ] [ ] } - ! foo.txt ..\\foo.txt - { [ t ] [ - [ - unicode-prefix % cwd % - dup first CHAR: \\ = [ CHAR: \\ , ] unless % - ] "" make - ] } - } cond [ "/\\." member? ] rtrim ; - +USE: io.windows USE: io.windows.nt.backend USE: io.windows.nt.files USE: io.windows.nt.sockets +USE: io.backend +USE: namespaces T{ windows-nt-io } io-backend set-global - -M: windows-nt-io init-io ( -- ) - #! Should only be called on startup. Calling this at any - #! other time can have unintended consequences. - global [ - master-completion-port \ master-completion-port set - H{ } clone \ io-hash set - init-winsock - ] bind ; - diff --git a/extra/windows/opengl32/opengl32.factor b/extra/windows/opengl32/opengl32.factor index fcda38ca53..93473a4fd3 100644 --- a/extra/windows/opengl32/opengl32.factor +++ b/extra/windows/opengl32/opengl32.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax parser namespaces kernel -math windows.types windows.types init assocs sequences opengl.gl ; +math windows.types windows.types init assocs sequences opengl.gl +libc ; IN: windows.opengl32 ! PIXELFORMATDESCRIPTOR flags diff --git a/misc/install.sh b/misc/install.sh new file mode 100755 index 0000000000..10c0bfc0df --- /dev/null +++ b/misc/install.sh @@ -0,0 +1,110 @@ +#!/bin/bash -e + +# Programs returning != 0 will not cause script to exit +set +e + +# Case insensitive string comparison +shopt -s nocaseglob +shopt -s nocasematch + +ensure_program_installed() { + echo -n "Checking for $1..." + result=`type -p $1` + if ! [[ -n $result ]] ; then + echo "not found!" + echo "Install $1 and try again." + exit 1 + fi + echo "found!" +} + +check_ret() { + RET=$? + if [[ $RET -ne 0 ]] ; then + echo $1 failed + exit 5 + fi +} + +ensure_program_installed uname +ensure_program_installed git +ensure_program_installed wget +ensure_program_installed gcc +ensure_program_installed make + +GCC_VERSION=`gcc --version` +if [[ $GCC_VERSION == *3.3.* ]] ; then + echo "You have a known buggy version of gcc (3.3)" + echo "Install gcc 3.4 or higher and try again." + exit 1 +fi + +# OS +OS= +uname_s=`uname -s` +case $uname_s in + CYGWIN_NT-5.2-WOW64) OS=windows-nt;; + *CYGWIN_NT*) OS=windows-nt;; + *CYGWIN*) OS=windows-nt;; + *darwin*) OS=macosx;; + *linux*) OS=linux;; +esac + +# Architecture +ARCH= +uname_m=`uname -m` +case $uname_m in + i386) ARCH=x86;; + i686) ARCH=x86;; + *86) ARCH=x86;; + "Power Macintosh") ARCH=ppc;; +esac + +WORD= +C_WORD=factor-word-size +# Word size +echo "#include " > $C_WORD.c +echo "int main() { printf(\"%d\", 8*sizeof(long)); return 0; }" >> $C_WORD.c +gcc -o $C_WORD $C_WORD.c +WORD=$(./$C_WORD) +check_ret $C_WORD +rm -f $C_WORD* + +case $OS in + windows-nt) FACTOR_BINARY=factor-nt;; + macosx) FACTOR_BINARY=./Factor.app/Contents/MacOS/factor;; + *) FACTOR_BINARY=factor;; +esac + +MAKE_TARGET=$OS-$ARCH-$WORD +BOOT_IMAGE=boot.$ARCH.$WORD.image + +echo OS=$OS +echo ARCH=$ARCH +echo WORD=$WORD +echo FACTOR_BINARY=$FACTOR_BINARY +echo MAKE_TARGET=$MAKE_TARGET +echo BOOT_IMAGE=$BOOT_IMAGE + +if ! [[ -n $OS && -n $ARCH && -n $WORD ]] ; then + echo "OS, ARCH, or WORD is empty. Please report this" + exit 4 +fi + +echo "Downloading the git repository from factorcode.org..." +git clone git://factorcode.org/git/factor.git +check_ret git + +cd factor +check_ret cd + +make $MAKE_TARGET +check_ret make + +echo "Deleting old images..." +rm $BOOT_IMAGE > /dev/null 2>&1 +rm $BOOT_IMAGE.* > /dev/null 2>&1 +wget http://factorcode.org/images/latest/$BOOT_IMAGE +check_ret wget + +./$FACTOR_BINARY -i=$BOOT_IMAGE diff --git a/vm/cpu-ppc.h b/vm/cpu-ppc.h index c74e13e68b..ac4a0a92ee 100644 --- a/vm/cpu-ppc.h +++ b/vm/cpu-ppc.h @@ -1,5 +1,5 @@ #define FACTOR_CPU_STRING "ppc" -#define FASTCALL +#define F_FASTCALL register CELL ds asm("r14"); register CELL rs asm("r15"); diff --git a/vm/cpu-x86.32.h b/vm/cpu-x86.32.h index 4c4acb0ad3..a81c9987c4 100644 --- a/vm/cpu-x86.32.h +++ b/vm/cpu-x86.32.h @@ -3,4 +3,5 @@ register CELL ds asm("esi"); register CELL rs asm("edi"); -#define FASTCALL __attribute__ ((regparm (2))) +#define F_FASTCALL __attribute__ ((regparm (2))) + diff --git a/vm/cpu-x86.64.h b/vm/cpu-x86.64.h index 0b3b5a2471..6412355129 100644 --- a/vm/cpu-x86.64.h +++ b/vm/cpu-x86.64.h @@ -3,4 +3,4 @@ register CELL ds asm("r14"); register CELL rs asm("r15"); -#define FASTCALL +#define F_FASTCALL diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S index ec5d09291e..7032b77e18 100644 --- a/vm/cpu-x86.S +++ b/vm/cpu-x86.S @@ -2,7 +2,7 @@ mov QUOT_XT_OFFSET(ARG0),XT_REG ; /* Load quot-xt */ \ jmp *XT_REG /* Jump to quot-xt */ -DEF(FASTCALL void,c_to_factor,(CELL quot)): +DEF(F_FASTCALL void,c_to_factor,(CELL quot)): PUSH_NONVOLATILE push ARG0 /* Save quot */ @@ -17,38 +17,38 @@ DEF(FASTCALL void,c_to_factor,(CELL quot)): POP_NONVOLATILE ret -DEF(FASTCALL void,undefined,(CELL word)): +DEF(F_FASTCALL void,undefined,(CELL word)): mov STACK_REG,ARG1 /* Pass callstack pointer */ jmp MANGLE(undefined_error) /* This throws an error */ -DEF(FASTCALL void,dosym,(CELL word)): +DEF(F_FASTCALL void,dosym,(CELL word)): add $CELL_SIZE,DS_REG /* Increment stack pointer */ mov ARG0,(DS_REG) /* Store word on stack */ ret /* Here we have two entry points. The first one is taken when profiling is enabled */ -DEF(FASTCALL void,docol_profiling,(CELL word)): +DEF(F_FASTCALL void,docol_profiling,(CELL word)): add $CELL_SIZE,PROFILING_OFFSET(ARG0) /* Increment profile-count slot */ -DEF(FASTCALL void,docol,(CELL word)): +DEF(F_FASTCALL void,docol,(CELL word)): mov WORD_DEF_OFFSET(ARG0),ARG0 /* Load word-def slot */ JUMP_QUOT /* We must pass the XT to the quotation in ECX. */ -DEF(FASTCALL void,primitive_call,(void)): +DEF(F_FASTCALL void,primitive_call,(void)): mov (DS_REG),ARG0 /* Load quotation from data stack */ sub $CELL_SIZE,DS_REG /* Pop data stack */ JUMP_QUOT /* We pass the word in EAX and the XT in ECX. Don't mess up EDX, it's the callstack top parameter to primitives. */ -DEF(FASTCALL void,primitive_execute,(void)): +DEF(F_FASTCALL void,primitive_execute,(void)): mov (DS_REG),ARG0 /* Load word from data stack */ sub $CELL_SIZE,DS_REG /* Pop data stack */ mov WORD_XT_OFFSET(ARG0),XT_REG /* Load word-xt slot */ jmp *XT_REG /* Go */ -DEF(FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)): +DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)): mov ARG1,STACK_REG /* rewind_to */ JUMP_QUOT diff --git a/vm/cpu-x86.h b/vm/cpu-x86.h index 63bf2b08e1..91f1f8236a 100644 --- a/vm/cpu-x86.h +++ b/vm/cpu-x86.h @@ -22,12 +22,12 @@ typedef struct _F_STACK_FRAME INLINE void flush_icache(CELL start, CELL len) {} -FASTCALL void c_to_factor(CELL quot); -FASTCALL void throw_impl(CELL quot, F_STACK_FRAME *rewind_to); -FASTCALL void undefined(CELL word); -FASTCALL void dosym(CELL word); -FASTCALL void docol_profiling(CELL word); -FASTCALL void docol(CELL word); -FASTCALL void lazy_jit_compile(CELL quot); +F_FASTCALL void c_to_factor(CELL quot); +F_FASTCALL void throw_impl(CELL quot, F_STACK_FRAME *rewind_to); +F_FASTCALL void undefined(CELL word); +F_FASTCALL void dosym(CELL word); +F_FASTCALL void docol_profiling(CELL word); +F_FASTCALL void docol(CELL word); +F_FASTCALL void lazy_jit_compile(CELL quot); void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy); diff --git a/vm/jit.c b/vm/jit.c index 6faf0a6a17..51fa06ef86 100644 --- a/vm/jit.c +++ b/vm/jit.c @@ -34,7 +34,7 @@ bool jit_stack_frame_p(F_ARRAY *array) return false; } -FASTCALL CELL jit_compile(CELL tagged, F_STACK_FRAME *stack) +F_FASTCALL CELL jit_compile(CELL tagged, F_STACK_FRAME *stack) { stack_chain->callstack_top = stack; diff --git a/vm/jit.h b/vm/jit.h index a9f1399472..d1c91b631b 100644 --- a/vm/jit.h +++ b/vm/jit.h @@ -1,2 +1,2 @@ -DLLEXPORT FASTCALL CELL jit_compile(CELL tagged, F_STACK_FRAME *stack); +DLLEXPORT F_FASTCALL CELL jit_compile(CELL tagged, F_STACK_FRAME *stack); XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset); diff --git a/vm/os-unix.c b/vm/os-unix.c index 2d9ba02ca5..65ae79550c 100644 --- a/vm/os-unix.c +++ b/vm/os-unix.c @@ -179,11 +179,6 @@ INLINE F_STACK_FRAME *uap_stack_pointer(void *uap) return NULL; } -void memory_signal_handler_impl(void) -{ - memory_protection_error(signal_fault_addr,signal_callstack_top); -} - void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap) { signal_fault_addr = (CELL)siginfo->si_addr; @@ -191,11 +186,6 @@ void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap) UAP_PROGRAM_COUNTER(uap) = (CELL)memory_signal_handler_impl; } -void misc_signal_handler_impl(void) -{ - signal_error(signal_number,signal_callstack_top); -} - void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap) { signal_number = signal; diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c index 2a87a85223..8f7513a32a 100644 --- a/vm/os-windows-nt.c +++ b/vm/os-windows-nt.c @@ -23,31 +23,39 @@ DEFINE_PRIMITIVE(cd) SetCurrentDirectory(unbox_u16_string()); } -void seh_call(void (*func)(), exception_handler_t *handler) +long exception_handler(PEXCEPTION_POINTERS pe) { - exception_record_t record; - asm volatile("mov %%fs:0, %0" : "=r" (record.next_handler)); - asm volatile("mov %0, %%fs:0" : : "r" (&record)); - record.handler_func = handler; - func(); - asm volatile("mov %0, %%fs:0" : "=r" (record.next_handler)); -} + PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord; + CONTEXT *c = (CONTEXT*)pe->ContextRecord; -long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch) -{ - if(rec->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) - memory_protection_error( - rec->ExceptionInformation[1], - native_stack_pointer()); - else if(rec->ExceptionCode == EXCEPTION_FLT_DIVIDE_BY_ZERO - || rec->ExceptionCode == EXCEPTION_INT_DIVIDE_BY_ZERO) - general_error(ERROR_DIVIDE_BY_ZERO,F,F,false,(void*)rec->ExceptionInformation[1]); + if(in_code_heap_p(c->Eip)) + signal_callstack_top = (void*)c->Esp; else - signal_error(11,(void*)rec->ExceptionInformation[1]); - return -1; /* unreachable */ + signal_callstack_top = NULL; + + if(e->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) + { + signal_fault_addr = e->ExceptionInformation[1]; + c->Eip = (CELL)memory_signal_handler_impl; + } + else if(e->ExceptionCode == EXCEPTION_FLT_DIVIDE_BY_ZERO + || e->ExceptionCode == EXCEPTION_INT_DIVIDE_BY_ZERO) + { + signal_number = ERROR_DIVIDE_BY_ZERO; + c->Eip = (CELL)divide_by_zero_signal_handler_impl; + } + else + { + signal_number = 11; + c->Eip = (CELL)misc_signal_handler_impl; + } + + return EXCEPTION_CONTINUE_EXECUTION; } -void run_toplevel(void) +void c_to_factor_toplevel(CELL quot) { - seh_call(run, exception_handler); + AddVectoredExceptionHandler(0, (void*)exception_handler); + c_to_factor(quot); + RemoveVectoredExceptionHandler((void*)exception_handler); } diff --git a/vm/os-windows-nt.h b/vm/os-windows-nt.h index 514da31477..f3017b0cbe 100644 --- a/vm/os-windows-nt.h +++ b/vm/os-windows-nt.h @@ -1,3 +1,6 @@ +#undef _WIN32_WINNT +#define _WIN32_WINNT 0x0501 // For AddVectoredExceptionHandler + #ifndef UNICODE #define UNICODE #endif @@ -10,3 +13,13 @@ typedef char F_SYMBOL; #define FACTOR_OS_STRING "windows" #define FACTOR_DLL L"factor-nt.dll" #define FACTOR_DLL_NAME "factor-nt.dll" + +void c_to_factor_toplevel(CELL quot); + +CELL signal_number; +CELL signal_fault_addr; +void *signal_callstack_top; + +void memory_signal_handler_impl(void); +void divide_by_zero_signal_handler_impl(void); +void misc_signal_handler_impl(void); diff --git a/vm/os-windows.c b/vm/os-windows.c index 823fd7e9d0..1be3e2a2af 100644 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -51,8 +51,8 @@ void ffi_dlopen (F_DLL *dll, bool error) { dll->dll = NULL; if(error) - general_error(ERROR_FFI,F, - tag_object(get_error_message())); + general_error(ERROR_FFI,F,F, + (void*)tag_object(get_error_message())); else return; } @@ -204,9 +204,3 @@ void sleep_millis(DWORD msec) { Sleep(msec); } - -void run(void) -{ - interpreter(); -} - diff --git a/vm/os-windows.h b/vm/os-windows.h index 04f5c87ac7..ed9b87aa93 100644 --- a/vm/os-windows.h +++ b/vm/os-windows.h @@ -49,20 +49,5 @@ s64 current_millis(void); INLINE void reset_stdio(void) {} -/* SEH support. Proceed with caution. */ -typedef long exception_handler_t( - PEXCEPTION_RECORD rec, void *frame, void *context, void *dispatch); +long exception_handler(PEXCEPTION_POINTERS pe); -typedef struct exception_record -{ - struct exception_record *next_handler; - void *handler_func; -} exception_record_t; - -long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch); - -DECLARE_PRIMITIVE(open_file); -DECLARE_PRIMITIVE(stat); -DECLARE_PRIMITIVE(read_dir); -DECLARE_PRIMITIVE(cwd); -DECLARE_PRIMITIVE(cd); diff --git a/vm/primitives.h b/vm/primitives.h index ce22cff528..2c0040f13f 100644 --- a/vm/primitives.h +++ b/vm/primitives.h @@ -14,19 +14,19 @@ DEFINE_PRIMITIVE(name) Becomes -FASTCALL void primitive_name(CELL word, F_STACK_FRAME *callstack_top) +F_FASTCALL void primitive_name(CELL word, F_STACK_FRAME *callstack_top) { stack_chain->callstack_top = callstack_top; ... CODE ... } -On x86, FASTCALL expands into a GCC declaration which forces the two parameters -to be passed in registers. This simplifies the quotation compiler and support -code in cpu-x86.S. */ +On x86, F_FASTCALL expands into a GCC declaration which forces the two +parameters to be passed in registers. This simplifies the quotation compiler +and support code in cpu-x86.S. */ #define DEFINE_PRIMITIVE(name) \ INLINE void primitive_##name##_impl(void); \ \ - FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top) \ + F_FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top) \ { \ stack_chain->callstack_top = callstack_top; \ primitive_##name##_impl(); \ @@ -36,4 +36,4 @@ code in cpu-x86.S. */ /* Prototype for header files */ #define DECLARE_PRIMITIVE(name) \ - FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top) + F_FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top) diff --git a/vm/run.c b/vm/run.c index 255be845d3..d4f95a47f2 100644 --- a/vm/run.c +++ b/vm/run.c @@ -197,7 +197,7 @@ void not_implemented_error(void) } /* This function is called from the undefined function in cpu_*.S */ -FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top) +F_FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top) { stack_chain->callstack_top = callstack_top; general_error(ERROR_UNDEFINED_WORD,word,F,NULL); @@ -244,6 +244,21 @@ void divide_by_zero_error(F_STACK_FRAME *native_stack) general_error(ERROR_DIVIDE_BY_ZERO,F,F,native_stack); } +void memory_signal_handler_impl(void) +{ + memory_protection_error(signal_fault_addr,signal_callstack_top); +} + +void divide_by_zero_signal_handler_impl(void) +{ + divide_by_zero_error(signal_callstack_top); +} + +void misc_signal_handler_impl(void) +{ + signal_error(signal_number,signal_callstack_top); +} + DEFINE_PRIMITIVE(throw) { uncurry(dpop()); diff --git a/vm/run.h b/vm/run.h index 72ee7eea17..73454989ce 100644 --- a/vm/run.h +++ b/vm/run.h @@ -197,7 +197,7 @@ void signal_error(int signal, F_STACK_FRAME *native_stack); void type_error(CELL type, CELL tagged); void not_implemented_error(void); -FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top); +F_FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top); DECLARE_PRIMITIVE(throw); diff --git a/vm/stack.c b/vm/stack.c index b2a05b9181..9ba4e35bf5 100644 --- a/vm/stack.c +++ b/vm/stack.c @@ -19,7 +19,7 @@ void fix_stacks(void) } /* called before entry into Factor code. */ -FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom) +F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom) { stack_chain->callstack_bottom = callstack_bottom; } diff --git a/vm/stack.h b/vm/stack.h index 62ee1d9ba2..58be5ae52f 100644 --- a/vm/stack.h +++ b/vm/stack.h @@ -48,7 +48,7 @@ CELL ds_size, rs_size; void reset_datastack(void); void reset_retainstack(void); void fix_stacks(void); -FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom); +F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom); DLLEXPORT void save_stacks(void); DLLEXPORT void nest_stacks(void); DLLEXPORT void unnest_stacks(void);