From 249601618b483cbf828fd56ca5159d2476e9c7b6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 4 May 2009 21:27:14 -0500 Subject: [PATCH 01/28] remove >bignum in crc32 -- 2x faster on both 32 and 64bit --- core/checksums/crc32/crc32.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/core/checksums/crc32/crc32.factor b/core/checksums/crc32/crc32.factor index 7655ec8482..209de83763 100644 --- a/core/checksums/crc32/crc32.factor +++ b/core/checksums/crc32/crc32.factor @@ -12,12 +12,12 @@ CONSTANT: crc32-table V{ } 256 iota [ 8 [ [ 2/ ] [ even? ] bi [ crc32-polynomial bitxor ] unless - ] times >bignum + ] times ] map 0 crc32-table copy : (crc32) ( crc ch -- crc ) - >bignum dupd bitxor - mask-byte crc32-table nth-unsafe >bignum + dupd bitxor + mask-byte crc32-table nth-unsafe swap -8 shift bitxor ; inline SINGLETON: crc32 From 029d93a83871987cc57179dd6af9208853c3dd94 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 09:12:32 -0500 Subject: [PATCH 02/28] Make walker work better with call( and breakpoints which are nested inside combinators --- basis/compiler/compiler.factor | 17 +++++----- basis/compiler/tree/builder/builder.factor | 2 -- .../tree/propagation/inlining/inlining.factor | 6 +--- .../known-words/known-words.factor | 2 +- .../tools/continuations/continuations.factor | 32 ++++++++----------- basis/tools/walker/walker-tests.factor | 18 +++++++++-- core/bootstrap/primitives.factor | 2 +- vm/callstack.cpp | 4 +-- vm/callstack.hpp | 2 +- vm/primitives.cpp | 2 +- 10 files changed, 44 insertions(+), 43 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index e418f0ef60..01e58461ff 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -112,19 +112,18 @@ M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ; } cond ; : optimize? ( word -- ? ) - { - [ predicate-engine-word? ] - [ contains-breakpoints? ] - [ single-generic? ] - } 1|| not ; + { [ predicate-engine-word? ] [ single-generic? ] } 1|| not ; + +: contains-breakpoints? ( -- ? ) + dependencies get keys [ "break?" word-prop ] any? ; : frontend ( word -- nodes ) #! If the word contains breakpoints, don't optimize it, since #! the walker does not support this. - dup optimize? - [ [ build-tree ] [ deoptimize ] recover optimize-tree ] - [ dup def>> deoptimize-with ] - if ; + dup optimize? [ + [ [ build-tree ] [ deoptimize ] recover optimize-tree ] keep + contains-breakpoints? [ nip dup def>> deoptimize-with ] [ drop ] if + ] [ dup def>> deoptimize-with ] if ; : compile-dependency ( word -- ) #! If a word calls an unoptimized word, try to compile the callee. diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index 37cc1f05da..00325f5a72 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -65,5 +65,3 @@ PRIVATE> ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ] with-variable ; -: contains-breakpoints? ( word -- ? ) - def>> [ word? ] filter [ "break?" word-prop ] any? ; diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 2a7d431314..ee9abf00ec 100755 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -157,11 +157,7 @@ DEFER: (flat-length) ] sum-outputs ; : should-inline? ( #call word -- ? ) - { - { [ dup contains-breakpoints? ] [ 2drop f ] } - { [ dup "inline" word-prop ] [ 2drop t ] } - [ inlining-rank 5 >= ] - } cond ; + dup inline? [ 2drop t ] [ inlining-rank 5 >= ] if ; SYMBOL: history diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index f6f94bf20d..7603324200 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -651,7 +651,7 @@ M: object infer-call* \ become { array array } { } define-primitive -\ innermost-frame-quot { callstack } { quotation } define-primitive +\ innermost-frame-executing { callstack } { object } define-primitive \ innermost-frame-scan { callstack } { fixnum } define-primitive diff --git a/basis/tools/continuations/continuations.factor b/basis/tools/continuations/continuations.factor index 8c572f4ae3..15fdb9f9b5 100644 --- a/basis/tools/continuations/continuations.factor +++ b/basis/tools/continuations/continuations.factor @@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators sequences math namespaces.private continuations.private concurrency.messaging quotations kernel.private words sequences.private assocs models models.arrow arrays accessors -generic generic.single definitions make sbufs tools.crossref ; +generic generic.single definitions make sbufs tools.crossref fry ; IN: tools.continuations > +: >innermost-frame< ( callstack -- n quot ) + [ innermost-frame-scan 1 + ] [ innermost-frame-executing ] bi ; + +: (change-frame) ( callstack quot -- callstack' ) + [ dup innermost-frame-executing quotation? ] dip '[ + clone [ >innermost-frame< @ ] [ set-innermost-frame-quot ] [ ] tri + ] when ; inline + : change-frame ( continuation quot -- continuation' ) #! Applies quot to innermost call frame of the #! continuation. - [ clone ] dip [ - [ clone ] dip - [ - [ - [ innermost-frame-scan 1+ ] - [ innermost-frame-quot ] bi - ] dip call - ] - [ drop set-innermost-frame-quot ] - [ drop ] - 2tri - ] curry change-call ; inline + [ clone ] dip '[ _ (change-frame) ] change-call ; inline PRIVATE> @@ -101,7 +98,7 @@ PRIVATE> [ 2dup length = [ nip [ break ] append ] [ 2dup nth \ break = [ nip ] [ - swap 1+ cut [ break ] glue + swap 1 + cut [ break ] glue ] if ] if ] change-frame ; @@ -109,7 +106,6 @@ PRIVATE> : continuation-step-out ( continuation -- continuation' ) [ nip \ break suffix ] change-frame ; - { { call [ (step-into-quot) ] } { dip [ (step-into-dip) ] } @@ -124,7 +120,7 @@ PRIVATE> ! Never step into these words : don't-step-into ( word -- ) - dup [ execute break ] curry "step-into" set-word-prop ; + dup '[ _ execute break ] "step-into" set-word-prop ; { >n ndrop >c c> @@ -151,6 +147,4 @@ PRIVATE> ] change-frame ; : continuation-current ( continuation -- obj ) - call>> - [ innermost-frame-scan 1+ ] - [ innermost-frame-quot ] bi ?nth ; + call>> >innermost-frame< ?nth ; diff --git a/basis/tools/walker/walker-tests.factor b/basis/tools/walker/walker-tests.factor index 6f87792faa..b6094d7d7e 100644 --- a/basis/tools/walker/walker-tests.factor +++ b/basis/tools/walker/walker-tests.factor @@ -2,7 +2,7 @@ USING: tools.walker io io.streams.string kernel math math.private namespaces prettyprint sequences tools.test continuations math.parser threads arrays tools.walker.debug generic.single sequences.private kernel.private -tools.continuations accessors words ; +tools.continuations accessors words combinators ; IN: tools.walker.tests [ { } ] [ @@ -131,4 +131,18 @@ M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ; \ method-breakpoint-test don't-step-into [ { 3 } ] -[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test \ No newline at end of file +[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test + +: case-breakpoint-test ( -- x ) + 5 { [ break 1 + ] } case ; + +\ case-breakpoint-test don't-step-into + +[ { 6 } ] [ [ case-breakpoint-test ] test-walker ] unit-test + +: call(-breakpoint-test ( -- x ) + [ break 1 ] call( -- x ) 2 + ; + +\ call(-breakpoint-test don't-step-into + +[ { 3 } ] [ [ call(-breakpoint-test ] test-walker ] unit-test diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index e5a6bbe5fa..83276cd3f2 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -493,7 +493,7 @@ tuple { "(sleep)" "threads.private" (( us -- )) } { "" "classes.tuple.private" (( ... layout -- tuple )) } { "callstack>array" "kernel" (( callstack -- array )) } - { "innermost-frame-quot" "kernel.private" (( callstack -- quot )) } + { "innermost-frame-executing" "kernel.private" (( callstack -- obj )) } { "innermost-frame-scan" "kernel.private" (( callstack -- n )) } { "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) } { "call-clear" "kernel" (( quot -- )) } diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 56056426dd..ade0b45db7 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -195,9 +195,9 @@ stack_frame *innermost_stack_frame_quot(callstack *callstack) /* Some primitives implementing a limited form of callstack mutation. Used by the single stepper. */ -PRIMITIVE(innermost_stack_frame_quot) +PRIMITIVE(innermost_stack_frame_executing) { - dpush(frame_executing(innermost_stack_frame_quot(untag_check(dpop())))); + dpush(frame_executing(innermost_stack_frame(untag_check(dpop())))); } PRIMITIVE(innermost_stack_frame_scan) diff --git a/vm/callstack.hpp b/vm/callstack.hpp index efdbc7ba05..ec2e8e37d1 100755 --- a/vm/callstack.hpp +++ b/vm/callstack.hpp @@ -22,7 +22,7 @@ cell frame_type(stack_frame *frame); PRIMITIVE(callstack); PRIMITIVE(set_callstack); PRIMITIVE(callstack_to_array); -PRIMITIVE(innermost_stack_frame_quot); +PRIMITIVE(innermost_stack_frame_executing); PRIMITIVE(innermost_stack_frame_scan); PRIMITIVE(set_innermost_stack_frame_quot); diff --git a/vm/primitives.cpp b/vm/primitives.cpp index 08db684ff6..f1c5468949 100755 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -135,7 +135,7 @@ const primitive_type primitives[] = { primitive_sleep, primitive_tuple_boa, primitive_callstack_to_array, - primitive_innermost_stack_frame_quot, + primitive_innermost_stack_frame_executing, primitive_innermost_stack_frame_scan, primitive_set_innermost_stack_frame_quot, primitive_call_clear, From 0ecb771aa48808ec0c168b0e390719962d6580bb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 09:12:39 -0500 Subject: [PATCH 03/28] alien.strings cleanup --- core/alien/strings/strings.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor index 943530d4f2..896fb7f09f 100644 --- a/core/alien/strings/strings.factor +++ b/core/alien/strings/strings.factor @@ -34,16 +34,16 @@ M: string string>alien HOOK: alien>native-string os ( alien -- string ) -HOOK: native-string>alien os ( string -- alien ) - M: windows alien>native-string utf16n alien>string ; +M: unix alien>native-string utf8 alien>string ; + +HOOK: native-string>alien os ( string -- alien ) + M: wince native-string>alien utf16n string>alien ; M: winnt native-string>alien utf8 string>alien ; -M: unix alien>native-string utf8 alien>string ; - M: unix native-string>alien utf8 string>alien ; : dll-path ( dll -- string ) From 84fe4a7d672ef6a3ddf72499a3233b268260c2ae Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 09:12:49 -0500 Subject: [PATCH 04/28] generic.standard: remove bogus error check --- core/generic/standard/standard.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 87611a76d0..bf801c4e47 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -8,9 +8,7 @@ IN: generic.standard TUPLE: standard-combination < single-combination # ; -: ( n -- standard-combination ) - dup 0 2 between? [ "Bad dispatch position" throw ] unless - standard-combination boa ; +C: standard-combination PREDICATE: standard-generic < generic "combination" word-prop standard-combination? ; From 4c756a1147f215c6448cf55edf09abad581b5272 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 09:40:58 -0500 Subject: [PATCH 05/28] cocoa: don't need to explicitly compile words anymore, as if more than a year ago... --- basis/cocoa/cocoa.factor | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor index 3e933e6643..b78bb020d0 100644 --- a/basis/cocoa/cocoa.factor +++ b/basis/cocoa/cocoa.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006 Slava Pestov +! Copyright (C) 2006, 2009 Slava Pestov ! 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 @@ -27,22 +27,16 @@ SYMBOL: frameworks frameworks [ V{ } clone ] initialize -[ frameworks get [ load-framework ] each ] "cocoa.messages" add-init-hook +[ frameworks get [ load-framework ] each ] "cocoa" add-init-hook SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ; SYNTAX: IMPORT: scan [ ] import-objc-class ; -"Compiling Objective C bridge..." print +"Importing Cocoa classes..." print "cocoa.classes" create-vocab drop -{ - "cocoa" "cocoa.runtime" "cocoa.messages" "cocoa.subclassing" -} [ words ] map concat compile - -"Importing Cocoa classes..." print - [ { "NSApplication" From 12de56c41e1c46169070989aa23179bfaab2abcb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 10:29:22 -0500 Subject: [PATCH 06/28] Fix botched replace all in VM source, clean up image saving code, and fix save-image-and-exit to actually call (save-image-and-exit) instead of (save-image) --- basis/tools/deploy/shaker/shaker.factor | 10 ++-------- core/memory/memory.factor | 2 +- vm/factor.cpp | 2 +- vm/image.cpp | 20 ++++++-------------- vm/run.hpp | 7 ++++++- 5 files changed, 16 insertions(+), 25 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index fd43d1ccc9..e8f4238ed6 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -346,13 +346,6 @@ IN: tools.deploy.shaker : compress-wrappers ( -- ) [ wrapper? ] [ ] "wrappers" compress ; -: finish-deploy ( final-image -- ) - "Finishing up" show - V{ } set-namestack - V{ } set-catchstack - "Saving final image" show - save-image-and-exit ; - SYMBOL: deploy-vocab : [:c] ( -- word ) ":c" "debugger" lookup ; @@ -437,7 +430,8 @@ SYMBOL: deploy-vocab "Vocabulary has no MAIN: word." print flush 1 exit ] unless strip - finish-deploy + "Saving final image" show + save-image-and-exit ] deploy-error-handler ] bind ; diff --git a/core/memory/memory.factor b/core/memory/memory.factor index c748f71c8e..1c61e33d83 100644 --- a/core/memory/memory.factor +++ b/core/memory/memory.factor @@ -26,6 +26,6 @@ IN: memory normalize-path native-string>alien (save-image) ; : save-image-and-exit ( path -- ) - normalize-path native-string>alien (save-image) ; + normalize-path native-string>alien (save-image-and-exit) ; : save ( -- ) image save-image ; diff --git a/vm/factor.cpp b/vm/factor.cpp index b607adba63..f8f7901304 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -134,7 +134,7 @@ VM_C_API void init_factor(vm_parameters *p) userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING); userenv[OS_ENV] = allot_alien(F,(cell)FACTOR_OS_STRING); - userenv[cell_SIZE_ENV] = tag_fixnum(sizeof(cell)); + userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(cell)); userenv[EXECUTABLE_ENV] = allot_alien(F,(cell)p->executable_path); userenv[ARGS_ENV] = F; userenv[EMBEDDED_ENV] = F; diff --git a/vm/image.cpp b/vm/image.cpp index 2aa7727136..fd547cca50 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -106,14 +106,8 @@ bool save_image(const vm_char *filename) h.bignum_pos_one = bignum_pos_one; h.bignum_neg_one = bignum_neg_one; - cell i; - for(i = 0; i < USER_ENV; i++) - { - if(i < FIRST_SAVE_ENV) - h.userenv[i] = F; - else - h.userenv[i] = userenv[i]; - } + for(cell i = 0; i < USER_ENV; i++) + h.userenv[i] = (save_env_p(i) ? userenv[i] : F); bool ok = true; @@ -149,12 +143,10 @@ PRIMITIVE(save_image_and_exit) path.untag_check(); /* strip out userenv data which is set on startup anyway */ - cell i; - for(i = 0; i < FIRST_SAVE_ENV; i++) - userenv[i] = F; - - for(i = LAST_SAVE_ENV + 1; i < STACK_TRACES_ENV; i++) - userenv[i] = F; + for(cell i = 0; i < USER_ENV; i++) + { + if(!save_env_p(i)) userenv[i] = F; + } /* do a full GC + code heap compaction */ performing_compaction = true; diff --git a/vm/run.hpp b/vm/run.hpp index 2204585fe5..829e25d2f7 100755 --- a/vm/run.hpp +++ b/vm/run.hpp @@ -14,7 +14,7 @@ enum special_object { BREAK_ENV = 5, /* quotation called by throw primitive */ ERROR_ENV, /* a marker consed onto kernel errors */ - cell_SIZE_ENV = 7, /* sizeof(cell) */ + CELL_SIZE_ENV = 7, /* sizeof(cell) */ CPU_ENV, /* CPU architecture */ OS_ENV, /* operating system name */ @@ -93,6 +93,11 @@ enum special_object { #define FIRST_SAVE_ENV BOOT_ENV #define LAST_SAVE_ENV STAGE2_ENV +inline static bool save_env_p(cell i) +{ + return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV; +} + /* Canonical T object. It's just a word */ extern cell T; From 786b9096e28e03c9e661e65d8a72b725ac424086 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 11:07:20 -0500 Subject: [PATCH 07/28] Store forwarding table off to the side instead of in the code block; saves one cell per code block --- vm/callstack.cpp | 2 +- vm/code_block.cpp | 28 ++++++++++++++-------------- vm/code_gc.cpp | 38 +++++++++++++++++++------------------- vm/code_gc.hpp | 4 ++-- vm/code_heap.cpp | 10 ++++++---- vm/inline_cache.cpp | 4 ++-- vm/layouts.hpp | 13 +++---------- vm/master.hpp | 5 +++++ vm/quotations.cpp | 2 +- vm/words.cpp | 2 +- vm/words.hpp | 2 +- 11 files changed, 55 insertions(+), 55 deletions(-) diff --git a/vm/callstack.cpp b/vm/callstack.cpp index ade0b45db7..2ad58534b5 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -100,7 +100,7 @@ code_block *frame_code(stack_frame *frame) cell frame_type(stack_frame *frame) { - return frame_code(frame)->block.type; + return frame_code(frame)->type; } cell frame_executing(stack_frame *frame) diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 4694381ed3..80adb1feac 100644 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -5,7 +5,7 @@ namespace factor void flush_icache_for(code_block *block) { - flush_icache((cell)block,block->block.size); + flush_icache((cell)block,block->size); } void iterate_relocations(code_block *compiled, relocation_iterator iter) @@ -122,7 +122,7 @@ void update_literal_references_step(relocation_entry rel, cell index, code_block /* Update pointers to literals from compiled code. */ void update_literal_references(code_block *compiled) { - if(!compiled->block.needs_fixup) + if(!compiled->needs_fixup) { iterate_relocations(compiled,update_literal_references_step); flush_icache_for(compiled); @@ -133,12 +133,12 @@ void update_literal_references(code_block *compiled) aging and nursery collections */ void copy_literal_references(code_block *compiled) { - if(collecting_gen >= compiled->block.last_scan) + if(collecting_gen >= compiled->last_scan) { if(collecting_accumulation_gen_p()) - compiled->block.last_scan = collecting_gen; + compiled->last_scan = collecting_gen; else - compiled->block.last_scan = collecting_gen + 1; + compiled->last_scan = collecting_gen + 1; /* initialize chase pointer */ cell scan = newspace->here; @@ -208,7 +208,7 @@ to update references to other words, without worrying about literals or dlsyms. */ void update_word_references(code_block *compiled) { - if(compiled->block.needs_fixup) + if(compiled->needs_fixup) relocate_code_block(compiled); /* update_word_references() is always applied to every block in the code heap. Since it resets all call sites to point to @@ -217,8 +217,8 @@ void update_word_references(code_block *compiled) are referenced after this is done. So instead of polluting the code heap with dead PICs that will be freed on the next GC, we add them to the free list immediately. */ - else if(compiled->block.type == PIC_TYPE) - heap_free(&code,&compiled->block); + else if(compiled->type == PIC_TYPE) + heap_free(&code,compiled); else { iterate_relocations(compiled,update_word_references_step); @@ -248,7 +248,7 @@ void mark_code_block(code_block *compiled) { check_code_address((cell)compiled); - mark_block(&compiled->block); + mark_block(compiled); copy_handle(&compiled->literals); copy_handle(&compiled->relocation); @@ -405,8 +405,8 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp /* Perform all fixups on a code block */ void relocate_code_block(code_block *compiled) { - compiled->block.last_scan = NURSERY; - compiled->block.needs_fixup = false; + compiled->last_scan = NURSERY; + compiled->needs_fixup = false; iterate_relocations(compiled,relocate_code_block_step); flush_icache_for(compiled); } @@ -474,9 +474,9 @@ code_block *add_code_block( code_block *compiled = allot_code_block(code_length); /* compiled header */ - compiled->block.type = type; - compiled->block.last_scan = NURSERY; - compiled->block.needs_fixup = true; + compiled->type = type; + compiled->last_scan = NURSERY; + compiled->needs_fixup = true; compiled->relocation = relocation.value(); /* slight space optimization */ diff --git a/vm/code_gc.cpp b/vm/code_gc.cpp index b86d08cf52..721c3f3a7a 100755 --- a/vm/code_gc.cpp +++ b/vm/code_gc.cpp @@ -22,9 +22,9 @@ void new_heap(heap *heap, cell size) static void add_to_free_list(heap *heap, free_heap_block *block) { - if(block->block.size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT) + if(block->size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT) { - int index = block->block.size / BLOCK_SIZE_INCREMENT; + int index = block->size / BLOCK_SIZE_INCREMENT; block->next_free = heap->free.small_blocks[index]; heap->free.small_blocks[index] = block; } @@ -73,8 +73,8 @@ void build_free_list(heap *heap, cell size) branch is only taken after loading a new image, not after code GC */ if((cell)(end + 1) <= heap->seg->end) { - end->block.status = B_FREE; - end->block.size = heap->seg->end - (cell)end; + end->status = B_FREE; + end->size = heap->seg->end - (cell)end; /* add final free block */ add_to_free_list(heap,end); @@ -93,7 +93,7 @@ void build_free_list(heap *heap, cell size) static void assert_free_block(free_heap_block *block) { - if(block->block.status != B_FREE) + if(block->status != B_FREE) critical_error("Invalid block in free list",(cell)block); } @@ -121,7 +121,7 @@ static free_heap_block *find_free_block(heap *heap, cell size) while(block) { assert_free_block(block); - if(block->block.size >= size) + if(block->size >= size) { if(prev) prev->next_free = block->next_free; @@ -139,14 +139,14 @@ static free_heap_block *find_free_block(heap *heap, cell size) static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size) { - if(block->block.size != size ) + if(block->size != size ) { /* split the block in two */ free_heap_block *split = (free_heap_block *)((cell)block + size); - split->block.status = B_FREE; - split->block.size = block->block.size - size; + split->status = B_FREE; + split->size = block->size - size; split->next_free = block->next_free; - block->block.size = size; + block->size = size; add_to_free_list(heap,split); } @@ -163,8 +163,8 @@ heap_block *heap_allot(heap *heap, cell size) { block = split_free_block(heap,block,size); - block->block.status = B_ALLOCATED; - return &block->block; + block->status = B_ALLOCATED; + return block; } else return NULL; @@ -303,16 +303,16 @@ cell heap_size(heap *heap) } /* Compute where each block is going to go, after compaction */ -cell compute_heap_forwarding(heap *heap) + cell compute_heap_forwarding(heap *heap, std::tr1::unordered_map &forwarding) { heap_block *scan = first_block(heap); - cell address = (cell)first_block(heap); + char *address = (char *)first_block(heap); while(scan) { if(scan->status == B_ALLOCATED) { - scan->forwarding = (heap_block *)address; + forwarding[scan] = address; address += scan->size; } else if(scan->status == B_MARKED) @@ -321,10 +321,10 @@ cell compute_heap_forwarding(heap *heap) scan = next_block(heap,scan); } - return address - heap->seg->start; + return (cell)address - heap->seg->start; } -void compact_heap(heap *heap) + void compact_heap(heap *heap, std::tr1::unordered_map &forwarding) { heap_block *scan = first_block(heap); @@ -332,8 +332,8 @@ void compact_heap(heap *heap) { heap_block *next = next_block(heap,scan); - if(scan->status == B_ALLOCATED && scan != scan->forwarding) - memcpy(scan->forwarding,scan,scan->size); + if(scan->status == B_ALLOCATED) + memmove(forwarding[scan],scan,scan->size); scan = next; } } diff --git a/vm/code_gc.hpp b/vm/code_gc.hpp index 3879d3c8e8..1ad68f46fd 100755 --- a/vm/code_gc.hpp +++ b/vm/code_gc.hpp @@ -25,8 +25,8 @@ void unmark_marked(heap *heap); void free_unmarked(heap *heap, heap_iterator iter); void heap_usage(heap *h, cell *used, cell *total_free, cell *max_free); cell heap_size(heap *h); -cell compute_heap_forwarding(heap *h); -void compact_heap(heap *h); +cell compute_heap_forwarding(heap *h, std::tr1::unordered_map &forwarding); +void compact_heap(heap *h, std::tr1::unordered_map &forwarding); inline static heap_block *next_block(heap *h, heap_block *block) { diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 5dca29b420..2342a3dd09 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -119,9 +119,11 @@ PRIMITIVE(code_room) dpush(tag_fixnum(max_free / 1024)); } +static std::tr1::unordered_map forwarding; + code_block *forward_xt(code_block *compiled) { - return (code_block *)compiled->block.forwarding; + return (code_block *)forwarding[compiled]; } void forward_frame_xt(stack_frame *frame) @@ -132,7 +134,7 @@ void forward_frame_xt(stack_frame *frame) FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset); } -void forward_object_xts(void) +void forward_object_xts() { begin_scan(); @@ -215,13 +217,13 @@ void compact_code_heap(void) gc(); /* Figure out where the code heap blocks are going to end up */ - cell size = compute_heap_forwarding(&code); + cell size = compute_heap_forwarding(&code, forwarding); /* Update word and quotation code pointers */ forward_object_xts(); /* Actually perform the compaction */ - compact_heap(&code); + compact_heap(&code,forwarding); /* Update word and quotation XTs */ fixup_object_xts(); diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 5d9fbf069e..23c4b27c47 100644 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -22,7 +22,7 @@ void deallocate_inline_cache(cell return_address) /* Find the call target. */ void *old_xt = get_call_target(return_address); code_block *old_block = (code_block *)old_xt - 1; - cell old_type = old_block->block.type; + cell old_type = old_block->type; #ifdef FACTOR_DEBUG /* The call target was either another PIC, @@ -31,7 +31,7 @@ void deallocate_inline_cache(cell return_address) #endif if(old_type == PIC_TYPE) - heap_free(&code,&old_block->block); + heap_free(&code,old_block); } /* Figure out what kind of type check the PIC needs based on the methods diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 4928fda632..114b88b925 100755 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -193,26 +193,19 @@ struct heap_block unsigned char status; /* free or allocated? */ unsigned char type; /* this is WORD_TYPE or QUOTATION_TYPE */ unsigned char last_scan; /* the youngest generation in which this block's literals may live */ - char needs_fixup; /* is this a new block that needs full fixup? */ + unsigned char needs_fixup; /* is this a new block that needs full fixup? */ /* In bytes, includes this header */ cell size; - - /* Used during compaction */ - heap_block *forwarding; }; -struct free_heap_block +struct free_heap_block : public heap_block { - heap_block block; - - /* Filled in on image load */ free_heap_block *next_free; }; -struct code_block +struct code_block : public heap_block { - heap_block block; cell literals; /* # bytes */ cell relocation; /* tagged pointer to byte-array or f */ diff --git a/vm/master.hpp b/vm/master.hpp index fa7d7fa1a4..65d17fab4b 100644 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -9,6 +9,7 @@ #include #endif +/* C headers */ #include #include #include @@ -20,6 +21,10 @@ #include #include +/* C++ headers */ +#include + +/* Factor headers */ #include "layouts.hpp" #include "platform.hpp" #include "primitives.hpp" diff --git a/vm/quotations.cpp b/vm/quotations.cpp index c87cf8dc82..af00bb468b 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -251,7 +251,7 @@ void quotation_jit::iterate_quotation() void set_quot_xt(quotation *quot, code_block *code) { - if(code->block.type != QUOTATION_TYPE) + if(code->type != QUOTATION_TYPE) critical_error("Bad param to set_quot_xt",(cell)code); quot->code = code; diff --git a/vm/words.cpp b/vm/words.cpp index cb2fdf0dd6..6e7c633c84 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -44,7 +44,7 @@ PRIMITIVE(word_xt) word *w = untag_check(dpop()); code_block *code = (profiling_p ? w->profiling : w->code); dpush(allot_cell((cell)code->xt())); - dpush(allot_cell((cell)code + code->block.size)); + dpush(allot_cell((cell)code + code->size)); } /* Allocates memory */ diff --git a/vm/words.hpp b/vm/words.hpp index 9c8e7ad57a..f9d5a7aff4 100644 --- a/vm/words.hpp +++ b/vm/words.hpp @@ -9,7 +9,7 @@ void update_word_xt(cell word); inline bool word_optimized_p(word *word) { - return word->code->block.type == WORD_TYPE; + return word->code->type == WORD_TYPE; } PRIMITIVE(optimized_p); From 53db9d737a49ca539310a6ab0814ea608abe9fda Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 11:33:35 -0500 Subject: [PATCH 08/28] Change (void) to () --- vm/alien.cpp | 4 ++-- vm/alien.hpp | 2 +- vm/callstack.cpp | 2 +- vm/code_block.cpp | 2 +- vm/code_block.hpp | 2 +- vm/code_heap.cpp | 8 ++++---- vm/code_heap.hpp | 4 ++-- vm/contexts.cpp | 14 +++++++------- vm/contexts.hpp | 12 ++++++------ vm/data_gc.cpp | 16 ++++++++-------- vm/data_gc.hpp | 10 +++++----- vm/data_heap.cpp | 8 ++++---- vm/data_heap.hpp | 8 ++++---- vm/debug.cpp | 12 ++++++------ vm/debug.hpp | 4 ++-- vm/errors.cpp | 10 +++++----- vm/errors.hpp | 10 +++++----- vm/factor.cpp | 6 +++--- vm/factor.hpp | 2 +- vm/io.cpp | 8 ++++---- vm/io.hpp | 8 ++++---- vm/mach_signal.cpp | 2 +- vm/mach_signal.hpp | 2 +- vm/math.cpp | 2 +- vm/math.hpp | 2 +- vm/os-freebsd.cpp | 2 +- vm/os-freebsd.hpp | 2 +- vm/os-genunix.cpp | 6 +++--- vm/os-genunix.hpp | 8 ++++---- vm/os-linux.cpp | 6 +++--- vm/os-linux.hpp | 2 +- vm/os-macosx.hpp | 8 ++++---- vm/os-netbsd.cpp | 2 +- vm/os-openbsd.cpp | 2 +- vm/os-solaris.cpp | 2 +- vm/os-unix.cpp | 10 +++++----- vm/os-unix.hpp | 8 ++++---- vm/os-windows-ce.cpp | 4 ++-- vm/os-windows-ce.hpp | 4 ++-- vm/os-windows-nt.cpp | 4 ++-- vm/os-windows-nt.hpp | 2 +- vm/os-windows.cpp | 8 ++++---- vm/os-windows.hpp | 14 +++++++------- vm/profiler.cpp | 2 +- vm/profiler.hpp | 2 +- vm/quotations.cpp | 2 +- vm/quotations.hpp | 2 +- vm/stacks.hpp | 2 +- vm/utilities.cpp | 4 ++-- vm/utilities.hpp | 4 ++-- 50 files changed, 136 insertions(+), 136 deletions(-) diff --git a/vm/alien.cpp b/vm/alien.cpp index 06dee31a14..29d18033c7 100755 --- a/vm/alien.cpp +++ b/vm/alien.cpp @@ -77,7 +77,7 @@ PRIMITIVE(alien_address) } /* pop ( alien n ) from datastack, return alien's address plus n */ -static void *alien_pointer(void) +static void *alien_pointer() { fixnum offset = to_fixnum(dpop()); return unbox_alien() + offset; @@ -182,7 +182,7 @@ VM_C_API char *alien_offset(cell obj) } /* pop an object representing a C pointer */ -VM_C_API char *unbox_alien(void) +VM_C_API char *unbox_alien() { return alien_offset(dpop()); } diff --git a/vm/alien.hpp b/vm/alien.hpp index a66135cf92..6235a2d6c7 100755 --- a/vm/alien.hpp +++ b/vm/alien.hpp @@ -39,7 +39,7 @@ PRIMITIVE(dlclose); PRIMITIVE(dll_validp); VM_C_API char *alien_offset(cell object); -VM_C_API char *unbox_alien(void); +VM_C_API char *unbox_alien(); VM_C_API void box_alien(void *ptr); VM_C_API void to_value_struct(cell src, void *dest, cell size); VM_C_API void box_value_struct(void *src, cell size); diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 2ad58534b5..d9ac8d6073 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -54,7 +54,7 @@ This means that if 'callstack' is called in tail position, we will have popped a necessary frame... however this word is only called by continuation implementation, and user code shouldn't be calling it at all, so we leave it as it is for now. */ -stack_frame *capture_start(void) +stack_frame *capture_start() { stack_frame *frame = stack_chain->callstack_bottom - 1; while(frame >= stack_chain->callstack_top diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 80adb1feac..d27460853d 100644 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -302,7 +302,7 @@ void mark_object_code_block(object *object) /* References to undefined symbols are patched up to call this function on image load */ -void undefined_symbol(void) +void undefined_symbol() { general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL); } diff --git a/vm/code_block.hpp b/vm/code_block.hpp index 9689ea5419..9ca1a419b6 100644 --- a/vm/code_block.hpp +++ b/vm/code_block.hpp @@ -82,7 +82,7 @@ void mark_object_code_block(object *scan); void relocate_code_block(code_block *relocating); -inline static bool stack_traces_p(void) +inline static bool stack_traces_p() { return userenv[STACK_TRACES_ENV] != F; } diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 2342a3dd09..db1fd8f880 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -45,14 +45,14 @@ void iterate_code_heap(code_heap_iterator iter) /* Copy literals referenced from all code blocks to newspace. Only for aging and nursery collections */ -void copy_code_heap_roots(void) +void copy_code_heap_roots() { iterate_code_heap(copy_literal_references); } /* Update pointers to words referenced from all code blocks. Only after defining a new word. */ -void update_code_heap_words(void) +void update_code_heap_words() { iterate_code_heap(update_word_references); } @@ -178,7 +178,7 @@ void forward_object_xts() } /* Set the XT fields now that the heap has been compacted */ -void fixup_object_xts(void) +void fixup_object_xts() { begin_scan(); @@ -211,7 +211,7 @@ void fixup_object_xts(void) since it makes several passes over the code and data heaps, but we only ever do this before saving a deployed image and exiting, so performaance is not critical here */ -void compact_code_heap(void) +void compact_code_heap() { /* Free all unreachable code blocks */ gc(); diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index 056a6a88c6..6f139a4728 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -14,13 +14,13 @@ typedef void (*code_heap_iterator)(code_block *compiled); void iterate_code_heap(code_heap_iterator iter); -void copy_code_heap_roots(void); +void copy_code_heap_roots(); PRIMITIVE(modify_code_heap); PRIMITIVE(code_room); -void compact_code_heap(void); +void compact_code_heap(); inline static void check_code_pointer(cell ptr) { diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 66570abc31..239b70876a 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -8,19 +8,19 @@ namespace factor cell ds_size, rs_size; context *unused_contexts; -void reset_datastack(void) +void reset_datastack() { ds = ds_bot - sizeof(cell); } -void reset_retainstack(void) +void reset_retainstack() { rs = rs_bot - sizeof(cell); } #define RESERVED (64 * sizeof(cell)) -void fix_stacks(void) +void fix_stacks() { if(ds + sizeof(cell) < ds_bot || ds + RESERVED >= ds_top) reset_datastack(); if(rs + sizeof(cell) < rs_bot || rs + RESERVED >= rs_top) reset_retainstack(); @@ -28,7 +28,7 @@ void fix_stacks(void) /* called before entry into foreign C code. Note that ds and rs might be stored in registers, so callbacks must save and restore the correct values */ -void save_stacks(void) +void save_stacks() { if(stack_chain) { @@ -37,7 +37,7 @@ void save_stacks(void) } } -context *alloc_context(void) +context *alloc_context() { context *new_context; @@ -63,7 +63,7 @@ void dealloc_context(context *old_context) } /* called on entry into a compiled callback */ -void nest_stacks(void) +void nest_stacks() { context *new_context = alloc_context(); @@ -95,7 +95,7 @@ void nest_stacks(void) } /* called when leaving a compiled callback */ -void unnest_stacks(void) +void unnest_stacks() { ds = stack_chain->datastack_save; rs = stack_chain->retainstack_save; diff --git a/vm/contexts.hpp b/vm/contexts.hpp index 13af17f2f0..4a6f401f0b 100644 --- a/vm/contexts.hpp +++ b/vm/contexts.hpp @@ -46,9 +46,9 @@ extern cell ds_size, rs_size; DEFPUSHPOP(d,ds) DEFPUSHPOP(r,rs) -void reset_datastack(void); -void reset_retainstack(void); -void fix_stacks(void); +void reset_datastack(); +void reset_retainstack(); +void fix_stacks(); void init_stacks(cell ds_size, cell rs_size); PRIMITIVE(datastack); @@ -57,9 +57,9 @@ PRIMITIVE(set_datastack); PRIMITIVE(set_retainstack); PRIMITIVE(check_datastack); -VM_C_API void save_stacks(void); -VM_C_API void nest_stacks(void); -VM_C_API void unnest_stacks(void); +VM_C_API void save_stacks(); +VM_C_API void nest_stacks(); +VM_C_API void unnest_stacks(); } diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp index e26edc9721..c9dbe9a953 100755 --- a/vm/data_gc.cpp +++ b/vm/data_gc.cpp @@ -33,7 +33,7 @@ cell last_code_heap_scan; bool growing_data_heap; data_heap *old_data_heap; -void init_data_gc(void) +void init_data_gc() { performing_gc = false; last_code_heap_scan = NURSERY; @@ -244,7 +244,7 @@ static void copy_gen_cards(cell gen) /* Scan cards in all generations older than the one being collected, copying old->new references */ -static void copy_cards(void) +static void copy_cards() { u64 start = current_micros(); @@ -264,7 +264,7 @@ static void copy_stack_elements(segment *region, cell top) copy_handle((cell*)ptr); } -static void copy_registered_locals(void) +static void copy_registered_locals() { cell scan = gc_locals_region->start; @@ -272,7 +272,7 @@ static void copy_registered_locals(void) copy_handle(*(cell **)scan); } -static void copy_registered_bignums(void) +static void copy_registered_bignums() { cell scan = gc_bignums_region->start; @@ -295,7 +295,7 @@ static void copy_registered_bignums(void) /* Copy roots over at the start of GC, namely various constants, stacks, the user environment and extra roots registered by local_roots.hpp */ -static void copy_roots(void) +static void copy_roots() { copy_handle(&T); copy_handle(&bignum_zero); @@ -593,7 +593,7 @@ void garbage_collection(cell gen, performing_gc = false; } -void gc(void) +void gc() { garbage_collection(TENURED,false,0); } @@ -633,7 +633,7 @@ PRIMITIVE(gc_stats) dpush(result.elements.value()); } -void clear_gc_stats(void) +void clear_gc_stats() { int i; for(i = 0; i < MAX_GEN_COUNT; i++) @@ -681,7 +681,7 @@ PRIMITIVE(become) compile_all_words(); } -VM_C_API void minor_gc(void) +VM_C_API void minor_gc() { garbage_collection(NURSERY,false,0); } diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp index 2869179394..01bff2ef68 100755 --- a/vm/data_gc.hpp +++ b/vm/data_gc.hpp @@ -18,11 +18,11 @@ extern bool collecting_aging_again; extern cell last_code_heap_scan; -void init_data_gc(void); +void init_data_gc(); -void gc(void); +void gc(); -inline static bool collecting_accumulation_gen_p(void) +inline static bool collecting_accumulation_gen_p() { return ((HAVE_AGING_P && collecting_gen == AGING @@ -114,7 +114,7 @@ void copy_reachable_objects(cell scan, cell *end); PRIMITIVE(gc); PRIMITIVE(gc_stats); -void clear_gc_stats(void); +void clear_gc_stats(); PRIMITIVE(clear_gc_stats); PRIMITIVE(become); @@ -143,6 +143,6 @@ inline static void check_tagged_pointer(cell tagged) #endif } -VM_C_API void minor_gc(void); +VM_C_API void minor_gc(); } diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index d83773de9c..0045539549 100644 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -24,7 +24,7 @@ cell init_zone(zone *z, cell size, cell start) return z->end; } -void init_card_decks(void) +void init_card_decks() { cell start = align(data->seg->start,DECK_SIZE); allot_markers_offset = (cell)data->allot_markers - (start >> CARD_BITS); @@ -312,7 +312,7 @@ references to an object for debugging purposes. */ cell heap_scan_ptr; /* Disables GC and activates next-object ( -- obj ) primitive */ -void begin_scan(void) +void begin_scan() { heap_scan_ptr = data->generations[TENURED].start; gc_off = true; @@ -323,7 +323,7 @@ PRIMITIVE(begin_scan) begin_scan(); } -cell next_object(void) +cell next_object() { if(!gc_off) general_error(ERROR_HEAP_SCAN,F,F,NULL); @@ -348,7 +348,7 @@ PRIMITIVE(end_scan) gc_off = false; } -cell find_all_words(void) +cell find_all_words() { growable_array words; diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp index bb8b35341e..bec86a2d0d 100644 --- a/vm/data_heap.hpp +++ b/vm/data_heap.hpp @@ -56,7 +56,7 @@ inline static bool in_zone(zone *z, object *pointer) cell init_zone(zone *z, cell size, cell base); -void init_card_decks(void); +void init_card_decks(); data_heap *grow_data_heap(data_heap *data, cell requested_bytes); @@ -86,8 +86,8 @@ cell unaligned_object_size(object *pointer); cell binary_payload_start(object *pointer); cell object_size(cell tagged); -void begin_scan(void); -cell next_object(void); +void begin_scan(); +cell next_object(); PRIMITIVE(data_room); PRIMITIVE(size); @@ -99,7 +99,7 @@ PRIMITIVE(end_scan); /* GC is off during heap walking */ extern bool gc_off; -cell find_all_words(void); +cell find_all_words(); /* Every object has a regular representation in the runtime, which makes GC much simpler. Every slot of the object until binary_payload_start is a pointer diff --git a/vm/debug.cpp b/vm/debug.cpp index 3cd05711ad..49fdd92541 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -155,13 +155,13 @@ void print_objects(cell *start, cell *end) } } -void print_datastack(void) +void print_datastack() { print_string("==== DATA STACK:\n"); print_objects((cell *)ds_bot,(cell *)ds); } -void print_retainstack(void) +void print_retainstack() { print_string("==== RETAIN STACK:\n"); print_objects((cell *)rs_bot,(cell *)rs); @@ -179,7 +179,7 @@ void print_stack_frame(stack_frame *frame) print_string("\n"); } -void print_callstack(void) +void print_callstack() { print_string("==== CALL STACK:\n"); cell bottom = (cell)stack_chain->callstack_bottom; @@ -210,7 +210,7 @@ void dump_zone(zone *z) print_string(", here="); print_cell(z->here - z->start); nl(); } -void dump_generations(void) +void dump_generations() { cell i; @@ -285,7 +285,7 @@ void find_data_references(cell look_for_) } /* Dump all code blocks for debugging */ -void dump_code_heap(void) +void dump_code_heap() { cell reloc_size = 0, literal_size = 0; @@ -325,7 +325,7 @@ void dump_code_heap(void) print_cell(literal_size); print_string(" bytes of literal data\n"); } -void factorbug(void) +void factorbug() { if(fep_disabled) { diff --git a/vm/debug.hpp b/vm/debug.hpp index 81874bf2ac..cb84c9256c 100755 --- a/vm/debug.hpp +++ b/vm/debug.hpp @@ -3,8 +3,8 @@ namespace factor void print_obj(cell obj); void print_nested_obj(cell obj, fixnum nesting); -void dump_generations(void); -void factorbug(void); +void dump_generations(); +void factorbug(); void dump_zone(zone *z); PRIMITIVE(die); diff --git a/vm/errors.cpp b/vm/errors.cpp index f2ba355293..610482f576 100755 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -9,7 +9,7 @@ cell signal_number; cell signal_fault_addr; stack_frame *signal_callstack_top; -void out_of_memory(void) +void out_of_memory() { print_string("Out of memory\n\n"); dump_generations(); @@ -88,7 +88,7 @@ void type_error(cell type, cell tagged) general_error(ERROR_TYPE,tag_fixnum(type),tagged,NULL); } -void not_implemented_error(void) +void not_implemented_error() { general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL); } @@ -125,7 +125,7 @@ void signal_error(int signal, stack_frame *native_stack) general_error(ERROR_SIGNAL,tag_fixnum(signal),F,native_stack); } -void divide_by_zero_error(void) +void divide_by_zero_error() { general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL); } @@ -141,12 +141,12 @@ PRIMITIVE(unimplemented) not_implemented_error(); } -void memory_signal_handler_impl(void) +void memory_signal_handler_impl() { memory_protection_error(signal_fault_addr,signal_callstack_top); } -void misc_signal_handler_impl(void) +void misc_signal_handler_impl() { signal_error(signal_number,signal_callstack_top); } diff --git a/vm/errors.hpp b/vm/errors.hpp index e5968468a5..11180508e5 100755 --- a/vm/errors.hpp +++ b/vm/errors.hpp @@ -22,7 +22,7 @@ enum vm_error_type ERROR_MEMORY, }; -void out_of_memory(void); +void out_of_memory(); void fatal_error(const char* msg, cell tagged); void critical_error(const char* msg, cell tagged); @@ -30,11 +30,11 @@ PRIMITIVE(die); void throw_error(cell error, stack_frame *native_stack); void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack); -void divide_by_zero_error(void); +void divide_by_zero_error(); void memory_protection_error(cell addr, stack_frame *native_stack); void signal_error(int signal, stack_frame *native_stack); void type_error(cell type, cell tagged); -void not_implemented_error(void); +void not_implemented_error(); PRIMITIVE(call_clear); PRIMITIVE(unimplemented); @@ -45,7 +45,7 @@ extern cell signal_number; extern cell signal_fault_addr; extern stack_frame *signal_callstack_top; -void memory_signal_handler_impl(void); -void misc_signal_handler_impl(void); +void memory_signal_handler_impl(); +void misc_signal_handler_impl(); } diff --git a/vm/factor.cpp b/vm/factor.cpp index f8f7901304..33d8b73dfe 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -81,7 +81,7 @@ VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **ar } /* Do some initialization that we do once only */ -static void do_stage1_init(void) +static void do_stage1_init() { print_string("*** Stage 2 early init... "); fflush(stdout); @@ -198,9 +198,9 @@ VM_C_API void factor_eval_free(char *result) free(result); } -VM_C_API void factor_yield(void) +VM_C_API void factor_yield() { - void (*callback)(void) = (void (*)(void))alien_offset(userenv[YIELD_CALLBACK_ENV]); + void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]); callback(); } diff --git a/vm/factor.hpp b/vm/factor.hpp index e9ba920e9f..6e00bc012e 100644 --- a/vm/factor.hpp +++ b/vm/factor.hpp @@ -10,7 +10,7 @@ VM_C_API void start_standalone_factor(int argc, vm_char **argv); VM_C_API char *factor_eval_string(char *string); VM_C_API void factor_eval_free(char *result); -VM_C_API void factor_yield(void); +VM_C_API void factor_yield(); VM_C_API void factor_sleep(long ms); } diff --git a/vm/io.cpp b/vm/io.cpp index 2d6c94faf0..5bb5834691 100755 --- a/vm/io.cpp +++ b/vm/io.cpp @@ -14,14 +14,14 @@ The Factor library provides platform-specific code for Unix and Windows with many more capabilities so these words are not usually used in normal operation. */ -void init_c_io(void) +void init_c_io() { userenv[STDIN_ENV] = allot_alien(F,(cell)stdin); userenv[STDOUT_ENV] = allot_alien(F,(cell)stdout); userenv[STDERR_ENV] = allot_alien(F,(cell)stderr); } -void io_error(void) +void io_error() { #ifndef WINCE if(errno == EINTR) @@ -216,12 +216,12 @@ PRIMITIVE(fclose) /* This function is used by FFI I/O. Accessing the errno global directly is not portable, since on some libc's errno is not a global but a funky macro that reads thread-local storage. */ -VM_C_API int err_no(void) +VM_C_API int err_no() { return errno; } -VM_C_API void clear_err_no(void) +VM_C_API void clear_err_no() { errno = 0; } diff --git a/vm/io.hpp b/vm/io.hpp index 968e96f0b5..d94d6402d9 100755 --- a/vm/io.hpp +++ b/vm/io.hpp @@ -1,8 +1,8 @@ namespace factor { -void init_c_io(void); -void io_error(void); +void init_c_io(); +void io_error(); PRIMITIVE(fopen); PRIMITIVE(fgetc); @@ -18,7 +18,7 @@ PRIMITIVE(open_file); PRIMITIVE(existsp); PRIMITIVE(read_dir); -VM_C_API int err_no(void); -VM_C_API void clear_err_no(void); +VM_C_API int err_no(); +VM_C_API void clear_err_no(); } diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp index f752c3cb8f..03edf862a8 100644 --- a/vm/mach_signal.cpp +++ b/vm/mach_signal.cpp @@ -169,7 +169,7 @@ mach_exception_thread (void *arg) } /* Initialize the Mach exception handler thread. */ -void mach_initialize (void) +void mach_initialize () { mach_port_t self; exception_mask_t mask; diff --git a/vm/mach_signal.hpp b/vm/mach_signal.hpp index 5dd344c080..a2ef07b0ec 100644 --- a/vm/mach_signal.hpp +++ b/vm/mach_signal.hpp @@ -79,6 +79,6 @@ catch_exception_raise_state_identity (mach_port_t exception_port, namespace factor { -void mach_initialize (void); +void mach_initialize (); } diff --git a/vm/math.cpp b/vm/math.cpp index 57d5e4a517..37768f5542 100644 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -219,7 +219,7 @@ PRIMITIVE(byte_array_to_bignum) drepl(tag(result)); } -cell unbox_array_size(void) +cell unbox_array_size() { switch(tagged(dpeek()).type()) { diff --git a/vm/math.hpp b/vm/math.hpp index 763ed55f9a..198960d3b5 100644 --- a/vm/math.hpp +++ b/vm/math.hpp @@ -59,7 +59,7 @@ inline static cell allot_cell(cell x) return tag_fixnum(x); } -cell unbox_array_size(void); +cell unbox_array_size(); inline static double untag_float(cell tagged) { diff --git a/vm/os-freebsd.cpp b/vm/os-freebsd.cpp index 63313f61e0..d259658284 100644 --- a/vm/os-freebsd.cpp +++ b/vm/os-freebsd.cpp @@ -4,7 +4,7 @@ namespace factor { /* From SBCL */ -const char *vm_executable_path(void) +const char *vm_executable_path() { char path[PATH_MAX + 1]; diff --git a/vm/os-freebsd.hpp b/vm/os-freebsd.hpp index 0acf537d45..7797a7199b 100644 --- a/vm/os-freebsd.hpp +++ b/vm/os-freebsd.hpp @@ -1,7 +1,7 @@ #include #include -extern "C" int getosreldate(void); +extern "C" int getosreldate(); #ifndef KERN_PROC_PATHNAME #define KERN_PROC_PATHNAME 12 diff --git a/vm/os-genunix.cpp b/vm/os-genunix.cpp index 731527d208..6cca455eb7 100755 --- a/vm/os-genunix.cpp +++ b/vm/os-genunix.cpp @@ -8,17 +8,17 @@ void c_to_factor_toplevel(cell quot) c_to_factor(quot); } -void init_signals(void) +void init_signals() { unix_init_signals(); } -void early_init(void) { } +void early_init() { } #define SUFFIX ".image" #define SUFFIX_LEN 6 -const char *default_image_path(void) +const char *default_image_path() { const char *path = vm_executable_path(); diff --git a/vm/os-genunix.hpp b/vm/os-genunix.hpp index bc12f716cf..1972a728e6 100644 --- a/vm/os-genunix.hpp +++ b/vm/os-genunix.hpp @@ -5,9 +5,9 @@ namespace factor #define NULL_DLL NULL void c_to_factor_toplevel(cell quot); -void init_signals(void); -void early_init(void); -const char *vm_executable_path(void); -const char *default_image_path(void); +void init_signals(); +void early_init(); +const char *vm_executable_path(); +const char *default_image_path(); } diff --git a/vm/os-linux.cpp b/vm/os-linux.cpp index ecc8973ebe..f5814d7f18 100644 --- a/vm/os-linux.cpp +++ b/vm/os-linux.cpp @@ -4,7 +4,7 @@ namespace factor { /* Snarfed from SBCL linux-so.c. You must free() this yourself. */ -const char *vm_executable_path(void) +const char *vm_executable_path() { char *path = (char *)safe_malloc(PATH_MAX + 1); @@ -23,7 +23,7 @@ const char *vm_executable_path(void) #ifdef SYS_inotify_init -int inotify_init(void) +int inotify_init() { return syscall(SYS_inotify_init); } @@ -40,7 +40,7 @@ int inotify_rm_watch(int fd, u32 wd) #else -int inotify_init(void) +int inotify_init() { not_implemented_error(); return -1; diff --git a/vm/os-linux.hpp b/vm/os-linux.hpp index 4e2f22b95f..257a6b0692 100644 --- a/vm/os-linux.hpp +++ b/vm/os-linux.hpp @@ -3,7 +3,7 @@ namespace factor { -int inotify_init(void); +int inotify_init(); int inotify_add_watch(int fd, const char *name, u32 mask); int inotify_rm_watch(int fd, u32 wd); diff --git a/vm/os-macosx.hpp b/vm/os-macosx.hpp index aa166910f5..cdc0ff7b42 100644 --- a/vm/os-macosx.hpp +++ b/vm/os-macosx.hpp @@ -5,11 +5,11 @@ namespace factor #define FACTOR_OS_STRING "macosx" #define NULL_DLL "libfactor.dylib" -void init_signals(void); -void early_init(void); +void init_signals(); +void early_init(); -const char *vm_executable_path(void); -const char *default_image_path(void); +const char *vm_executable_path(); +const char *default_image_path(); inline static void *ucontext_stack_pointer(void *uap) { diff --git a/vm/os-netbsd.cpp b/vm/os-netbsd.cpp index 7a3cb30652..e280d99a80 100755 --- a/vm/os-netbsd.cpp +++ b/vm/os-netbsd.cpp @@ -5,7 +5,7 @@ namespace factor extern "C" int main(); -const char *vm_executable_path(void) +const char *vm_executable_path() { static Dl_info info = {0}; if (!info.dli_fname) diff --git a/vm/os-openbsd.cpp b/vm/os-openbsd.cpp index fc8aac8cf7..f763f8055f 100644 --- a/vm/os-openbsd.cpp +++ b/vm/os-openbsd.cpp @@ -3,7 +3,7 @@ namespace factor { -const char *vm_executable_path(void) +const char *vm_executable_path() { return NULL; } diff --git a/vm/os-solaris.cpp b/vm/os-solaris.cpp index fc8aac8cf7..f763f8055f 100644 --- a/vm/os-solaris.cpp +++ b/vm/os-solaris.cpp @@ -3,7 +3,7 @@ namespace factor { -const char *vm_executable_path(void) +const char *vm_executable_path() { return NULL; } diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index c0a268018e..18300949bd 100755 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -19,7 +19,7 @@ void start_thread(void *(*start_routine)(void *)) static void *null_dll; -s64 current_micros(void) +s64 current_micros() { struct timeval t; gettimeofday(&t,NULL); @@ -31,7 +31,7 @@ void sleep_micros(cell usec) usleep(usec); } -void init_ffi(void) +void init_ffi() { /* NULL_DLL is "libfactor.dylib" for OS X and NULL for generic unix */ null_dll = dlopen(NULL_DLL,RTLD_LAZY); @@ -145,7 +145,7 @@ static void sigaction_safe(int signum, const struct sigaction *act, struct sigac fatal_error("sigaction failed", 0); } -void unix_init_signals(void) +void unix_init_signals() { struct sigaction memory_sigaction; struct sigaction misc_sigaction; @@ -279,7 +279,7 @@ void *stdin_loop(void *arg) return NULL; } -void open_console(void) +void open_console() { int filedes[2]; @@ -304,7 +304,7 @@ void open_console(void) start_thread(stdin_loop); } -VM_C_API void wait_for_stdin(void) +VM_C_API void wait_for_stdin() { if(write(control_write,"X",1) != 1) { diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp index 24e8016db4..07ec385763 100755 --- a/vm/os-unix.hpp +++ b/vm/os-unix.hpp @@ -42,18 +42,18 @@ typedef char symbol_char; void start_thread(void *(*start_routine)(void *)); -void init_ffi(void); +void init_ffi(); void ffi_dlopen(dll *dll); void *ffi_dlsym(dll *dll, symbol_char *symbol); void ffi_dlclose(dll *dll); -void unix_init_signals(void); +void unix_init_signals(); void signal_handler(int signal, siginfo_t* siginfo, void* uap); void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap); -s64 current_micros(void); +s64 current_micros(); void sleep_micros(cell usec); -void open_console(void); +void open_console(); } diff --git a/vm/os-windows-ce.cpp b/vm/os-windows-ce.cpp index 71c72e55f8..2e69a1eb5b 100755 --- a/vm/os-windows-ce.cpp +++ b/vm/os-windows-ce.cpp @@ -3,7 +3,7 @@ namespace factor { -s64 current_micros(void) +s64 current_micros() { SYSTEMTIME st; FILETIME ft; @@ -40,6 +40,6 @@ void c_to_factor_toplevel(cell quot) c_to_factor(quot); } -void open_console(void) { } +void open_console() { } } diff --git a/vm/os-windows-ce.hpp b/vm/os-windows-ce.hpp index 49450f91c7..f41262e54b 100755 --- a/vm/os-windows-ce.hpp +++ b/vm/os-windows-ce.hpp @@ -22,8 +22,8 @@ char *getenv(char *name); #define snprintf _snprintf #define snwprintf _snwprintf -s64 current_micros(void); +s64 current_micros(); void c_to_factor_toplevel(cell quot); -void open_console(void); +void open_console(); } diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp index 0a63dce513..5a60fff11b 100755 --- a/vm/os-windows-nt.cpp +++ b/vm/os-windows-nt.cpp @@ -3,7 +3,7 @@ namespace factor { -s64 current_micros(void) +s64 current_micros() { FILETIME t; GetSystemTimeAsFileTime(&t); @@ -49,7 +49,7 @@ void c_to_factor_toplevel(cell quot) RemoveVectoredExceptionHandler((void*)exception_handler); } -void open_console(void) +void open_console() { } diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp index 107e42ea2e..9dbb8a9970 100755 --- a/vm/os-windows-nt.hpp +++ b/vm/os-windows-nt.hpp @@ -19,6 +19,6 @@ typedef char symbol_char; void c_to_factor_toplevel(cell quot); long exception_handler(PEXCEPTION_POINTERS pe); -void open_console(void); +void open_console(); } diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index 796a1c7184..90461a93d0 100755 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -5,7 +5,7 @@ namespace factor HMODULE hFactorDll; -void init_ffi(void) +void init_ffi() { hFactorDll = GetModuleHandle(FACTOR_DLL); if(!hFactorDll) @@ -63,7 +63,7 @@ void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int len } /* You must free() this yourself. */ -const vm_char *default_image_path(void) +const vm_char *default_image_path() { vm_char full_path[MAX_UNICODE_PATH]; vm_char *ptr; @@ -82,7 +82,7 @@ const vm_char *default_image_path(void) } /* You must free() this yourself. */ -const vm_char *vm_executable_path(void) +const vm_char *vm_executable_path() { vm_char full_path[MAX_UNICODE_PATH]; if(!GetModuleFileName(NULL, full_path, MAX_UNICODE_PATH)) @@ -131,7 +131,7 @@ void dealloc_segment(segment *block) free(block); } -long getpagesize(void) +long getpagesize() { static long g_pagesize = 0; if (! g_pagesize) diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp index 2926ea50a8..5422216593 100755 --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -41,19 +41,19 @@ typedef wchar_t vm_char; /* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */ #define EPOCH_OFFSET 0x019db1ded53e8000LL -void init_ffi(void); +void init_ffi(); void ffi_dlopen(dll *dll); void *ffi_dlsym(dll *dll, symbol_char *symbol); void ffi_dlclose(dll *dll); void sleep_micros(u64 msec); -inline static void init_signals(void) {} -inline static void early_init(void) {} -const vm_char *vm_executable_path(void); -const vm_char *default_image_path(void); -long getpagesize (void); +inline static void init_signals() {} +inline static void early_init() {} +const vm_char *vm_executable_path(); +const vm_char *default_image_path(); +long getpagesize (); -s64 current_micros(void); +s64 current_micros(); } diff --git a/vm/profiler.cpp b/vm/profiler.cpp index 9651e4a27e..a3265e0ffa 100755 --- a/vm/profiler.cpp +++ b/vm/profiler.cpp @@ -5,7 +5,7 @@ namespace factor bool profiling_p; -void init_profiler(void) +void init_profiler() { profiling_p = false; } diff --git a/vm/profiler.hpp b/vm/profiler.hpp index 00f3e8067b..b83ef3d354 100755 --- a/vm/profiler.hpp +++ b/vm/profiler.hpp @@ -2,7 +2,7 @@ namespace factor { extern bool profiling_p; -void init_profiler(void); +void init_profiler(); code_block *compile_profiling_stub(cell word); PRIMITIVE(profiling); diff --git a/vm/quotations.cpp b/vm/quotations.cpp index af00bb468b..555ecc6420 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -297,7 +297,7 @@ PRIMITIVE(quotation_xt) drepl(allot_cell((cell)quot->xt)); } -void compile_all_words(void) +void compile_all_words() { gc_root words(find_all_words()); diff --git a/vm/quotations.hpp b/vm/quotations.hpp index a4545f3956..719a94176e 100755 --- a/vm/quotations.hpp +++ b/vm/quotations.hpp @@ -28,7 +28,7 @@ fixnum quot_code_offset_to_scan(cell quot, cell offset); PRIMITIVE(jit_compile); -void compile_all_words(void); +void compile_all_words(); PRIMITIVE(array_to_quotation); PRIMITIVE(quotation_xt); diff --git a/vm/stacks.hpp b/vm/stacks.hpp index 4af31e17d9..bc1aac8154 100644 --- a/vm/stacks.hpp +++ b/vm/stacks.hpp @@ -4,7 +4,7 @@ namespace factor #define DEFPUSHPOP(prefix,ptr) \ inline static cell prefix##peek() { return *(cell *)ptr; } \ inline static void prefix##repl(cell tagged) { *(cell *)ptr = tagged; } \ - inline static cell prefix##pop(void) \ + inline static cell prefix##pop() \ { \ cell value = prefix##peek(); \ ptr -= sizeof(cell); \ diff --git a/vm/utilities.cpp b/vm/utilities.cpp index 532de80ed1..df5c09847d 100755 --- a/vm/utilities.cpp +++ b/vm/utilities.cpp @@ -20,7 +20,7 @@ vm_char *safe_strdup(const vm_char *str) /* We don't use printf directly, because format directives are not portable. Instead we define the common cases here. */ -void nl(void) +void nl() { fputs("\n",stdout); } @@ -50,7 +50,7 @@ void print_fixnum(fixnum x) printf(FIXNUM_FORMAT,x); } -cell read_cell_hex(void) +cell read_cell_hex() { cell cell; if(scanf(cell_HEX_FORMAT,&cell) < 0) exit(1); diff --git a/vm/utilities.hpp b/vm/utilities.hpp index d311b954ed..7e7765170e 100755 --- a/vm/utilities.hpp +++ b/vm/utilities.hpp @@ -4,12 +4,12 @@ namespace factor void *safe_malloc(size_t size); vm_char *safe_strdup(const vm_char *str); -void nl(void); +void nl(); void print_string(const char *str); void print_cell(cell x); void print_cell_hex(cell x); void print_cell_hex_pad(cell x); void print_fixnum(fixnum x); -cell read_cell_hex(void); +cell read_cell_hex(); } From 9f907c287e2bccb112e7aa54b8d6c437558c43a5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 11:40:28 -0500 Subject: [PATCH 09/28] alien.strings: fix native-string>alien on Windows --- core/alien/strings/strings.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor index 896fb7f09f..3b778d2bd1 100644 --- a/core/alien/strings/strings.factor +++ b/core/alien/strings/strings.factor @@ -40,9 +40,7 @@ M: unix alien>native-string utf8 alien>string ; HOOK: native-string>alien os ( string -- alien ) -M: wince native-string>alien utf16n string>alien ; - -M: winnt native-string>alien utf8 string>alien ; +M: windows native-string>alien utf16n string>alien ; M: unix native-string>alien utf8 string>alien ; From a8cd8e75f8f8aeaa5238073e655957afecec315d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 12:35:27 -0500 Subject: [PATCH 10/28] Update README.txt --- README.txt | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/README.txt b/README.txt index addbe38f0d..54d53b090a 100755 --- a/README.txt +++ b/README.txt @@ -20,25 +20,17 @@ implementation. It is not an introduction to the language itself. * Compiling the Factor VM -The Factor runtime is written in GNU C++, and is built with GNU make and -gcc. - Factor supports various platforms. For an up-to-date list, see . -Factor requires gcc 3.4 or later. - -On x86, Factor /will not/ build using gcc 3.3 or earlier. - -If you are using gcc 4.3, you might get an unusable Factor binary unless -you add 'SITE_CFLAGS=-fno-forward-propagate' to the command-line -arguments for make. +The Factor VM is written in C++ and uses the GNU and TR1 extensions. +As a result, it requires GCC 4.x to compile. Run 'make' ('gmake' on *BSD) with no parameters to build the Factor VM. * Bootstrapping the Factor image -Once you have compiled the Factor runtime, you must bootstrap the Factor +Once you have compiled the Factor VM, you must bootstrap the Factor system using the image that corresponds to your CPU architecture. Boot images can be obtained from . @@ -97,7 +89,7 @@ When compiling Factor, pass the X11=1 parameter: Then bootstrap with the following switches: - ./factor -i=boot..image -ui-backend=x11 -ui-text-backend=pango + ./factor -i=boot..image -ui-backend=x11 Now if $DISPLAY is set, running ./factor will start the UI. @@ -138,7 +130,7 @@ usage documentation, enter the following in the UI listener: The Factor source tree is organized as follows: build-support/ - scripts used for compiling Factor - vm/ - sources for the Factor VM, written in C++ + vm/ - Factor VM core/ - Factor core library basis/ - Factor basis library, compiler, tools extra/ - more libraries and applications From ea2090f9de13db1e15cc5df861d79f3be65e302d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 12:36:17 -0500 Subject: [PATCH 11/28] udis: use a real structure instead of a char[] to fix buffer overflow on 64-bit --- .../tools/disassembler/udis/udis-tests.factor | 8 +++ basis/tools/disassembler/udis/udis.factor | 52 ++++++++++++++++++- 2 files changed, 59 insertions(+), 1 deletion(-) create mode 100644 basis/tools/disassembler/udis/udis-tests.factor diff --git a/basis/tools/disassembler/udis/udis-tests.factor b/basis/tools/disassembler/udis/udis-tests.factor new file mode 100644 index 0000000000..db100a4f31 --- /dev/null +++ b/basis/tools/disassembler/udis/udis-tests.factor @@ -0,0 +1,8 @@ +IN: tools.disassembler.udis.tests +USING: tools.disassembler.udis tools.test alien.c-types system combinators kernel ; + +{ + { [ os linux? cpu x86.64? and ] [ [ 656 ] [ "ud" heap-size ] unit-test ] } + { [ os macosx? cpu x86.32? and ] [ [ 592 ] [ "ud" heap-size ] unit-test ] } + { [ os macosx? cpu x86.64? and ] [ [ 656 ] [ "ud" heap-size ] unit-test ] } +} cond \ No newline at end of file diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index cd9dd9cf4b..1ffe3e0222 100755 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -16,7 +16,57 @@ IN: tools.disassembler.udis LIBRARY: libudis86 -TYPEDEF: char[592] ud +C-STRUCT: ud_operand + { "int" "type" } + { "uint8_t" "size" } + { "uint64_t" "lval" } + { "int" "base" } + { "int" "index" } + { "uint8_t" "offset" } + { "uint8_t" "scale" } ; + +C-STRUCT: ud + { "void*" "inp_hook" } + { "uint8_t" "inp_curr" } + { "uint8_t" "inp_fill" } + { "FILE*" "inp_file" } + { "uint8_t" "inp_ctr" } + { "uint8_t*" "inp_buff" } + { "uint8_t*" "inp_buff_end" } + { "uint8_t" "inp_end" } + { "void*" "translator" } + { "uint64_t" "insn_offset" } + { "char[32]" "insn_hexcode" } + { "char[64]" "insn_buffer" } + { "uint" "insn_fill" } + { "uint8_t" "dis_mode" } + { "uint64_t" "pc" } + { "uint8_t" "vendor" } + { "struct map_entry*" "mapen" } + { "int" "mnemonic" } + { "ud_operand[3]" "operand" } + { "uint8_t" "error" } + { "uint8_t" " " "pfx_rex" } + { "uint8_t" "pfx_seg" } + { "uint8_t" "pfx_opr" } + { "uint8_t" "pfx_adr" } + { "uint8_t" "pfx_lock" } + { "uint8_t" "pfx_rep" } + { "uint8_t" "pfx_repe" } + { "uint8_t" "pfx_repne" } + { "uint8_t" "pfx_insn" } + { "uint8_t" "default64" } + { "uint8_t" "opr_mode" } + { "uint8_t" "adr_mode" } + { "uint8_t" "br_far" } + { "uint8_t" "br_near" } + { "uint8_t" "implicit_addr" } + { "uint8_t" "c1" } + { "uint8_t" "c2" } + { "uint8_t" "c3" } + { "uint8_t[256]" "inp_cache" } + { "uint8_t[64]" "inp_sess" } + { "ud_itab_entry*" "itab_entry" } ; FUNCTION: void ud_translate_intel ( ud* u ) ; FUNCTION: void ud_translate_att ( ud* u ) ; From b0e8ec2aeac35432c246482861885322ddf002de Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 12:47:33 -0500 Subject: [PATCH 12/28] continuations: update tests for word renaming --- core/continuations/continuations-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor index 6409fc588e..a2617d0ebb 100644 --- a/core/continuations/continuations-tests.factor +++ b/core/continuations/continuations-tests.factor @@ -64,7 +64,7 @@ IN: continuations.tests [ 1 2 ] [ bar ] unit-test -[ t ] [ \ bar def>> "c" get innermost-frame-quot = ] unit-test +[ t ] [ \ bar def>> "c" get innermost-frame-executing = ] unit-test [ 1 ] [ "c" get innermost-frame-scan ] unit-test From 6e26c7b55407175f8440eb17df52d92caae7ba91 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 5 May 2009 13:03:24 -0500 Subject: [PATCH 13/28] Fixing compile errors on Windows --- vm/Config.windows | 2 +- vm/alien.cpp | 2 +- vm/os-windows-nt.cpp | 4 ++-- vm/os-windows-nt.hpp | 2 +- vm/os-windows.cpp | 9 +++++---- 5 files changed, 10 insertions(+), 9 deletions(-) diff --git a/vm/Config.windows b/vm/Config.windows index cdb72f4e24..b0b1352cb2 100644 --- a/vm/Config.windows +++ b/vm/Config.windows @@ -6,5 +6,5 @@ EXE_EXTENSION=.exe CONSOLE_EXTENSION=.com DLL_EXTENSION=.dll SHARED_DLL_EXTENSION=.dll -LINKER = $(CC) -shared -mno-cygwin -o +LINKER = $(CPP) -shared -mno-cygwin -o LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX) diff --git a/vm/alien.cpp b/vm/alien.cpp index 06dee31a14..1eb9c5a68d 100755 --- a/vm/alien.cpp +++ b/vm/alien.cpp @@ -128,7 +128,7 @@ PRIMITIVE(dlsym) gc_root name(dpop()); name.untag_check(); - vm_char *sym = (vm_char *)(name.untagged() + 1); + symbol_char *sym = name->data(); if(library.value() == F) box_alien(ffi_dlsym(NULL,sym)); diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp index 0a63dce513..5e0a4c70c6 100755 --- a/vm/os-windows-nt.cpp +++ b/vm/os-windows-nt.cpp @@ -17,7 +17,7 @@ long exception_handler(PEXCEPTION_POINTERS pe) CONTEXT *c = (CONTEXT*)pe->ContextRecord; if(in_code_heap_p(c->EIP)) - signal_callstack_top = (void *)c->ESP; + signal_callstack_top = (stack_frame *)c->ESP; else signal_callstack_top = NULL; @@ -43,7 +43,7 @@ long exception_handler(PEXCEPTION_POINTERS pe) void c_to_factor_toplevel(cell quot) { - if(!AddVectoredExceptionHandler(0, (void*)exception_handler)) + if(!AddVectoredExceptionHandler(0, exception_handler)) fatal_error("AddVectoredExceptionHandler failed", 0); c_to_factor(quot); RemoveVectoredExceptionHandler((void*)exception_handler); diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp index 107e42ea2e..2765f0a180 100755 --- a/vm/os-windows-nt.hpp +++ b/vm/os-windows-nt.hpp @@ -5,8 +5,8 @@ #define UNICODE #endif -#include #include +#include namespace factor { diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index 796a1c7184..001b48ab4d 100755 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -14,12 +14,12 @@ void init_ffi(void) void ffi_dlopen(dll *dll) { - dll->dll = LoadLibraryEx(alien_offset(dll->path), NULL, 0); + dll->dll = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0); } void *ffi_dlsym(dll *dll, symbol_char *symbol) { - return GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol); + return (void *)GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol); } void ffi_dlclose(dll *dll) @@ -93,7 +93,8 @@ const vm_char *vm_executable_path(void) PRIMITIVE(existsp) { - vm_char *path = (vm_char *)(untag_check(dpop()) + 1); + vm_char *path = untag_check(dpop())->data(); + wprintf(L"existsp: path is %s\n",path); box_boolean(windows_stat(path)); } @@ -113,7 +114,7 @@ segment *alloc_segment(cell size) getpagesize(), PAGE_NOACCESS, &ignore)) fatal_error("Cannot allocate high guard page", (cell)mem); - segment *block = safe_malloc(sizeof(segment)); + segment *block = (segment *)safe_malloc(sizeof(segment)); block->start = (cell)mem + getpagesize(); block->size = size; From 56597b65f4595172058cfe077696c37b187030b3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 14:17:02 -0500 Subject: [PATCH 14/28] VM now compiles with GCC 3.4 on Windows --- vm/code_gc.cpp | 4 ++-- vm/code_gc.hpp | 4 ++-- vm/code_heap.cpp | 2 +- vm/data_heap.cpp | 4 ++-- vm/dispatch.cpp | 2 +- vm/inline_cache.cpp | 2 +- vm/layouts.hpp | 3 +++ vm/master.hpp | 10 +++++++++- vm/math.cpp | 6 +++--- vm/os-windows-nt.cpp | 6 +++--- vm/os-windows-nt.hpp | 4 +++- 11 files changed, 30 insertions(+), 17 deletions(-) mode change 100644 => 100755 vm/data_heap.cpp mode change 100644 => 100755 vm/dispatch.cpp mode change 100644 => 100755 vm/inline_cache.cpp mode change 100644 => 100755 vm/master.hpp mode change 100644 => 100755 vm/math.cpp diff --git a/vm/code_gc.cpp b/vm/code_gc.cpp index 721c3f3a7a..59110d13f8 100755 --- a/vm/code_gc.cpp +++ b/vm/code_gc.cpp @@ -303,7 +303,7 @@ cell heap_size(heap *heap) } /* Compute where each block is going to go, after compaction */ - cell compute_heap_forwarding(heap *heap, std::tr1::unordered_map &forwarding) + cell compute_heap_forwarding(heap *heap, unordered_map &forwarding) { heap_block *scan = first_block(heap); char *address = (char *)first_block(heap); @@ -324,7 +324,7 @@ cell heap_size(heap *heap) return (cell)address - heap->seg->start; } - void compact_heap(heap *heap, std::tr1::unordered_map &forwarding) + void compact_heap(heap *heap, unordered_map &forwarding) { heap_block *scan = first_block(heap); diff --git a/vm/code_gc.hpp b/vm/code_gc.hpp index 1ad68f46fd..ebd6349ab9 100755 --- a/vm/code_gc.hpp +++ b/vm/code_gc.hpp @@ -25,8 +25,8 @@ void unmark_marked(heap *heap); void free_unmarked(heap *heap, heap_iterator iter); void heap_usage(heap *h, cell *used, cell *total_free, cell *max_free); cell heap_size(heap *h); -cell compute_heap_forwarding(heap *h, std::tr1::unordered_map &forwarding); -void compact_heap(heap *h, std::tr1::unordered_map &forwarding); +cell compute_heap_forwarding(heap *h, unordered_map &forwarding); +void compact_heap(heap *h, unordered_map &forwarding); inline static heap_block *next_block(heap *h, heap_block *block) { diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index db1fd8f880..77c78ad533 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -119,7 +119,7 @@ PRIMITIVE(code_room) dpush(tag_fixnum(max_free / 1024)); } -static std::tr1::unordered_map forwarding; +static unordered_map forwarding; code_block *forward_xt(code_block *compiled) { diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp old mode 100644 new mode 100755 index 0045539549..9c84a993c8 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -241,7 +241,7 @@ cell unaligned_object_size(object *pointer) return callstack_size(untag_fixnum(((callstack *)pointer)->length)); default: critical_error("Invalid header",(cell)pointer); - return -1; /* can't happen */ + return 0; /* can't happen */ } } @@ -283,7 +283,7 @@ cell binary_payload_start(object *pointer) return sizeof(wrapper); default: critical_error("Invalid header",(cell)pointer); - return -1; /* can't happen */ + return 0; /* can't happen */ } } diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp old mode 100644 new mode 100755 index bbcf20c57b..847a19d738 --- a/vm/dispatch.cpp +++ b/vm/dispatch.cpp @@ -103,7 +103,7 @@ static cell lookup_hairy_method(cell obj, cell methods) break; default: critical_error("Bad methods array",methods); - return -1; + return 0; } } } diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp old mode 100644 new mode 100755 index 23c4b27c47..259a3e0c77 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -70,7 +70,7 @@ static cell determine_inline_cache_type(array *cache_entries) if(!seen_hi_tag && !seen_tuple) return PIC_TAG; critical_error("Oops",0); - return -1; + return 0; } static void update_pic_count(cell type) diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 114b88b925..8c96cf3187 100755 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -93,6 +93,9 @@ class object; struct header { cell value; + /* Default ctor to make gcc 3.x happy */ + header() { abort(); } + header(cell value_) : value(value_ << TAG_BITS) {} void check_header() { diff --git a/vm/master.hpp b/vm/master.hpp old mode 100644 new mode 100755 index 65d17fab4b..6409d65494 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -22,7 +22,15 @@ #include /* C++ headers */ -#include +#if __GNUC__ == 4 + #include + #define unordered_map std::tr1::unordered_map +#elif __GNUC__ == 3 + #include + #define unordered_map boost::unordered_map +#else + #error Factor requires GCC 3.x or later +#endif /* Factor headers */ #include "layouts.hpp" diff --git a/vm/math.cpp b/vm/math.cpp old mode 100644 new mode 100755 index 37768f5542..7a2abe7463 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -377,7 +377,7 @@ VM_C_API fixnum to_fixnum(cell tagged) return bignum_to_fixnum(untag(tagged)); default: type_error(FIXNUM_TYPE,tagged); - return -1; /* can't happen */ + return 0; /* can't happen */ } } @@ -444,7 +444,7 @@ VM_C_API s64 to_signed_8(cell obj) return bignum_to_long_long(untag(obj)); default: type_error(BIGNUM_TYPE,obj); - return -1; + return 0; } } @@ -466,7 +466,7 @@ VM_C_API u64 to_unsigned_8(cell obj) return bignum_to_ulong_long(untag(obj)); default: type_error(BIGNUM_TYPE,obj); - return -1; + return 0; } } diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp index f07fdaeb87..c4349f243b 100755 --- a/vm/os-windows-nt.cpp +++ b/vm/os-windows-nt.cpp @@ -11,7 +11,7 @@ s64 current_micros() - EPOCH_OFFSET) / 10; } -long exception_handler(PEXCEPTION_POINTERS pe) +FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe) { PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord; CONTEXT *c = (CONTEXT*)pe->ContextRecord; @@ -43,10 +43,10 @@ long exception_handler(PEXCEPTION_POINTERS pe) void c_to_factor_toplevel(cell quot) { - if(!AddVectoredExceptionHandler(0, exception_handler)) + if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler)) fatal_error("AddVectoredExceptionHandler failed", 0); c_to_factor(quot); - RemoveVectoredExceptionHandler((void*)exception_handler); + RemoveVectoredExceptionHandler((void *)exception_handler); } void open_console() diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp index 551a798b45..4371771c13 100755 --- a/vm/os-windows-nt.hpp +++ b/vm/os-windows-nt.hpp @@ -17,8 +17,10 @@ typedef char symbol_char; #define FACTOR_DLL L"factor.dll" #define FACTOR_DLL_NAME "factor.dll" +#define FACTOR_STDCALL __attribute__((stdcall)) + void c_to_factor_toplevel(cell quot); -long exception_handler(PEXCEPTION_POINTERS pe); +FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe); void open_console(); } From 3295c54bff32ebe561c34504d78542ae7e4e7ad8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 14:27:22 -0500 Subject: [PATCH 15/28] Remove debug messages from VM --- vm/code_block.cpp | 1 - vm/os-windows.cpp | 1 - 2 files changed, 2 deletions(-) mode change 100644 => 100755 vm/code_block.cpp diff --git a/vm/code_block.cpp b/vm/code_block.cpp old mode 100644 new mode 100755 index d27460853d..bb3481904e --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -329,7 +329,6 @@ void *get_rel_symbol(array *literals, cell index) return sym; else { - printf("%s\n",name); return (void *)undefined_symbol; } } diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index bd87c96155..7db19ff560 100755 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -94,7 +94,6 @@ const vm_char *vm_executable_path() PRIMITIVE(existsp) { vm_char *path = untag_check(dpop())->data(); - wprintf(L"existsp: path is %s\n",path); box_boolean(windows_stat(path)); } From 44e6ec400b1a3c58eef826cb5e986f217201ded4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 14:36:15 -0500 Subject: [PATCH 16/28] Update README.txt for new compilation dependencies --- README.txt | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.txt b/README.txt index 54d53b090a..a33a85b218 100755 --- a/README.txt +++ b/README.txt @@ -23,8 +23,9 @@ implementation. It is not an introduction to the language itself. Factor supports various platforms. For an up-to-date list, see . -The Factor VM is written in C++ and uses the GNU and TR1 extensions. -As a result, it requires GCC 4.x to compile. +The Factor VM is written in C++ and uses GNU extensions. When compiling +with GCC 3.x, boost::unordered_map must be installed. On GCC 4.x, Factor +uses std::tr1::unordered_map which is shipped as part of GCC. Run 'make' ('gmake' on *BSD) with no parameters to build the Factor VM. From 764ee52cde88c6feefcc55a09e5ea689e65356a9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 14:41:38 -0500 Subject: [PATCH 17/28] alien.strings: fix symbol>string for Windows --- core/alien/strings/strings.factor | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor index 3b778d2bd1..c74c325726 100644 --- a/core/alien/strings/strings.factor +++ b/core/alien/strings/strings.factor @@ -47,10 +47,19 @@ M: unix native-string>alien utf8 string>alien ; : dll-path ( dll -- string ) path>> alien>native-string ; -: string>symbol ( str -- alien ) - dup string? - [ native-string>alien ] - [ [ native-string>alien ] map ] if ; +HOOK: string>symbol* os ( str/seq -- alien ) + +M: winnt string>symbol* utf8 string>alien ; + +M: wince string>symbol* utf16n string>alien ; + +M: unix string>symbol* utf8 string>alien ; + +GENERIC: string>symbol ( str -- alien ) + +M: string string>symbol string>symbol* ; + +M: sequence string>symbol [ string>symbol* ] map ; [ 8 getenv utf8 alien>string string>cpu \ cpu set-global From 428f443c9c2ad0917af035d87b3f5f6480d7ec3d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 15:06:05 -0500 Subject: [PATCH 18/28] compiler.constants: update compiled-header-size --- basis/compiler/constants/constants.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index 2f0494b58a..cc6397bd65 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -23,7 +23,7 @@ CONSTANT: deck-bits 18 : quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline : word-code-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline : array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline -: compiled-header-size ( -- n ) 5 bootstrap-cells ; inline +: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline ! Relocation classes CONSTANT: rc-absolute-cell 0 From 8133436d6de2caa3202aa312c96687376a961153 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 15:54:49 -0500 Subject: [PATCH 19/28] literals: Improve ${ word --- basis/literals/literals-tests.factor | 6 ++++-- basis/literals/literals.factor | 19 ++++++++++++++++--- 2 files changed, 20 insertions(+), 5 deletions(-) mode change 100644 => 100755 basis/literals/literals-tests.factor mode change 100644 => 100755 basis/literals/literals.factor diff --git a/basis/literals/literals-tests.factor b/basis/literals/literals-tests.factor old mode 100644 new mode 100755 index 29072f1299..d7256a64b1 --- a/basis/literals/literals-tests.factor +++ b/basis/literals/literals-tests.factor @@ -20,8 +20,10 @@ IN: literals.tests [ { 1.0 { 0.5 1.5 } 4.0 } ] [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test -<< CONSTANT: constant-a 3 ->> [ { 3 10 "ftw" } ] [ ${ constant-a 10 "ftw" } ] unit-test + +: sixty-nine ( -- a b ) 6 9 ; + +[ { 6 9 } ] [ ${ sixty-nine } ] unit-test diff --git a/basis/literals/literals.factor b/basis/literals/literals.factor old mode 100644 new mode 100755 index 7c7592dda8..ba1da393b1 --- a/basis/literals/literals.factor +++ b/basis/literals/literals.factor @@ -1,8 +1,21 @@ ! (c) Joe Groff, see license for details USING: accessors continuations kernel parser words quotations -combinators.smart vectors sequences ; +combinators.smart vectors sequences fry ; IN: literals -SYNTAX: $ scan-word [ def>> call ] curry with-datastack >vector ; +> call so that CONSTANT:s defined in the same file can +! be called + +: expand-literal ( seq obj -- seq' ) + '[ _ dup word? [ def>> call ] when ] with-datastack ; + +: expand-literals ( seq -- seq' ) + [ [ { } ] dip expand-literal ] map concat ; + +PRIVATE> + +SYNTAX: $ scan-word expand-literal >vector ; SYNTAX: $[ parse-quotation with-datastack >vector ; -SYNTAX: ${ \ } [ [ ?execute ] { } map-as ] parse-literal ; +SYNTAX: ${ \ } [ expand-literals ] parse-literal ; From 8d5d1b8bb53e27b0d18cbe0db47a48d39872982a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 15:55:41 -0500 Subject: [PATCH 20/28] Fix VM code to export the right symbols on Windows --- vm/cpu-x86.32.hpp | 2 +- vm/cpu-x86.64.hpp | 2 +- vm/write_barrier.hpp | 9 ++++----- 3 files changed, 6 insertions(+), 7 deletions(-) mode change 100644 => 100755 vm/cpu-x86.64.hpp mode change 100644 => 100755 vm/write_barrier.hpp diff --git a/vm/cpu-x86.32.hpp b/vm/cpu-x86.32.hpp index 6b6328aa4f..902b33b0b4 100755 --- a/vm/cpu-x86.32.hpp +++ b/vm/cpu-x86.32.hpp @@ -6,6 +6,6 @@ namespace factor register cell ds asm("esi"); register cell rs asm("edi"); -#define VM_ASM_API extern "C" __attribute__ ((regparm (2))) +#define VM_ASM_API VM_C_API __attribute__ ((regparm (2))) } diff --git a/vm/cpu-x86.64.hpp b/vm/cpu-x86.64.hpp old mode 100644 new mode 100755 index be71a78aa8..679c301548 --- a/vm/cpu-x86.64.hpp +++ b/vm/cpu-x86.64.hpp @@ -6,6 +6,6 @@ namespace factor register cell ds asm("r14"); register cell rs asm("r15"); -#define VM_ASM_API extern "C" +#define VM_ASM_API VM_C_API } diff --git a/vm/write_barrier.hpp b/vm/write_barrier.hpp old mode 100644 new mode 100755 index ae7fbb25dd..e656b66a56 --- a/vm/write_barrier.hpp +++ b/vm/write_barrier.hpp @@ -6,6 +6,9 @@ card has a slot written to. the offset of the first object is set by the allocator. */ +VM_C_API factor::cell cards_offset; +VM_C_API factor::cell decks_offset; + namespace factor { @@ -19,8 +22,6 @@ typedef u8 card; #define CARD_SIZE (1<> CARD_BITS) + cards_offset); @@ -42,8 +43,6 @@ typedef u8 card_deck; #define DECK_SIZE (1<> DECK_BITS) + decks_offset); @@ -61,7 +60,7 @@ inline static card *deck_to_card(card_deck *d) #define INVALID_ALLOT_MARKER 0xff -VM_C_API cell allot_markers_offset; +cell allot_markers_offset; inline static card *addr_to_allot_marker(object *a) { From e4289f5ae403859ba1144fb95905095fde4021ee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 15:56:53 -0500 Subject: [PATCH 21/28] tools.disassembler.udis: fix types for Windows --- basis/tools/disassembler/udis/udis.factor | 70 +++++++++++------------ 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index 1ffe3e0222..df624cab28 100755 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -18,54 +18,54 @@ LIBRARY: libudis86 C-STRUCT: ud_operand { "int" "type" } - { "uint8_t" "size" } - { "uint64_t" "lval" } + { "uchar" "size" } + { "ulonglong" "lval" } { "int" "base" } { "int" "index" } - { "uint8_t" "offset" } - { "uint8_t" "scale" } ; + { "uchar" "offset" } + { "uchar" "scale" } ; C-STRUCT: ud { "void*" "inp_hook" } - { "uint8_t" "inp_curr" } - { "uint8_t" "inp_fill" } + { "uchar" "inp_curr" } + { "uchar" "inp_fill" } { "FILE*" "inp_file" } - { "uint8_t" "inp_ctr" } - { "uint8_t*" "inp_buff" } - { "uint8_t*" "inp_buff_end" } - { "uint8_t" "inp_end" } + { "uchar" "inp_ctr" } + { "uchar*" "inp_buff" } + { "uchar*" "inp_buff_end" } + { "uchar" "inp_end" } { "void*" "translator" } - { "uint64_t" "insn_offset" } + { "ulonglong" "insn_offset" } { "char[32]" "insn_hexcode" } { "char[64]" "insn_buffer" } { "uint" "insn_fill" } - { "uint8_t" "dis_mode" } - { "uint64_t" "pc" } - { "uint8_t" "vendor" } + { "uchar" "dis_mode" } + { "ulonglong" "pc" } + { "uchar" "vendor" } { "struct map_entry*" "mapen" } { "int" "mnemonic" } { "ud_operand[3]" "operand" } - { "uint8_t" "error" } - { "uint8_t" " " "pfx_rex" } - { "uint8_t" "pfx_seg" } - { "uint8_t" "pfx_opr" } - { "uint8_t" "pfx_adr" } - { "uint8_t" "pfx_lock" } - { "uint8_t" "pfx_rep" } - { "uint8_t" "pfx_repe" } - { "uint8_t" "pfx_repne" } - { "uint8_t" "pfx_insn" } - { "uint8_t" "default64" } - { "uint8_t" "opr_mode" } - { "uint8_t" "adr_mode" } - { "uint8_t" "br_far" } - { "uint8_t" "br_near" } - { "uint8_t" "implicit_addr" } - { "uint8_t" "c1" } - { "uint8_t" "c2" } - { "uint8_t" "c3" } - { "uint8_t[256]" "inp_cache" } - { "uint8_t[64]" "inp_sess" } + { "uchar" "error" } + { "uchar" "pfx_rex" } + { "uchar" "pfx_seg" } + { "uchar" "pfx_opr" } + { "uchar" "pfx_adr" } + { "uchar" "pfx_lock" } + { "uchar" "pfx_rep" } + { "uchar" "pfx_repe" } + { "uchar" "pfx_repne" } + { "uchar" "pfx_insn" } + { "uchar" "default64" } + { "uchar" "opr_mode" } + { "uchar" "adr_mode" } + { "uchar" "br_far" } + { "uchar" "br_near" } + { "uchar" "implicit_addr" } + { "uchar" "c1" } + { "uchar" "c2" } + { "uchar" "c3" } + { "uchar[256]" "inp_cache" } + { "uchar[64]" "inp_sess" } { "ud_itab_entry*" "itab_entry" } ; FUNCTION: void ud_translate_intel ( ud* u ) ; From e68a4df399e5521094e0d55660470ef0c19f8b00 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 15:57:08 -0500 Subject: [PATCH 22/28] bootstrap.compiler: clean up --- basis/bootstrap/compiler/compiler.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 basis/bootstrap/compiler/compiler.factor diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor old mode 100644 new mode 100755 index 7940703140..3aefdec29f --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -41,7 +41,7 @@ nl ! which are also quick to compile are replaced by ! compiled definitions as soon as possible. { - roll -roll declare not + not array? hashtable? vector? tuple? sbuf? tombstone? From a6afbea707fe5b02abede051b9af24d837c5ca05 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 16:00:31 -0500 Subject: [PATCH 23/28] alien.libraries: Fix dlsym on Windows --- basis/alien/libraries/libraries.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 basis/alien/libraries/libraries.factor diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor old mode 100644 new mode 100755 index 6c18065ab6..0b39bedadd --- a/basis/alien/libraries/libraries.factor +++ b/basis/alien/libraries/libraries.factor @@ -5,7 +5,7 @@ IN: alien.libraries : dlopen ( path -- dll ) native-string>alien (dlopen) ; -: dlsym ( name dll -- alien ) [ native-string>alien ] dip (dlsym) ; +: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ; SYMBOL: libraries From be207afe9a3929315817c4156fb5be233e7726a2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 16:19:13 -0500 Subject: [PATCH 24/28] Fix VM compile error --- vm/write_barrier.cpp | 6 +++++- vm/write_barrier.hpp | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) mode change 100644 => 100755 vm/write_barrier.cpp diff --git a/vm/write_barrier.cpp b/vm/write_barrier.cpp old mode 100644 new mode 100755 index 4137b0a6eb..0e87434b56 --- a/vm/write_barrier.cpp +++ b/vm/write_barrier.cpp @@ -4,4 +4,8 @@ using namespace factor; cell cards_offset; cell decks_offset; -cell allot_markers_offset; + +namespace factor +{ + cell allot_markers_offset; +} diff --git a/vm/write_barrier.hpp b/vm/write_barrier.hpp index e656b66a56..eaede538ed 100755 --- a/vm/write_barrier.hpp +++ b/vm/write_barrier.hpp @@ -60,7 +60,7 @@ inline static card *deck_to_card(card_deck *d) #define INVALID_ALLOT_MARKER 0xff -cell allot_markers_offset; +extern cell allot_markers_offset; inline static card *addr_to_allot_marker(object *a) { From 875d98197bdd9c0789c5baf6fad98f68768969e5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 16:46:57 -0500 Subject: [PATCH 25/28] images.viewer: now accepts image objects --- extra/images/viewer/viewer.factor | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor index 2818c16f9f..b891142d5b 100644 --- a/extra/images/viewer/viewer.factor +++ b/extra/images/viewer/viewer.factor @@ -5,23 +5,28 @@ opengl opengl.gl opengl.textures sequences strings ui ui.gadgets ui.gadgets.panes ui.render ui.images ; IN: images.viewer -TUPLE: image-gadget < gadget image-name ; +TUPLE: image-gadget < gadget image texture ; -M: image-gadget pref-dim* - image-name>> image-dim ; +M: image-gadget pref-dim* image>> dim>> ; + +: image-gadget-texture ( gadget -- texture ) + dup texture>> [ ] [ dup image>> { 0 0 } >>texture texture>> ] ?if ; M: image-gadget draw-gadget* ( gadget -- ) - image-name>> draw-image ; + [ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture ; -: ( image-name -- gadget ) +! Todo: delete texture on ungraft + +GENERIC: ( object -- gadget ) + +M: image \ image-gadget new - swap >>image-name ; + swap >>image ; -: image-window ( path -- gadget ) - [ dup ] [ open-window ] bi ; +M: string load-image ; -GENERIC: image. ( object -- ) +M: pathname load-image ; -M: string image. ( image -- ) gadget. ; +: image-window ( object -- ) "Image" open-window ; -M: pathname image. ( image -- ) gadget. ; +: image. ( object -- ) gadget. ; From a4d80eb27bfa8d9192fe66f1a85c7b3378c849c1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 17:35:06 -0500 Subject: [PATCH 26/28] tools.disassembler.udis: fix unix tests --- basis/tools/disassembler/udis/udis-tests.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/tools/disassembler/udis/udis-tests.factor b/basis/tools/disassembler/udis/udis-tests.factor index db100a4f31..9ad3dbbcc2 100644 --- a/basis/tools/disassembler/udis/udis-tests.factor +++ b/basis/tools/disassembler/udis/udis-tests.factor @@ -5,4 +5,5 @@ USING: tools.disassembler.udis tools.test alien.c-types system combinators kerne { [ os linux? cpu x86.64? and ] [ [ 656 ] [ "ud" heap-size ] unit-test ] } { [ os macosx? cpu x86.32? and ] [ [ 592 ] [ "ud" heap-size ] unit-test ] } { [ os macosx? cpu x86.64? and ] [ [ 656 ] [ "ud" heap-size ] unit-test ] } + [ ] } cond \ No newline at end of file From 4ee581584364e08ae1532e10e7872e887d36eea0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 18:34:52 -0500 Subject: [PATCH 27/28] math.polynomials: use instead of --- basis/math/polynomials/polynomials.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index 749bde3a10..ec09b366a1 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -16,7 +16,7 @@ IN: math.polynomials PRIVATE> : powers ( n x -- seq ) - 1 [ * ] accumulate nip ; + 1 [ * ] accumulate nip ; : p= ( p q -- ? ) pextend = ; From 58d0e17936036aeb74962775dc33bc23d3749abd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 18:37:40 -0500 Subject: [PATCH 28/28] Fix bool type; its actually 1 byte not 4 in structs. Bug reported by jedahu --- basis/alien/c-types/c-types.factor | 8 ++++---- basis/compiler/tests/alien.factor | 13 +++++++++++++ vm/ffi_test.c | 5 +++++ vm/ffi_test.h | 10 ++++++++++ 4 files changed, 32 insertions(+), 4 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 9cd57f61ab..6067c90f2d 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -409,10 +409,10 @@ CONSTANT: primitive-types "uchar" define-primitive-type - [ alien-unsigned-4 zero? not ] >>getter - [ [ 1 0 ? ] 2dip set-alien-unsigned-4 ] >>setter - 4 >>size - 4 >>align + [ alien-unsigned-1 zero? not ] >>getter + [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter + 1 >>size + 1 >>align "box_boolean" >>boxer "to_boolean" >>unboxer "bool" define-primitive-type diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 42ed90d64a..f7f24433d7 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -588,3 +588,16 @@ FUNCTION: complex-float ffi_test_47 ( complex-float x, complex-double y ) ; C{ 1.0 2.0 } C{ 1.5 1.0 } ffi_test_47 ] unit-test + +! Reported by jedahu +C-STRUCT: bool-field-test + { "char*" "name" } + { "bool" "on" } + { "short" "parents" } ; + +FUNCTION: short ffi_test_48 ( bool-field-test x ) ; + +[ 123 ] [ + "bool-field-test" 123 over set-bool-field-test-parents + ffi_test_48 +] unit-test \ No newline at end of file diff --git a/vm/ffi_test.c b/vm/ffi_test.c index 680b144140..d45ceb4514 100755 --- a/vm/ffi_test.c +++ b/vm/ffi_test.c @@ -319,3 +319,8 @@ _Complex float ffi_test_47(_Complex float x, _Complex double y) { return x + 2 * y; } + +short ffi_test_48(struct bool_field_test x) +{ + return x.parents; +} diff --git a/vm/ffi_test.h b/vm/ffi_test.h index 835f9e942f..af0c0b46a4 100755 --- a/vm/ffi_test.h +++ b/vm/ffi_test.h @@ -1,3 +1,5 @@ +#include + #if defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32) #define F_STDCALL __attribute__((stdcall)) #else @@ -102,3 +104,11 @@ F_EXPORT _Complex float ffi_test_45(int x); F_EXPORT _Complex double ffi_test_46(int x); F_EXPORT _Complex float ffi_test_47(_Complex float x, _Complex double y); + +struct bool_field_test { + char *name; + bool on; + short parents; +}; + +F_EXPORT short ffi_test_48(struct bool_field_test x);