Merge branch 'master' into startup

basis/alien/remote-control/remote-control.factor

@@ -1,18 +1,19 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.data alien.strings parser
+USING: accessors alien alien.c-types alien.data alien.strings
-threads words kernel.private kernel io.encodings.utf8 eval ;
+parser threads words kernel.private kernel io.encodings.utf8
+eval ;
 IN: alien.remote-control
 
 : eval-callback ( -- callback )
-    "void*" { "char*" } "cdecl"
+    void* { char* } "cdecl"
     [ eval>string utf8 malloc-string ] alien-callback ;
 
 : yield-callback ( -- callback )
-    "void" { } "cdecl" [ yield ] alien-callback ;
+    void { } "cdecl" [ yield ] alien-callback ;
 
 : sleep-callback ( -- callback )
-    "void" { "long" } "cdecl" [ sleep ] alien-callback ;
+    void { long } "cdecl" [ sleep ] alien-callback ;
 
 : ?callback ( word -- alien )
     dup optimized? [ execute ] [ drop f ] if ; inline

basis/compiler/alien/alien.factor

@@ -9,10 +9,10 @@ IN: compiler.alien
 
 : alien-parameters ( params -- seq )
     dup parameters>>
-    swap return>> large-struct? [ "void*" prefix ] when ;
+    swap return>> large-struct? [ void* prefix ] when ;
 
 : alien-return ( params -- ctype )
-    return>> dup large-struct? [ drop "void" ] when ;
+    return>> dup large-struct? [ drop void ] when ;
 
 : c-type-stack-align ( type -- align )
     dup c-type-stack-align? [ c-type-align ] [ drop cell ] if ;
@@ -20,8 +20,7 @@ IN: compiler.alien
 : parameter-align ( n type -- n delta )
     [ c-type-stack-align align dup ] [ drop ] 2bi - ;
 
-: parameter-sizes ( types -- total offsets )
+: parameter-offsets ( types -- total offsets )
-    #! Compute stack frame locations.
     [
         0 [
             [ parameter-align drop dup , ] keep stack-size +

basis/compiler/cfg/build-stack-frame/build-stack-frame.factor

@@ -27,7 +27,9 @@ M: ##call compute-stack-frame*
 
 M: ##gc compute-stack-frame*
     frame-required? on
-    stack-frame new swap tagged-values>> length cells >>gc-root-size
+    stack-frame new
+        swap tagged-values>> length cells >>gc-root-size
+        t >>calls-vm?
     request-stack-frame ;
 
 M: _spill-area-size compute-stack-frame*

basis/compiler/cfg/builder/builder.factor

@@ -212,7 +212,8 @@ M: #terminate emit-node drop ##no-tco end-basic-block ;
     stack-frame new
         swap
         [ return>> return-size >>return ]
-        [ alien-parameters parameter-sizes drop >>params ] bi ;
+        [ alien-parameters parameter-offsets drop >>params ] bi
+        t >>calls-vm? ;
 
 : alien-node-height ( params -- )
     [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;

basis/compiler/cfg/stack-frame/stack-frame.factor

@@ -9,7 +9,8 @@ TUPLE: stack-frame
 { return integer }
 { total-size integer }
 { gc-root-size integer }
-{ spill-area-size integer } ;
+{ spill-area-size integer }
+{ calls-vm? boolean } ;
 
 ! Stack frame utilities
 : param-base ( -- n )
@@ -35,7 +36,9 @@ TUPLE: stack-frame
 
 : max-stack-frame ( frame1 frame2 -- frame3 )
     [ stack-frame new ] 2dip
+    {
         [ [ params>> ] bi@ max >>params ]
         [ [ return>> ] bi@ max >>return ]
         [ [ gc-root-size>> ] bi@ max >>gc-root-size ]
-        2tri ;
+        [ [ calls-vm?>> ] bi@ or >>calls-vm? ]
+    } 2cleave ;

basis/compiler/codegen/codegen.factor

@@ -333,35 +333,29 @@ M: reg-class reg-class-full?
     [ alloc-stack-param ] [ alloc-fastcall-param ] if
     [ param-reg ] dip ;
 
-: (flatten-int-type) ( size -- seq )
+: (flatten-int-type) ( type -- seq )
-    cell /i "void*" c-type <repetition> ;
+    stack-size cell align cell /i void* c-type <repetition> ;
 
 GENERIC: flatten-value-type ( type -- types )
 
 M: object flatten-value-type 1array ;
-
+M: struct-c-type flatten-value-type (flatten-int-type) ;
-M: struct-c-type flatten-value-type ( type -- types )
+M: long-long-type flatten-value-type (flatten-int-type) ;
-    stack-size cell align (flatten-int-type) ;
+M: c-type-name flatten-value-type c-type flatten-value-type ;
-
-M: long-long-type flatten-value-type ( type -- types )
-    stack-size cell align (flatten-int-type) ;
 
 : flatten-value-types ( params -- params )
     #! Convert value type structs to consecutive void*s.
     [
         0 [
             c-type
-            [ parameter-align (flatten-int-type) % ] keep
+            [ parameter-align cell /i void* c-type <repetition> % ] keep
             [ stack-size cell align + ] keep
             flatten-value-type %
         ] reduce drop
     ] { } make ;
 
 : each-parameter ( parameters quot -- )
-    [ [ parameter-sizes nip ] keep ] dip 2each ; inline
+    [ [ parameter-offsets nip ] keep ] dip 2each ; inline
-
-: reverse-each-parameter ( parameters quot -- )
-    [ [ parameter-sizes nip ] keep ] dip 2reverse-each ; inline
 
 : reset-fastcall-counts ( -- )
     { int-regs float-regs stack-params } [ 0 swap set ] each ;
@@ -378,10 +372,17 @@ M: long-long-type flatten-value-type ( type -- types )
     [ '[ alloc-parameter _ execute ] ]
     bi* each-parameter ; inline
 
+: reverse-each-parameter ( parameters quot -- )
+    [ [ parameter-offsets nip ] keep ] dip 2reverse-each ; inline
+
+: prepare-unbox-parameters ( parameters -- offsets types indices )
+    [ parameter-offsets nip ] [ ] [ length iota reverse ] tri ;
+
 : unbox-parameters ( offset node -- )
-    parameters>> [
+    parameters>> swap
-        %prepare-unbox [ over + ] dip unbox-parameter
+    '[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ]
-    ] reverse-each-parameter drop ;
+    [ length neg %inc-d ]
+    bi ;
 
 : prepare-box-struct ( node -- offset )
     #! Return offset on C stack where to store unboxed
@@ -413,7 +414,7 @@ M: long-long-type flatten-value-type ( type -- types )
     ] if ;
 
 : stdcall-mangle ( symbol params -- symbol )
-    parameters>> parameter-sizes drop number>string "@" glue ;
+    parameters>> parameter-offsets drop number>string "@" glue ;
 
 : alien-invoke-dlsym ( params -- symbols dll )
     [ [ function>> dup ] keep stdcall-mangle 2array ]

basis/cpu/architecture/architecture.factor

@@ -463,7 +463,7 @@ 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 ( -- )
+HOOK: %prepare-unbox cpu ( n -- )
 
 HOOK: %unbox cpu ( n rep func -- )
 

basis/cpu/ppc/ppc.factor

@@ -577,10 +577,8 @@ 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 ( -- )
+M: ppc %prepare-unbox ( n -- )
-    ! First parameter is top of stack
+    [ 3 ] dip <ds-loc> loc>operand LWZ ;
-    3 ds-reg 0 LWZ
-    ds-reg dup cell SUBI ;
 
 M: ppc %unbox ( n rep func -- )
     ! Value must be in r3

basis/cpu/x86/32/32.factor

@@ -25,6 +25,11 @@ M: x86.32 rs-reg EDI ;
 M: x86.32 stack-reg ESP ;
 M: x86.32 temp-reg ECX ;
 
+: local@ ( n -- op )
+    stack-frame get extra-stack-space dup 16 assert= + stack@ ;
+
+M: x86.32 extra-stack-space calls-vm?>> 16 0 ? ;
+
 M: x86.32 %mark-card
     drop HEX: ffffffff [+] card-mark <byte> MOV
     building get pop
@@ -57,12 +62,12 @@ M:: x86.32 %dispatch ( src temp -- )
 
 M: x86.32 pic-tail-reg EBX ;
 
-M: x86.32 reserved-area-size 0 ;
+M: x86.32 reserved-stack-space 4 cells ;
 
 M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
 
-: push-vm-ptr ( -- )
+: save-vm-ptr ( n -- )
-    0 PUSH 0 rc-absolute-cell rel-vm ; ! push the vm ptr as an argument
+    stack@ 0 MOV 0 rc-absolute-cell rel-vm ;
 
 M: x86.32 return-struct-in-registers? ( c-type -- ? )
     c-type
@@ -72,44 +77,34 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? )
     and or ;
 
 : struct-return@ ( n -- operand )
-    [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ;
+    [ next-stack@ ] [ stack-frame get params>> local@ ] if* ;
 
 ! On x86, parameters are never passed in registers.
 M: int-regs return-reg drop EAX ;
 M: int-regs param-regs drop { } ;
 M: float-regs param-regs drop { } ;
 
-GENERIC: push-return-reg ( rep -- )
+GENERIC: load-return-reg ( src rep -- )
-GENERIC: load-return-reg ( n rep -- )
+GENERIC: store-return-reg ( dst rep -- )
-GENERIC: store-return-reg ( n rep -- )
 
-M: int-rep push-return-reg drop EAX PUSH ;
+M: int-rep load-return-reg drop EAX swap MOV ;
-M: int-rep load-return-reg drop EAX swap next-stack@ MOV ;
+M: int-rep store-return-reg drop EAX MOV ;
-M: int-rep store-return-reg drop stack@ EAX MOV ;
 
-M: float-rep push-return-reg drop ESP 4 SUB ESP [] FSTPS ;
+M: float-rep load-return-reg drop FLDS ;
-M: float-rep load-return-reg drop next-stack@ FLDS ;
+M: float-rep store-return-reg drop FSTPS ;
-M: float-rep store-return-reg drop stack@ FSTPS ;
 
-M: double-rep push-return-reg drop ESP 8 SUB ESP [] FSTPL ;
+M: double-rep load-return-reg drop FLDL ;
-M: double-rep load-return-reg drop next-stack@ FLDL ;
+M: double-rep store-return-reg drop FSTPL ;
-M: double-rep store-return-reg drop stack@ FSTPL ;
-
-: align-sub ( n -- )
-    [ align-stack ] keep - decr-stack-reg ;
-
-: align-add ( n -- )
-    align-stack incr-stack-reg ;
-
-: with-aligned-stack ( n quot -- )
-    '[ align-sub @ ] [ align-add ] bi ; inline
 
 M: x86.32 %prologue ( n -- )
     dup PUSH
     0 PUSH rc-absolute-cell rel-this
     3 cells - decr-stack-reg ;
 
-M: x86.32 %load-param-reg 3drop ;
+M: x86.32 %load-param-reg
+    stack-params assert=
+    [ [ EAX ] dip local@ MOV ] dip
+    stack@ EAX MOV ;
 
 M: x86.32 %save-param-reg 3drop ;
 
@@ -118,16 +113,14 @@ M: x86.32 %save-param-reg 3drop ;
     #! are boxing a return value of a C function. If n is an
     #! integer, push [ESP+n] on the stack; we are boxing a
     #! parameter being passed to a callback from C.
-    over [ load-return-reg ] [ 2drop ] if ;
+    over [ [ next-stack@ ] dip load-return-reg ] [ 2drop ] if ;
 
 M:: x86.32 %box ( n rep func -- )
     n rep (%box)
-    rep rep-size cell + [
+    rep rep-size save-vm-ptr
-        push-vm-ptr
+    0 stack@ rep store-return-reg
-        rep push-return-reg
+    func f %alien-invoke ;
-        func f %alien-invoke
+
-    ] with-aligned-stack ;
-    
 : (%box-long-long) ( n -- )
     [
         EDX over next-stack@ MOV
@@ -136,56 +129,39 @@ M:: x86.32 %box ( n rep func -- )
 
 M: x86.32 %box-long-long ( n func -- )
     [ (%box-long-long) ] dip
-    12 [
+    8 save-vm-ptr
-        push-vm-ptr
+    4 stack@ EDX MOV
-        EDX PUSH
+    0 stack@ EAX MOV
-        EAX PUSH
+    f %alien-invoke ;
-        f %alien-invoke
-    ] with-aligned-stack ;
 
 M:: x86.32 %box-large-struct ( n c-type -- )
-    ! Compute destination address
     EDX n struct-return@ LEA
-    12 [
+    8 save-vm-ptr
-        push-vm-ptr
+    4 stack@ c-type heap-size MOV
-        ! Push struct size
+    0 stack@ EDX MOV
-        c-type heap-size PUSH
+    "box_value_struct" f %alien-invoke ;
-        ! Push destination address
-        EDX PUSH
-        ! Copy the struct from the C stack
-        "box_value_struct" f %alien-invoke
-    ] with-aligned-stack ;
 
 M: x86.32 %prepare-box-struct ( -- )
     ! Compute target address for value struct return
     EAX f struct-return@ LEA
     ! Store it as the first parameter
-    0 stack@ EAX MOV ;
+    0 local@ EAX MOV ;
 
 M: x86.32 %box-small-struct ( c-type -- )
     #! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
-    16 [
+    12 save-vm-ptr
-        push-vm-ptr
+    8 stack@ swap heap-size MOV
-        heap-size PUSH
+    4 stack@ EDX MOV
-        EDX PUSH
+    0 stack@ EAX MOV
-        EAX PUSH
+    "box_small_struct" f %alien-invoke ;
-        "box_small_struct" f %alien-invoke
-    ] with-aligned-stack ;
 
 M: x86.32 %prepare-unbox ( -- )
-    #! Move top of data stack to EAX.
+    EAX swap ds-reg reg-stack MOV ;
-    EAX ESI [] MOV
-    ESI 4 SUB ;
 
 : call-unbox-func ( func -- )
-    8 [
+    4 save-vm-ptr
-        ! push the vm ptr as an argument
+    0 stack@ EAX MOV
-        push-vm-ptr
+    f %alien-invoke ;
-        ! Push parameter
-        EAX PUSH
-        ! Call the unboxer
-        f %alien-invoke
-    ] with-aligned-stack ;
 
 M: x86.32 %unbox ( n rep func -- )
     #! The value being unboxed must already be in EAX.
@@ -194,37 +170,33 @@ M: x86.32 %unbox ( n rep func -- )
     #! a parameter to a C function about to be called.
     call-unbox-func
     ! Store the return value on the C stack
-    over [ store-return-reg ] [ 2drop ] if ;
+    over [ [ local@ ] dip store-return-reg ] [ 2drop ] if ;
 
 M: x86.32 %unbox-long-long ( n func -- )
     call-unbox-func
     ! Store the return value on the C stack
     [
-        dup stack@ EAX MOV
+        [ local@ EAX MOV ]
-        cell + stack@ EDX MOV
+        [ 4 + local@ EDX MOV ] bi
     ] when* ;
 
 : %unbox-struct-1 ( -- )
     #! Alien must be in EAX.
-    8 [
+    4 save-vm-ptr
-        push-vm-ptr
+    0 stack@ EAX MOV
-        EAX PUSH
+    "alien_offset" f %alien-invoke
-        "alien_offset" f %alien-invoke
+    ! Load first cell
-        ! Load first cell
+    EAX EAX [] MOV ;
-        EAX EAX [] MOV
-    ] with-aligned-stack ;
 
 : %unbox-struct-2 ( -- )
     #! Alien must be in EAX.
-    8 [
+    4 save-vm-ptr
-        push-vm-ptr
+    0 stack@ EAX MOV
-        EAX PUSH
+    "alien_offset" f %alien-invoke
-        "alien_offset" f %alien-invoke
+    ! Load second cell
-        ! Load second cell
+    EDX EAX 4 [+] MOV
-        EDX EAX 4 [+] MOV
+    ! Load first cell
-        ! Load first cell
+    EAX EAX [] MOV ;
-        EAX EAX [] MOV
-    ] with-aligned-stack ;
 
 M: x86 %unbox-small-struct ( size -- )
     #! Alien must be in EAX.
@@ -236,63 +208,46 @@ M: x86 %unbox-small-struct ( size -- )
 M:: x86.32 %unbox-large-struct ( n c-type -- )
     ! Alien must be in EAX.
     ! Compute destination address
-    EDX n stack@ LEA
+    EDX n local@ LEA
-    16 [
+    12 save-vm-ptr
-        push-vm-ptr
+    8 stack@ c-type heap-size MOV
-        ! Push struct size
+    4 stack@ EDX MOV
-        c-type heap-size PUSH
+    0 stack@ EAX MOV
-        ! Push destination address
+    "to_value_struct" f %alien-invoke ;
-        EDX PUSH
-        ! Push source address
-        EAX PUSH
-        ! Copy the struct to the stack
-        "to_value_struct" f %alien-invoke
-    ] with-aligned-stack ;
 
 M: x86.32 %nest-stacks ( -- )
     ! Save current frame. See comment in vm/contexts.hpp
     EAX stack-reg stack-frame get total-size>> 3 cells - [+] LEA
-    8 [
+    4 save-vm-ptr
-        push-vm-ptr
+    0 stack@ EAX MOV
-        EAX PUSH
+    "nest_stacks" f %alien-invoke ;
-        "nest_stacks" f %alien-invoke
-    ] with-aligned-stack ;
 
 M: x86.32 %unnest-stacks ( -- )
-    4 [
+    0 save-vm-ptr
-        push-vm-ptr
+    "unnest_stacks" f %alien-invoke ;
-        "unnest_stacks" f %alien-invoke
-    ] with-aligned-stack ;
 
 M: x86.32 %prepare-alien-indirect ( -- )
-    4 [
+    0 save-vm-ptr
-        push-vm-ptr
+    "unbox_alien" f %alien-invoke
-        "unbox_alien" f %alien-invoke
-    ] with-aligned-stack
     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
     "c_to_factor" f %alien-invoke ;
 
 M: x86.32 %callback-value ( ctype -- )
-    ! Align C stack
+    0 %prepare-unbox
-    ESP 12 SUB
+    4 stack@ EAX MOV
-    ! Save top of data stack in non-volatile register
+    0 save-vm-ptr
-    %prepare-unbox
-    EAX PUSH
-    push-vm-ptr
     ! Restore data/call/retain stacks
     "unnest_stacks" f %alien-invoke
-    ! Place top of data stack in EAX
+    ! Place former top of data stack back in EAX
-    temp-reg POP
+    EAX 4 stack@ MOV
-    EAX POP
-    ! Restore C stack
-    ESP 12 ADD
     ! Unbox EAX
     unbox-return ;
 
@@ -357,17 +312,11 @@ M: x86.32 %callback-return ( n -- )
     } cond RET ;
 
 M:: x86.32 %call-gc ( gc-root-count temp -- )
-    temp gc-root-base param@ LEA
+    temp gc-root-base special@ LEA
-    12 [
+    8 save-vm-ptr
-        ! Pass the VM ptr as the third parameter
+    4 stack@ gc-root-count MOV
-        push-vm-ptr
+    0 stack@ temp MOV
-        ! Pass number of roots as second parameter
+    "inline_gc" f %alien-invoke ;
-        gc-root-count PUSH 
-        ! Pass pointer to start of GC roots as first parameter
-        temp PUSH 
-        ! Call GC
-        "inline_gc" f %alien-invoke
-    ] with-aligned-stack ;
 
 M: x86.32 dummy-stack-params? f ;
 
@@ -375,10 +324,13 @@ M: x86.32 dummy-int-params? f ;
 
 M: x86.32 dummy-fp-params? f ;
 
+! Dreadful
+M: object flatten-value-type (flatten-int-type) ;
+
 os windows? [
-    cell "longlong" c-type (>>align)
+    cell longlong c-type (>>align)
-    cell "ulonglong" c-type (>>align)
+    cell ulonglong c-type (>>align)
-    4 "double" c-type (>>align)
+    4 double c-type (>>align)
 ] unless
 
 check-sse

basis/cpu/x86/64/64.factor

@@ -8,6 +8,22 @@ compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame
 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
 IN: cpu.x86.64
 
+: param-reg-1 ( -- reg ) int-regs param-regs first ; inline
+: param-reg-2 ( -- reg ) int-regs param-regs second ; inline
+: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
+: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline
+
+M: x86.64 pic-tail-reg RBX ;
+
+M: int-regs return-reg drop RAX ;
+M: float-regs return-reg drop XMM0 ;
+
+M: x86.64 ds-reg R14 ;
+M: x86.64 rs-reg R15 ;
+M: x86.64 stack-reg RSP ;
+
+M: x86.64 extra-stack-space drop 0 ;
+
 M: x86.64 machine-registers
     {
         { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
@@ -17,9 +33,13 @@ M: x86.64 machine-registers
         } }
     } ;
 
-M: x86.64 ds-reg R14 ;
+: param@ ( n -- op ) reserved-stack-space + stack@ ;
-M: x86.64 rs-reg R15 ;
+
-M: x86.64 stack-reg RSP ;
+M: x86.64 %prologue ( n -- )
+    temp-reg 0 MOV rc-absolute-cell rel-this
+    dup PUSH
+    temp-reg PUSH
+    stack-reg swap 3 cells - SUB ;
 
 : load-cards-offset ( dst -- )
     0 MOV rc-absolute-cell rel-cards-offset ;
@@ -50,22 +70,6 @@ M:: x86.64 %dispatch ( src temp -- )
     [ align-code ]
     bi ;
 
-: param-reg-1 ( -- reg ) int-regs param-regs first ; inline
-: param-reg-2 ( -- reg ) int-regs param-regs second ; inline
-: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
-: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline
-
-M: x86.64 pic-tail-reg RBX ;
-
-M: int-regs return-reg drop RAX ;
-M: float-regs return-reg drop XMM0 ;
-
-M: x86.64 %prologue ( n -- )
-    temp-reg 0 MOV rc-absolute-cell rel-this
-    dup PUSH
-    temp-reg PUSH
-    stack-reg swap 3 cells - SUB ;
-
 M: stack-params copy-register*
     drop
     {
@@ -84,10 +88,8 @@ M: x86 %load-param-reg [ swap param@ ] dip %copy ;
         call
     ] with-scope ; inline
 
-M: x86.64 %prepare-unbox ( -- )
+M: x86.64 %prepare-unbox ( n -- )
-    ! First parameter is top of stack
+    param-reg-1 swap ds-reg reg-stack MOV ;
-    param-reg-1 R14 [] MOV
-    R14 cell SUB ;
 
 M:: x86.64 %unbox ( n rep func -- )
     param-reg-2 %mov-vm-ptr
@@ -217,9 +219,7 @@ M: x86.64 %alien-callback ( quot -- )
     "c_to_factor" f %alien-invoke ;
 
 M: x86.64 %callback-value ( ctype -- )
-    ! Save top of data stack
+    0 %prepare-unbox
-    %prepare-unbox
-    ! Save top of data stack
     RSP 8 SUB
     param-reg-1 PUSH
     param-reg-1 %mov-vm-ptr

basis/cpu/x86/64/unix/unix.factor

@@ -12,7 +12,7 @@ M: int-regs param-regs
 M: float-regs param-regs
     drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
 
-M: x86.64 reserved-area-size 0 ;
+M: x86.64 reserved-stack-space 0 ;
 
 SYMBOL: (stack-value)
 ! The ABI for passing structs by value is pretty great

basis/cpu/x86/64/winnt/winnt.factor

@@ -9,7 +9,7 @@ M: int-regs param-regs drop { RCX RDX R8 R9 } ;
 
 M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
 
-M: x86.64 reserved-area-size 4 cells ;
+M: x86.64 reserved-stack-space 4 cells ;
 
 M: x86.64 return-struct-in-registers? ( c-type -- ? )
     heap-size { 1 2 4 8 } member? ;

basis/cpu/x86/x86.factor

@@ -24,15 +24,20 @@ M: x86 vector-regs float-regs ;
 
 HOOK: stack-reg cpu ( -- reg )
 
-HOOK: reserved-area-size cpu ( -- n )
+HOOK: reserved-stack-space cpu ( -- n )
+
+HOOK: extra-stack-space cpu ( stack-frame -- n )
 
 : stack@ ( n -- op ) stack-reg swap [+] ;
 
-: param@ ( n -- op ) reserved-area-size + stack@ ;
+: special@ ( n -- op )
+    stack-frame get extra-stack-space +
+    reserved-stack-space +
+    stack@ ;
 
-: spill@ ( n -- op ) spill-offset param@ ;
+: spill@ ( n -- op ) spill-offset special@ ;
 
-: gc-root@ ( n -- op ) gc-root-offset param@ ;
+: gc-root@ ( n -- op ) gc-root-offset special@ ;
 
 : decr-stack-reg ( n -- )
     dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
@@ -44,7 +49,11 @@ HOOK: reserved-area-size cpu ( -- n )
     os macosx? cpu x86.64? or [ 16 align ] when ;
 
 M: x86 stack-frame-size ( stack-frame -- i )
-    (stack-frame-size) 3 cells reserved-area-size + + align-stack ;
+    [ (stack-frame-size) ]
+    [ extra-stack-space ] bi +
+    reserved-stack-space +
+    3 cells +
+    align-stack ;
 
 ! Must be a volatile register not used for parameter passing, for safe
 ! use in calls in and out of C

basis/help/handbook/handbook-tests.factor

@@ -4,5 +4,4 @@ IN: help.handbook.tests
 [ ] [ "article-index" print-topic ] unit-test
 [ ] [ "primitive-index" print-topic ] unit-test
 [ ] [ "error-index" print-topic ] unit-test
-[ ] [ "type-index" print-topic ] unit-test
 [ ] [ "class-index" print-topic ] unit-test

basis/help/handbook/handbook.factor

@@ -239,9 +239,6 @@ ARTICLE: "primitive-index" "Primitive index"
 ARTICLE: "error-index" "Error index"
 { $index [ all-errors ] } ;
 
-ARTICLE: "type-index" "Type index"
-{ $index [ builtins get sift ] } ;
-
 ARTICLE: "class-index" "Class index"
 { $heading "Built-in classes" }
 { $index [ classes [ builtin-class? ] filter ] }
@@ -387,7 +384,6 @@ ARTICLE: "handbook" "Factor handbook"
     "article-index"
     "primitive-index"
     "error-index"
-    "type-index"
     "class-index"
 }
 { $heading "Explore the code base" }

basis/math/vectors/vectors.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays alien.c-types assocs kernel sequences math math.functions
-hints math.order math.libm fry combinators byte-arrays accessors
+hints math.order math.libm math.floats.private fry combinators
-locals ;
+byte-arrays accessors locals ;
 QUALIFIED-WITH: alien.c-types c
 IN: math.vectors
 
@@ -29,8 +29,16 @@ M: object element-type drop f ; inline
 : [v-] ( u v -- w ) [ [-] ] 2map ;
 : v*   ( u v -- w ) [ * ] 2map ;
 : v/   ( u v -- w ) [ / ] 2map ;
-: vmax ( u v -- w ) [ max ] 2map ;
+
-: vmin ( u v -- w ) [ min ] 2map ;
+<PRIVATE
+
+: if-both-floats ( x y p q -- )
+    [ 2dup [ float? ] both? ] 2dip if ; inline
+
+PRIVATE>
+
+: vmax ( u v -- w ) [ [ float-max ] [ max ] if-both-floats ] 2map ;
+: vmin ( u v -- w ) [ [ float-min ] [ min ] if-both-floats ] 2map ;
 
 : v+- ( u v -- w )
     [ t ] 2dip

basis/specialized-arrays/specialized-arrays-tests.factor

@@ -122,10 +122,6 @@ SPECIALIZED-ARRAY: fixed-string
 ! If the C type doesn't exist, don't generate a vocab
 SYMBOL: __does_not_exist__
 
-[ ] [
-    [ __does_not_exist__ specialized-array-vocab forget-vocab ] with-compilation-unit
-] unit-test
-
 [
     """
 IN: specialized-arrays.tests
@@ -151,4 +147,9 @@ SPECIALIZED-ARRAY: __does_not_exist__
     deferred?
 ] unit-test
 
-[ \ __does_not_exist__ forget ] with-compilation-unit
+[ ] [
+    [
+        \ __does_not_exist__ forget
+        __does_not_exist__ specialized-array-vocab forget-vocab
+    ] with-compilation-unit
+] unit-test

extra/ui/gadgets/controls/controls.factor

@@ -1,7 +1,7 @@
 USING: accessors assocs arrays kernel models monads sequences
 models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.buttons.private ui.gadgets.editors words images.loader
+ui.gadgets.buttons.private ui.gadgets.editors ui.gadgets.editors.private
-ui.gadgets.scrollers ui.images vocabs.parser lexer
+words images.loader ui.gadgets.scrollers ui.images vocabs.parser lexer
 models.range ui.gadgets.sliders ;
 QUALIFIED-WITH: ui.gadgets.sliders slider
 QUALIFIED-WITH: ui.gadgets.tables tbl