From ae9bca2b1edc3de107b57f1b1a842e942f569d50 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 12 Dec 2009 23:39:59 -0600 Subject: [PATCH 1/8] add MAIN: run-unix-factor to math.primes.factors --- basis/math/primes/factors/factors.factor | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/basis/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor index c71fa18ab2..7cdfd552a1 100644 --- a/basis/math/primes/factors/factors.factor +++ b/basis/math/primes/factors/factors.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: arrays combinators kernel make math math.functions -math.primes math.ranges sequences sequences.product sorting ; +math.primes math.ranges sequences sequences.product sorting +io math.parser ; IN: math.primes.factors group-factors [ first2 [0,b] [ ^ ] with map ] map [ product ] product-map natural-sort ] if ; + +: unix-factor ( string -- ) + dup string>number [ + [ ": " append write ] + [ factors [ number>string ] map " " join print ] bi* + ] [ + "factor: `" "' is not a valid positive integer" surround print + ] if* ; + +: run-unix-factor ( -- ) + [ readln [ unix-factor t ] [ f ] if* ] loop ; + +MAIN: run-unix-factor From 9fea67f3ffe876b00f0e08b7957f8942027fba12 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Dec 2009 02:03:06 -0600 Subject: [PATCH 2/8] triyng to rice crc32 a bit --- basis/io/ports/ports.factor | 4 ++-- core/checksums/crc32/crc32.factor | 4 ++-- core/io/io.factor | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 3ea4c105f5..727d69adf8 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -27,7 +27,7 @@ TUPLE: buffered-port < port { buffer buffer } ; TUPLE: input-port < buffered-port ; -M: input-port stream-element-type drop +byte+ ; +M: input-port stream-element-type drop +byte+ ; inline : ( handle -- input-port ) input-port ; @@ -104,7 +104,7 @@ TUPLE: output-port < buffered-port ; [ nip ] [ buffer>> buffer-capacity <= ] 2bi [ drop ] [ stream-flush ] if ; inline -M: output-port stream-element-type stream>> stream-element-type ; +M: output-port stream-element-type stream>> stream-element-type ; inline M: output-port stream-write1 dup check-disposed diff --git a/core/checksums/crc32/crc32.factor b/core/checksums/crc32/crc32.factor index 209de83763..e937cf5910 100644 --- a/core/checksums/crc32/crc32.factor +++ b/core/checksums/crc32/crc32.factor @@ -33,9 +33,9 @@ INSTANCE: crc32 checksum M: crc32 checksum-bytes init-crc32 [ (crc32) ] each - finish-crc32 ; + finish-crc32 ; inline M: crc32 checksum-lines init-crc32 [ [ (crc32) ] each CHAR: \n (crc32) ] each - finish-crc32 ; + finish-crc32 ; inline diff --git a/core/io/io.factor b/core/io/io.factor index ca36bc3b36..c134ba2108 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -99,7 +99,7 @@ SYMBOL: error-stream } case ; inline : stream-element-exemplar ( stream -- exemplar ) - stream-element-type (stream-element-exemplar) ; + stream-element-type (stream-element-exemplar) ; inline : element-exemplar ( -- exemplar ) input-stream get stream-element-exemplar ; inline From 564934a9f1c1b30d266c29d25bb740b36fbaf62a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 13 Dec 2009 16:10:30 -0600 Subject: [PATCH 3/8] fix compiler warning on linux --- vm/code_blocks.hpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/code_blocks.hpp b/vm/code_blocks.hpp index 8aa8b5693f..075fe389b4 100644 --- a/vm/code_blocks.hpp +++ b/vm/code_blocks.hpp @@ -11,7 +11,7 @@ struct code_block bool free_p() const { - return header & 1 == 1; + return (header & 1) == 1; } code_block_type type() const From 7c583dd66f84bc8214bb9263421da247d1ce631d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 13 Dec 2009 16:52:36 -0600 Subject: [PATCH 4/8] windows.dinput.constants: use C type symbols rather than strings --- basis/windows/dinput/constants/constants.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) mode change 100644 => 100755 basis/windows/dinput/constants/constants.factor diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor old mode 100644 new mode 100755 index 4e97cb0e01..7e4ad39945 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -102,8 +102,8 @@ M: array array-base-type first ; : define-joystick-format-constant ( -- ) c_dfDIJoystick2 [ DIDF_ABSAXIS - "DIJOYSTATE2" heap-size - "DIJOYSTATE2" { + DIJOYSTATE2 heap-size + DIJOYSTATE2 { { GUID_XAxis_malloced "lX" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 } { GUID_YAxis_malloced "lY" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 } { GUID_ZAxis_malloced "lZ" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 } @@ -274,8 +274,8 @@ M: array array-base-type first ; : define-mouse-format-constant ( -- ) c_dfDIMouse2 [ DIDF_RELAXIS - "DIMOUSESTATE2" heap-size - "DIMOUSESTATE2" { + DIMOUSESTATE2 heap-size + DIMOUSESTATE2 { { GUID_XAxis_malloced "lX" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 } { GUID_YAxis_malloced "lY" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 } { GUID_ZAxis_malloced "lZ" 0 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_AXIS } 0 } From 62e7aed2d3c30ff6832e18845ae15b3b96fc8ea0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 13 Dec 2009 16:52:59 -0600 Subject: [PATCH 5/8] vm/os-windows-nt.cpp: fix formatting --- vm/os-windows-nt.cpp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp index 796834a9c4..69df5f666f 100755 --- a/vm/os-windows-nt.cpp +++ b/vm/os-windows-nt.cpp @@ -3,8 +3,9 @@ namespace factor { -THREADHANDLE start_thread(void *(*start_routine)(void *),void *args){ - return (void*) CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0); +THREADHANDLE start_thread(void *(*start_routine)(void *), void *args) +{ + return (void *)CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0); } DWORD dwTlsIndex; @@ -47,7 +48,7 @@ u64 nano_count() ret = QueryPerformanceFrequency(&frequency); if(ret == 0) fatal_error("QueryPerformanceFrequency", 0); - + return count.QuadPart*(1000000000/frequency.QuadPart); } From 1454e534fe160a6e17f9612ea880c0104409b524 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Dec 2009 20:00:02 -0600 Subject: [PATCH 6/8] fix a couple of warnings on win64 --- vm/code_heap.cpp | 2 +- vm/os-windows-nt.hpp | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index b7aa9185e8..9e64ff6552 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -5,7 +5,7 @@ namespace factor code_heap::code_heap(cell size) { - if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); + if(size > ((u64)1 << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); seg = new segment(align_page(size),true); if(!seg) fatal_error("Out of memory in heap allocator",size); allocator = new free_list_allocator(size,seg->start); diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp index 5b55ce1f2b..f8407aeee5 100755 --- a/vm/os-windows-nt.hpp +++ b/vm/os-windows-nt.hpp @@ -23,8 +23,13 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe); // SSE traps raise these exception codes, which are defined in internal NT headers // but not winbase.h +#ifndef STATUS_FLOAT_MULTIPLE_FAULTS #define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4 +#endif + +#ifndef STATUS_FLOAT_MULTIPLE_TRAPS #define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5 +#endif typedef HANDLE THREADHANDLE; From 0eccec21339e87008e6a94d5f1ddc67070d639dc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Dec 2009 20:42:51 -0600 Subject: [PATCH 7/8] workaround for QueryPerformanceCounter: if the high part of the count doesn't increment when the low part overflows, keep track of this and add the correction on future calls to nano_count --- vm/os-windows-nt.cpp | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp index 796834a9c4..7890ec5ff6 100755 --- a/vm/os-windows-nt.cpp +++ b/vm/os-windows-nt.cpp @@ -36,10 +36,15 @@ u64 system_micros() - EPOCH_OFFSET) / 10; } +/* On VirtualBox, QueryPerformanceCounter does not increment +the high part every time the low part overflows. Workaround. */ u64 nano_count() { LARGE_INTEGER count; LARGE_INTEGER frequency; + static u32 hi_correction = 0; + static u32 hi = 0xffffffff; + static u32 lo = 0xffffffff; BOOL ret; ret = QueryPerformanceCounter(&count); if(ret == 0) @@ -47,7 +52,14 @@ u64 nano_count() ret = QueryPerformanceFrequency(&frequency); if(ret == 0) fatal_error("QueryPerformanceFrequency", 0); - + + if((u32)count.LowPart < lo && (u32)count.HighPart == hi) + hi_correction++; + + hi = count.HighPart; + lo = count.LowPart; + count.HighPart += hi_correction; + return count.QuadPart*(1000000000/frequency.QuadPart); } From 0a3c5f5ac686d02b29a0b8bef1d89a76a01808e0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 14 Dec 2009 01:09:04 -0600 Subject: [PATCH 8/8] vm: fep out if monotonic counter decreases --- vm/run.cpp | 5 ++++- vm/vm.cpp | 3 ++- vm/vm.hpp | 4 ++++ 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/vm/run.cpp b/vm/run.cpp index 1bb2e0c44e..583d4f658b 100755 --- a/vm/run.cpp +++ b/vm/run.cpp @@ -15,7 +15,10 @@ void factor_vm::primitive_system_micros() void factor_vm::primitive_nano_count() { - box_unsigned_8(nano_count()); + u64 nanos = nano_count(); + if(nanos < last_nano_count) critical_error("Monotonic counter decreased",0); + last_nano_count = nanos; + box_unsigned_8(nanos); } void factor_vm::primitive_sleep() diff --git a/vm/vm.cpp b/vm/vm.cpp index 72c63292fd..d911b80227 100755 --- a/vm/vm.cpp +++ b/vm/vm.cpp @@ -10,7 +10,8 @@ factor_vm::factor_vm() : current_gc(NULL), gc_events(NULL), fep_disabled(false), - full_output(false) + full_output(false), + last_nano_count(0) { primitive_reset_dispatch_stats(); } diff --git a/vm/vm.hpp b/vm/vm.hpp index 2d78bae709..a3019bd054 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -87,6 +87,10 @@ struct factor_vm /* Incrementing object counter for identity hashing */ cell object_counter; + /* Sanity check to ensure that monotonic counter doesn't + decrease */ + u64 last_nano_count; + // contexts void reset_datastack(); void reset_retainstack();