Merge branch 'master' of git://factorcode.org/git/factor

basis/cpu/ppc/ppc.factor

@@ -659,13 +659,40 @@ M: ppc %callback-value ( ctype -- )
 
 M: ppc small-enough? ( n -- ? ) -32768 32767 between? ;
 
-M: ppc return-struct-in-registers? ( c-type -- ? ) drop f ;
+M: ppc return-struct-in-registers? ( c-type -- ? )
+    c-type return-in-registers?>> ;
 
-M: ppc %box-small-struct
-    drop "No small structs" throw ;
+M: ppc %box-small-struct ( c-type -- )
+    #! Box a <= 16-byte struct returned in r3:r4:r5:r6
+    heap-size 7 LI
+    "box_medium_struct" f %alien-invoke ;
 
-M: ppc %unbox-small-struct
-    drop "No small structs" throw ;
+: %unbox-struct-1 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    3 3 0 LWZ ;
+
+: %unbox-struct-2 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    4 3 4 LWZ
+    3 3 0 LWZ ;
+
+: %unbox-struct-4 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    6 3 12 LWZ
+    5 3 8 LWZ
+    4 3 4 LWZ
+    3 3 0 LWZ ;
+
+M: ppc %unbox-small-struct ( size -- )
+    #! Alien must be in EAX.
+    heap-size cell align cell /i {
+        { 1 [ %unbox-struct-1 ] }
+        { 2 [ %unbox-struct-2 ] }
+        { 4 [ %unbox-struct-4 ] }
+    } case ;
 
 USE: vocabs.loader
 
@@ -673,3 +700,5 @@ USE: vocabs.loader
     { [ os macosx? ] [ "cpu.ppc.macosx" require ] }
     { [ os linux? ] [ "cpu.ppc.linux" require ] }
 } cond
+
+"complex-double" c-type t >>return-in-registers? drop

basis/models/models-docs.factor

@@ -5,12 +5,13 @@ IN: models
 HELP: model
 { $class-description "A mutable cell holding a single value. When the value is changed, a sequence of connected objects are notified. Models have the following slots:"
     { $list
-        { { $snippet "value" } " - the value of the model. Use " { $link set-model } " to change the value." }
-        { { $snippet "connections" } " - a sequence of objects implementing the " { $link model-changed } " generic word, to be notified when the model's value changes." }
-        { { $snippet "dependencies" } " - a sequence of models which should have this model added to their sequence of connections when activated." }
-        { { $snippet "ref" } " - a reference count tracking the number of models which depend on this one." }
+        { { $slot "value" } " - the value of the model. Use " { $link set-model } " to change the value." }
+        { { $slot "connections" } " - a sequence of objects implementing the " { $link model-changed } " generic word, to be notified when the model's value changes." }
+        { { $slot "dependencies" } " - a sequence of models which should have this model added to their sequence of connections when activated." }
+        { { $slot "ref" } " - a reference count tracking the number of models which depend on this one." }
+        { { $slot "locked?" } " - a slot set by " { $link with-locked-model } " to ensure that the model doesn't get changed recursively" }
     }
-"Other classes may delegate to " { $link model } "."
+"Other classes may inherit from " { $link model } "."
 } ;
 
 HELP: <model>

basis/regexp/compiler/compiler.factor

@@ -84,21 +84,24 @@ C: <box> box
     { } assoc-like [ first integer? ] partition
     [ [ literals>cases ] keep ] dip non-literals>dispatch ;
 
-:: step ( last-match index str quot final? direction -- last-index/f )
+: advance ( index backwards? -- index+/-1 )
+    -1 1 ? + >fixnum ; inline
+
+: check ( index string backwards? -- in-bounds? )
+    [ drop -1 eq? not ] [ length < ] if ; inline
+
+:: step ( last-match index str quot final? backwards? -- last-index/f )
     final? index last-match ?
-    index str bounds-check? [
-        index direction + str
+    index str backwards? check [
+        index backwards? advance str
         index str nth-unsafe
         quot call
     ] when ; inline
 
-: direction ( -- n )
-    backwards? get -1 1 ? ;
-
 : transitions>quot ( transitions final-state? -- quot )
     dup shortest? get and [ 2drop [ drop nip ] ] [
-        [ split-literals swap case>quot ] dip direction
-        '[ { array-capacity string } declare _ _ _ step ]
+        [ split-literals swap case>quot ] dip backwards? get
+        '[ { fixnum string } declare _ _ _ step ]
     ] if ;
 
 : word>quot ( word dfa -- quot )
@@ -122,10 +125,13 @@ C: <box> box
 : dfa>main-word ( dfa -- word )
     states>words [ states>code ] keep start-state>> ;
 
+: word-template ( quot -- quot' )
+    '[ drop [ f ] 2dip over array-capacity? _ [ 2drop ] if ] ;
+
 PRIVATE>
 
 : dfa>word ( dfa -- quot )
-    dfa>main-word execution-quot '[ drop [ f ] 2dip @ ]
+    dfa>main-word execution-quot word-template
     (( start-index string regexp -- i/f )) define-temp ;
 
 : dfa>shortest-word ( dfa -- word )

core/syntax/syntax.factor

@@ -138,7 +138,7 @@ IN: bootstrap.syntax
     ] define-core-syntax
 
     "CONSTANT:" [
-        CREATE scan-object define-constant
+        CREATE-WORD scan-object define-constant
     ] define-core-syntax
 
     ":" [

core/words/alias/alias-tests.factor

@@ -0,0 +1,6 @@
+USING: math eval tools.test effects ;
+IN: words.alias.tests
+
+ALIAS: foo +
+[ ] [ "IN: words.alias.tests CONSTANT: foo 5" eval ] unit-test
+[ (( -- value )) ] [ \ foo stack-effect ] unit-test

vm/alien.c

@@ -160,7 +160,7 @@ void box_value_struct(void *src, CELL size)
 	dpush(tag_object(array));
 }
 
-/* On OS X, structs <= 8 bytes are returned in registers. */
+/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
 void box_small_struct(CELL x, CELL y, CELL size)
 {
 	CELL data[2];
@@ -169,6 +169,17 @@ void box_small_struct(CELL x, CELL y, CELL size)
 	box_value_struct(data,size);
 }
 
+/* On OS X/PPC, complex numbers are returned in registers. */
+void box_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);
+}
+
 /* open a native library and push a handle */
 void primitive_dlopen(void)
 {

vm/alien.h

@@ -40,6 +40,7 @@ void primitive_set_alien_cell(void);
 DLLEXPORT void to_value_struct(CELL src, void *dest, CELL size);
 DLLEXPORT void box_value_struct(void *src, CELL size);
 DLLEXPORT void box_small_struct(CELL x, CELL y, CELL size);
+void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size);
 
 DEFINE_UNTAG(F_DLL,DLL_TYPE,dll)