Get optimizing compiler working without global register variables in VM

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 85a05f3a56a0e1e99f88dd7252dbc20f8ddecffb..347d157a79e660f75fd988bef529429890452827 100644 (file)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -344,7 +344,7 @@ SYMBOLS:
         bootstrap-cell >>align
         bootstrap-cell >>align-first
         [ >c-ptr ] >>unboxer-quot
-        "box_alien" >>boxer
+        "allot_alien" >>boxer
         "alien_offset" >>unboxer
     \ void* define-primitive-type
 
@@ -355,7 +355,7 @@ SYMBOLS:
         [ set-alien-signed-8 ] >>setter
         8 >>size
         8-byte-alignment
-        "box_signed_8" >>boxer
+        "from_signed_8" >>boxer
         "to_signed_8" >>unboxer
     \ longlong define-primitive-type
 
@@ -366,7 +366,7 @@ SYMBOLS:
         [ set-alien-unsigned-8 ] >>setter
         8 >>size
         8-byte-alignment
-        "box_unsigned_8" >>boxer
+        "from_unsigned_8" >>boxer
         "to_unsigned_8" >>unboxer
     \ ulonglong define-primitive-type
 
@@ -378,7 +378,7 @@ SYMBOLS:
         bootstrap-cell >>size
         bootstrap-cell >>align
         bootstrap-cell >>align-first
-        "box_signed_cell" >>boxer
+        "from_signed_cell" >>boxer
         "to_fixnum" >>unboxer
     \ long define-primitive-type
 
@@ -390,7 +390,7 @@ SYMBOLS:
         bootstrap-cell >>size
         bootstrap-cell >>align
         bootstrap-cell >>align-first
-        "box_unsigned_cell" >>boxer
+        "from_unsigned_cell" >>boxer
         "to_cell" >>unboxer
     \ ulong define-primitive-type
 
@@ -402,7 +402,7 @@ SYMBOLS:
         4 >>size
         4 >>align
         4 >>align-first
-        "box_signed_4" >>boxer
+        "from_signed_4" >>boxer
         "to_fixnum" >>unboxer
     \ int define-primitive-type
 
@@ -414,7 +414,7 @@ SYMBOLS:
         4 >>size
         4 >>align
         4 >>align-first
-        "box_unsigned_4" >>boxer
+        "from_unsigned_4" >>boxer
         "to_cell" >>unboxer
     \ uint define-primitive-type
 
@@ -426,7 +426,7 @@ SYMBOLS:
         2 >>size
         2 >>align
         2 >>align-first
-        "box_signed_2" >>boxer
+        "from_signed_2" >>boxer
         "to_fixnum" >>unboxer
     \ short define-primitive-type
 
@@ -438,7 +438,7 @@ SYMBOLS:
         2 >>size
         2 >>align
         2 >>align-first
-        "box_unsigned_2" >>boxer
+        "from_unsigned_2" >>boxer
         "to_cell" >>unboxer
     \ ushort define-primitive-type
 
@@ -450,7 +450,7 @@ SYMBOLS:
         1 >>size
         1 >>align
         1 >>align-first
-        "box_signed_1" >>boxer
+        "from_signed_1" >>boxer
         "to_fixnum" >>unboxer
     \ char define-primitive-type
 
@@ -462,7 +462,7 @@ SYMBOLS:
         1 >>size
         1 >>align
         1 >>align-first
-        "box_unsigned_1" >>boxer
+        "from_unsigned_1" >>boxer
         "to_cell" >>unboxer
     \ uchar define-primitive-type
 
@@ -473,7 +473,7 @@ SYMBOLS:
             4 >>size
             4 >>align
             4 >>align-first
-            "box_boolean" >>boxer
+            "from_boolean" >>boxer
             "to_boolean" >>unboxer
     ] [
         <c-type>
@@ -482,7 +482,7 @@ SYMBOLS:
             1 >>size
             1 >>align
             1 >>align-first
-            "box_boolean" >>boxer
+            "from_boolean" >>boxer
             "to_boolean" >>unboxer
     ] if
     \ bool define-primitive-type
@@ -495,7 +495,7 @@ SYMBOLS:
         4 >>size
         4 >>align
         4 >>align-first
-        "box_float" >>boxer
+        "from_float" >>boxer
         "to_float" >>unboxer
         float-rep >>rep
         [ >float ] >>unboxer-quot
@@ -508,7 +508,7 @@ SYMBOLS:
         [ [ >float ] 2dip set-alien-double ] >>setter
         8 >>size
         8-byte-alignment
-        "box_double" >>boxer
+        "from_double" >>boxer
         "to_double" >>unboxer
         double-rep >>rep
         [ >float ] >>unboxer-quot

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 93b960c576713e6a972fe441d70163ac59281270..662c12ed330e565b0e604bed31ee0f76cb83430a 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -748,8 +748,7 @@ temp: temp1/int-rep temp2/int-rep
 literal: size data-values tagged-values uninitialized-locs ;
 
 INSN: ##save-context
-temp: temp1/int-rep temp2/int-rep
-literal: callback-allowed? ;
+temp: temp1/int-rep temp2/int-rep ;
 
 ! Instructions used by machine IR only.
 INSN: _prologue

diff --git a/basis/compiler/cfg/save-contexts/save-contexts-tests.factor b/basis/compiler/cfg/save-contexts/save-contexts-tests.factor
index 23646cfcd7bd274336ba1ec5e1a4c9f38830e876..020d000b6aeb10027e2115e315346bf50ced4d85 100644 (file)
--- a/basis/compiler/cfg/save-contexts/save-contexts-tests.factor
+++ b/basis/compiler/cfg/save-contexts/save-contexts-tests.factor
@@ -15,7 +15,7 @@ V{
 
 [
     V{
-        T{ ##save-context f 1 2 f }
+        T{ ##save-context f 1 2 }
         T{ ##unary-float-function f 2 3 "sqrt" }
         T{ ##branch }
     }

diff --git a/basis/compiler/cfg/save-contexts/save-contexts.factor b/basis/compiler/cfg/save-contexts/save-contexts.factor
index fd92ace1507937b92a97544793cbfef0a2947dec..4296fb54f947bd764977d2562dd76dae46946918 100644 (file)
--- a/basis/compiler/cfg/save-contexts/save-contexts.factor
+++ b/basis/compiler/cfg/save-contexts/save-contexts.factor
@@ -17,19 +17,10 @@ IN: compiler.cfg.save-contexts
         } 1||
     ] any? ;
 
-: needs-callback-context? ( insns -- ? )
-    [
-        {
-            [ ##alien-invoke? ]
-            [ ##alien-indirect? ]
-        } 1||
-    ] any? ;
-
 : insert-save-context ( bb -- )
     dup instructions>> dup needs-save-context? [
         int-rep next-vreg-rep
         int-rep next-vreg-rep
-        pick needs-callback-context?
         \ ##save-context new-insn prefix
         >>instructions drop
     ] [ 2drop ] if ;

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index b1b39c0b07ee1c5f8b18edd9e94fef6d36fd5bd9..430b48e1ef5cdea1eebf7bcee98a8ca8b4db5880 100644 (file)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -283,7 +283,7 @@ M: ##gc generate-insn
         [ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
         [ data-values>> save-data-regs ]
         [ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ]
-        [ [ temp1>> ] [ temp2>> ] bi t %save-context ]
+        [ [ temp1>> ] [ temp2>> ] bi %save-context ]
         [ [ tagged-values>> length ] [ temp1>> ] bi %call-gc ]
         [ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
         [ data-values>> load-data-regs ]
@@ -384,7 +384,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
 
 : unbox-parameters ( offset node -- )
     parameters>> swap
-    '[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ]
+    '[ prepare-unbox-parameters [ %pop-stack [ _ + ] dip unbox-parameter ] 3each ]
     [ length neg %inc-d ]
     bi ;
 
@@ -407,7 +407,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
     ] with-param-regs ;
 
 : box-return* ( node -- )
-    return>> [ ] [ box-return ] if-void ;
+    return>> [ ] [ box-return %push-stack ] if-void ;
 
 : check-dlsym ( symbols dll -- )
     dup dll-valid? [
@@ -452,7 +452,7 @@ M: ##alien-indirect generate-insn
 
 ! ##alien-callback
 : box-parameters ( params -- )
-    alien-parameters [ box-parameter ] each-parameter ;
+    alien-parameters [ box-parameter %push-context-stack ] each-parameter ;
 
 : registers>objects ( node -- )
     ! Generate code for boxing input parameters in a callback.

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index a2ce533afdaa195718c65ebe8402d20ee97cefd7..e6abab1267857dbf6ba8173cd98786a84c8fc70f 100644 (file)
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -94,6 +94,8 @@ FUNCTION: TINY ffi_test_17 int x ;
 
 { 1 1 } [ indirect-test-1 ] must-infer-as
 
+[ B{ } indirect-test-1 ] [ { "kernel-error" 3 6 B{ } } = ] must-fail-with
+
 [ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
 
 : indirect-test-1' ( ptr -- )

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 0a4db25d351f5947ef8c1d284a0931da71dedb77..26878f7c1f7286c5f3e9578e95ee7cfedf358ceb 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -503,8 +503,27 @@ HOOK: dummy-int-params? cpu ( -- ? )
 ! If t, all int parameters are shadowed by dummy FP parameters
 HOOK: dummy-fp-params? cpu ( -- ? )
 
-HOOK: %prepare-unbox cpu ( n -- )
-
+! Load a value (from the data stack in the ds register).
+! The value is then passed as a parameter to a VM to_*() function
+HOOK: %pop-stack cpu ( n -- )
+
+! Store a value (to the data stack in the VM's current context)
+! The value is passed to a VM to_*() function -- used for
+! callback returns
+HOOK: %pop-context-stack cpu ( -- )
+
+! Store a value (to the data stack in the ds register).
+! The value was returned from a VM from_*() function
+HOOK: %push-stack cpu ( -- )
+
+! Store a value (to the data stack in the VM's current context)
+! The value is returned from a VM from_*() function -- used for
+! callback parameters
+HOOK: %push-context-stack cpu ( -- )
+
+! Call a function to convert a tagged pointer returned by
+! %pop-stack or %pop-context-stack into a value that can be
+! passed to a C function, or returned from a callback
 HOOK: %unbox cpu ( n rep func -- )
 
 HOOK: %unbox-long-long cpu ( n func -- )
@@ -513,6 +532,10 @@ HOOK: %unbox-small-struct cpu ( c-type -- )
 
 HOOK: %unbox-large-struct cpu ( n c-type -- )
 
+! Call a function to convert a value into a tagged pointer,
+! possibly allocating a bignum, float, or alien instance,
+! which is then pushed on the data stack by %push-stack or
+! %push-context-stack
 HOOK: %box cpu ( n rep func -- )
 
 HOOK: %box-long-long cpu ( n func -- )
@@ -527,7 +550,7 @@ HOOK: %save-param-reg cpu ( stack reg rep -- )
 
 HOOK: %load-param-reg cpu ( stack reg rep -- )
 
-HOOK: %save-context cpu ( temp1 temp2 callback-allowed? -- )
+HOOK: %save-context cpu ( temp1 temp2 -- )
 
 HOOK: %prepare-var-args cpu ( -- )
 

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index a7eb3bb4a59f410afcf88b5688cbc00deaa9152b..90cd6387932cf1d2b6a3b7c50014f3b347860fd2 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -590,7 +590,7 @@ M:: ppc %save-param-reg ( stack reg rep -- )
 M:: ppc %load-param-reg ( stack reg rep -- )
     reg stack local@ rep load-from-frame ;
 
-M: ppc %prepare-unbox ( n -- )
+M: ppc %pop-stack ( n -- )
     [ 3 ] dip <ds-loc> loc>operand LWZ ;
 
 M: ppc %unbox ( n rep func -- )
@@ -650,13 +650,13 @@ M: ppc %box-large-struct ( n c-type -- )
     [ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
     5 %load-vm-addr
     ! Call the function
-    "box_value_struct" f %alien-invoke ;
+    "from_value_struct" f %alien-invoke ;
 
 M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    temp1 "stack_chain" %load-vm-field-addr
+    temp1 "ctx" %load-vm-field-addr
     temp1 temp1 0 LWZ
     1 temp1 0 STW
     callback-allowed? [
@@ -703,7 +703,7 @@ M: ppc %box-small-struct ( c-type -- )
     #! Box a <= 16-byte struct returned in r3:r4:r5:r6
     heap-size 7 LI
     8 %load-vm-addr
-    "box_medium_struct" f %alien-invoke ;
+    "from_medium_struct" f %alien-invoke ;
 
 : %unbox-struct-1 ( -- )
     ! Alien must be in r3.

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 8867ca659739c009e59e7773f1863ec38bed10f1..6996417edf12561de9866cc09496e34ac899fa87 100644 (file)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -136,7 +136,7 @@ M:: x86.32 %box-large-struct ( n c-type -- )
     8 save-vm-ptr
     4 stack@ c-type heap-size MOV
     0 stack@ EDX MOV
-    "box_value_struct" f %alien-invoke ;
+    "from_value_struct" f %alien-invoke ;
 
 M: x86.32 %prepare-box-struct ( -- )
     ! Compute target address for value struct return
@@ -150,11 +150,17 @@ M: x86.32 %box-small-struct ( c-type -- )
     8 stack@ swap heap-size MOV
     4 stack@ EDX MOV
     0 stack@ EAX MOV
-    "box_small_struct" f %alien-invoke ;
+    "from_small_struct" f %alien-invoke ;
 
-M: x86.32 %prepare-unbox ( -- )
+M: x86.32 %pop-stack ( n -- )
     EAX swap ds-reg reg-stack MOV ;
 
+M: x86.32 %pop-context-stack ( -- )
+    temp-reg %load-context-datastack
+    EAX temp-reg [] MOV
+    EAX EAX [] MOV
+    temp-reg [] bootstrap-cell SUB ;
+
 : call-unbox-func ( func -- )
     4 save-vm-ptr
     0 stack@ EAX MOV
@@ -224,21 +230,23 @@ M: x86.32 %unnest-stacks ( -- )
     "unnest_stacks" f %alien-invoke ;
 
 M: x86.32 %prepare-alien-indirect ( -- )
-    0 save-vm-ptr
-    "unbox_alien" f %alien-invoke
+    EAX ds-reg [] MOV
+    ds-reg 4 SUB
+    4 save-vm-ptr
+    0 stack@ EAX MOV
+    "pinned_alien_offset" f %alien-invoke
     EBP EAX MOV ;
 
 M: x86.32 %alien-indirect ( -- )
     EBP CALL ;
 
 M: x86.32 %alien-callback ( quot -- )
-    ! Fastcall
-    param-reg-1 swap %load-reference
-    param-reg-2 %mov-vm-ptr
+    EAX swap %load-reference
+    EDX %mov-vm-ptr
     "c_to_factor" f %alien-invoke ;
 
 M: x86.32 %callback-value ( ctype -- )
-    0 %prepare-unbox
+    %pop-context-stack
     4 stack@ EAX MOV
     0 save-vm-ptr
     ! Restore data/call/retain stacks

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index cbc5c4d7e5a399b7bc270026bd2bb153d42f1129..06a348b4e652063f540508a83de62e2a19d0a398 100644 (file)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -88,7 +88,7 @@ M: x86 %load-param-reg [ swap param@ ] dip %copy ;
         call
     ] with-scope ; inline
 
-M: x86.64 %prepare-unbox ( n -- )
+M: x86.64 %pop-stack ( n -- )
     param-reg-1 swap ds-reg reg-stack MOV ;
 
 M:: x86.64 %unbox ( n rep func -- )
@@ -167,7 +167,7 @@ M: x86.64 %box-small-struct ( c-type -- )
         param-reg-1 0 box-struct-field@ MOV
         param-reg-2 1 box-struct-field@ MOV
         param-reg-4 %mov-vm-ptr
-        "box_small_struct" f %alien-invoke
+        "from_small_struct" f %alien-invoke
     ] with-return-regs ;
 
 : struct-return@ ( n -- operand )
@@ -180,7 +180,7 @@ M: x86.64 %box-large-struct ( n c-type -- )
     param-reg-1 swap struct-return@ LEA
     param-reg-3 %mov-vm-ptr
     ! Copy the struct from the C stack
-    "box_value_struct" f %alien-invoke ;
+    "from_value_struct" f %alien-invoke ;
 
 M: x86.64 %prepare-box-struct ( -- )
     ! Compute target address for value struct return
@@ -219,7 +219,7 @@ M: x86.64 %alien-callback ( quot -- )
     "c_to_factor" f %alien-invoke ;
 
 M: x86.64 %callback-value ( ctype -- )
-    0 %prepare-unbox
+    0 %pop-stack
     RSP 8 SUB
     param-reg-1 PUSH
     param-reg-1 %mov-vm-ptr

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 36711f7122a449a848ef65003e51423e87fbd2e7..465e2d4929fc9133fdf30432490b79a1002495b2 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -472,6 +472,23 @@ M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
 M: x86 %alien-global ( dst symbol library -- )
     [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;    
 
+M: x86 %push-stack ( -- )
+    ds-reg cell ADD
+    ds-reg [] int-regs return-reg MOV ;
+
+:: %load-context-datastack ( dst -- )
+    ! Load context struct
+    dst "ctx" %vm-field-ptr
+    dst dst [] MOV
+    ! Load context datastack pointer
+    dst "datastack" context-field-offset ADD ;
+
+M: x86 %push-context-stack ( -- )
+    temp-reg %load-context-datastack
+    temp-reg [] bootstrap-cell ADD
+    temp-reg temp-reg [] MOV
+    temp-reg [] int-regs return-reg MOV ;
+
 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
 
 :: %boolean ( dst temp word -- )
@@ -649,43 +666,6 @@ M: x86 %fill-vector-reps
         { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
     } available-reps ;
 
-! M:: x86 %broadcast-vector ( dst src rep -- )
-!     rep signed-rep {
-!         { float-4-rep [
-!             dst src float-4-rep %copy
-!             dst dst { 0 0 0 0 } SHUFPS
-!         ] }
-!         { double-2-rep [
-!             dst src MOVDDUP
-!         ] }
-!         { longlong-2-rep [
-!             dst src =
-!             [ dst dst PUNPCKLQDQ ]
-!             [ dst src { 0 1 0 1 } PSHUFD ]
-!             if
-!         ] }
-!         { int-4-rep [
-!             dst src { 0 0 0 0 } PSHUFD
-!         ] }
-!         { short-8-rep [
-!             dst src { 0 0 0 0 } PSHUFLW 
-!             dst dst PUNPCKLQDQ 
-!         ] }
-!         { char-16-rep [
-!             dst src char-16-rep %copy
-!             dst dst PUNPCKLBW
-!             dst dst { 0 0 0 0 } PSHUFLW
-!             dst dst PUNPCKLQDQ
-!         ] }
-!     } case ;
-! 
-! M: x86 %broadcast-vector-reps
-!     {
-!         ! Can't do this with sse1 since it will want to unbox
-!         ! a double-precision float and convert to single precision
-!         { sse2? { float-4-rep double-2-rep longlong-2-rep ulonglong-2-rep int-4-rep uint-4-rep short-8-rep ushort-8-rep char-16-rep uchar-16-rep } }
-!     } available-reps ;
-
 M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
     rep signed-rep {
         { float-4-rep [
@@ -883,6 +863,7 @@ M: x86 %float>integer-vector-reps
 
 : (%compare-float-vector) ( dst src rep double single -- )
     [ double-2-rep eq? ] 2dip if ; inline
+
 : %compare-float-vector ( dst src rep cc -- )
     {
         { cc<    [ [ CMPLTPD    ] [ CMPLTPS    ] (%compare-float-vector) ] }
@@ -903,6 +884,7 @@ M: x86 %float>integer-vector-reps
         { short-8-rep    [ int16 call ] }
         { char-16-rep    [ int8  call ] }
     } case ; inline
+
 : %compare-int-vector ( dst src rep cc -- )
     {
         { cc= [ [ PCMPEQQ ] [ PCMPEQD ] [ PCMPEQW ] [ PCMPEQB ] (%compare-int-vector) ] }
@@ -921,6 +903,7 @@ M: x86 %compare-vector ( dst src1 src2 rep cc -- )
         { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
         { sse4.1? { longlong-2-rep ulonglong-2-rep } }
     } available-reps ;
+
 : %compare-vector-ord-reps ( -- reps )
     {
         { sse? { float-4-rep } }
@@ -1409,6 +1392,7 @@ M: x86 %integer>scalar drop MOVD ;
     } case ;
 
 M: x86.32 %scalar>integer ( dst src rep -- ) %scalar>integer-32 ;
+
 M: x86.64 %scalar>integer ( dst src rep -- )
     {
         { longlong-scalar-rep  [ MOVD ] }
@@ -1424,18 +1408,16 @@ M:: x86 %reload ( dst rep src -- ) dst src rep %copy ;
 
 M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
 
-M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
+M:: x86 %save-context ( temp1 temp2 -- )
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    temp1 "stack_chain" %vm-field-ptr
+    temp1 "ctx" %vm-field-ptr
     temp1 temp1 [] MOV
     temp2 stack-reg cell neg [+] LEA
     temp1 [] temp2 MOV
-    callback-allowed? [
-        temp1 2 cells [+] ds-reg MOV
-        temp1 3 cells [+] rs-reg MOV
-    ] when ;
+    temp1 2 cells [+] ds-reg MOV
+    temp1 3 cells [+] rs-reg MOV ;
 
 M: x86 value-struct? drop t ;
 

diff --git a/basis/io/backend/unix/macosx/macosx.factor b/basis/io/backend/unix/macosx/macosx.factor
index e669875448cb6066b4747a19117441bd0a6f457f..0bc2b85b321e91e256b5c79bf248c3f2e255fd1b 100644 (file)
--- a/basis/io/backend/unix/macosx/macosx.factor
+++ b/basis/io/backend/unix/macosx/macosx.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend system namespaces io.backend.unix.bsd
 io.backend.unix.multiplexers io.backend.unix.multiplexers.run-loop ;
-IN: io.backend.macosx
+IN: io.backend.unix.macosx
 
 M: macosx init-io ( -- )
     <run-loop-mx> mx set-global ;

diff --git a/basis/vm/vm.factor b/basis/vm/vm.factor
index e3585952db4d7d5d6c00ee1b092ca429cca7f4b6..278296c4d049b3b98da5429887f5af0951f0c9bb 100644 (file)
--- a/basis/vm/vm.factor
+++ b/basis/vm/vm.factor
@@ -4,7 +4,20 @@ USING: classes.struct alien.c-types alien.syntax ;
 IN: vm
 
 TYPEDEF: uintptr_t cell
-C-TYPE: context
+
+STRUCT: context
+{ callstack-top void* }
+{ callstack-bottom void* }
+{ datastack cell }
+{ callstack cell }
+{ magic-frame void* }
+{ datastack-region void* }
+{ retainstack-region void* }
+{ catchstack-save cell }
+{ current-callback-save cell }
+{ next context* } ;
+
+: context-field-offset ( field -- offset ) context offset-of ; inline
 
 STRUCT: zone
 { start cell }
@@ -13,10 +26,10 @@ STRUCT: zone
 { end cell } ;
 
 STRUCT: vm
-{ stack_chain context* }
+{ ctx context* }
 { nursery zone }
-{ cards_offset cell }
-{ decks_offset cell }
+{ cards-offset cell }
+{ decks-offset cell }
 { userenv cell[70] } ;
 
 : vm-field-offset ( field -- offset ) vm offset-of ; inline

diff --git a/build-support/factor.sh b/build-support/factor.sh
index 4943d3e5c0e2bdc36145f5bccda5b1c8a697862b..d54f9d8a7752df8c93e3ce44780323e030c7b054 100755 (executable)
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -63,20 +63,6 @@ check_ret() {
     fi
 }
 
-check_gcc_version() {
-    $ECHO -n "Checking gcc version..."
-    GCC_VERSION=`$CC --version`
-    check_ret gcc
-    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_script 3
-    elif [[ $GCC_VERSION == *4.3.* ]] ; then
-       MAKE_OPTS="$MAKE_OPTS SITE_CFLAGS=-fno-forward-propagate"
-    fi
-    $ECHO "ok."
-}
-
 set_downloader() {
     test_program_installed wget curl
     if [[ $? -ne 0 ]] ; then
@@ -124,7 +110,6 @@ check_installed_programs() {
     ensure_program_installed make gmake
     ensure_program_installed md5sum md5
     ensure_program_installed cut
-    check_gcc_version
 }
 
 check_library_exists() {

diff --git a/vm/Config.openbsd b/vm/Config.openbsd
index 74ea32ebb03eae6c1cd7ca93cf69d405f5e8db4c..a172cbfaba3ae47358da23c2609032846aed0e7c 100644 (file)
--- a/vm/Config.openbsd
+++ b/vm/Config.openbsd
@@ -2,6 +2,5 @@ include vm/Config.unix
 PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o
 CC = egcc
 CPP = eg++
-# -fno-inline-functions works around a gcc 4.2.0 bug
-CFLAGS += -export-dynamic -fno-inline-functions
+CFLAGS += -export-dynamic
 LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread

diff --git a/vm/Config.x86.32 b/vm/Config.x86.32
index e060ef7019eb7acc2fe991a859538a28d9abbde3..b7f8bc65f0ec6ee3f3666677fc05cd1565d2780e 100644 (file)
--- a/vm/Config.x86.32
+++ b/vm/Config.x86.32
@@ -1,5 +1,2 @@
 BOOT_ARCH = x86
 PLAF_DLL_OBJS += vm/cpu-x86.32.o
-
-# gcc bug workaround
-CFLAGS += -fno-builtin-strlen -fno-builtin-strcat

diff --git a/vm/aging_collector.cpp b/vm/aging_collector.cpp
index bef4dc6202f1f6ee390adc066045c744406db8b2..c832ca792faf4e1eee2a9397780f87fe254347cf 100644 (file)
--- a/vm/aging_collector.cpp
+++ b/vm/aging_collector.cpp
@@ -49,8 +49,7 @@ void factor_vm::collect_aging()
                collector.cheneys_algorithm();
 
                data->reset_generation(&nursery);
-               code->points_to_nursery.clear();
-               code->points_to_aging.clear();
+               code->clear_remembered_set();
        }
 }
 

diff --git a/vm/alien.cpp b/vm/alien.cpp
index 5fd6cad4afba654370b2f077149c1b362e09a740..84d31a69c07b1d5550d314c15135e43e2a4b56bf 100755 (executable)
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -211,46 +211,46 @@ VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *parent
 }
 
 /* For FFI callbacks receiving structs by value */
-void factor_vm::box_value_struct(void *src, cell size)
+cell factor_vm::from_value_struct(void *src, cell size)
 {
        byte_array *bytes = allot_byte_array(size);
        memcpy(bytes->data<void>(),src,size);
-       ctx->push(tag<byte_array>(bytes));
+       return tag<byte_array>(bytes);
 }
 
-VM_C_API void box_value_struct(void *src, cell size,factor_vm *parent)
+VM_C_API cell from_value_struct(void *src, cell size, factor_vm *parent)
 {
-       return parent->box_value_struct(src,size);
+       return parent->from_value_struct(src,size);
 }
 
 /* On some x86 OSes, structs <= 8 bytes are returned in registers. */
-void factor_vm::box_small_struct(cell x, cell y, cell size)
+cell factor_vm::from_small_struct(cell x, cell y, cell size)
 {
        cell data[2];
        data[0] = x;
        data[1] = y;
-       box_value_struct(data,size);
+       return from_value_struct(data,size);
 }
 
-VM_C_API void box_small_struct(cell x, cell y, cell size, factor_vm *parent)
+VM_C_API cell from_small_struct(cell x, cell y, cell size, factor_vm *parent)
 {
-       return parent->box_small_struct(x,y,size);
+       return parent->from_small_struct(x,y,size);
 }
 
 /* On OS X/PPC, complex numbers are returned in registers. */
-void factor_vm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
+cell factor_vm::from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
 {
        cell data[4];
        data[0] = x1;
        data[1] = x2;
        data[2] = x3;
        data[3] = x4;
-       box_value_struct(data,size);
+       return from_value_struct(data,size);
 }
 
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *parent)
+VM_C_API cell from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *parent)
 {
-       return parent->box_medium_struct(x1, x2, x3, x4, size);
+       return parent->from_medium_struct(x1, x2, x3, x4, size);
 }
 
 void factor_vm::primitive_vm_ptr()

diff --git a/vm/alien.hpp b/vm/alien.hpp
index 906e204ebe869c0705c3bd9de6b940feb61381a5..add6f4ba728ebd1e86946ba787f83403c8cbad6a 100755 (executable)
--- a/vm/alien.hpp
+++ b/vm/alien.hpp
@@ -5,8 +5,8 @@ VM_C_API char *alien_offset(cell object, factor_vm *vm);
 VM_C_API char *pinned_alien_offset(cell object, factor_vm *vm);
 VM_C_API cell allot_alien(void *address, factor_vm *vm);
 VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *vm);
-VM_C_API void box_value_struct(void *src, cell size,factor_vm *vm);
-VM_C_API void box_small_struct(cell x, cell y, cell size,factor_vm *vm);
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size,factor_vm *vm);
+VM_C_API cell from_value_struct(void *src, cell size, factor_vm *vm);
+VM_C_API cell from_small_struct(cell x, cell y, cell size, factor_vm *vm);
+VM_C_API cell from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *vm);
 
 }

diff --git a/vm/code_blocks.hpp b/vm/code_blocks.hpp
index 075fe389b4cea78ea9099b064e1bfe6461dd7d28..35abe2234288cf45676956425018e484e878ebaa 100644 (file)
--- a/vm/code_blocks.hpp
+++ b/vm/code_blocks.hpp
@@ -36,7 +36,11 @@ struct code_block
 
        cell size() const
        {
-               return header & ~7;
+               cell size = header & ~7;
+#ifdef FACTOR_DEBUG
+               assert(size > 0);
+#endif
+               return size;
        }
 
        void *xt() const

diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 4ea378a6f9b59e493f936c7c4f60938b7b139470..27cbb8e3aa614182793381b3c133b17e709814e0 100644 (file)
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -54,6 +54,9 @@ void factor_vm::nest_stacks(stack_frame *magic_frame)
        new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK];
        new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK];
 
+       new_ctx->reset_datastack();
+       new_ctx->reset_retainstack();
+
        new_ctx->next = ctx;
        ctx = new_ctx;
 }

diff --git a/vm/cpu-ppc.hpp b/vm/cpu-ppc.hpp
index 495eb375ec6dd7fff3fa93aaa9baf64eceefd40b..e46db4d1f3c7fd3670b2d0621c0f5c8d03fa074e 100644 (file)
--- a/vm/cpu-ppc.hpp
+++ b/vm/cpu-ppc.hpp
@@ -4,9 +4,6 @@ namespace factor
 #define FACTOR_CPU_STRING "ppc"
 #define VM_ASM_API VM_C_API
 
-register cell ds asm("r13");
-register cell rs asm("r14");
-
 /* In the instruction sequence:
 
    LOAD32 r3,...
@@ -81,14 +78,16 @@ inline static unsigned int fpu_status(unsigned int status)
 }
 
 /* Defined in assembly */
-VM_ASM_API void c_to_factor(cell quot, void *vm);
-VM_ASM_API void throw_impl(cell quot, stack_frame *rewind, void *vm);
-VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
-VM_ASM_API void flush_icache(cell start, cell len);
-
-VM_ASM_API void set_callstack(stack_frame *to,
-                              stack_frame *from,
-                              cell length,
-                              void *(*memcpy)(void*,const void*, size_t));
+VM_C_API void c_to_factor(cell quot, void *vm);
+VM_C_API void throw_impl(cell quot, void *new_stack, void *vm);
+VM_C_API void lazy_jit_compile(cell quot, void *vm);
+VM_C_API void flush_icache(cell start, cell len);
+
+VM_C_API void set_callstack(
+       void *vm,
+       stack_frame *to,
+       stack_frame *from,
+       cell length,
+       void *(*memcpy)(void*,const void*, size_t));
 
 }

diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 1a943e6d1ee1b3fc6d57e76cdbfd43b1b9bbf5c9..5df375d29fc5f5835fce736203a3127575f38ff7 100644 (file)
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -2,6 +2,7 @@
 
 #define STACK_REG %rsp
 #define DS_REG %r14
+#define RS_REG %r15
 #define RETURN_REG %rax
 
 #define CELL_SIZE 8
@@ -18,6 +19,8 @@
        #define ARG3 %r9
 
        #define PUSH_NONVOLATILE \
+               push %r15 ; \
+               push %r14 ; \
                push %r12 ; \
                push %r13 ; \
                push %rdi ; \
@@ -31,7 +34,9 @@
                pop %rsi ; \
                pop %rdi ; \
                pop %r13 ; \
-               pop %r12
+               pop %r12 ; \
+               pop %r14 ; \
+               pop %r15
 
 #else
 
@@ -44,9 +49,13 @@
                push %rbx ; \
                push %rbp ; \
                push %r12 ; \
-               push %r13
+               push %r13 ; \
+               push %r14 ; \
+               push %r15
 
        #define POP_NONVOLATILE \
+               pop %r15 ; \
+               pop %r14 ; \
                pop %r13 ; \
                pop %r12 ; \
                pop %rbp ; \

diff --git a/vm/cpu-x86.64.hpp b/vm/cpu-x86.64.hpp
index 75d432ee13a35825933e502fee0210c1ef5e7914..aa1a77842f82fca8e01a4405c512e6bfa9a27f3c 100644 (file)
--- a/vm/cpu-x86.64.hpp
+++ b/vm/cpu-x86.64.hpp
@@ -2,9 +2,6 @@ namespace factor
 {
 
 #define FACTOR_CPU_STRING "x86.64"
-
-register cell ds asm("r14");
-register cell rs asm("r15");
-
 #define VM_ASM_API VM_C_API
+
 }

diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index c148f7e5ebd27c91753f7ef898d25e8ae726528c..013aa481d9b70ee5517533f24afc7be28a15ad79 100644 (file)
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -3,27 +3,30 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
        mov ARG0,NV0
        mov ARG1,NV1
 
-    /* Save old stack pointer and align */
-    mov STACK_REG,ARG0
-    and $-16,STACK_REG
-    add $CELL_SIZE,STACK_REG
-    push ARG0
+       push ARG0
+       push ARG1
 
-       /* Create register shadow area for Win64 */
+       /* Save old stack pointer and align */
+       mov STACK_REG,ARG0
+       and $-16,STACK_REG
+       add $CELL_SIZE,STACK_REG
+       push ARG0
+
+       /* Create register shadow area (required for Win64 only) */
        sub $32,STACK_REG
 
        /* Load context */
-    mov (NV1),ARG0
+       mov (NV1),ARG0
 
-    /* Save ctx->callstack_bottom */
+       /* Save ctx->callstack_bottom */
        lea -CELL_SIZE(STACK_REG),ARG1
-    mov ARG1,CELL_SIZE(ARG0)
+       mov ARG1,CELL_SIZE(ARG0)
 
-    /* Load ctx->datastack */
-    mov (CELL_SIZE * 2)(ARG0),DS_REG
+       /* Load ctx->datastack */
+       mov (CELL_SIZE * 2)(ARG0),DS_REG
 
-    /* Load ctx->retainstack */
-    mov (CELL_SIZE * 3)(ARG0),RS_REG
+       /* Load ctx->retainstack */
+       mov (CELL_SIZE * 3)(ARG0),RS_REG
 
        /* Call quot-xt */
        mov NV0,ARG0
@@ -33,8 +36,19 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
        /* Tear down register shadow area */
        add $32,STACK_REG
 
-    /* Undo stack alignment */
-    mov (STACK_REG),STACK_REG
+       /* Undo stack alignment */
+       mov (STACK_REG),STACK_REG
+
+       /* Load context */
+       pop ARG1
+       pop ARG0
+       mov (ARG1),ARG0
+
+       /* Save ctx->datastack */
+       mov DS_REG,(CELL_SIZE * 2)(ARG0)
+
+       /* Save ctx->retainstack */
+       mov RS_REG,(CELL_SIZE * 3)(ARG0)
 
        POP_NONVOLATILE
        ret

diff --git a/vm/data_heap_checker.cpp b/vm/data_heap_checker.cpp
index fb05508e3f6bfa76f3d1b0a84240f4adef38d851..0d79abc15b56f6f05dda223437073e6019649d5c 100644 (file)
--- a/vm/data_heap_checker.cpp
+++ b/vm/data_heap_checker.cpp
@@ -42,16 +42,16 @@ struct slot_checker {
                char slot_card_value = *(char *)slot_card_pointer;
                if((slot_card_value & mask) != mask)
                {
-                       printf("card not marked\n");
-                       printf("source generation: %d\n",gen);
-                       printf("target generation: %d\n",target);
-                       printf("object: 0x%lx\n",(cell)obj);
-                       printf("object type: %ld\n",obj->type());
-                       printf("slot pointer: 0x%lx\n",(cell)slot_ptr);
-                       printf("slot value: 0x%lx\n",*slot_ptr);
-                       printf("card of object: 0x%lx\n",object_card_pointer);
-                       printf("card of slot: 0x%lx\n",slot_card_pointer);
-                       printf("\n");
+                       std::cout << "card not marked" << std::endl;
+                       std::cout << "source generation: " << gen << std::endl;
+                       std::cout << "target generation: " << target << std::endl;
+                       std::cout << "object: 0x" << std::hex << (cell)obj << std::dec << std::endl;
+                       std::cout << "object type: " << obj->type() << std::endl;
+                       std::cout << "slot pointer: 0x" << std::hex << (cell)slot_ptr << std::dec << std::endl;
+                       std::cout << "slot value: 0x" << std::hex << *slot_ptr << std::dec << std::endl;
+                       std::cout << "card of object: 0x" << std::hex << object_card_pointer << std::dec << std::endl;
+                       std::cout << "card of slot: 0x" << std::hex << slot_card_pointer << std::dec << std::endl;
+                       std::cout << std::endl;
                        parent->factorbug();
                }
        }

diff --git a/vm/free_list.hpp b/vm/free_list.hpp
index d934ec34ac752a400f260de843afd0bbced67bee..0a0a5c7614ec02fe5f82a13eddf85b90488752d3 100644 (file)
--- a/vm/free_list.hpp
+++ b/vm/free_list.hpp
@@ -15,11 +15,18 @@ struct free_heap_block
 
        cell size() const
        {
-               return header & ~7;
+               cell size = header & ~7;
+#ifdef FACTOR_DEBUG
+               assert(size > 0);
+#endif
+               return size;
        }
 
        void make_free(cell size)
        {
+#ifdef FACTOR_DEBUG
+               assert(size > 0);
+#endif
                header = size | 1;
        }
 };

diff --git a/vm/vm.hpp b/vm/vm.hpp
index c147ae59b5e9e50e26a7ff5474f70166a5e486ff..ffdb9f25917296572991a876f1736559d73a2a78 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -591,9 +591,9 @@ struct factor_vm
        void primitive_vm_ptr();
        char *alien_offset(cell obj);
        void to_value_struct(cell src, void *dest, cell size);
-       void box_value_struct(void *src, cell size);
-       void box_small_struct(cell x, cell y, cell size);
-       void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
+       cell from_value_struct(void *src, cell size);
+       cell from_small_struct(cell x, cell y, cell size);
+       cell from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
 
        //quotations
        void primitive_jit_compile();