Merge branch 'master' into new_gc

diff --combined basis/bootstrap/image/image.factor
index 711f2f36f368719d4c89c5060078a54a8ced0299,567a3b8bfdff9a60c577a4a8df99f1b935534a5e..85309752b8e0c45eac1ae25c251b1780962c8532
--- 1/basis/bootstrap/image/image.factor
--- 2/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@@ -218,12 -218,8 +218,12 @@@ USERENV: undefined-quot 6
  
  : here-as ( tag -- pointer ) here bitor ;
  
 +: (align-here) ( alignment -- )
 +    [ here neg ] dip rem
 +    [ bootstrap-cell /i [ 0 emit ] times ] unless-zero ;
 +
  : align-here ( -- )
 -    here 8 mod 4 = [ 0 emit ] when ;
 +    data-alignment get (align-here) ;
  
  : emit-fixnum ( n -- ) tag-fixnum emit ;
  
@@@ -297,7 -293,7 +297,7 @@@ M: fake-bignum ' n>> tag-fixnum 
  M: float '
      [
          float [
 -            align-here double>bits emit-64
 +            8 (align-here) double>bits emit-64
          ] emit-object
      ] cache-eql-object ;
  
@@@ -355,7 -351,7 +355,7 @@@ M: f 
      [ ] [ "Not in image: " word-error ] ?if ;
  
  : fixup-words ( -- )
-     image get [ dup word? [ fixup-word ] when ] change-each ;
+     image get [ dup word? [ fixup-word ] when ] map! drop ;
  
  M: word ' ;
  
@@@ -415,7 -411,6 +415,7 @@@ M: byte-array 
      [
          byte-array [
              dup length emit-fixnum
 +            bootstrap-cell 4 = [ 0 emit 0 emit ] when
              pad-bytes emit-bytes
          ] emit-object
      ] cache-eq-object ;

diff --combined basis/cpu/ppc/ppc.factor
index 7226145c27917bc92dd96045c374543f4572ad0f,8ddacaa0e1a65d870542e15bec9d76e73ecc2473..823e2c8188226c2fe80aba41be4105c28f55870a
--- 1/basis/cpu/ppc/ppc.factor
--- 2/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@@ -374,7 -374,7 +374,7 @@@ M: ppc %set-alien-double -rot STFD 
      [ drop load-zone-ptr ] [ swap 0 LWZ ] 2bi ;
  
  :: inc-allot-ptr ( nursery-ptr allot-ptr n -- )
 -    scratch-reg allot-ptr n 8 align ADDI
 +    scratch-reg allot-ptr n data-alignment get align ADDI
      scratch-reg nursery-ptr 0 STW ;
  
  :: store-header ( dst class -- )
@@@ -504,11 -504,11 +504,11 @@@ M: ppc %compare [ (%compare) ] 2dip %bo
  M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
  
  M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- )
-     src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
+     src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
      dst temp branch1 branch2 (%boolean) ;
  
  M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- )
-     src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
+     src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
      dst temp branch1 branch2 (%boolean) ;
  
  :: %branch ( label cc -- )
@@@ -534,11 -534,11 +534,11 @@@ M:: ppc %compare-imm-branch ( label src
      branch2 [ label branch2 execute( label -- ) ] when ; inline
  
  M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- )
-     src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
+     src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
      label branch1 branch2 (%branch) ;
  
  M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
-     src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
+     src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
      label branch1 branch2 (%branch) ;
  
  : load-from-frame ( dst n rep -- )

diff --combined basis/cpu/x86/x86.factor
index 938bb3a8df95a8b53bd62d920095c40ebe24b19c,869f973b30b169ba5320dcbfba30d13eea06a9b1..b96f33f392cd911849613029cd0dab1fda1f7d16
--- 1/basis/cpu/x86/x86.factor
--- 2/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@@ -254,7 -254,7 +254,7 @@@ CONSTANT: have-byte-regs { EAX ECX EDX 
  
  M: x86.32 has-small-reg?
      {
-         { 8 [ have-byte-regs memq? ] }
+         { 8 [ have-byte-regs member-eq? ] }
          { 16 [ drop t ] }
          { 32 [ drop t ] }
      } case ;
@@@ -264,7 -264,7 +264,7 @@@ M: x86.64 has-small-reg? 2drop t 
  : small-reg-that-isn't ( exclude -- reg' )
      [ have-byte-regs ] dip
      [ native-version-of ] map
-     '[ _ memq? not ] find nip ;
+     '[ _ member-eq? not ] find nip ;
  
  : with-save/restore ( reg quot -- )
      [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline
@@@ -356,7 -356,7 +356,7 @@@ M: x86 %set-alien-float [ [+] ] dip MOV
  M: x86 %set-alien-double [ [+] ] dip MOVSD ;
  M: x86 %set-alien-vector [ [+] ] 2dip %copy ;
  
- : shift-count? ( reg -- ? ) { ECX RCX } memq? ;
+ : shift-count? ( reg -- ? ) { ECX RCX } member-eq? ;
  
  :: emit-shift ( dst src quot -- )
      src shift-count? [
@@@ -388,7 -388,7 +388,7 @@@ M: x86 %vm-field-ptr ( dst field -- 
      [ drop "nursery" %vm-field-ptr ] [ swap [] MOV ] 2bi ;
  
  : inc-allot-ptr ( nursery-ptr n -- )
 -    [ [] ] dip 8 align ADD ;
 +    [ [] ] dip data-alignment get align ADD ;
  
  : store-header ( temp class -- )
      [ [] ] [ type-number tag-fixnum ] bi* MOV ;
@@@ -893,7 -893,7 +893,7 @@@ M: x86 %compare-vector ( dst src1 src2 
  
  M: x86 %compare-vector-reps
      {
-         { [ dup { cc= cc/= cc/<>= cc<>= } memq? ] [ drop %compare-vector-eq-reps ] }
+         { [ dup { cc= cc/= cc/<>= cc<>= } member-eq? ] [ drop %compare-vector-eq-reps ] }
          [ drop %compare-vector-ord-reps ]
      } cond ;
  
@@@ -1155,18 -1155,18 +1155,18 @@@ M: x86 %horizontal-add-vector-rep
          { sse3? { float-4-rep double-2-rep } }
      } available-reps ;
  
- M: x86 %horizontal-shl-vector ( dst src1 src2 rep -- )
+ M: x86 %horizontal-shl-vector-imm ( dst src1 src2 rep -- )
      two-operand PSLLDQ ;
  
- M: x86 %horizontal-shl-vector-reps
+ M: x86 %horizontal-shl-vector-imm-reps
      {
          { sse2? { 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 %horizontal-shr-vector ( dst src1 src2 rep -- )
+ M: x86 %horizontal-shr-vector-imm ( dst src1 src2 rep -- )
      two-operand PSRLDQ ;
  
- M: x86 %horizontal-shr-vector-reps
+ M: x86 %horizontal-shr-vector-imm-reps
      {
          { sse2? { 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 ;
@@@ -1282,6 -1282,11 +1282,11 @@@ M: x86 %shr-vector-rep
          { sse2? { short-8-rep ushort-8-rep int-4-rep uint-4-rep ulonglong-2-rep } }
      } available-reps ;
  
+ M: x86 %shl-vector-imm %shl-vector ;
+ M: x86 %shl-vector-imm-reps %shl-vector-reps ;
+ M: x86 %shr-vector-imm %shr-vector ;
+ M: x86 %shr-vector-imm-reps %shr-vector-reps ;
+ 
  : scalar-sized-reg ( reg rep -- reg' )
      rep-size 8 * n-bit-version-of ;
  

diff --combined basis/stack-checker/known-words/known-words.factor
index a5ddde9409e045482b3f6ca17df928c04523f188,62a9526e20e7a8ccf1b975fbfb0d32a3d841c999..d3a9d2d4cef944482e0efbcf65dec52d0ff2a960
--- 1/basis/stack-checker/known-words/known-words.factor
--- 2/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@@ -192,17 -192,17 +192,17 @@@ M: bad-executable summar
  
  \ load-local [ infer-load-local ] "special" set-word-prop
  
- : infer-get-local ( -- )
-     [let* | n [ pop-literal nip 1 swap - ]
-             in-r [ n consume-r ]
-             out-d [ in-r first copy-value 1array ]
-             out-r [ in-r copy-values ] |
-          out-d output-d
-          out-r output-r
-          f out-d in-r out-r
-          out-r in-r zip out-d first in-r first 2array suffix
-          #shuffle,
-     ] ;
+ :: infer-get-local ( -- )
+     pop-literal nip 1 swap - :> n
+     n consume-r :> in-r
+     in-r first copy-value 1array :> out-d
+     in-r copy-values :> out-r
+ 
+     out-d output-d
+     out-r output-r
+     f out-d in-r out-r
+     out-r in-r zip out-d first in-r first 2array suffix
+     #shuffle, ;
  
  \ get-local [ infer-get-local ] "special" set-word-prop
  
@@@ -501,14 -501,16 +501,14 @@@
  
  \ compact-gc { } { } define-primitive
  
 -\ gc-stats { } { array } define-primitive
 -
  \ (save-image) { byte-array } { } define-primitive
  
  \ (save-image-and-exit) { byte-array } { } define-primitive
  
 -\ data-room { } { integer integer array } define-primitive
 +\ data-room { } { byte-array } define-primitive
  \ data-room make-flushable
  
 -\ code-room { } { integer integer integer integer } define-primitive
 +\ code-room { } { byte-array } define-primitive
  \ code-room  make-flushable
  
  \ micros { } { integer } define-primitive
@@@ -699,6 -701,10 +699,6 @@@
  
  \ unimplemented { } { } define-primitive
  
 -\ gc-reset { } { } define-primitive
 -
 -\ gc-stats { } { array } define-primitive
 -
  \ jit-compile { quotation } { } define-primitive
  
  \ lookup-method { object array } { word } define-primitive
@@@ -713,6 -719,3 +713,6 @@@
  \ strip-stack-traces { } { } define-primitive
  
  \ <callback> { word } { alien } define-primitive
 +
 +\ enable-gc-events { } { } define-primitive
 +\ disable-gc-events { } { object } define-primitive