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/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 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 } 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 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 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.cpp b/vm/os-windows-nt.cpp index 796834a9c4..60aad336f7 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; @@ -36,10 +37,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 +53,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); } 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; 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 31f013eae4..c32070482b 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();