diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt index 4c5aa78..98ffd82 100644 Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ diff --git a/scheme/ikarus.timer.ss b/scheme/ikarus.timer.ss index 788030c..31b1276 100644 --- a/scheme/ikarus.timer.ss +++ b/scheme/ikarus.timer.ss @@ -26,17 +26,18 @@ gc-user-secs gc-user-usecs gc-sys-secs gc-sys-usecs gc-real-secs gc-real-usecs + bytes-minor bytes-major )) (define (mk-stats) - (make-stats #f #f #f #f #f #f #f #f #f #f #f #f #f)) + (make-stats #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f)) (define verbose-timer (make-parameter #f)) (define (set-stats! t) (foreign-call "ikrt_stats_now" t)) - (define (print-stats message bytes t1 t0) + (define (print-stats message t1 t0) (define (print-time msg msecs gc-msecs) (fprintf (console-error-port) @@ -78,7 +79,12 @@ (stats-sys-usecs t1) (stats-sys-usecs t0)) (msecs (stats-gc-sys-secs t1) (stats-gc-sys-secs t0) (stats-gc-sys-usecs t1) (stats-gc-sys-usecs t0)))) - (fprintf (console-error-port) " ~a bytes allocated\n" bytes)) + (fprintf (console-error-port) " ~a bytes allocated\n" + (diff-bytes + (stats-bytes-minor t0) + (stats-bytes-major t0) + (stats-bytes-minor t1) + (stats-bytes-major t1)))) (define time-it (case-lambda @@ -88,31 +94,20 @@ (unless (procedure? proc) (die 'time-it "not a procedure" proc)) (let* ([t0 (mk-stats)] - [t1 (mk-stats)] - [bytes-min (bytes-minor)] - [bytes-maj (bytes-major)]) - (set-stats! t0) - (call-with-values proc + [t1 (mk-stats)]) + (define k (case-lambda [(v) (set-stats! t1) - (print-stats message - (diff-bytes bytes-min bytes-maj - (bytes-minor) (bytes-major)) - t1 t0) + (print-stats message t1 t0) v] [v* (set-stats! t1) - (print-stats message - (diff-bytes bytes-min bytes-maj - (bytes-minor) (bytes-major)) - t1 t0) - (apply values v*)])))])) - - (define (bytes-minor) - (foreign-call "ikrt_bytes_allocated")) - (define (bytes-major) - (foreign-call "ikrt_bytes_allocated_major")) + (print-stats message t1 t0) + (apply values v*)])) + (set-stats! t0) + (call-with-values proc k))])) + (define (diff-bytes mnr0 mjr0 mnr1 mjr1) (+ (fx- mnr1 mnr0) (* (fx- mjr1 mjr0) #x10000000))) diff --git a/scheme/last-revision b/scheme/last-revision index 85ce150..8735ed1 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1332 +1333 diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c index 6abc22b..6a84ebf 100644 --- a/src/ikarus-runtime.c +++ b/src/ikarus-runtime.c @@ -839,6 +839,15 @@ ikrt_stats_now(ikptr t, ikpcb* pcb){ ref(t, off_record_data + 10 * wordsize) = fix(pcb->collect_stime.tv_usec); ref(t, off_record_data + 11 * wordsize) = fix(pcb->collect_rtime.tv_sec); ref(t, off_record_data + 12 * wordsize) = fix(pcb->collect_rtime.tv_usec); + { + /* minor bytes */ + long int bytes_in_heap = ((long int) pcb->allocation_pointer) - + ((long int) pcb->heap_base); + long int bytes = bytes_in_heap + pcb->allocation_count_minor; + ref(t, off_record_data + 13 * wordsize) = fix(bytes); + } + /* major bytes */ + ref(t, off_record_data + 14 * wordsize) = fix(pcb->allocation_count_major); return void_object; } @@ -868,24 +877,6 @@ ikrt_gmt_offset(ikptr t){ */ } - - - -ikptr -ikrt_bytes_allocated(ikpcb* pcb){ - int bytes_in_heap = ((long int) pcb->allocation_pointer) - - ((long int) pcb->heap_base); - int bytes = bytes_in_heap + pcb->allocation_count_minor; - return fix(bytes); -} - - -ikptr -ikrt_bytes_allocated_major(ikpcb* pcb){ - return fix(pcb->allocation_count_major); -} - - ikptr ikrt_fork(){ int pid = fork();