diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 6b6bd3d51a..adb69d317c 100755 --- a/core/assocs/assocs.factor +++ b/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 ; diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index bd5273efcb..09ffead029 100755 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/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 ; diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor index b5b3f0b2c0..f3dc0fb10e 100755 --- a/core/generator/registers/registers.factor +++ b/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 - ] curry map 2array flip ; + [ swap - ] curry map zip ; : slow-shuffle ( locs -- ) #! We don't have enough free registers to load all shuffle diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 8f505c21a1..33a5da87f4 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -373,7 +373,7 @@ set-primitive-effect \ data-room { } { integer array } set-primitive-effect \ data-room make-flushable -\ code-room { } { integer integer } set-primitive-effect +\ code-room { } { integer integer integer integer } set-primitive-effect \ code-room make-flushable \ os-env { string } { object } set-primitive-effect diff --git a/core/mirrors/mirrors.factor b/core/mirrors/mirrors.factor index a13e1331fa..61cdbdad24 100755 --- a/core/mirrors/mirrors.factor +++ b/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 ; diff --git a/vm/code_gc.c b/vm/code_gc.c index 93eb49c1be..141f4abbfe 100755 --- a/vm/code_gc.c +++ b/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 */ diff --git a/vm/code_gc.h b/vm/code_gc.h index 32f304c16c..658dc990ae 100644 --- a/vm/code_gc.h +++ b/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) diff --git a/vm/code_heap.c b/vm/code_heap.c index ec63441bcb..92915e49d1 100755 --- a/vm/code_heap.c +++ b/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;