From 028e0075d8b4dcf3a7e14084e4a9bc1fbd52a622 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Jan 2008 01:33:40 -0500 Subject: [PATCH 1/7] PowerPC support work in progress --- core/compiler/compiler.factor | 2 +- core/compiler/errors/errors.factor | 4 ++- core/cpu/ppc/architecture/architecture.factor | 33 ++++--------------- core/cpu/ppc/bootstrap.factor | 2 +- core/cpu/ppc/intrinsics/intrinsics.factor | 2 +- core/cpu/ppc/ppc.factor | 2 -- vm/callstack.c | 3 +- vm/code_heap.c | 6 ++-- vm/code_heap.h | 2 +- vm/factor.c | 2 +- vm/profiler.c | 2 +- vm/quotations.c | 11 +++---- vm/quotations.h | 2 +- vm/types.c | 2 +- 14 files changed, 27 insertions(+), 48 deletions(-) diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 0be3aa5362..e83fbd925c 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -57,7 +57,7 @@ compiled-crossref global [ H{ } assoc-like ] change-at ] computing-dependencies ; : compile-failed ( word error -- ) - dup inference-error? [ rethrow ] unless + ! dup inference-error? [ rethrow ] unless f pick compiled get set-at swap compiler-error ; diff --git a/core/compiler/errors/errors.factor b/core/compiler/errors/errors.factor index 106b69893b..c53937b9d9 100755 --- a/core/compiler/errors/errors.factor +++ b/core/compiler/errors/errors.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces assocs prettyprint io sequences sorting continuations debugger math ; @@ -24,6 +24,8 @@ SYMBOL: with-compiler-errors? GENERIC: compiler-warning? ( error -- ? ) +M: object compiler-warning? drop f ; + : (:errors) ( -- assoc ) compiler-errors get-global [ nip compiler-warning? not ] assoc-subset ; diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index 8bd9ca505d..e93d092b10 100755 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/core/cpu/ppc/architecture/architecture.factor @@ -3,7 +3,8 @@ USING: alien.c-types cpu.ppc.assembler cpu.architecture generic kernel kernel.private math memory namespaces sequences words assocs generator generator.registers generator.fixup system -layouts classes words.private alien combinators ; +layouts classes words.private alien combinators +compiler.constants ; IN: cpu.ppc.architecture TUPLE: ppc-backend ; @@ -37,7 +38,7 @@ TUPLE: ppc-backend ; : local@ ( n -- x ) reserved-area-size param-save-size + + ; inline -: factor-area-size 4 cells ; +: factor-area-size 2 cells ; : next-save ( n -- i ) cell - ; @@ -77,7 +78,7 @@ M: ppc-backend load-indirect ( obj reg -- ) dup 0 LWZ ; M: ppc-backend %save-word-xt ( -- ) - 0 11 LOAD32 rc-absolute-ppc-2/2 rel-current-word ; + 0 11 LOAD32 rc-absolute-ppc-2/2 rel-this ; M: ppc-backend %prologue ( n -- ) 0 MFLR @@ -99,35 +100,15 @@ M: ppc-backend %epilogue ( n -- ) : %load-dlsym ( symbol dll register -- ) 0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ; -M: ppc-backend %profiler-prologue ( word -- ) - 3 load-indirect - 4 3 profile-count-offset LWZ - 4 4 1 v>operand ADDI - 4 3 profile-count-offset STW ; - M: ppc-backend %call-label ( label -- ) BL ; M: ppc-backend %jump-label ( label -- ) B ; -: %prepare-primitive ( word -- ) - #! Save stack pointer to stack_chain->callstack_top, load XT - 4 1 MR - 0 11 LOAD32 - rc-absolute-ppc-2/2 rel-word ; - -: (%call) 11 MTLR BLRL ; - -M: ppc-backend %call-primitive ( word -- ) - %prepare-primitive (%call) ; - -: (%jump) 11 MTCTR BCTR ; - -M: ppc-backend %jump-primitive ( word -- ) - %prepare-primitive (%jump) ; - M: ppc-backend %jump-t ( label -- ) 0 "flag" operand f v>operand CMPI BNE ; +: (%call) 11 MTLR BLRL ; + : dispatch-template ( word-table# quot -- ) [ >r @@ -145,7 +126,7 @@ M: ppc-backend %call-dispatch ( word-table# -- ) [ (%call) ] dispatch-template ; M: ppc-backend %jump-dispatch ( word-table# -- ) - [ %epilogue-later (%jump) ] dispatch-template ; + [ %epilogue-later 11 MTCTR BCTR ] dispatch-template ; M: ppc-backend %return ( -- ) %epilogue-later BLR ; diff --git a/core/cpu/ppc/bootstrap.factor b/core/cpu/ppc/bootstrap.factor index 616f77c3da..dcaee7290a 100755 --- a/core/cpu/ppc/bootstrap.factor +++ b/core/cpu/ppc/bootstrap.factor @@ -29,7 +29,7 @@ big-endian on temp-reg dup 0 LWZ ! Bump profiling counter aux-reg temp-reg profile-count-offset LWZ - aux-reg dup 1 tag-fixnum ADD + aux-reg dup 1 tag-fixnum ADDI aux-reg temp-reg profile-count-offset STW ! Load word->code aux-reg temp-reg word-code-offset LWZ diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index e1d86db178..86db66a61f 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -8,7 +8,7 @@ generator generator.registers generator.fixup sequences.private sbufs vectors system layouts math.floats.private classes tuples tuples.private sbufs.private vectors.private strings.private slots.private combinators bit-arrays -float-arrays ; +float-arrays compiler.constants ; IN: cpu.ppc.intrinsics : %slot-literal-known-tag diff --git a/core/cpu/ppc/ppc.factor b/core/cpu/ppc/ppc.factor index 0c677cbe51..901b339d7e 100755 --- a/core/cpu/ppc/ppc.factor +++ b/core/cpu/ppc/ppc.factor @@ -13,5 +13,3 @@ namespaces alien.c-types kernel system combinators ; } cond T{ ppc-backend } compiler-backend set-global - -6 cells profiler-prologue set-global diff --git a/vm/callstack.c b/vm/callstack.c index 762dabe07e..25219d1569 100755 --- a/vm/callstack.c +++ b/vm/callstack.c @@ -216,8 +216,7 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot) REGISTER_UNTAGGED(callstack); REGISTER_UNTAGGED(quot); - if(quot->compiledp == F) - jit_compile(tag_object(quot)); + jit_compile(tag_object(quot),true); UNREGISTER_UNTAGGED(quot); UNREGISTER_UNTAGGED(callstack); diff --git a/vm/code_heap.c b/vm/code_heap.c index ecce29229f..7cfdffe8ca 100755 --- a/vm/code_heap.c +++ b/vm/code_heap.c @@ -303,10 +303,10 @@ void set_word_code(F_WORD *word, F_COMPILED *compiled) } /* Allocates memory */ -void default_word_code(F_WORD *word) +void default_word_code(F_WORD *word, bool relocate) { REGISTER_UNTAGGED(word); - jit_compile(word->def); + jit_compile(word->def,relocate); UNREGISTER_UNTAGGED(word); word->code = untag_quotation(word->def)->code; @@ -336,7 +336,7 @@ DEFINE_PRIMITIVE(modify_code_heap) { REGISTER_UNTAGGED(alist); REGISTER_UNTAGGED(word); - default_word_code(word); + default_word_code(word,false); UNREGISTER_UNTAGGED(word); UNREGISTER_UNTAGGED(alist); } diff --git a/vm/code_heap.h b/vm/code_heap.h index e741cf1a75..c8e41d3fbe 100755 --- a/vm/code_heap.h +++ b/vm/code_heap.h @@ -56,7 +56,7 @@ typedef struct { void relocate_code_block(F_COMPILED *relocating, CELL code_start, CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end); -void default_word_code(F_WORD *word); +void default_word_code(F_WORD *word, bool relocate); void set_word_code(F_WORD *word, F_COMPILED *compiled); diff --git a/vm/factor.c b/vm/factor.c index d8fdad4dfd..0754067b95 100755 --- a/vm/factor.c +++ b/vm/factor.c @@ -44,7 +44,7 @@ void do_stage1_init(void) if(type_of(obj) == WORD_TYPE) { F_WORD *word = untag_object(obj); - default_word_code(word); + default_word_code(word,false); update_word_xt(word); } } diff --git a/vm/profiler.c b/vm/profiler.c index 402f7e2a0d..f9dbda860a 100755 --- a/vm/profiler.c +++ b/vm/profiler.c @@ -13,7 +13,7 @@ F_COMPILED *compile_profiling_stub(F_WORD *word) CELL rel_type = allot_cell(to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8)); - CELL rel_offset = array_nth(quadruple,3); + CELL rel_offset = array_nth(quadruple,3) * compiled_code_format(); CELL relocation = allot_array_2(rel_type,rel_offset); diff --git a/vm/quotations.c b/vm/quotations.c index b1948fa8a8..1e3fa8a47a 100755 --- a/vm/quotations.c +++ b/vm/quotations.c @@ -52,7 +52,7 @@ F_REL rel_to_emit(CELL name, CELL code_format, CELL code_length, rel.type = to_fixnum(rel_type) | (to_fixnum(rel_class) << 8) | (rel_argument << 16); - rel.offset = code_length * code_format + to_fixnum(offset); + rel.offset = (code_length + to_fixnum(offset)) * code_format; } return rel; @@ -95,7 +95,7 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code) } /* Might GC */ -void jit_compile(CELL quot) +void jit_compile(CELL quot, bool relocate) { if(untag_quotation(quot)->compiledp != F) return; @@ -230,11 +230,10 @@ void jit_compile(CELL quot) untag_object(words), untag_object(literals)); - /* We must do this before relocate_code_block(), so that - relocation knows the quotation's XT. */ set_quot_xt(untag_object(quot),compiled); - iterate_code_heap_step(compiled,relocate_code_block); + if(relocate) + iterate_code_heap_step(compiled,relocate_code_block); UNREGISTER_ROOT(words); UNREGISTER_ROOT(literals); @@ -352,7 +351,7 @@ F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack) { stack_chain->callstack_top = stack; REGISTER_ROOT(quot); - jit_compile(quot); + jit_compile(quot,true); UNREGISTER_ROOT(quot); return quot; } diff --git a/vm/quotations.h b/vm/quotations.h index 0466ff1f9b..d975d9e0f5 100755 --- a/vm/quotations.h +++ b/vm/quotations.h @@ -1,5 +1,5 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code); -void jit_compile(CELL quot); +void jit_compile(CELL quot, bool relocate); F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack); F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset); void uncurry(CELL obj); diff --git a/vm/types.c b/vm/types.c index 70d754caea..d70c1623f4 100755 --- a/vm/types.c +++ b/vm/types.c @@ -511,7 +511,7 @@ F_WORD *allot_word(CELL vocab, CELL name) word->profiling = NULL; REGISTER_UNTAGGED(word); - default_word_code(word); + default_word_code(word,true); UNREGISTER_UNTAGGED(word); REGISTER_UNTAGGED(word); From 2e19bdae2d34581cb3e2d73ec388d6609b878b5c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Jan 2008 01:33:51 -0500 Subject: [PATCH 2/7] Pastebin RSS feed: limit number of posts --- extra/webapps/pastebin/pastebin.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index 0a7dc559c3..9492e9e5a1 100755 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -57,8 +57,11 @@ C: annotation : paste-link ( paste -- link ) paste-n number>string [ show-paste ] curry quot-link ; +: safe-head ( seq n -- seq' ) + over length min head ; + : paste-feed ( -- entries ) - get-pastebin pastebin-pastes [ + get-pastebin pastebin-pastes 20 safe-head [ { paste-summary paste-link From 731549bdcb721992a926150f59335c1f15690dc1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Jan 2008 01:34:04 -0500 Subject: [PATCH 3/7] new-slots: define change-* combinators --- extra/new-slots/new-slots.factor | 40 +++++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 11 deletions(-) diff --git a/extra/new-slots/new-slots.factor b/extra/new-slots/new-slots.factor index 8d6fa2c498..0f411f3e88 100755 --- a/extra/new-slots/new-slots.factor +++ b/extra/new-slots/new-slots.factor @@ -1,33 +1,51 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: effects words kernel sequences slots slots.private -assocs parser mirrors ; +assocs parser mirrors namespaces math vocabs ; IN: new-slots -: reader-effect T{ effect f 1 1 } ; inline - -: writer-effect T{ effect f 2 0 } ; inline - : create-accessor ( name effect -- word ) >r "accessors" create dup r> "declared-effect" set-word-prop ; +: reader-effect T{ effect f { "object" } { "value" } } ; inline + : reader-word ( name -- word ) ">>" append reader-effect create-accessor ; -: writer-word ( name -- word ) - ">>" swap append writer-effect create-accessor ; - : define-reader ( class slot name -- ) reader-word [ slot ] define-slot-word ; +: writer-effect T{ effect f { "value" "object" } { } } ; inline + +: writer-word ( name -- word ) + ">>" swap append writer-effect create-accessor ; + : define-writer ( class slot name -- ) writer-word [ set-slot ] define-slot-word ; +: changer-effect T{ effect f { "object" "quot" } } ; inline + +: changer-word ( name -- word ) + "change-" swap append changer-effect create-accessor ; + +: define-changer ( name -- ) + dup changer-word dup deferred? [ + [ + [ over >r >r ] % + over reader-word , + [ r> call r> ] % + swap writer-word , + ] [ ] make define + ] [ 2drop ] if ; + +: define-new-slot ( class slot name -- ) + dup define-changer 3dup define-reader define-writer ; + : define-new-slots ( tuple-class -- ) [ "slot-names" word-prop >alist ] keep - [ - swap first2 >r 2 + r> 3dup define-reader define-writer - ] curry each ; + [ swap first2 >r 4 + r> define-new-slot ] curry each ; : NEW-SLOTS: scan-word define-new-slots ; parsing + +"accessors" create-vocab drop From fa72e695a4523dd9bc2119c0ad235018b5f93869 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Jan 2008 01:35:28 -0500 Subject: [PATCH 4/7] Fix tpo --- core/vocabs/vocabs-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/vocabs/vocabs-docs.factor b/core/vocabs/vocabs-docs.factor index 5734dcf426..a802ff7e10 100644 --- a/core/vocabs/vocabs-docs.factor +++ b/core/vocabs/vocabs-docs.factor @@ -42,7 +42,7 @@ HELP: vocabs { $description "Outputs a sequence of all defined vocabulary names." } ; HELP: vocab -{ $values { "name" string } { "vocab" vocab } } +{ $values { "vocab-spec" "a vocabulary specifier" } { "vocab" vocab } } { $description "Outputs a named vocabulary, or " { $link f } " if no vocabulary with this name exists." } { $class-description "Instances represent vocabularies." } ; From 005319da1ad432ee19edb52183e2af305be232ea Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Jan 2008 01:36:11 -0500 Subject: [PATCH 5/7] Load fixes for Mac OS X-related libraries --- extra/bootstrap/ui/tools/tools.factor | 2 - .../cocoa/application/application-docs.factor | 17 ++++- extra/cocoa/application/application.factor | 4 ++ extra/cocoa/cocoa-docs.factor | 15 +---- extra/cocoa/cocoa-tests.factor | 6 +- extra/cocoa/cocoa.factor | 63 +++++++++---------- extra/cocoa/dialogs/dialogs-docs.factor | 3 +- extra/cocoa/messages/messages-docs.factor | 3 +- extra/cocoa/messages/messages.factor | 4 +- extra/cocoa/nibs/nibs-docs.factor | 3 +- extra/cocoa/pasteboard/pasteboard-docs.factor | 3 +- .../cocoa/subclassing/subclassing-docs.factor | 4 +- extra/cocoa/subclassing/subclassing.factor | 15 +++-- extra/cocoa/types/types-docs.factor | 3 +- extra/cocoa/views/views-docs.factor | 3 +- extra/cocoa/windows/windows-docs.factor | 3 +- .../core-foundation-docs.factor | 4 +- .../parser-combinators-docs.factor | 3 +- extra/tools/profiler/profiler-docs.factor | 10 +-- 19 files changed, 87 insertions(+), 81 deletions(-) diff --git a/extra/bootstrap/ui/tools/tools.factor b/extra/bootstrap/ui/tools/tools.factor index 9dde428e72..af715966b3 100644 --- a/extra/bootstrap/ui/tools/tools.factor +++ b/extra/bootstrap/ui/tools/tools.factor @@ -8,5 +8,3 @@ USING: kernel vocabs vocabs.loader sequences system ; "ui.cocoa.tools" require ] when ] when - -macosx? [ "ui.tools.deploy" require ] when diff --git a/extra/cocoa/application/application-docs.factor b/extra/cocoa/application/application-docs.factor index edca5ca70e..ad2f8ffbd9 100644 --- a/extra/cocoa/application/application-docs.factor +++ b/extra/cocoa/application/application-docs.factor @@ -1,5 +1,18 @@ -USING: cocoa.application debugger quotations help.markup -help.syntax strings alien core-foundation ; +USING: debugger quotations help.markup help.syntax strings alien +core-foundation ; +IN: cocoa.application + +HELP: +{ $values { "str" string } { "alien" alien } } +{ $description "Allocates an autoreleased " { $snippet "CFString" } "." } ; + +{ CF>string } related-words + +HELP: +{ $values { "seq" "a sequence of " { $link alien } " instances" } { "alien" alien } } +{ $description "Allocates an autoreleased " { $snippet "CFArray" } "." } ; + +{ } related-words HELP: with-autorelease-pool { $values { "quot" quotation } } diff --git a/extra/cocoa/application/application.factor b/extra/cocoa/application/application.factor index 43df84f4aa..709d318e63 100644 --- a/extra/cocoa/application/application.factor +++ b/extra/cocoa/application/application.factor @@ -5,6 +5,10 @@ cocoa cocoa.classes cocoa.runtime sequences threads debugger init inspector kernel.private ; IN: cocoa.application +: ( str -- alien ) -> autorelease ; + +: ( seq -- alien ) -> autorelease ; + : NSApplicationDelegateReplySuccess 0 ; : NSApplicationDelegateReplyCancel 1 ; : NSApplicationDelegateReplyFailure 2 ; diff --git a/extra/cocoa/cocoa-docs.factor b/extra/cocoa/cocoa-docs.factor index b2da1c93be..30602db40b 100644 --- a/extra/cocoa/cocoa-docs.factor +++ b/extra/cocoa/cocoa-docs.factor @@ -1,5 +1,6 @@ -USING: cocoa cocoa.messages help.markup help.syntax strings +USING: cocoa.messages help.markup help.syntax strings alien core-foundation ; +IN: cocoa HELP: -> { $syntax "-> selector" } @@ -15,18 +16,6 @@ HELP: SUPER-> { send super-send POSTPONE: -> POSTPONE: SUPER-> } related-words -HELP: -{ $values { "str" string } { "alien" alien } } -{ $description "Allocates an autoreleased " { $snippet "CFString" } "." } ; - -{ CF>string } related-words - -HELP: -{ $values { "seq" "a sequence of " { $link alien } " instances" } { "alien" alien } } -{ $description "Allocates an autoreleased " { $snippet "CFArray" } "." } ; - -{ } related-words - ARTICLE: "objc-calling" "Calling Objective C code" "Before an Objective C class can be used, it must be imported; by default, a small set of common classes are imported automatically, but additional classes can be imported as needed." { $subsection import-objc-class } diff --git a/extra/cocoa/cocoa-tests.factor b/extra/cocoa/cocoa-tests.factor index 03e3ebe445..1f94c051b7 100644 --- a/extra/cocoa/cocoa-tests.factor +++ b/extra/cocoa/cocoa-tests.factor @@ -12,8 +12,6 @@ CLASS: { [ data-gc "x" set 2drop ] } ; -recompile - : test-foo Foo -> alloc -> init dup 1.0 2.0 101.0 102.0 -> foo: @@ -36,13 +34,11 @@ CLASS: { [ 2drop test-foo "x" get ] } ; -recompile - Bar [ -> alloc -> init dup -> bar "x" set -> release -] compile-1 +] compile-call [ 1 ] [ "x" get NSRect-x ] unit-test [ 2 ] [ "x" get NSRect-y ] unit-test diff --git a/extra/cocoa/cocoa.factor b/extra/cocoa/cocoa.factor index 60fb0c7e15..387da32549 100755 --- a/extra/cocoa/cocoa.factor +++ b/extra/cocoa/cocoa.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: compiler io kernel cocoa.runtime cocoa.subclassing cocoa.messages cocoa.types sequences words vocabs parser -core-foundation namespaces assocs hashtables ; +core-foundation namespaces assocs hashtables definitions ; IN: cocoa : (remember-send) ( selector variable -- ) @@ -32,37 +32,36 @@ SYMBOL: super-sent-messages { "cocoa" "cocoa.runtime" "cocoa.messages" "cocoa.subclassing" -} [ words ] map concat compile-batch +} [ words ] map concat compile "Importing Cocoa classes..." print -{ - "NSApplication" - "NSArray" - "NSAutoreleasePool" - "NSBundle" - "NSError" - "NSEvent" - "NSException" - "NSMenu" - "NSMenuItem" - "NSNib" - "NSNotification" - "NSNotificationCenter" - "NSObject" - "NSOpenGLContext" - "NSOpenGLPixelFormat" - "NSOpenGLView" - "NSOpenPanel" - "NSPasteboard" - "NSResponder" - "NSSavePanel" - "NSView" - "NSWindow" - "NSWorkspace" -} [ - [ ] import-objc-class -] each -: ( str -- alien ) -> autorelease ; - -: ( seq -- alien ) -> autorelease ; +[ + { + "NSApplication" + "NSArray" + "NSAutoreleasePool" + "NSBundle" + "NSError" + "NSEvent" + "NSException" + "NSMenu" + "NSMenuItem" + "NSNib" + "NSNotification" + "NSNotificationCenter" + "NSObject" + "NSOpenGLContext" + "NSOpenGLPixelFormat" + "NSOpenGLView" + "NSOpenPanel" + "NSPasteboard" + "NSResponder" + "NSSavePanel" + "NSView" + "NSWindow" + "NSWorkspace" + } [ + [ ] import-objc-class + ] each +] with-compilation-unit diff --git a/extra/cocoa/dialogs/dialogs-docs.factor b/extra/cocoa/dialogs/dialogs-docs.factor index 5f14282cf2..798d8aa135 100644 --- a/extra/cocoa/dialogs/dialogs-docs.factor +++ b/extra/cocoa/dialogs/dialogs-docs.factor @@ -1,4 +1,5 @@ -USING: cocoa.dialogs help.markup help.syntax ; +USING: help.markup help.syntax ; +IN: cocoa.dialogs HELP: { $values { "panel" "an " { $snippet "NSOpenPanel" } } } diff --git a/extra/cocoa/messages/messages-docs.factor b/extra/cocoa/messages/messages-docs.factor index 6a36ee761c..f78981c923 100644 --- a/extra/cocoa/messages/messages-docs.factor +++ b/extra/cocoa/messages/messages-docs.factor @@ -1,4 +1,5 @@ -USING: cocoa.messages help.markup help.syntax strings alien ; +USING: help.markup help.syntax strings alien ; +IN: cocoa.messages HELP: send { $values { "args..." "method arguments" } { "receiver" alien } { "selector" string } { "return..." "value returned by method, if any" } } diff --git a/extra/cocoa/messages/messages.factor b/extra/cocoa/messages/messages.factor index 54ddbaa0cf..dcf499304b 100755 --- a/extra/cocoa/messages/messages.factor +++ b/extra/cocoa/messages/messages.factor @@ -16,7 +16,7 @@ IN: cocoa.messages : sender-stub ( method function -- word ) [ sender-stub-name f dup ] 2keep over first large-struct? [ "_stret" append ] when - make-sender define-compound dup compile ; + make-sender define ; SYMBOL: message-senders SYMBOL: super-message-senders @@ -196,7 +196,7 @@ H{ : define-objc-class-word ( name quot -- ) [ over , , \ unless-defined , dup , \ objc-class , - ] [ ] make >r "cocoa.classes" create r> define-compound ; + ] [ ] make >r "cocoa.classes" create r> define ; : import-objc-class ( name quot -- ) 2dup unless-defined diff --git a/extra/cocoa/nibs/nibs-docs.factor b/extra/cocoa/nibs/nibs-docs.factor index a6972016a7..ff53cb0b58 100644 --- a/extra/cocoa/nibs/nibs-docs.factor +++ b/extra/cocoa/nibs/nibs-docs.factor @@ -1,4 +1,5 @@ -USING: help.markup help.syntax cocoa.nibs strings ; +USING: help.markup help.syntax strings ; +IN: cocoa.nibs HELP: load-nib { $values { "name" string } } diff --git a/extra/cocoa/pasteboard/pasteboard-docs.factor b/extra/cocoa/pasteboard/pasteboard-docs.factor index afd5ea2020..ca64b1e136 100644 --- a/extra/cocoa/pasteboard/pasteboard-docs.factor +++ b/extra/cocoa/pasteboard/pasteboard-docs.factor @@ -1,4 +1,5 @@ -USING: cocoa.pasteboard help.markup help.syntax strings ; +USING: help.markup help.syntax strings ; +IN: cocoa.pasteboard HELP: pasteboard-string? { $values { "pasteboard" "an " { $snippet "NSPasteBoard" } } { "?" "a boolean" } } diff --git a/extra/cocoa/subclassing/subclassing-docs.factor b/extra/cocoa/subclassing/subclassing-docs.factor index b3c22b12bc..6924777d3d 100644 --- a/extra/cocoa/subclassing/subclassing-docs.factor +++ b/extra/cocoa/subclassing/subclassing-docs.factor @@ -1,5 +1,5 @@ -USING: cocoa.subclassing help.markup help.syntax strings alien -hashtables ; +USING: help.markup help.syntax strings alien hashtables ; +IN: cocoa.subclassing HELP: define-objc-class { $values { "hash" hashtable } { "imeth" "a sequence of instance method definitions" } } diff --git a/extra/cocoa/subclassing/subclassing.factor b/extra/cocoa/subclassing/subclassing.factor index d918bf29ca..f4d51b19d4 100755 --- a/extra/cocoa/subclassing/subclassing.factor +++ b/extra/cocoa/subclassing/subclassing.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays assocs combinators compiler hashtables kernel libc math namespaces parser sequences words -cocoa.messages cocoa.runtime ; +cocoa.messages cocoa.runtime definitions ; IN: cocoa.subclassing : init-method ( method alien -- ) @@ -86,7 +86,9 @@ IN: cocoa.subclassing ] [ ] make define-temp ; : prepare-methods ( methods -- methods ) - [ first4 prepare-method 3array ] map ; + [ + [ first4 prepare-method 3array ] map + ] with-compilation-unit ; : redefine-objc-methods ( imeth name -- ) dup class-exists? [ @@ -102,16 +104,13 @@ SYMBOL: +superclass+ : define-objc-class ( imeth hash -- ) clone [ prepare-methods + +name+ get "cocoa.classes" create drop +name+ get 2dup redefine-objc-methods swap [ +protocols+ get , +superclass+ get , +name+ get , , \ (define-objc-class) , ] [ ] make import-objc-class ] bind ; -: define-objc-class-early ( hash -- ) - +name+ swap at "cocoa.classes" create drop ; - : CLASS: - parse-definition unclip >r parsed r> - >hashtable dup define-objc-class-early parsed - \ define-objc-class parsed ; parsing + parse-definition unclip + >hashtable define-objc-class ; parsing diff --git a/extra/cocoa/types/types-docs.factor b/extra/cocoa/types/types-docs.factor index 7f53d5f78e..0c4b01a476 100644 --- a/extra/cocoa/types/types-docs.factor +++ b/extra/cocoa/types/types-docs.factor @@ -1,4 +1,5 @@ -USING: cocoa.types math help.markup help.syntax ; +USING: math help.markup help.syntax ; +IN: cocoa.types HELP: { $values { "x" real } { "y" real } { "w" real } { "h" real } { "rect" "an " { $snippet "NSRect" } } } diff --git a/extra/cocoa/views/views-docs.factor b/extra/cocoa/views/views-docs.factor index 7e844005e6..a1cd792436 100644 --- a/extra/cocoa/views/views-docs.factor +++ b/extra/cocoa/views/views-docs.factor @@ -1,4 +1,5 @@ -USING: cocoa.views help.syntax help.markup ; +USING: help.syntax help.markup ; +IN: cocoa.views HELP: { $values { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } } diff --git a/extra/cocoa/windows/windows-docs.factor b/extra/cocoa/windows/windows-docs.factor index 1cf49e38bb..39bd631b19 100644 --- a/extra/cocoa/windows/windows-docs.factor +++ b/extra/cocoa/windows/windows-docs.factor @@ -1,4 +1,5 @@ -USING: cocoa.windows help.markup help.syntax ; +USING: help.markup help.syntax ; +IN: cocoa.windows HELP: { $values { "rect" "an " { $snippet "NSRect" } } { "window" "an " { $snippet "NSWindow" } } } diff --git a/extra/core-foundation/core-foundation-docs.factor b/extra/core-foundation/core-foundation-docs.factor index 9914ffea19..ef8f5842a2 100644 --- a/extra/core-foundation/core-foundation-docs.factor +++ b/extra/core-foundation/core-foundation-docs.factor @@ -1,5 +1,5 @@ -USING: core-foundation alien strings arrays help.markup -help.syntax ; +USING: alien strings arrays help.markup help.syntax ; +IN: core-foundation HELP: CF>array { $values { "alien" "a " { $snippet "CFArray" } } { "array" "an array of " { $link alien } " instances" } } diff --git a/extra/parser-combinators/parser-combinators-docs.factor b/extra/parser-combinators/parser-combinators-docs.factor index 7b575e4da9..774069d5a5 100755 --- a/extra/parser-combinators/parser-combinators-docs.factor +++ b/extra/parser-combinators/parser-combinators-docs.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax parser-combinators ; +USING: help.markup help.syntax ; +IN: parser-combinators HELP: list-of { $values diff --git a/extra/tools/profiler/profiler-docs.factor b/extra/tools/profiler/profiler-docs.factor index feb6abbbb1..a8c700b490 100644 --- a/extra/tools/profiler/profiler-docs.factor +++ b/extra/tools/profiler/profiler-docs.factor @@ -3,13 +3,13 @@ quotations io strings words definitions ; IN: tools.profiler ARTICLE: "profiling" "Profiling code" -"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler. The profiler has three main limitations:" +"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler. The profiler is completely accurate with words which are compiled with the non-optimizing compiler. Some optimizations performed by the optimizing compiler can inhibit accurate call counting, however:" { $list - "Calls to primitives are not counted." - { "Calls to " { $link POSTPONE: inline } " words from words compiled with the optimizing compiler are not counted." } - "Certain types of tail-recursive words compiled with the optimizing compiler will only count the initial invocation of the word, not every tail call." + "The optimizing compiler open-codes certain primitives with inline machine code, and in some cases optimizes them out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations." + { "Calls to " { $link POSTPONE: inline } " words are not counted.." } + "Tail-recursive loops will only count the initial invocation of the word, not every tail call." } -"Quotations can be passed to a combinator which calls them with word call counting enabled:" +"Quotations can be passed to a combinator which calls them with the profiler enabled:" { $subsection profile } "After a quotation has been profiled, call counts can be presented in various ways:" { $subsection profile. } From 2180b0f146dd95ae306be3b47bea620e05cf4b96 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Jan 2008 01:50:25 -0500 Subject: [PATCH 6/7] Fix init-stdio scope issue --- core/io/streams/c/c.factor | 2 +- extra/io/unix/backend/backend.factor | 2 +- extra/io/windows/ce/backend/backend.factor | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index fe5ced95ce..61eea4ba7b 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -61,7 +61,7 @@ M: object init-io ; : stdout 12 getenv ; M: object init-stdio - stdin stdout stdio set ; + stdin stdout stdio set-global ; M: object io-multiplex (sleep) ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 76eeff74a9..3522a2218b 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -187,4 +187,4 @@ M: unix-io init-io ( -- ) ] bind ; M: unix-io init-stdio ( -- ) - 0 1 handle>duplex-stream stdio set ; + 0 1 handle>duplex-stream stdio set-global ; diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index b9ad30d910..142447fe0c 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -42,4 +42,4 @@ M: windows-ce-io init-stdio ( -- ) 0 _getstdfilex _fileno 1 _getstdfilex _fileno ] if - ] with-variable stdio set ; + ] with-variable stdio set-global ; From 4e2fbe4f53ff2d3c3878420d4f620c54f1323486 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 9 Jan 2008 01:51:00 -0500 Subject: [PATCH 7/7] Fix memoize unit tests --- extra/memoize/memoize-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/memoize/memoize-tests.factor b/extra/memoize/memoize-tests.factor index c4ab3ddcc1..f5a7f85edb 100644 --- a/extra/memoize/memoize-tests.factor +++ b/extra/memoize/memoize-tests.factor @@ -7,4 +7,4 @@ MEMO: fib ( m -- n ) [ 89 ] [ 10 fib ] unit-test -[ "USE: memoize MEMO: x ( a b c d e -- f g h i j ) >r >r >r >r 1+ r> r> r> r> ;" parse ] unit-test-fails +[ "USING: kernel math memoize ; MEMO: x ( a b c d e -- f g h i j ) >r >r >r >r 1+ r> r> r> r> ;" eval ] unit-test-fails