* Fixed a bug in the GC that caused performance to degrade when
ik_alloc extends the heap (by 128KB) and the heap size remains set to that value (causing more frequent GCs than usual). Now, after ik_collect, if the heapsize is less than 4MB, it's extended to 4MB (minimum).
This commit is contained in:
parent
a2ed662821
commit
82a00e2628
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -376,7 +376,6 @@ ik_collect(int mem_req, ikpcb* pcb){
|
||||||
add_to_collect_count(pcb, bytes);
|
add_to_collect_count(pcb, bytes);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
struct rusage t0, t1;
|
struct rusage t0, t1;
|
||||||
struct timeval rt0, rt1;
|
struct timeval rt0, rt1;
|
||||||
gettimeofday(&rt0, 0);
|
gettimeofday(&rt0, 0);
|
||||||
|
@ -496,11 +495,13 @@ ik_collect(int mem_req, ikpcb* pcb){
|
||||||
int free_space =
|
int free_space =
|
||||||
((unsigned int)pcb->allocation_redline) -
|
((unsigned int)pcb->allocation_redline) -
|
||||||
((unsigned int)pcb->allocation_pointer);
|
((unsigned int)pcb->allocation_pointer);
|
||||||
if(free_space <= mem_req){
|
#define HEAPSIZE (1024 * 4096)
|
||||||
|
if((free_space <= mem_req) || (pcb->heap_size < HEAPSIZE)){
|
||||||
#ifndef NDEBUG
|
#ifndef NDEBUG
|
||||||
fprintf(stderr, "REQ=%d, got %d\n", mem_req, free_space);
|
fprintf(stderr, "REQ=%d, got %d\n", mem_req, free_space);
|
||||||
#endif
|
#endif
|
||||||
int memsize = align_to_next_page(mem_req);
|
int memsize = (mem_req>HEAPSIZE) ? mem_req : HEAPSIZE;
|
||||||
|
memsize = align_to_next_page(memsize);
|
||||||
ik_munmap_from_segment(
|
ik_munmap_from_segment(
|
||||||
pcb->heap_base,
|
pcb->heap_base,
|
||||||
pcb->heap_size,
|
pcb->heap_size,
|
||||||
|
|
|
@ -457,7 +457,6 @@ char* ik_uuid(char* str){
|
||||||
static const char* uuid_chars =
|
static const char* uuid_chars =
|
||||||
"!$%&/0123456789<=>?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
|
"!$%&/0123456789<=>?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
|
||||||
static int uuid_strlen = 1;
|
static int uuid_strlen = 1;
|
||||||
|
|
||||||
ikp ik_uuid(ikp str){
|
ikp ik_uuid(ikp str){
|
||||||
static int fd = -1;
|
static int fd = -1;
|
||||||
if(fd == -1){
|
if(fd == -1){
|
||||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -250,7 +250,9 @@
|
||||||
(error 'fxarithmetic-shift "~s is not a fixnum" y))
|
(error 'fxarithmetic-shift "~s is not a fixnum" y))
|
||||||
(if ($fx>= y 0)
|
(if ($fx>= y 0)
|
||||||
($fxsll x y)
|
($fxsll x y)
|
||||||
($fxsra x ($fx- 0 y)))))
|
(if ($fx< x -100) ;;; arbitrary number < (fixnum-width)
|
||||||
|
($fxsra x 32)
|
||||||
|
($fxsra x ($fx- 0 y))))))
|
||||||
|
|
||||||
(define (fxpositive? x)
|
(define (fxpositive? x)
|
||||||
(if (fixnum? x)
|
(if (fixnum? x)
|
||||||
|
|
|
@ -1,13 +1,15 @@
|
||||||
|
|
||||||
(library (ikarus singular-objects)
|
(library (ikarus singular-objects)
|
||||||
(export base-rtd eof-object void)
|
(export base-rtd eof-object void #;fixnum-width)
|
||||||
(import
|
(import
|
||||||
(rename (ikarus system $records) (base-rtd sys:base-rtd))
|
(rename (ikarus system $records) (base-rtd sys:base-rtd))
|
||||||
(rename (ikarus)
|
(rename (ikarus)
|
||||||
(void sys:void)
|
(void sys:void)
|
||||||
|
#; (fixnum-width sys:fixnum-width)
|
||||||
(eof-object sys:eof-object)))
|
(eof-object sys:eof-object)))
|
||||||
|
|
||||||
(define (void) (sys:void))
|
(define (void) (sys:void))
|
||||||
|
#; (define (fixnum-width) (sys:fixnum-width))
|
||||||
(define (eof-object) (sys:eof-object))
|
(define (eof-object) (sys:eof-object))
|
||||||
(define (base-rtd) (sys:base-rtd)))
|
(define (base-rtd) (sys:base-rtd)))
|
||||||
|
|
||||||
|
|
|
@ -459,6 +459,7 @@
|
||||||
[fxarithmetic-shift i]
|
[fxarithmetic-shift i]
|
||||||
[fxmin i]
|
[fxmin i]
|
||||||
[fxmax i]
|
[fxmax i]
|
||||||
|
[fixnum-width i]
|
||||||
|
|
||||||
[for-each i r]
|
[for-each i r]
|
||||||
[map i r]
|
[map i r]
|
||||||
|
|
|
@ -545,6 +545,15 @@
|
||||||
[(P x) (tag-test (T x) fixnum-mask fixnum-tag)]
|
[(P x) (tag-test (T x) fixnum-mask fixnum-tag)]
|
||||||
[(E x) (nop)])
|
[(E x) (nop)])
|
||||||
|
|
||||||
|
;(define-primop foo safe
|
||||||
|
; [(V) (K 0)])
|
||||||
|
|
||||||
|
;(define-primop fixnum-width safe
|
||||||
|
; [(V) (K 0)] ;(K (fxsll (- (* wordsize 8) fx-shift) fx-shift))]
|
||||||
|
; ;[(E) (nop)]
|
||||||
|
; ;[(P) (K #t)]
|
||||||
|
; )
|
||||||
|
|
||||||
(define-primop $fxzero? unsafe
|
(define-primop $fxzero? unsafe
|
||||||
[(P x) (prm '= (T x) (K 0))]
|
[(P x) (prm '= (T x) (K 0))]
|
||||||
[(E x) (nop)])
|
[(E x) (nop)])
|
||||||
|
|
|
@ -18,7 +18,6 @@
|
||||||
(define fixnum-mask 3))
|
(define fixnum-mask 3))
|
||||||
|
|
||||||
(module primops (primop? get-primop set-primop!)
|
(module primops (primop? get-primop set-primop!)
|
||||||
|
|
||||||
(define cookie (gensym))
|
(define cookie (gensym))
|
||||||
(define (primop? x)
|
(define (primop? x)
|
||||||
(and (getprop x cookie) #t))
|
(and (getprop x cookie) #t))
|
||||||
|
|
Loading…
Reference in New Issue