Merge branch 'master' of git://github.com/slavapestov/factor

diff --git a/Nmakefile b/Nmakefile
index 9df7a6a1eee94bad9e9b40f349d01335da6f4185..1edc14199ddd4bf58b3b61c0ed4b497f465cbd22 100755 (executable)
--- a/Nmakefile
+++ b/Nmakefile
@@ -1,15 +1,27 @@
-!IF DEFINED(DEBUG)
-LINK_FLAGS = /nologo /DEBUG shell32.lib
-CL_FLAGS = /nologo /Zi /O2 /W3 /DFACTOR_DEBUG
-!ELSE
-LINK_FLAGS = /nologo /safeseh:no shell32.lib
+!IF DEFINED(PLATFORM)
+
+LINK_FLAGS = /nologo shell32.lib
 CL_FLAGS = /nologo /O2 /W3
+
+!IF DEFINED(DEBUG)
+LINK_FLAGS = $(LINK_FLAGS) /DEBUG
+CL_FLAGS = $(CL_FLAGS) /Zi /DFACTOR_DEBUG
 !ENDIF
 
+!IF "$(PLATFORM)" == "x86-32"
+LINK_FLAGS = $(LINK_FLAGS) /safeseh
+PLAF_DLL_OBJS = vm\os-windows-nt-x86.32.obj vm\safeseh.obj
+!ELSEIF "$(PLATFORM)" == "x86-64"
+PLAF_DLL_OBJS = vm\os-windows-nt-x86.64.obj
+!ENDIF
+
+ML_FLAGS = /nologo /safeseh
+
 EXE_OBJS = vm\main-windows-nt.obj vm\factor.res
 
-DLL_OBJS = vm\os-windows-nt.obj \
+DLL_OBJS = $(PLAF_DLL_OBJS) \
        vm\os-windows.obj \
+       vm\os-windows-nt.obj \
        vm\aging_collector.obj \
        vm\alien.obj \
        vm\arrays.obj \
@@ -60,11 +72,12 @@ DLL_OBJS = vm\os-windows-nt.obj \
 .c.obj:
        cl $(CL_FLAGS) /Fo$@ /c $<
 
+.asm.obj:
+       ml $(ML_FLAGS) /Fo$@ /c $<
+
 .rs.res:
        rc $<
 
-all: factor.com factor.exe factor.dll.lib libfactor-ffi-test.dll
-
 libfactor-ffi-test.dll: vm/ffi_test.obj
        link $(LINK_FLAGS) /out:libfactor-ffi-test.dll /dll vm/ffi_test.obj
 
@@ -77,6 +90,23 @@ factor.com: $(EXE_OBJS) $(DLL_OBJS)
 factor.exe: $(EXE_OBJS) $(DLL_OBJS)
        link $(LINK_FLAGS) /out:factor.exe /SUBSYSTEM:windows $(EXE_OBJS) $(DLL_OBJS)
 
+all: factor.com factor.exe factor.dll.lib libfactor-ffi-test.dll
+
+!ENDIF
+
+default:
+       @echo Usage: nmake /f Nmakefile platform
+       @echo Where platform is one of:
+       @echo x86-32
+       @echo x86-64
+       @exit 1
+
+x86-32:
+       nmake PLATFORM=x86-32 /f Nmakefile all
+
+x86-64:
+       nmake PLATFORM=x86-64 /f Nmakefile all
+
 clean:
        del vm\*.obj
        del factor.lib
@@ -85,6 +115,6 @@ clean:
        del factor.dll
        del factor.dll.lib
 
-.PHONY: all clean
+.PHONY: all default x86-32 x86-64 clean
 
 .SUFFIXES: .rs

diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index 9b1a1de23dc6de804065ebc9dbee4909cd071473..b2cd241df1de6d47ab014faa1f4e14999e7d8591 100644 (file)
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -330,6 +330,3 @@ IN: bootstrap.x86
     jit-delete-current-context
     jit-start-context
 ] \ (start-context-and-delete) define-sub-primitive
-
-<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
-call

diff --git a/basis/cpu/x86/32/unix/bootstrap.factor b/basis/cpu/x86/32/unix/bootstrap.factor
index 1e3bee4961a18dd6b6c7aba387e1d883a38202cf..56d18511e43892a5f841271ab53df17896ca5ad3 100644 (file)
--- a/basis/cpu/x86/32/unix/bootstrap.factor
+++ b/basis/cpu/x86/32/unix/bootstrap.factor
@@ -1,14 +1,8 @@
 ! Copyright (C) 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: cpu.x86.assembler cpu.x86.assembler.operands kernel
-layouts parser sequences ;
+USING: kernel parser sequences ;
 IN: bootstrap.x86
 
-: jit-save-tib ( -- ) ;
-: jit-restore-tib ( -- ) ;
-: jit-update-tib ( ctx-reg -- ) drop ;
-: jit-install-seh ( -- ) ESP bootstrap-cell ADD ;
-: jit-update-seh ( ctx-reg -- ) drop ;
-
-<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >>
-call
+<< "vocab:cpu/x86/unix/bootstrap.factor" parse-file suffix! >> call
+<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >> call
+<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call

diff --git a/basis/cpu/x86/32/winnt/bootstrap.factor b/basis/cpu/x86/32/winnt/bootstrap.factor
index b8ee1dacafb65f5d066ddd025f8046e0bcdc4164..5628632e6cf03427bb69d621322055845df159cc 100644 (file)
--- a/basis/cpu/x86/32/winnt/bootstrap.factor
+++ b/basis/cpu/x86/32/winnt/bootstrap.factor
@@ -5,50 +5,32 @@ cpu.x86.assembler cpu.x86.assembler.operands kernel layouts
 locals parser sequences ;
 IN: bootstrap.x86
 
-: tib-exception-list-offset ( -- n ) 0 bootstrap-cells ;
-: tib-stack-base-offset ( -- n ) 1 bootstrap-cells ;
-: tib-stack-limit-offset ( -- n ) 2 bootstrap-cells ;
+: tib-segment ( -- ) FS ;
+: tib-temp ( -- reg ) EAX ;
 
-: jit-save-tib ( -- )
-    tib-exception-list-offset [] FS PUSH
-    tib-stack-base-offset [] FS PUSH
-    tib-stack-limit-offset [] FS PUSH ;
-
-: jit-restore-tib ( -- )
-    tib-stack-limit-offset [] FS POP
-    tib-stack-base-offset [] FS POP
-    tib-exception-list-offset [] FS POP ;
-
-:: jit-update-tib ( ctx-reg -- )
-    ! There's a redundant load here because we're not allowed
-    ! to clobber ctx-reg. Clobbers EAX.
-    ! Save callstack base in TIB
-    EAX ctx-reg context-callstack-seg-offset [+] MOV
-    EAX EAX segment-end-offset [+] MOV
-    tib-stack-base-offset [] EAX FS MOV
-    ! Save callstack limit in TIB
-    EAX ctx-reg context-callstack-seg-offset [+] MOV
-    EAX EAX segment-start-offset [+] MOV
-    tib-stack-limit-offset [] EAX FS MOV ;
+<< "vocab:cpu/x86/winnt/bootstrap.factor" parse-file suffix! >> call
 
 : jit-install-seh ( -- )
     ! Create a new exception record and store it in the TIB.
+    ! Clobbers tib-temp.
     ! Align stack
     ESP 3 bootstrap-cells ADD
     ! Exception handler address filled in by callback.cpp
-    0 PUSH rc-absolute-cell rt-exception-handler jit-rel
+    tib-temp 0 MOV rc-absolute-cell rt-exception-handler jit-rel
+    tib-temp PUSH
     ! No next handler
     0 PUSH
     ! This is the new exception handler
-    tib-exception-list-offset [] ESP FS MOV ;
+    tib-exception-list-offset [] ESP tib-segment MOV ;
 
 :: jit-update-seh ( ctx-reg -- )
     ! Load exception record structure that jit-install-seh
-    ! created from the bottom of the callstack. Clobbers EAX.
-    EAX ctx-reg context-callstack-bottom-offset [+] MOV
-    EAX bootstrap-cell ADD
+    ! created from the bottom of the callstack.
+    ! Clobbers tib-temp.
+    tib-temp ctx-reg context-callstack-bottom-offset [+] MOV
+    tib-temp bootstrap-cell ADD
     ! Store exception record in TIB.
-    tib-exception-list-offset [] EAX FS MOV ;
+    tib-exception-list-offset [] tib-temp tib-segment MOV ;
 
-<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >>
-call
+<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >> call
+<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call

diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor
index 69734df225140c3ebc6e82728b043eab245d103f..68c3d8b7025dc7a89322ca62262f8d4091729d52 100644 (file)
--- a/basis/cpu/x86/64/bootstrap.factor
+++ b/basis/cpu/x86/64/bootstrap.factor
@@ -26,11 +26,6 @@ IN: bootstrap.x86
 : fixnum>slot@ ( -- ) temp0 1 SAR ;
 : rex-length ( -- n ) 1 ;
 
-: jit-save-tib ( -- ) ;
-: jit-restore-tib ( -- ) ;
-: jit-update-tib ( ctx-reg -- ) drop ;
-: jit-install-seh ( -- ) stack-reg bootstrap-cell ADD ;
-
 : jit-call ( name -- )
     RAX 0 MOV rc-absolute-cell jit-dlsym
     RAX CALL ;
@@ -238,7 +233,9 @@ IN: bootstrap.x86
     RSP ctx-reg context-callstack-top-offset [+] MOV
 
     ! Load new ds, rs registers
-    jit-restore-context ;
+    jit-restore-context
+
+    ctx-reg jit-update-tib ;
 
 : jit-pop-context-and-param ( -- )
     arg1 ds-reg [] MOV
@@ -293,6 +290,3 @@ IN: bootstrap.x86
     jit-delete-current-context
     jit-start-context
 ] \ (start-context-and-delete) define-sub-primitive
-
-<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
-call

diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor
index d19b5306a0ea8bf2514609148fec95b72b821653..cffb12902c3088ae05dbbd0461d25bb9c3d18379 100644 (file)
--- a/basis/cpu/x86/64/unix/bootstrap.factor
+++ b/basis/cpu/x86/64/unix/bootstrap.factor
@@ -12,5 +12,6 @@ IN: bootstrap.x86
 : arg3 ( -- reg ) RDX ;
 : arg4 ( -- reg ) RCX ;
 
-<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >>
-call
+<< "vocab:cpu/x86/unix/bootstrap.factor" parse-file suffix! >> call
+<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call
+<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call

diff --git a/basis/cpu/x86/64/winnt/bootstrap.factor b/basis/cpu/x86/64/winnt/bootstrap.factor
index 113a13918f1f84bd04c4cfda4e6372624acf8768..f816980e57121fa207fd91a92bb9a6b2f78a10b9 100644 (file)
--- a/basis/cpu/x86/64/winnt/bootstrap.factor
+++ b/basis/cpu/x86/64/winnt/bootstrap.factor
@@ -5,6 +5,8 @@ vocabs sequences cpu.x86.assembler parser
 cpu.x86.assembler.operands ;
 IN: bootstrap.x86
 
+DEFER: stack-reg
+
 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
 : nv-regs ( -- seq ) { RBX RSI RDI R12 R13 R14 R15 } ;
 : arg1 ( -- reg ) RCX ;
@@ -12,5 +14,12 @@ IN: bootstrap.x86
 : arg3 ( -- reg ) R8 ;
 : arg4 ( -- reg ) R9 ;
 
-<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >>
-call
+: tib-segment ( -- ) GS ;
+: tib-temp ( -- reg ) R11 ;
+
+: jit-install-seh ( -- ) stack-reg bootstrap-cell ADD ;
+: jit-update-seh ( ctx-reg -- ) drop ;
+
+<< "vocab:cpu/x86/winnt/bootstrap.factor" parse-file suffix! >> call
+<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call
+<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call

diff --git a/basis/cpu/x86/unix/bootstrap.factor b/basis/cpu/x86/unix/bootstrap.factor
new file mode 100644 (file)
index 0000000..20dd738
--- /dev/null
+++ b/basis/cpu/x86/unix/bootstrap.factor
@@ -0,0 +1,13 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cpu.x86.assembler cpu.x86.assembler.operands kernel
+layouts ;
+IN: bootstrap.x86
+
+DEFER: stack-reg
+
+: jit-save-tib ( -- ) ;
+: jit-restore-tib ( -- ) ;
+: jit-update-tib ( ctx-reg -- ) drop ;
+: jit-install-seh ( -- ) stack-reg bootstrap-cell ADD ;
+: jit-update-seh ( ctx-reg -- ) drop ;

diff --git a/basis/cpu/x86/winnt/bootstrap.factor b/basis/cpu/x86/winnt/bootstrap.factor
new file mode 100644 (file)
index 0000000..b81c1eb
--- /dev/null
+++ b/basis/cpu/x86/winnt/bootstrap.factor
@@ -0,0 +1,32 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private compiler.constants
+cpu.x86.assembler cpu.x86.assembler.operands kernel layouts
+locals parser sequences ;
+IN: bootstrap.x86
+
+: tib-exception-list-offset ( -- n ) 0 bootstrap-cells ;
+: tib-stack-base-offset ( -- n ) 1 bootstrap-cells ;
+: tib-stack-limit-offset ( -- n ) 2 bootstrap-cells ;
+
+: jit-save-tib ( -- )
+    tib-exception-list-offset [] tib-segment PUSH
+    tib-stack-base-offset [] tib-segment PUSH
+    tib-stack-limit-offset [] tib-segment PUSH ;
+
+: jit-restore-tib ( -- )
+    tib-stack-limit-offset [] tib-segment POP
+    tib-stack-base-offset [] tib-segment POP
+    tib-exception-list-offset [] tib-segment POP ;
+
+:: jit-update-tib ( ctx-reg -- )
+    ! There's a redundant load here because we're not allowed
+    ! to clobber ctx-reg. Clobbers tib-temp.
+    ! Save callstack base in TIB
+    tib-temp ctx-reg context-callstack-seg-offset [+] MOV
+    tib-temp tib-temp segment-end-offset [+] MOV
+    tib-stack-base-offset [] tib-temp tib-segment MOV
+    ! Save callstack limit in TIB
+    tib-temp ctx-reg context-callstack-seg-offset [+] MOV
+    tib-temp tib-temp segment-start-offset [+] MOV
+    tib-stack-limit-offset [] tib-temp tib-segment MOV ;

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 8f448ff23756f2beea489dc73b556b2cf78204c6..8856871f1126c37e3f4d0719a5ccd3628772debb 100644 (file)
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -270,20 +270,20 @@ M: no-current-vocab summary
 
 M: no-word-error summary
     name>>
-    "No word named ``"
-    "'' found in current vocabulary search path" surround ;
+    "No word named “"
+    "” found in current vocabulary search path" surround ;
 
 M: no-word-error error. summary print ;
 
 M: no-word-in-vocab summary
     [ vocab>> ] [ word>> ] bi
-    [ "No word named ``" % % "'' found in ``" % % "'' vocabulary" % ] "" make ;
+    [ "No word named “" % % "” found in “" % % "” vocabulary" % ] "" make ;
 
 M: no-word-in-vocab error. summary print ;
 
 M: ambiguous-use-error summary
     words>> first name>>
-    "More than one vocabulary defines a word named ``" "''" surround ;
+    "More than one vocabulary defines a word named “" "”" surround ;
 
 M: ambiguous-use-error error. summary print ;
 
@@ -306,6 +306,9 @@ M: bad-inheritance summary
 M: not-in-a-method-error summary
     drop "call-next-method can only be called in a method definition" ;
 
+M: version-control-merge-conflict summary
+    drop "Version control merge conflict in source code" ;
+
 GENERIC: expected>string ( obj -- str )
 
 M: f expected>string drop "end of input" ;

diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor
index b573e2fa2b43f49b72cae37d35f512e94cee9508..70daed901851d66083e3dd98b424114f1e74e6a9 100644 (file)
--- a/basis/io/monitors/recursive/recursive.factor
+++ b/basis/io/monitors/recursive/recursive.factor
@@ -1,9 +1,10 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors sequences assocs arrays continuations
 destructors combinators kernel threads concurrency.messaging
 concurrency.mailboxes concurrency.promises io.files io.files.info
-io.directories io.pathnames io.monitors debugger fry ;
+io.directories io.pathnames io.monitors io.monitors.private
+debugger fry ;
 IN: io.monitors.recursive
 
 ! Simulate recursive monitors on platforms that don't have them
@@ -71,12 +72,14 @@ M: recursive-monitor dispose*
     ] with with each ;
 
 : pump-loop ( -- )
-    receive dup +stop+ eq? [
-        drop stop-pump
-    ] [
-        [ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
-        pump-loop
-    ] if ;
+    receive {
+        { [ dup +stop+ eq? ] [ drop stop-pump ] }
+        { [ dup monitor-disposed eq? ] [ drop ] }
+        [
+            [ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
+            pump-loop
+        ]
+    } cond ;
 
 : monitor-ready ( error/t -- )
     monitor tget ready>> fulfill ;

diff --git a/basis/ui/gadgets/grids/grids-docs.factor b/basis/ui/gadgets/grids/grids-docs.factor
index 10b3bb7259f5aaa2bfba8ccfc667095ef2ce8215..1632072ca2cd38d30d2be815562894a85cd0b4be 100644 (file)
--- a/basis/ui/gadgets/grids/grids-docs.factor
+++ b/basis/ui/gadgets/grids/grids-docs.factor
@@ -2,7 +2,7 @@ USING: ui.gadgets help.markup help.syntax arrays ;
 IN: ui.gadgets.grids
 
 ARTICLE: "ui-grid-layout" "Grid layouts"
-"Grid gadgets layout their children in a rectangular grid."
+"Grid gadgets layout their children in a rectangular grid. The grid is represented as a sequence of sequences of gadgets. Every child sequence is a row of gadgets. Every row must have an equal number of gadgets in it."
 { $subsections grid }
 "Creating grids from a fixed set of gadgets:"
 { $subsections <grid> }

diff --git a/basis/windows/directx/d3d9types/d3d9types.factor b/basis/windows/directx/d3d9types/d3d9types.factor
index ad2d4a8279db680609359cd7d0a896b434aa68bc..09c19bcae44523f0c81e2fdba971f14ec5f28d06 100644 (file)
--- a/basis/windows/directx/d3d9types/d3d9types.factor
+++ b/basis/windows/directx/d3d9types/d3d9types.factor
@@ -758,25 +758,25 @@ CONSTANT: D3DSHADER_ADDRMODE_FORCE_DWORD HEX: 7fffffff
 CONSTANT: D3DVS_SWIZZLE_SHIFT     16
 CONSTANT: D3DVS_SWIZZLE_MASK      HEX: 00FF0000
 
-: D3DVS_X_X ( -- n ) 0 D3DVS_SWIZZLE_SHIFT shift ; inline
-: D3DVS_X_Y ( -- n ) 1 D3DVS_SWIZZLE_SHIFT shift ; inline
-: D3DVS_X_Z ( -- n ) 2 D3DVS_SWIZZLE_SHIFT shift ; inline
-: D3DVS_X_W ( -- n ) 3 D3DVS_SWIZZLE_SHIFT shift ; inline
-
-: D3DVS_Y_X ( -- n ) 0 D3DVS_SWIZZLE_SHIFT 2 + shift ; inline
-: D3DVS_Y_Y ( -- n ) 1 D3DVS_SWIZZLE_SHIFT 2 + shift ; inline
-: D3DVS_Y_Z ( -- n ) 2 D3DVS_SWIZZLE_SHIFT 2 + shift ; inline
-: D3DVS_Y_W ( -- n ) 3 D3DVS_SWIZZLE_SHIFT 2 + shift ; inline
-
-: D3DVS_Z_X ( -- n ) 0 D3DVS_SWIZZLE_SHIFT 4 + shift ; inline
-: D3DVS_Z_Y ( -- n ) 1 D3DVS_SWIZZLE_SHIFT 4 + shift ; inline
-: D3DVS_Z_Z ( -- n ) 2 D3DVS_SWIZZLE_SHIFT 4 + shift ; inline
-: D3DVS_Z_W ( -- n ) 3 D3DVS_SWIZZLE_SHIFT 4 + shift ; inline
-
-: D3DVS_W_X ( -- n ) 0 D3DVS_SWIZZLE_SHIFT 6 + shift ; inline
-: D3DVS_W_Y ( -- n ) 1 D3DVS_SWIZZLE_SHIFT 6 + shift ; inline
-: D3DVS_W_Z ( -- n ) 2 D3DVS_SWIZZLE_SHIFT 6 + shift ; inline
-: D3DVS_W_W ( -- n ) 3 D3DVS_SWIZZLE_SHIFT 6 + shift ; inline
+CONSTANT: D3DVS_X_X $[ 0 16 shift ]
+CONSTANT: D3DVS_X_Y $[ 1 16 shift ]
+CONSTANT: D3DVS_X_Z $[ 2 16 shift ]
+CONSTANT: D3DVS_X_W $[ 3 16 shift ]
+
+CONSTANT: D3DVS_Y_X $[ 0 16 2 + shift ]
+CONSTANT: D3DVS_Y_Y $[ 1 16 2 + shift ]
+CONSTANT: D3DVS_Y_Z $[ 2 16 2 + shift ]
+CONSTANT: D3DVS_Y_W $[ 3 16 2 + shift ]
+
+CONSTANT: D3DVS_Z_X $[ 0 16 4 + shift ]
+CONSTANT: D3DVS_Z_Y $[ 1 16 4 + shift ]
+CONSTANT: D3DVS_Z_Z $[ 2 16 4 + shift ]
+CONSTANT: D3DVS_Z_W $[ 3 16 4 + shift ]
+
+CONSTANT: D3DVS_W_X $[ 0 16 6 + shift ]
+CONSTANT: D3DVS_W_Y $[ 1 16 6 + shift ]
+CONSTANT: D3DVS_W_Z $[ 2 16 6 + shift ]
+CONSTANT: D3DVS_W_W $[ 3 16 6 + shift ]
 
 CONSTANT: D3DVS_NOSWIZZLE flags{ D3DVS_X_X D3DVS_Y_Y D3DVS_Z_Z D3DVS_W_W }
 
@@ -786,20 +786,20 @@ CONSTANT: D3DSP_SRCMOD_SHIFT      24
 CONSTANT: D3DSP_SRCMOD_MASK       HEX: 0F000000
 
 TYPEDEF: int D3DSHADER_PARAM_SRCMOD_TYPE
-: D3DSPSM_NONE    ( -- n ) 0 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_NEG     ( -- n ) 1 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_BIAS    ( -- n ) 2 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_BIASNEG ( -- n ) 3 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_SIGN    ( -- n ) 4 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_SIGNNEG ( -- n ) 5 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_COMP    ( -- n ) 6 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_X2      ( -- n ) 7 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_X2NEG   ( -- n ) 8 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_DZ      ( -- n ) 9 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_DW      ( -- n ) 10 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_ABS     ( -- n ) 11 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_ABSNEG  ( -- n ) 12 D3DSP_SRCMOD_SHIFT shift ; inline
-: D3DSPSM_NOT     ( -- n ) 13 D3DSP_SRCMOD_SHIFT shift ; inline
+CONSTANT: D3DSPSM_NONE    $[ 0 24 shift ]
+CONSTANT: D3DSPSM_NEG     $[ 1 24 shift ]
+CONSTANT: D3DSPSM_BIAS    $[ 2 24 shift ]
+CONSTANT: D3DSPSM_BIASNEG $[ 3 24 shift ]
+CONSTANT: D3DSPSM_SIGN    $[ 4 24 shift ]
+CONSTANT: D3DSPSM_SIGNNEG $[ 5 24 shift ]
+CONSTANT: D3DSPSM_COMP    $[ 6 24 shift ]
+CONSTANT: D3DSPSM_X2      $[ 7 24 shift ]
+CONSTANT: D3DSPSM_X2NEG   $[ 8 24 shift ]
+CONSTANT: D3DSPSM_DZ      $[ 9 24 shift ]
+CONSTANT: D3DSPSM_DW      $[ 10 24 shift ]
+CONSTANT: D3DSPSM_ABS     $[ 11 24 shift ]
+CONSTANT: D3DSPSM_ABSNEG  $[ 12 24 shift ]
+CONSTANT: D3DSPSM_NOT     $[ 13 24 shift ]
 CONSTANT: D3DSPSM_FORCE_DWORD HEX: 7fffffff
 
 : D3DPS_VERSION ( major minor -- n )

diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 49a3d6e9faf861ce2fb98d31c6f905502b47a365..4dd7d7385c9ee94d3ead654665497c4abd9aefdd 100644 (file)
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -3,7 +3,7 @@
 USING: alien alien.c-types alien.strings alien.syntax arrays
 byte-arrays kernel literals math sequences windows.types
 windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
-classes.struct windows.com.syntax init literals ;
+classes.struct windows.com.syntax init ;
 FROM: alien.c-types => short ;
 IN: windows.winsock
 

diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor
index c13f9f9026a1c78c35a51358e0ba306ff35746a7..9395447aa6ffaf2b4e75f32da0c950cce04a42a3 100644 (file)
--- a/core/bootstrap/syntax.factor
+++ b/core/bootstrap/syntax.factor
@@ -89,6 +89,12 @@ IN: bootstrap.syntax
         "read-only"
         "call("
         "execute("
+        "<<<<<<"
+        "======"
+        ">>>>>>"
+        "<<<<<<<"
+        "======="
+        ">>>>>>>"
     } [ "syntax" create drop ] each
 
     "t" "syntax" lookup define-symbol

diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor
index b239b1eac9a2ab28ee034d0b8ec2889a8ab297f0..1e7a61daaaca52bbd725eaa88f4ea2becb20563d 100644 (file)
--- a/core/combinators/combinators-tests.factor
+++ b/core/combinators/combinators-tests.factor
@@ -35,6 +35,24 @@ IN: combinators.tests
 [ 7 ] [ 1 3 [ 2 * ] [ + ] compose compile-call(-test-1 ] unit-test
 [ 4 ] [ 1 3 [ { + } [ ] like call ] compile-call(-test-1 ] unit-test
 
+[ [ ] call( -- * ) ] must-fail
+
+: compile-call(-test-2 ( -- ) [ ] call( -- * ) ;
+
+[ compile-call(-test-2 ] [ wrong-values? ] must-fail-with
+
+: compile-call(-test-3 ( quot -- ) call( -- * ) ;
+
+[ [ ] compile-call(-test-3 ] [ wrong-values? ] must-fail-with
+
+: compile-execute(-test-3 ( a -- ) \ . execute( value -- * ) ;
+
+[ 10 compile-execute(-test-3 ] [ wrong-values? ] must-fail-with
+
+: compile-execute(-test-4 ( a word -- ) execute( value -- * ) ;
+
+[ 10 \ . compile-execute(-test-4 ] [ wrong-values? ] must-fail-with
+
 ! Compiled
 : cond-test-1 ( obj -- str )
     {

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 7ef2ed5f9fd9d7dabc0632d81147b1365994dadc..bbfee30b3deceabcde0c0fa7967aea48871896b0 100644 (file)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -26,15 +26,17 @@ ERROR: wrong-values quot call-site ;
 ! We can't USE: effects here so we forward reference slots instead
 SLOT: in
 SLOT: out
+SLOT: terminated?
 
 : call-effect ( quot effect -- )
     ! Don't use fancy combinators here, since this word always
     ! runs unoptimized
-    [ datastack ] 2dip
     2dup [
-        [ dip ] dip
-        dup in>> length swap out>> length
-        check-datastack
+        [ [ datastack ] dip dip ] dip
+        dup terminated?>> [ 2drop f ] [
+            dup in>> length swap out>> length
+            check-datastack
+        ] if
     ] 2dip rot
     [ 2drop ] [ wrong-values ] if ;
 

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 064978f99bf805bd12640e87dd07a8a1b2e164e6..f977a0487b847ffdc74e5e999f50e7f452f3deff 100644 (file)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -575,19 +575,51 @@ HELP: if
 { $values { "?" "a generalized boolean" } { "true" quotation } { "false" quotation } }
 { $description "If " { $snippet "cond" } " is " { $link f } ", calls the " { $snippet "false" } " quotation. Otherwise calls the " { $snippet "true" } " quotation."
 $nl
-"The " { $snippet "cond" } " value is removed from the stack before either quotation is called." } ;
+"The " { $snippet "cond" } " value is removed from the stack before either quotation is called." }
+{ $examples
+    { $example
+        "USING: io kernel math ;"
+        "10 3 < [ \"Math is broken\" print ] [ \"Math is good\" print ] if"
+        "Math is good"
+    }
+} ;
 
 HELP: when
 { $values { "?" "a generalized boolean" } { "true" quotation } }
 { $description "If " { $snippet "cond" } " is not " { $link f } ", calls the " { $snippet "true" } " quotation."
 $nl
-"The " { $snippet "cond" } " value is removed from the stack before the quotation is called." } ;
+"The " { $snippet "cond" } " value is removed from the stack before the quotation is called." }
+{ $examples
+    { $example
+        "USING: kernel math prettyprint ;"
+        "-5 dup 0 < [ 3 + ] when ."
+        "-2"
+    }
+} ;
 
 HELP: unless
 { $values { "?" "a generalized boolean" } { "false" quotation } }
 { $description "If " { $snippet "cond" } " is " { $link f } ", calls the " { $snippet "false" } " quotation."
 $nl
-"The " { $snippet "cond" } " value is removed from the stack before the quotation is called." } ;
+"The " { $snippet "cond" } " value is removed from the stack before the quotation is called." }
+{ $examples
+    { $example
+        "USING: kernel math prettyprint sequences ;"
+        "IN: scratchpad"
+        ""
+        "CONSTANT: american-cities {"
+        "    \"San Francisco\""
+        "    \"Los Angeles\""
+        "    \"New York\""
+        "}"
+        ""
+        ": add-tax ( price city -- price' )"
+        "    american-cities member? [ 1.1 * ] unless ;"
+        ""
+        "123 \"Ottawa\" add-tax ."
+        "135.3"
+    }
+} ;
 
 HELP: if*
 { $values { "?" "a generalized boolean" } { "true" { $quotation "( ..a ? -- ..b )" } } { "false" { $quotation "( ..a -- ..b )" } } }
@@ -596,7 +628,31 @@ $nl
 "If the condition is true, it is retained on the stack before the " { $snippet "true" } " quotation is called. Otherwise, the condition is removed from the stack and the " { $snippet "false" } " quotation is called."
 $nl
 "The following two lines are equivalent:"
-{ $code "X [ Y ] [ Z ] if*" "X dup [ Y ] [ drop Z ] if" } } ;
+{ $code "X [ Y ] [ Z ] if*" "X dup [ Y ] [ drop Z ] if" } }
+{ $examples
+    "Notice how in this example, the same value is tested by the conditional, and then used in the true branch; the false branch does not need to drop the value because of how " { $link if* } " works:"
+    { $example
+        "USING: assocs io kernel math.parser ;"
+        "IN: scratchpad"
+        ""
+        ": curry-price ( meat -- price )
+    {
+        { \"Beef\" 10 }
+        { \"Chicken\" 12 }
+        { \"Lamb\" 13 }
+    } at ;
+
+: order-curry ( meat -- )
+    curry-price [
+        \"Your order will be \" write
+        number>string write
+        \" dollars.\" write
+    ] [ \"Invalid order.\" print ] if* ;"
+        ""
+        "\"Deer\" order-curry"
+        "Invalid order."
+    }
+} ;
 
 HELP: when*
 { $values { "?" "a generalized boolean" } { "true" { $quotation "( cond -- ... )" } } }

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 3257bd69a4b2f137023ca8ec2cbce7cfa67d579e..be43979b31a6181b9f89cf5ab1096cfc89acad47 100644 (file)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -207,3 +207,5 @@ print-use-hook [ [ ] ] initialize
 
 : ?run-file ( path -- )
     dup exists? [ run-file ] [ drop ] if ;
+
+ERROR: version-control-merge-conflict ;

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index bd70b0be62235d1ab443a04d92c79851c381d81e..de719c72726bab9df1169e40136a2ccdb6acaa5b 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -257,4 +257,12 @@ IN: bootstrap.syntax
     "call(" [ \ call-effect parse-call( ] define-core-syntax
 
     "execute(" [ \ execute-effect parse-call( ] define-core-syntax
+
+    "<<<<<<<" [ version-control-merge-conflict ] define-core-syntax
+    "=======" [ version-control-merge-conflict ] define-core-syntax
+    ">>>>>>>" [ version-control-merge-conflict ] define-core-syntax
+
+    "<<<<<<" [ version-control-merge-conflict ] define-core-syntax
+    "======" [ version-control-merge-conflict ] define-core-syntax
+    ">>>>>>" [ version-control-merge-conflict ] define-core-syntax
 ] with-compilation-unit

diff --git a/extra/cursors/cursors-tests.factor b/extra/cursors/cursors-tests.factor
index d71999ab871c1d6c36f63891c6be0e763be72a53..44eb6bc16c4640eeb3fe4c4e0c0b564872e1446d 100644 (file)
--- a/extra/cursors/cursors-tests.factor
+++ b/extra/cursors/cursors-tests.factor
@@ -21,20 +21,6 @@ IN: cursors.tests
 [ B{ } ] [ [ { } [ , ] each ] B{ } make ] unit-test
 [ { 2 4 6 8 10 } ] [ { 1 2 3 4 5 } [ 2 * ] map ] unit-test
 
-[ { "roses: lutefisk" "tulips: lox" } ]
-[
-    [
-        { { "roses" "lutefisk" } { "tulips" "lox" } }
-        [ ": " glue , ] assoc-each
-    ] { } make
-] unit-test
-
-[ { "roses: lutefisk" "tulips: lox" } ]
-[
-    { { "roses" "lutefisk" } { "tulips" "lox" } }
-    [ ": " glue ] { } assoc>map
-] unit-test
-
 [ { "roses: lutefisk" "tulips: lox" } ]
 [
     [
@@ -65,8 +51,14 @@ IN: cursors.tests
 [ { 2 4 6 8 10 } ] [ { 1 2 3 4 5 } compile-test-map ] unit-test
 
 [ { "roses: lutefisk" "tulips: lox" } ]
-[ [ { { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc-each ] { } make ] unit-test
+[
+    [ H{ { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc-each ]
+    { } make natural-sort
+] unit-test
 
 [ { "roses: lutefisk" "tulips: lox" } ]
-[ { { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc>map ] unit-test
+[
+    H{ { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc>map
+    natural-sort
+] unit-test
 

diff --git a/extra/cursors/cursors.factor b/extra/cursors/cursors.factor
index d7fe5fb893b4ec0412fd5ace29c2a6cece411070..776a5523c4a5f6b91d2c2831f488431168ea7251 100644 (file)
--- a/extra/cursors/cursors.factor
+++ b/extra/cursors/cursors.factor
@@ -61,13 +61,19 @@ ERROR: invalid-cursor cursor ;
 
 MIXIN: input-cursor
 
-GENERIC: cursor-value ( cursor -- value )
+GENERIC: cursor-key-value ( cursor -- key value )
 <PRIVATE
-GENERIC: cursor-value-unsafe ( cursor -- value )
+GENERIC: cursor-key-value-unsafe ( cursor -- key value )
 PRIVATE>
-M: input-cursor cursor-value-unsafe cursor-value ; inline
-M: input-cursor cursor-value
-    dup cursor-valid? [ cursor-value-unsafe ] [ invalid-cursor ] if ; inline
+M: input-cursor cursor-key-value-unsafe cursor-key-value ; inline
+M: input-cursor cursor-key-value
+    dup cursor-valid? [ cursor-key-value-unsafe ] [ invalid-cursor ] if ; inline
+
+: cursor-key ( cursor -- key ) cursor-key-value drop ;
+: cursor-value ( cursor -- key ) cursor-key-value nip ;
+
+: cursor-key-unsafe ( cursor -- key ) cursor-key-value-unsafe drop ;
+: cursor-value-unsafe ( cursor -- key ) cursor-key-value-unsafe nip ;
 
 !
 ! output cursors
@@ -155,7 +161,7 @@ M: numeric-cursor cursor>= [ value>> ] bi@ >= ; inline
 
 INSTANCE: numeric-cursor input-cursor
 
-M: numeric-cursor cursor-value value>> ; inline
+M: numeric-cursor cursor-key-value value>> dup ; inline
 
 !
 ! linear cursor
@@ -278,8 +284,8 @@ M: sequence-cursor cursor-distance ( cursor cursor -- n )
 
 INSTANCE: sequence-cursor input-cursor
 
-M: sequence-cursor cursor-value-unsafe [ n>> ] [ seq>> ] bi nth-unsafe ; inline
-M: sequence-cursor cursor-value [ n>> ] [ seq>> ] bi nth ; inline
+M: sequence-cursor cursor-key-value-unsafe [ n>> dup ] [ seq>> ] bi nth-unsafe ; inline
+M: sequence-cursor cursor-key-value [ n>> dup ] [ seq>> ] bi nth ; inline
 
 INSTANCE: sequence-cursor output-cursor
 
@@ -362,13 +368,9 @@ M: forward-cursor new-sequence-cursor
     over map-as ; inline
 
 !
-! assoc cursors
+! assoc combinators
 !
 
-MIXIN: assoc-cursor
-
-GENERIC: cursor-key-value ( cursor -- key value )
-
 : -assoc- ( quot -- quot' )
     '[ cursor-key-value @ ] ; inline
 
@@ -380,11 +382,6 @@ GENERIC: cursor-key-value ( cursor -- key value )
 : assoc>map ( ... assoc quot: ( ... k v -- ... newx ) exemplar -- ... newcontainer )
     [ assoc- ] dip -map-as ; inline
 
-INSTANCE: input-cursor assoc-cursor
-
-M: input-cursor cursor-key-value
-    cursor-value-unsafe first2 ; inline
-
 !
 ! hashtable cursor
 !
@@ -421,16 +418,11 @@ M: hashtable-cursor inc-cursor ( cursor -- cursor' )
     [ hashtable>> dup array>> ] [ n>> 2 + ] bi
     (inc-hashtable-cursor) <hashtable-cursor> ; inline
 
-INSTANCE: hashtable-cursor assoc-cursor
-    
-M: hashtable-cursor cursor-key-value
-    [ n>> ] [ hashtable>> array>> ] bi
-    [ nth-unsafe ] [ [ 1 + ] dip nth-unsafe ] 2bi ; inline
-
 INSTANCE: hashtable-cursor input-cursor
 
-M: hashtable-cursor cursor-value-unsafe
-    cursor-key-value 2array ; inline
+M: hashtable-cursor cursor-key-value-unsafe
+    [ n>> ] [ hashtable>> array>> ] bi
+    [ nth-unsafe ] [ [ 1 + ] dip nth-unsafe ] 2bi ; inline
 
 INSTANCE: hashtable container
 
@@ -472,7 +464,7 @@ M: zip-cursor cursor-distance-hint ( cursor cursor -- n )
 M: zip-cursor inc-cursor ( cursor -- cursor' )
     [ keys>> inc-cursor ] [ values>> inc-cursor ] bi <zip-cursor> ; inline
     
-INSTANCE: zip-cursor assoc-cursor
+INSTANCE: zip-cursor input-cursor
 
 M: zip-cursor cursor-key-value
     [ keys>> cursor-value-unsafe ] [ values>> cursor-value-unsafe ] bi ; inline

diff --git a/extra/mason/child/child-tests.factor b/extra/mason/child/child-tests.factor
index f8046ac8e567b8ac7a2815c93453af42dec1d09d..1018a1ec4040308aefda582eda3f2c6f841a1764 100644 (file)
--- a/extra/mason/child/child-tests.factor
+++ b/extra/mason/child/child-tests.factor
@@ -1,7 +1,7 @@
 IN: mason.child.tests
 USING: mason.child mason.config tools.test namespaces io kernel sequences ;
 
-[ { "nmake" "/f" "nmakefile" } ] [
+[ { "nmake" "/f" "nmakefile" "x86-32" } ] [
     [
         "winnt" target-os set
         "x86.32" target-cpu set

diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor
index 017e4401d8ecae31e6f2bc753d8f640b9b2ef972..d9821f8fcc82a7efdd12fd33413dbc27a5187542 100644 (file)
--- a/extra/mason/child/child.factor
+++ b/extra/mason/child/child.factor
@@ -4,13 +4,20 @@ USING: accessors arrays calendar combinators.short-circuit fry
 continuations debugger io.directories io.files io.launcher
 io.pathnames io.encodings.ascii kernel make mason.common mason.config
 mason.platform mason.report mason.notify namespaces sequences
-quotations macros system combinators ;
+quotations macros system combinators splitting ;
 IN: mason.child
 
+: nmake-cmd ( -- args )
+    { "nmake" "/f" "nmakefile" }
+    target-cpu get "." split "-" join suffix ;
+
+: gnu-make-cmd ( -- args )
+    gnu-make platform 2array ;
+
 : make-cmd ( -- args )
     {
-        { [ target-os get "winnt" = ] [ { "nmake" "/f" "nmakefile" } ] }
-        [ gnu-make platform 2array ]
+        { [ target-os get "winnt" = ] [ nmake-cmd ] }
+        [ gnu-make-cmd ]
     } cond ;
 
 : make-vm ( -- )

diff --git a/vm/Config.windows.nt.x86.32 b/vm/Config.windows.nt.x86.32
index d27629fe8358552f93499239c2f1cb63a70aca9b..73bf064ce54042bf08adcfa3506c4fdc557727c7 100644 (file)
--- a/vm/Config.windows.nt.x86.32
+++ b/vm/Config.windows.nt.x86.32
@@ -1,3 +1,4 @@
+PLAF_DLL_OBJS += vm/os-windows-nt-x86.32.o
 DLL_PATH=http://factorcode.org/dlls
 WINDRES=windres
 include vm/Config.windows.nt

diff --git a/vm/Config.windows.nt.x86.64 b/vm/Config.windows.nt.x86.64
index ddb61480e5cf8c340bf8a1708b0cda2fa259d5a4..495a3ccac9ac49925dde97c13c13132955445463 100644 (file)
--- a/vm/Config.windows.nt.x86.64
+++ b/vm/Config.windows.nt.x86.64
@@ -1,3 +1,4 @@
+PLAF_DLL_OBJS += vm/os-windows-nt-x86.64.o
 DLL_PATH=http://factorcode.org/dlls/64
 CC=$(WIN64_PATH)-gcc.exe
 WINDRES=$(WIN64_PATH)-windres.exe

diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 40fe00b0e9ff6a2ac906ac6ef606887998db6796..96d95416655ccb4af9251b28890fc46b637b9fcc 100755 (executable)
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -7,8 +7,14 @@ code_heap::code_heap(cell size)
 {
        if(size > ((u64)1 << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size);
        seg = new segment(align_page(size),true);
-       if(!seg) fatal_error("Out of memory in heap allocator",size);
-       allocator = new free_list_allocator<code_block>(size,seg->start);
+       if(!seg) fatal_error("Out of memory in code_heap constructor",size);
+
+       cell start = seg->start + seh_area_size;
+
+       allocator = new free_list_allocator<code_block>(seg->end - start,start);
+
+       /* See os-windows-nt-x86.64.cpp for seh_area usage */
+       seh_area = (char *)seg->start;
 }
 
 code_heap::~code_heap()

diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index 78ffa6c76a19cd06926c002f8031daca7aba8337..20ce03c8357a83648c483dc993ef8000eb6f3917 100755 (executable)
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -1,10 +1,19 @@
 namespace factor
 {
 
+#if defined(WINDOWS) && defined(FACTOR_64)
+       const cell seh_area_size = 1024;
+#else
+       const cell seh_area_size = 0;
+#endif
+
 struct code_heap {
        /* The actual memory area */
        segment *seg;
 
+       /* Memory area reserved for SEH. Only used on Windows */
+       char *seh_area;
+
        /* Memory allocator */
        free_list_allocator<code_block> *allocator;
 

diff --git a/vm/image.cpp b/vm/image.cpp
index c74351c1911301846969058ea466505df2433ff3..ccce96a952c56970c8b728293989347173338bc6 100755 (executable)
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -258,7 +258,7 @@ void factor_vm::load_image(vm_parameters *p)
        init_objects(&h);
 
        cell data_offset = data->tenured->start - h.data_relocation_base;
-       cell code_offset = code->seg->start - h.code_relocation_base;
+       cell code_offset = code->allocator->start - h.code_relocation_base;
 
        fixup_data(data_offset,code_offset);
        fixup_code(data_offset,code_offset);
@@ -285,7 +285,7 @@ bool factor_vm::save_image(const vm_char *saving_filename, const vm_char *filena
        h.version = image_version;
        h.data_relocation_base = data->tenured->start;
        h.data_size = data->tenured->occupied_space();
-       h.code_relocation_base = code->seg->start;
+       h.code_relocation_base = code->allocator->start;
        h.code_size = code->allocator->occupied_space();
 
        h.true_object = true_object;

diff --git a/vm/os-windows-nt-x86.32.cpp b/vm/os-windows-nt-x86.32.cpp
new file mode 100644 (file)
index 0000000..61cf9f6
--- /dev/null
+++ b/vm/os-windows-nt-x86.32.cpp
@@ -0,0 +1,12 @@
+#include "master.hpp"
+
+namespace factor
+{
+
+void factor_vm::c_to_factor_toplevel(cell quot)
+{
+       /* 32-bit Windows SEH is set up in basis/cpu/x86/32/winnt/bootstrap.factor */
+       c_to_factor(quot);
+}
+
+}

diff --git a/vm/os-windows-nt-x86.64.cpp b/vm/os-windows-nt-x86.64.cpp
new file mode 100644 (file)
index 0000000..876d0c5
--- /dev/null
+++ b/vm/os-windows-nt-x86.64.cpp
@@ -0,0 +1,85 @@
+#include "master.hpp"
+
+namespace factor {
+
+typedef unsigned char UBYTE;
+
+const UBYTE UNW_FLAG_EHANDLER = 0x1;
+
+struct UNWIND_INFO {
+       UBYTE Version:3;
+       UBYTE Flags:5;
+       UBYTE SizeOfProlog;
+       UBYTE CountOfCodes;
+       UBYTE FrameRegister:4;
+       UBYTE FrameOffset:4;
+       ULONG ExceptionHandler;
+       ULONG ExceptionData[1];
+};
+
+struct seh_data {
+       UNWIND_INFO unwind_info;
+       RUNTIME_FUNCTION func;
+       UBYTE handler[32];
+};
+
+void factor_vm::c_to_factor_toplevel(cell quot)
+{
+       /* The annoying thing about Win64 SEH is that the offsets in
+        * function tables are 32-bit integers, and the exception handler
+        * itself must reside between the start and end pointers, so
+        * we stick everything at the beginning of the code heap and
+        * generate a small trampoline that jumps to the real
+        * exception handler. */
+
+       seh_data *seh_area = (seh_data *)code->seh_area;
+       cell base = code->seg->start;
+
+       /* Should look at generating this with the Factor assembler */
+
+       /* mov rax,0 */
+       seh_area->handler[0] = 0x48;
+       seh_area->handler[1] = 0xb8;
+       seh_area->handler[2] = 0x0;
+       seh_area->handler[3] = 0x0;
+       seh_area->handler[4] = 0x0;
+       seh_area->handler[5] = 0x0;
+       seh_area->handler[6] = 0x0;
+       seh_area->handler[7] = 0x0;
+       seh_area->handler[8] = 0x0;
+       seh_area->handler[9] = 0x0;
+
+       /* jmp rax */
+       seh_area->handler[10] = 0x48;
+       seh_area->handler[11] = 0xff;
+       seh_area->handler[12] = 0xe0;
+
+       /* Store address of exception handler in the operand of the 'mov' */
+       cell handler = (cell)&factor::exception_handler;
+       memcpy(&seh_area->handler[2],&handler,sizeof(cell));
+
+       UNWIND_INFO *unwind_info = &seh_area->unwind_info;
+       unwind_info->Version = 1;
+       unwind_info->Flags = UNW_FLAG_EHANDLER;
+       unwind_info->SizeOfProlog = 0;
+       unwind_info->CountOfCodes = 0;
+       unwind_info->FrameRegister = 0;
+       unwind_info->FrameOffset = 0;
+       unwind_info->ExceptionHandler = (DWORD)((cell)&seh_area->handler[0] - base);
+       unwind_info->ExceptionData[0] = 0;
+
+       RUNTIME_FUNCTION *func = &seh_area->func;
+       func->BeginAddress = 0;
+       func->EndAddress = (DWORD)(code->seg->end - base);
+       func->UnwindData = (DWORD)((cell)&seh_area->unwind_info - base);
+
+       if(!RtlAddFunctionTable(func,1,base))
+               fatal_error("RtlAddFunctionTable() failed",0);
+
+       c_to_factor(quot);
+
+       if(!RtlDeleteFunctionTable(func))
+               fatal_error("RtlDeleteFunctionTable() failed",0);
+}
+
+}

diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 4f90d7f641d24ed5bfe34d85c6356aa8f8062d1f..4fea294a12da583fb82ff55565c83a67f636113d 100755 (executable)
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -84,19 +84,14 @@ LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c,
                break;
        }
 
-       return ExceptionContinueExecution;
+       return 0;
 }
 
-LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch)
+VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch)
 {
        return current_vm()->exception_handler(e,frame,c,dispatch);
 }
 
-void factor_vm::c_to_factor_toplevel(cell quot)
-{
-       c_to_factor(quot);
-}
-
 void factor_vm::open_console()
 {
 }

diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index d84ac972982991b63c83d90704afb9ce6135603c..60990c0986510a6188daf1bb5887667fd12b9488 100755 (executable)
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -22,7 +22,7 @@ typedef char symbol_char;
 
 #define FACTOR_DLL NULL
 
-LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch);
+VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch);
 
 // SSE traps raise these exception codes, which are defined in internal NT headers
 // but not winbase.h

diff --git a/vm/platform.hpp b/vm/platform.hpp
index a71aae1e89b5dbbb03615f28849fe5813286f4dd..e5a07a05d426e5ac580e8aab98faae2563fcd29f 100755 (executable)
--- a/vm/platform.hpp
+++ b/vm/platform.hpp
@@ -3,8 +3,8 @@
                #include "os-windows-ce.hpp"
                #include "os-windows.hpp"
        #elif defined(WINNT)
-               #include "os-windows-nt.hpp"
                #include "os-windows.hpp"
+               #include "os-windows-nt.hpp"
 
                #if defined(FACTOR_AMD64)
                        #include "os-windows-nt.64.hpp"

diff --git a/vm/safeseh.asm b/vm/safeseh.asm
new file mode 100755 (executable)
index 0000000..fb706c1
--- /dev/null
+++ b/vm/safeseh.asm
@@ -0,0 +1,5 @@
+.386\r
+.model flat\r
+exception_handler proto\r
+.safeseh exception_handler\r
+end\r