Ignore:
Timestamp:
Mar 21, 2008, 5:38:34 AM (13 years ago)
Author:
gb
Message:

Conditionalize some TIME/GET-INTERNAL-RUN-TIME stuff for win64.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/win64/lib/misc.lisp

    r8728 r8837  
    370370;;
    371371
     372
     373(defun %page-fault-info ()
     374  #-(or darwin-target windows-target)
     375  (rlet ((usage :rusage))
     376    (%%rusage usage)
     377    (values (pref usage :rusage.ru_minflt)
     378            (pref usage :rusage.ru_majflt)
     379            (pref usage :rusage.ru_nswap)))
     380  #+darwin-target
     381  (rlet ((count #>mach_msg_type_number_t #$TASK_EVENTS_INFO_COUNT)
     382         (info #>task_events_info))
     383    (#_task_info (#_mach_task_self) #$TASK_EVENTS_INFO info count)
     384    (values (pref info #>task_events_info.cow_faults)
     385            (pref info #>task_events_info.faults)
     386            (pref info #>task_events_info.pageins)))
     387  #+windows-target
     388  ;; Um, don't know how to determine this, or anything like it.
     389  (values 0 0 0))
     390
     391
     392         
    372393(defparameter *report-time-function* nil
    373394  "If non-NULL, should be a function which accepts the following
     
    423444             0
    424445             (* (logand (+ 2 (uvsize i)) (lognot 1)) 4))))
    425     (rlet ((start :rusage)
    426            (stop :rusage)
    427            (timediff :timeval))
    428       (let* ((initial-real-time (get-internal-real-time))
    429              (initial-gc-time (gctime))
    430              (initial-consed (total-bytes-allocated))           
    431              (initial-overhead (integer-size-in-bytes initial-consed)))
    432         (%%rusage start)
    433         (let* ((results (multiple-value-list (funcall thunk))))
    434           (declare (dynamic-extent results))
    435           (%%rusage stop)         
    436           (let* ((new-consed (total-bytes-allocated))               
    437                  (bytes-consed
    438                   (- new-consed (+ initial-overhead initial-consed)))
    439                  (elapsed-real-time
    440                   (- (get-internal-real-time) initial-real-time))
    441                  (elapsed-gc-time (- (gctime) initial-gc-time))
    442                  (elapsed-user-time
    443                   (progn
    444                     (%sub-timevals timediff
    445                                    (pref stop :rusage.ru_utime)
    446                                    (pref start :rusage.ru_utime))
    447                     (ecase internal-time-units-per-second
    448                       (1000000 (timeval->microseconds timediff))
    449                       (1000 (timeval->milliseconds timediff)))))
    450                  (elapsed-system-time
    451                   (progn
    452                     (%sub-timevals timediff
    453                                    (pref stop :rusage.ru_stime)
    454                                    (pref start :rusage.ru_stime))
    455                     (ecase internal-time-units-per-second
    456                       (1000000 (timeval->microseconds timediff))
    457                       (1000 (timeval->milliseconds timediff)))))
    458                  (elapsed-minor (- (pref stop :rusage.ru_minflt)
    459                                    (pref start :rusage.ru_minflt)))
    460                  (elapsed-major (- (pref stop :rusage.ru_majflt)
    461                                    (pref start :rusage.ru_majflt)))
    462                  (elapsed-swaps (- (pref stop :rusage.ru_nswap)
    463                                    (pref start :rusage.ru_nswap))))
    464             (funcall (or *report-time-function*
    465                          #'standard-report-time)
    466                      :form form
    467                      :results results
    468                      :elapsed-time elapsed-real-time
    469                      :user-time elapsed-user-time
    470                      :system-time elapsed-system-time
    471                      :gc-time elapsed-gc-time
    472                      :bytes-allocated bytes-consed
    473                      :minor-page-faults elapsed-minor
    474                      :major-page-faults elapsed-major
    475                      :swaps elapsed-swaps)))))))
     446    (multiple-value-bind (user-start system-start)
     447        (%internal-run-time)
     448      (multiple-value-bind (minor-start major-start swaps-start)
     449          (%page-fault-info)
     450        (let* ((initial-real-time (get-internal-real-time))
     451               (initial-gc-time (gctime))
     452               (initial-consed (total-bytes-allocated))           
     453               (initial-overhead (integer-size-in-bytes initial-consed)))
     454          (let* ((results (multiple-value-list (funcall thunk))))
     455            (declare (dynamic-extent results))
     456            (multiple-value-bind (user-end system-end)
     457                (%internal-run-time)
     458              (multiple-value-bind (minor-end major-end swaps-end)
     459                  (%page-fault-info)
     460                (let* ((new-consed (total-bytes-allocated))                 
     461                       (bytes-consed
     462                        (- new-consed (+ initial-overhead initial-consed)))
     463                       (elapsed-real-time
     464                        (- (get-internal-real-time) initial-real-time))
     465                       (elapsed-gc-time (- (gctime) initial-gc-time))
     466                       (elapsed-user-time
     467                        (- user-end user-start))
     468                       (elapsed-system-time
     469                        (- system-end system-start))
     470                       (elapsed-minor (- minor-end minor-start))
     471                       (elapsed-major (- major-end major-start))
     472                       (elapsed-swaps (- swaps-end swaps-start)))
     473                  (funcall (or *report-time-function*
     474                               #'standard-report-time)
     475                           :form form
     476                           :results results
     477                           :elapsed-time elapsed-real-time
     478                           :user-time elapsed-user-time
     479                           :system-time elapsed-system-time
     480                           :gc-time elapsed-gc-time
     481                           :bytes-allocated bytes-consed
     482                           :minor-page-faults elapsed-minor
     483                           :major-page-faults elapsed-major
     484                           :swaps elapsed-swaps))))))))))
    476485
    477486
Note: See TracChangeset for help on using the changeset viewer.