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

core/assocs/assocs.factor

@@ -155,6 +155,9 @@ M: assoc >alist [ 2array ] { } assoc>map ;
 : value-at ( value assoc -- key/f )
     swap [ = nip ] curry assoc-find 2drop ;
 
+: zip ( keys values -- alist )
+    2array flip ; inline
+
 : search-alist ( key alist -- pair i )
     [ first = ] with find swap ; inline
 
@@ -204,7 +207,7 @@ M: enum set-at seq>> set-nth ;
 M: enum delete-at enum-seq delete-nth ;
 
 M: enum >alist ( enum -- alist )
-    seq>> [ length ] keep 2array flip ;
+    seq>> [ length ] keep zip ;
 
 M: enum assoc-size seq>> length ;
 

core/cpu/ppc/architecture/architecture.factor

@@ -146,7 +146,7 @@ M: int-regs %save-param-reg drop 1 rot local@ STW ;
 
 M: int-regs %load-param-reg drop 1 rot local@ LWZ ;
 
-GENERIC: STF ( src dst reg-class -- )
+GENERIC: STF ( src dst off reg-class -- )
 
 M: single-float-regs STF drop STFS ;
 
@@ -154,7 +154,7 @@ M: double-float-regs STF drop STFD ;
 
 M: float-regs %save-param-reg >r 1 rot local@ r> STF ;
 
-GENERIC: LF ( src dst reg-class -- )
+GENERIC: LF ( dst src off reg-class -- )
 
 M: single-float-regs LF drop LFS ;
 

core/generator/registers/registers.factor

@@ -322,7 +322,7 @@ M: phantom-retainstack finalize-height
 
 : (live-locs) ( phantom -- seq )
     #! Discard locs which haven't moved
-    [ phantom-locs* ] [ stack>> ] bi 2array flip
+    [ phantom-locs* ] [ stack>> ] bi zip
     [ live-loc? ] assoc-subset
     values ;
 
@@ -421,7 +421,7 @@ M: loc lazy-store
 
 : slow-shuffle-mapping ( locs tmp -- pairs )
     >r dup length r>
-    [ swap - <ds-loc> ] curry map 2array flip ;
+    [ swap - <ds-loc> ] curry map zip ;
 
 : slow-shuffle ( locs -- )
     #! We don't have enough free registers to load all shuffle

core/inference/known-words/known-words.factor

@@ -373,7 +373,7 @@ set-primitive-effect
 \ data-room { } { integer array } <effect> set-primitive-effect
 \ data-room make-flushable
 
-\ code-room { } { integer integer } <effect> set-primitive-effect
+\ code-room { } { integer integer integer integer } <effect> set-primitive-effect
 \ code-room  make-flushable
 
 \ os-env { string } { object } <effect> set-primitive-effect

core/mirrors/mirrors.factor

@@ -42,7 +42,7 @@ M: mirror delete-at ( key mirror -- )
 M: mirror >alist ( mirror -- alist )
     >mirror<
     [ [ slot-spec-offset slot ] with map ] keep
-    [ slot-spec-name ] map swap 2array flip ;
+    [ slot-spec-name ] map swap zip ;
 
 M: mirror assoc-size mirror-slots length ;
 

vm/code_gc.c

@@ -198,20 +198,33 @@ void free_unmarked(F_HEAP *heap)
 	build_free_list(heap,heap->segment->size);
 }
 
-/* Compute total sum of sizes of free blocks */
-CELL heap_usage(F_HEAP *heap, F_BLOCK_STATUS status)
+/* Compute total sum of sizes of free blocks, and size of largest free block */
+void heap_usage(F_HEAP *heap, CELL *used, CELL *total_free, CELL *max_free)
 {
-	CELL size = 0;
+	*used = 0;
+	*total_free = 0;
+	*max_free = 0;
+
 	F_BLOCK *scan = first_block(heap);
 
 	while(scan)
 	{
-		if(scan->status == status)
-			size += scan->size;
+		switch(scan->status)
+		{
+		case B_ALLOCATED:
+			*used += scan->size;
+			break;
+		case B_FREE:
+			*total_free += scan->size;
+			if(scan->size > *max_free)
+				*max_free = scan->size;
+			break;
+		default:
+			critical_error("Invalid scan->status",(CELL)scan);
+		}
+
 		scan = next_block(heap,scan);
 	}
-
-	return size;
 }
 
 /* The size of the heap, not including the last block if it's free */
@@ -283,8 +296,12 @@ void recursive_mark(F_BLOCK *block)
 /* Push the free space and total size of the code heap */
 DEFINE_PRIMITIVE(code_room)
 {
-	dpush(tag_fixnum(heap_usage(&code_heap,B_FREE) / 1024));
+	CELL used, total_free, max_free;
+	heap_usage(&code_heap,&used,&total_free,&max_free);
 	dpush(tag_fixnum((code_heap.segment->size) / 1024));
+	dpush(tag_fixnum(used / 1024));
+	dpush(tag_fixnum(total_free / 1024));
+	dpush(tag_fixnum(max_free / 1024));
 }
 
 /* Dump all code blocks for debugging */

vm/code_gc.h

@@ -32,7 +32,7 @@ void build_free_list(F_HEAP *heap, CELL size);
 CELL heap_allot(F_HEAP *heap, CELL size);
 void unmark_marked(F_HEAP *heap);
 void free_unmarked(F_HEAP *heap);
-CELL heap_usage(F_HEAP *heap, F_BLOCK_STATUS status);
+void heap_usage(F_HEAP *heap, CELL *used, CELL *total_free, CELL *max_free);
 CELL heap_size(F_HEAP *heap);
 
 INLINE F_BLOCK *next_block(F_HEAP *heap, F_BLOCK *block)

vm/code_heap.c

@@ -229,7 +229,16 @@ CELL allot_code_block(CELL size)
 
 		/* Insufficient room even after code GC, give up */
 		if(start == 0)
+		{
+			CELL used, total_free, max_free;
+			heap_usage(&code_heap,&used,&total_free,&max_free);
+
+			fprintf(stderr,"Code heap stats:\n");
+			fprintf(stderr,"Used: %ld\n",used);
+			fprintf(stderr,"Total free space: %ld\n",total_free);
+			fprintf(stderr,"Largest free block: %ld\n",max_free);
 			fatal_error("Out of memory in add-compiled-block",0);
+		}
 	}
 
 	return start;