From 5a903d7bcd935efab6134f74e60a845ed13346cb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 29 Mar 2009 22:46:27 -0500 Subject: [PATCH 1/4] Fix a bug in CONSTANT: -- it wasn't calling reset-word --- core/syntax/syntax.factor | 2 +- core/words/alias/alias-tests.factor | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) create mode 100644 core/words/alias/alias-tests.factor diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index bcf9decdf3..cb5cdfd5ac 100644 --- a/core/syntax/syntax.factor +++ b/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 ":" [ diff --git a/core/words/alias/alias-tests.factor b/core/words/alias/alias-tests.factor new file mode 100644 index 0000000000..0278a4d4b9 --- /dev/null +++ b/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 \ No newline at end of file From 5ecff284effd254bacd6498dc13cb7997de37d77 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 29 Mar 2009 22:57:13 -0500 Subject: [PATCH 2/4] Fixing regexp compiler's bounds checks --- basis/regexp/compiler/compiler.factor | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/basis/regexp/compiler/compiler.factor b/basis/regexp/compiler/compiler.factor index 6c7896dcca..5482734865 100644 --- a/basis/regexp/compiler/compiler.factor +++ b/basis/regexp/compiler/compiler.factor @@ -84,21 +84,24 @@ C: 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 : 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 ) From bd91ac56cebf4166cda3ba66728f4e697bfef9f4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 29 Mar 2009 23:13:30 -0500 Subject: [PATCH 3/4] Fix model docs --- basis/models/models-docs.factor | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/models/models-docs.factor b/basis/models/models-docs.factor index 82dd035467..2b90bdb0d5 100644 --- a/basis/models/models-docs.factor +++ b/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: From 42d164db7709f8f0fa125fb17b95df1cd6e37425 Mon Sep 17 00:00:00 2001 From: sheeple Date: Mon, 30 Mar 2009 07:19:14 -0500 Subject: [PATCH 4/4] Fix C99 complex number support in FFI on Mac OS X/PPC --- basis/cpu/ppc/ppc.factor | 39 ++++++++++++++++++++++++++++++++++----- vm/alien.c | 13 ++++++++++++- vm/alien.h | 1 + 3 files changed, 47 insertions(+), 6 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 8b6b4fbb11..85bf188bb8 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/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 diff --git a/vm/alien.c b/vm/alien.c index 8b7df45e9a..2681579c5d 100755 --- a/vm/alien.c +++ b/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) { diff --git a/vm/alien.h b/vm/alien.h index ec1eb08acf..dc76d49810 100755 --- a/vm/alien.h +++ b/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)