Merge branch 'master' of git://factorcode.org/git/factor

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
 
 : <input-port> ( handle -- input-port )
     input-port <buffered-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

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
 
 <PRIVATE
@@ -49,3 +50,16 @@ PRIVATE>
         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

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 }

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

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

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

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<code_block>(size,seg->start);

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);
 }
 

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;
 

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()

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();
 }

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();